|
sourcecode:
|
module CPM.PackageCache.Local
( cacheDir
, createLinkToGlobalCache
, linkPackages
, clearCache
, createLink
, doesLinkPointToGlobalCache
, packageDir
, isPackageInCache
, allPackages
) where
import Debug.Trace
import System.Directory ( createDirectoryIfMissing, copyFile
, getDirectoryContents, doesDirectoryExist
, doesFileExist )
import System.FilePath ( (</>) )
import Data.Either ( rights )
import Data.List ( isPrefixOf )
import Control.Monad
import System.IOExts ( readCompleteFile )
import CPM.Config ( Config, packageInstallDir )
import CPM.ErrorLogger
import CPM.FileUtil ( createSymlink, getRealPath, isSymlink, linkTarget
, removeSymlink )
import CPM.Package ( Package, packageId, packageSpecFile, readPackageSpec )
import CPM.PackageCache.Global ( installedPackageDir )
--- The cache directory of the local package cache.
---
--- @param dir the package directory
cacheDir :: String -> String
cacheDir pkgDir = pkgDir </> ".cpm" </> "package_cache"
--- Reads all packages specifications from the local package cache.
---
--- @param dir the package directory
allPackages :: String -> ErrorLogger [Package]
allPackages pkgDir = do
cacheExists <- liftIOEL $ doesDirectoryExist cdir
if cacheExists
then do
logDebug $ "Reading local package cache from '" ++ cdir ++ "'..."
cdircont <- liftIOEL $ getDirectoryContents cdir
let pkgDirs = filter (not . isPrefixOf ".") cdircont
pkgPaths <- liftIOEL $ mapM removeIfIllegalSymLink $ map (cdir </>) pkgDirs
let specPaths = map (</> packageSpecFile) $ concat pkgPaths
specs <- liftIOEL $ mapM (readPackageSpecIO . readCompleteFile) specPaths
return $ rights specs
else return []
where
readPackageSpecIO = fmap readPackageSpec
cdir = cacheDir pkgDir
removeIfIllegalSymLink target = do
dirExists <- doesDirectoryExist target
fileExists <- doesFileExist target
isLink <- isSymlink target
if isLink && (dirExists || fileExists)
then return [target]
else when isLink (removeSymlink target >> return ()) >> return []
--- Creates a link to a package from the global cache in the local cache. Does
--- not overwrite existing links.
---
--- @param cfg the current configuration
--- @param dir the package directory
--- @param gc the global package cache
--- @param pkg the package to copy
createLinkToGlobalCache :: Config -> String -> Package -> ErrorLogger ()
createLinkToGlobalCache cfg pkgDir pkg =
createLink pkgDir (installedPackageDir cfg pkg) (packageId pkg) False
--- Links a list of packages from the global cache into the local cache. Does
--- not overwrite existing links.
---
--- @param cfg the current configuration
--- @param dir the package directory
--- @param gc the global package cache
--- @param pkgs the list of packages
linkPackages :: Config -> String -> [Package]
-> ErrorLogger ()
linkPackages cfg pkgDir pkgs =
mapM (createLinkToGlobalCache cfg pkgDir) pkgs >> return ()
--- Tests whether a link in the local package cache points to a package in the
--- global package cache.
---
--- @param cfg the current configuration
--- @param gc the global package cache
--- @param dir the package directory
--- @param name the name of the link
doesLinkPointToGlobalCache :: Config -> String -> String -> IO Bool
doesLinkPointToGlobalCache cfg pkgDir name = do
target <- linkTarget link
return $ isPrefixOf (packageInstallDir cfg) target
where
link = (cacheDir pkgDir) </> name
--- Calculates the local package path of the given package
---
--- @param dir the package directory
--- @param pkg the package
packageDir :: String -> Package -> String
packageDir pkgDir pkg = (cacheDir pkgDir) </> (packageId pkg)
--- Checks whether a package is in the local cache.
---
--- @param dir the package directory
--- @param pkg the package
isPackageInCache :: String -> Package -> IO Bool
isPackageInCache pkgDir pkg = do
dirExists <- doesDirectoryExist packageDir'
fileExists <- doesFileExist packageDir'
return $ dirExists || fileExists
where
packageDir' = packageDir pkgDir pkg
--- Clear the local package cache.
---
--- @param dir the package directory
clearCache :: String -> ErrorLogger ()
clearCache pkgDir = do
cacheExists <- liftIOEL $ doesDirectoryExist cdir
if cacheExists
then do
pkgDirs <- liftIOEL $ getDirectoryContents cdir
mapM deleteIfLink (map (cdir </>) $ filter (not . isDotOrDotDot) pkgDirs)
return ()
else return ()
where
cdir = cacheDir pkgDir
ensureCacheDir :: String -> IO String
ensureCacheDir pkgDir = do
createDirectoryIfMissing True (cacheDir pkgDir)
return (cacheDir pkgDir)
deleteIfLink :: String -> ErrorLogger ()
deleteIfLink target = do
dirExists <- liftIOEL $ doesDirectoryExist target
fileExists <- liftIOEL $ doesFileExist target
isLink <- liftIOEL $ isSymlink target
if dirExists || fileExists
then
if isLink
then liftIOEL (removeSymlink target) >> return ()
else fail $ "deleteIfLink can only delete links!\n" ++
"Unexpected target: " ++ target
else
if isLink -- maybe it is a link to some non-existing target
then liftIOEL (removeSymlink target) >> return ()
else return ()
linkExists :: String -> IO Bool
linkExists target = do
dirExists <- doesDirectoryExist target
fileExists <- doesFileExist target
if dirExists || fileExists
then isSymlink target
else return False
isDotOrDotDot :: String -> Bool
isDotOrDotDot s = case s of
"." -> True
".." -> True
_ -> False
--- Create a link from a directory into the local package cache.
---
--- @param pkgDir the package directory
--- @param from the source directory to be linked into the local cache
--- @param name the name of the link in the package directory (should be a
--- package id)
--- @param replace replace existing link?
createLink :: String -> String -> String -> Bool -> ErrorLogger ()
createLink pkgDir from name replace = do
liftIOEL $ ensureCacheDir pkgDir
exists <- liftIOEL $ linkExists target
if exists && not replace
then return ()
else do
deleteIfLink target
fromabs <- liftIOEL $ getRealPath from
rc <- liftIOEL $ createSymlink fromabs target
if rc == 0
then return ()
else fail $ "Failed to create symlink from '" ++ from ++ "' to '" ++
target ++ "', return code " ++ show rc
where
target = cacheDir pkgDir </> name
|