Commit 66a860b7 authored by Michael Hanus 's avatar Michael Hanus
Browse files

CPM updated

parent 501a9137
......@@ -11,6 +11,7 @@ module CPM.FileUtil
, isSymlink
, linkTarget
, copyDirectoryFollowingSymlinks
, quote
, fileInPath
, tempDir
, inTempDir
......@@ -73,6 +74,8 @@ linkTarget link = do
then return $ replaceFileName link out
else return ""
--- Puts a file argument into quotes to avoid problems with files containing
--- blanks.
quote :: String -> String
quote s = "\"" ++ s ++ "\""
......
......@@ -76,23 +76,23 @@ runWithArgs opts = do
Left err -> do putStrLn $ "Error reading .cpmrc settings: " ++ err
exitWith 1
Right c' -> return c'
let getGC = getGlobalCache config
let getRepo = getRepository config
let getRepoGC = getRepository config >>= \repo ->
getGlobalCache config repo >>= \gc -> return (repo,gc)
setLogLevel $ optLogLevel opts
(msgs, result) <- case optCommand opts of
NoCommand -> failIO "NoCommand"
Update -> updateRepository config
Compiler o -> compiler o config getRepo getGC
Exec o -> exec o config getRepo getGC
Doc o -> docCmd o config getRepo getGC
Test o -> test o config getRepo getGC
Compiler o -> compiler o config getRepoGC
Exec o -> exec o config getRepoGC
Doc o -> docCmd o config getRepoGC
Test o -> test o config getRepoGC
Clean -> cleanPackage Info
New o -> newPackage o
_ -> do repo <- getRepo
_ -> do repo <- getRepository config
case optCommand opts of
List o -> listCmd o config repo
Search o -> search o config repo
_ -> do globalCache <- getGC
_ -> do globalCache <- getGlobalCache config repo
case optCommand opts of
Deps -> deps config repo globalCache
PkgInfo o -> info o config repo globalCache
......@@ -111,9 +111,9 @@ runWithArgs opts = do
result
exitWith (if allOk then 0 else 1)
getGlobalCache :: Config -> IO GlobalCache
getGlobalCache config = do
maybeGC <- readInstalledPackagesFromDir $ packageInstallDir config
getGlobalCache :: Config -> Repository -> IO GlobalCache
getGlobalCache config repo = do
maybeGC <- readInstalledPackagesFromDir repo $ packageInstallDir config
case maybeGC of
Left err -> do putStrLn $ "Error reading global package cache: " ++ err
exitWith 1
......@@ -626,9 +626,9 @@ printInfo allinfos plain gc pkg =
putStrLn (renderPackageInfo allinfos plain gc pkg) >> succeedIO ()
compiler :: CompilerOptions -> Config -> IO Repository -> IO GlobalCache
compiler :: CompilerOptions -> Config -> IO (Repository,GlobalCache)
-> IO (ErrorLogger ())
compiler o cfg getRepo getGC =
compiler o cfg getRepoGC =
tryFindLocalPackageSpec "." |>= \pkgdir ->
loadPackageSpec pkgdir |>= \pkg ->
checkCompiler cfg pkg >>
......@@ -645,8 +645,7 @@ compiler o cfg getRepo getGC =
currybin = curryExec cfg
computePackageLoadPath pkgdir pkg =
getRepo >>= \repo ->
getGC >>= \gc ->
getRepoGC >>= \ (repo,gc) ->
resolveAndCopyDependenciesForPackage cfg repo gc pkgdir pkg |>= \pkgs ->
getAbsolutePath pkgdir >>= \abs -> succeedIO () |>
let srcdirs = map (abs </>) (sourceDirsOf pkg)
......@@ -728,7 +727,7 @@ installExecutable cfg repo pkg =
checkCompiler cfg pkg >>
-- we read the global cache again since it might be modified by
-- the installation of the package:
getGlobalCache cfg >>= \gc ->
getGlobalCache cfg repo >>= \gc ->
maybe (succeedIO ())
(\ (PackageExecutable name mainmod) ->
getLogLevel >>= \lvl ->
......@@ -740,7 +739,7 @@ installExecutable cfg repo pkg =
bindir = binInstallDir cfg
binexec = bindir </> name
in compiler CompilerOptions { comCommand = cmd }
cfg (return repo) (return gc) |>
cfg (return (repo,gc)) |>
log Info ("Installing executable '" ++ name ++ "' into '" ++
bindir ++ "'") |>
(whenFileExists binexec (backupExistingBin binexec) >>
......@@ -896,9 +895,9 @@ link (LinkOptions src) _ _ _ =
--- or, if they are not given, on exported modules (if specified in the
--- package), on the main executable (if specified in the package),
--- or on all source modules of the package.
docCmd :: DocOptions -> Config -> IO Repository -> IO GlobalCache
docCmd :: DocOptions -> Config -> IO (Repository,GlobalCache)
-> IO (ErrorLogger ())
docCmd opts cfg getRepo getGC =
docCmd opts cfg getRepoGC =
tryFindLocalPackageSpec "." |>= \specDir ->
loadPackageSpec specDir |>= \pkg -> do
checkCompiler cfg pkg
......@@ -937,14 +936,14 @@ docCmd opts cfg getRepo getGC =
runDocCmd pkgdir doccmd = do
let cmd = unwords doccmd
infoMessage $ "Running CurryDoc: " ++ cmd
execWithPkgDir (ExecOptions cmd []) cfg getRepo getGC pkgdir
execWithPkgDir (ExecOptions cmd []) cfg getRepoGC pkgdir
--- `test` command: run `curry check` on the modules provided as an argument
--- or, if they are not provided, on the exported (if specified)
--- or all source modules of the package.
test :: TestOptions -> Config -> IO Repository -> IO GlobalCache
test :: TestOptions -> Config -> IO (Repository,GlobalCache)
-> IO (ErrorLogger ())
test opts cfg getRepo getGC =
test opts cfg getRepoGC =
tryFindLocalPackageSpec "." |>= \specDir ->
loadPackageSpec specDir |>= \pkg -> do
checkCompiler cfg pkg
......@@ -975,7 +974,7 @@ test opts cfg getRepo getGC =
debugMessage $ "Removing directory: " ++ currysubdir
showExecCmd (unwords ["rm", "-rf", currysubdir])
inDirectory (apkgdir </> dir) $
execWithPkgDir (ExecOptions testcmd []) cfg getRepo getGC apkgdir
execWithPkgDir (ExecOptions testcmd []) cfg getRepoGC apkgdir
testsuites spec mainprogs = case testModules opts of
Nothing -> maybe (let exports = exportedModules spec
......@@ -1050,14 +1049,14 @@ diff opts cfg repo gc =
else succeedIO ()
exec :: ExecOptions -> Config -> IO Repository -> IO GlobalCache
exec :: ExecOptions -> Config -> IO (Repository,GlobalCache)
-> IO (ErrorLogger ())
exec o cfg getRepo getGC =
tryFindLocalPackageSpec "." |>= execWithPkgDir o cfg getRepo getGC
exec o cfg getRepoGC =
tryFindLocalPackageSpec "." |>= execWithPkgDir o cfg getRepoGC
execWithPkgDir :: ExecOptions -> Config -> IO Repository -> IO GlobalCache
execWithPkgDir :: ExecOptions -> Config -> IO (Repository,GlobalCache)
-> String -> IO (ErrorLogger ())
execWithPkgDir o cfg getRepo getGC specDir =
execWithPkgDir o cfg getRepoGC specDir =
loadCurryPathFromCache specDir |>=
maybe (computePackageLoadPath specDir) succeedIO |>= \currypath ->
let execpath = joinSearchPath (exePath o ++ splitSearchPath currypath)
......@@ -1069,7 +1068,7 @@ execWithPkgDir o cfg getRepo getGC specDir =
succeedIO ()
where
computePackageLoadPath pkgdir =
getRepo >>= \repo -> getGC >>= \gc ->
getRepoGC >>= \ (repo,gc) ->
loadPackageSpec pkgdir |>= \pkg ->
resolveAndCopyDependenciesForPackage cfg repo gc pkgdir pkg |>= \pkgs ->
getAbsolutePath pkgdir >>= \abs -> succeedIO () |>
......
......@@ -33,8 +33,9 @@ import CPM.Config (Config, packageInstallDir)
import CPM.ErrorLogger
import CPM.FileUtil ( copyDirectory, inTempDir, recreateDirectory, inDirectory
, removeDirectoryComplete, tempDir
, checkAndGetDirectoryContents )
, checkAndGetDirectoryContents, quote )
import CPM.Package
import CPM.Repository
--- The global package cache.
data GlobalCache = GlobalCache [Package]
......@@ -86,8 +87,8 @@ isPackageInstalled db p = isJust $ findVersion db (name p) (version p)
--- The directory of a package in the global package cache. Does not check
--- whether the package is actually installed!
installedPackageDir :: Config -> Package -> String
installedPackageDir cfg pkg = base
</> (name pkg ++ "-" ++ (showVersion $ version pkg))
installedPackageDir cfg pkg =
base </> (name pkg ++ "-" ++ (showVersion $ version pkg))
where
base = packageInstallDir cfg
......@@ -259,13 +260,18 @@ tryFindPackage gc name ver = case findVersion gc name ver of
" could not be found."
--- Tries to read package specifications from a GC directory structure.
readInstalledPackagesFromDir :: String -> IO (Either String GlobalCache)
readInstalledPackagesFromDir path = do
--- If some GC package directory has the same name as a package from
--- the repository index, the package specification from the repository
--- is used, otherwise (this case should not occur) the package specification
--- stored in the directory is read.
--- This should result in faster GC loading.
readInstalledPackagesFromDir :: Repository -> String
-> IO (Either String GlobalCache)
readInstalledPackagesFromDir repo path = do
debugMessage $ "Reading global package cache from '" ++ path ++ "'..."
pkgDirs <- checkAndGetDirectoryContents path
pkgPaths <- return $ map (path </>) $ filter (not . isPrefixOf ".") pkgDirs
specPaths <- return $ map (</> "package.json") pkgPaths
specs <- mapIO readPackageSpecFromFile specPaths
pkgPaths <- return $ filter (not . isPrefixOf ".") pkgDirs
specs <- mapIO loadPackageSpecFromDir pkgPaths
if null (lefts specs)
then do debugMessage "Finished reading global package cache"
return (Right $ GlobalCache (rights specs))
......@@ -273,13 +279,28 @@ readInstalledPackagesFromDir path = do
where
readPackageSpecIO = liftIO readPackageSpec
readPackageSpecFromFile f = do
loadPackageSpecFromDir pkgdir = case packageVersionFromFile pkgdir of
Nothing -> readPackageSpecFromFile pkgdir
Just (pn,pv) -> case CPM.Repository.findVersion repo pn pv of
Nothing -> readPackageSpecFromFile pkgdir
Just p -> do debugMessage $ "Package spec '" ++ packageId p ++
"' loaded from repository"
return (Right p)
readPackageSpecFromFile pkgdir = do
let f = path </> pkgdir </> "package.json"
debugMessage $ "Reading package spec from '" ++ f ++ "'..."
spec <- readPackageSpecIO $ readFile f
return $ case spec of
Left err -> Left $ err ++ " for file '" ++ f ++ "'"
Right v -> Right v
quote :: String -> String
quote s = "\"" ++ s ++ "\""
packageVersionFromFile :: String -> Maybe (String, Version)
packageVersionFromFile fn =
let ps = split (=='-') fn
l = length ps
in if l < 2
then Nothing
else case readVersion (last ps) of
Nothing -> Nothing
Just v -> Just (intercalate "-" (take (l-1) ps), v)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment