Commit 8c8c8827 authored by Michael Hanus 's avatar Michael Hanus
Browse files

CPM updated

parent c76a3422
......@@ -601,7 +601,7 @@ Unless the option \code{--versions} is set, only the newest version
of a package (compatible to the current compiler) is shown.
The option \code{--versions} shows all versions of the packages.
If a package is not compatible to the current compiler, then
the package version is shown as \ccode{???}.
the package version is shown in brackets (e.g., \ccode{(1.5.4)}).
The option \code{--csv} shows the information in CSV format.
\item[\fbox{\code{list --category [--csv]}}]
......
......@@ -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) >>
......@@ -847,11 +846,11 @@ packageVersionAsTable cfg pkgs = (colsizes, rows)
formatPkg p = [name p, synopsis p, showVersionIfCompatible cfg p]
--- Shows the version of a package if it is compatible with the
--- current compiler, otherwise shows "???".
--- current compiler, otherwise shows the version in brackets.
showVersionIfCompatible :: Config -> Package -> String
showVersionIfCompatible cfg p =
if isCompatibleToCompiler cfg p then showVersion (version p)
else "???"
let s = showVersion (version p)
in if isCompatibleToCompiler cfg p then s else '(' : s ++ ")"
cpmInfo :: String
cpmInfo = "Use 'cpm info PACKAGE' for more information about a package."
......@@ -868,7 +867,7 @@ search (SearchOptions q smod) cfg repo = putStr rendered >> succeedIO ()
(colsizes,rows) = packageVersionAsTable cfg results
rendered = unlines $
if null results
then ["No packages found for '" ++ q, "", cpmUpdate]
then ["No packages found for '" ++ q, "'", cpmUpdate]
else [ render (table rows colsizes), cpmInfo, cpmUpdate ]
upgrade :: UpgradeOptions -> Config -> Repository -> GlobalCache
......@@ -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)
......@@ -65,7 +65,8 @@ allPackages pkgDir = do
--- @param dir the package directory
--- @param gc the global package cache
--- @param pkg the package to copy
createLinkToGlobalCache :: Config -> String -> GlobalCache -> Package -> IO (ErrorLogger ())
createLinkToGlobalCache :: Config -> String -> GlobalCache -> Package
-> IO (ErrorLogger ())
createLinkToGlobalCache cfg pkgDir _ pkg =
createLink pkgDir (installedPackageDir cfg pkg) (packageId pkg) False
......@@ -76,7 +77,8 @@ createLinkToGlobalCache cfg pkgDir _ pkg =
--- @param dir the package directory
--- @param gc the global package cache
--- @param pkgs the list of packages
linkPackages :: Config -> String -> GlobalCache -> [Package] -> IO (ErrorLogger ())
linkPackages :: Config -> String -> GlobalCache -> [Package]
-> IO (ErrorLogger ())
linkPackages cfg pkgDir gc pkgs =
mapEL (createLinkToGlobalCache cfg pkgDir gc) pkgs |> succeedIO ()
......@@ -171,12 +173,13 @@ createLink :: String -> String -> String -> Bool -> IO (ErrorLogger ())
createLink pkgDir from name replace = do
ensureCacheDir pkgDir
exists <- linkExists target
if exists && (not replace)
if exists && not replace
then succeedIO ()
else deleteIfLink target |> do
rc <- createSymlink from target
if rc == 0
then succeedIO ()
else failIO $ "Failed to create symlink from '" ++ from ++ "' to '" ++ target ++ "', return code " ++ (show rc)
else failIO $ "Failed to create symlink from '" ++ from ++ "' to '" ++
target ++ "', return code " ++ show rc
where
target = (cacheDir pkgDir) </> name
target = cacheDir pkgDir </> name
......@@ -153,9 +153,9 @@ linkToLocalCache :: String -> String -> IO (ErrorLogger ())
linkToLocalCache src pkgDir = do
dirExists <- doesDirectoryExist src
if dirExists
then loadPackageSpec src |>=
\pkgSpec -> LocalCache.createLink pkgDir src (packageId pkgSpec) True |>
succeedIO ()
then loadPackageSpec src |>= \pkgSpec ->
LocalCache.createLink pkgDir src (packageId pkgSpec) True |>
succeedIO ()
else log Critical ("Directory '" ++ src ++ "' does not exist.") |>
succeedIO ()
......
rewriting
=========
These libraries provide a representation of first-order terms
and various notions of term rewriting, like position, substitution,
unification, critical pairs, etc. Moreover, it defines also
operations for rewriting and narrowing strategies and a
representation of definitional trees.
A previous version of these libraries were part of the
PAKCS/KiCS2 distributions.
rewriting
=========
These libraries provide a representation of first-order terms
and various notions of term rewriting, like position, substitution,
unification, critical pairs, etc. Moreover, it defines also
operations for rewriting and narrowing strategies and a
representation of definitional trees.
A previous version of these libraries were part of the
PAKCS/KiCS2 distributions.
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