Commit 0414c78f authored by Michael Hanus's avatar Michael Hanus
Browse files

CPM updated

parent 7d877c00
...@@ -32,7 +32,7 @@ import CPM.Config ( Config (..) ...@@ -32,7 +32,7 @@ import CPM.Config ( Config (..)
, showConfiguration ) , showConfiguration )
import CPM.PackageCache.Global ( GlobalCache, readInstalledPackagesFromDir import CPM.PackageCache.Global ( GlobalCache, readInstalledPackagesFromDir
, installFromZip, checkoutPackage , installFromZip, checkoutPackage
, uninstallPackage ) , uninstallPackage, isPackageInstalled )
import CPM.Package import CPM.Package
import CPM.Resolution ( isCompatibleToCompiler, showResult ) import CPM.Resolution ( isCompatibleToCompiler, showResult )
import CPM.Repository ( Repository, readRepository, findVersion, listPackages import CPM.Repository ( Repository, readRepository, findVersion, listPackages
...@@ -90,6 +90,7 @@ runWithArgs opts = do ...@@ -90,6 +90,7 @@ runWithArgs opts = do
Test o -> testCmd o config getRepoGC Test o -> testCmd o config getRepoGC
Uninstall o -> uninstall o config getRepoGC Uninstall o -> uninstall o config getRepoGC
Deps o -> depsCmd o config getRepoGC Deps o -> depsCmd o config getRepoGC
PkgInfo o -> infoCmd o config getRepoGC
Link o -> linkCmd o config Link o -> linkCmd o config
Add o -> addCmd o config Add o -> addCmd o config
Clean -> cleanPackage Info Clean -> cleanPackage Info
...@@ -100,12 +101,12 @@ runWithArgs opts = do ...@@ -100,12 +101,12 @@ runWithArgs opts = do
Search o -> searchCmd o config repo Search o -> searchCmd o config repo
_ -> do globalCache <- getGlobalCache config repo _ -> do globalCache <- getGlobalCache config repo
case optCommand opts of case optCommand opts of
PkgInfo o -> infoCmd o config repo globalCache --PkgInfo o -> infoCmd o config repo globalCache
Checkout o -> checkout o config repo globalCache Checkout o -> checkout o config repo globalCache
InstallApp o -> installapp o config repo globalCache InstallApp o -> installapp o config repo globalCache
Install o -> install o config repo globalCache Install o -> install o config repo globalCache
Diff o -> diff o config repo globalCache Diff o -> diff o config repo globalCache
Upgrade o -> upgrade o config repo globalCache Upgrade o -> upgrade o config repo globalCache
_ -> error "Internal command processing error!" _ -> error "Internal command processing error!"
mapIO showLogEntry msgs mapIO showLogEntry msgs
let allOk = all (levelGte Info) (map logLevelOf msgs) && let allOk = all (levelGte Info) (map logLevelOf msgs) &&
...@@ -701,30 +702,46 @@ depsCmd opts cfg getRepoGC = ...@@ -701,30 +702,46 @@ depsCmd opts cfg getRepoGC =
resolveDependencies cfg repo gc specDir |>= \result -> resolveDependencies cfg repo gc specDir |>= \result ->
putStrLn (showResult result) >> succeedIO () putStrLn (showResult result) >> succeedIO ()
infoCmd :: InfoOptions -> Config -> Repository -> GlobalCache ------------------------------------------------------------------------------
-- `info` command:
infoCmd :: InfoOptions -> Config -> IO (Repository,GlobalCache)
-> IO (ErrorLogger ()) -> IO (ErrorLogger ())
infoCmd (InfoOptions Nothing Nothing allinfos plain) _ _ gc = infoCmd opts cfg getRepoGC = case (infoPackage opts, infoVersion opts) of
getLocalPackageSpec "." |>= \specDir -> (Nothing, Just _) -> failIO "Must specify package name"
loadPackageSpec specDir |>= printInfo allinfos plain gc (Nothing, Nothing) ->
infoCmd (InfoOptions (Just pkg) Nothing allinfos plain) cfg repo gc = getLocalPackageSpec "." |>= \specDir ->
loadPackageSpec specDir |>= \p ->
let allinfos = infoAll opts
in if allinfos
then getRepoGC >>= \ (_,gc) ->
printInfo (infoAll opts) (infoPlain opts)
(Just (isPackageInstalled gc p)) p
else printInfo (infoAll opts) (infoPlain opts) Nothing p
(Just pkg, mbvers) ->
getRepoGC >>= \ (repo,gc) ->
infoCmdRepoGC pkg mbvers (infoAll opts) (infoPlain opts) cfg repo gc
infoCmdRepoGC :: String -> Maybe Version -> Bool -> Bool -> Config
-> Repository -> GlobalCache -> IO (ErrorLogger ())
infoCmdRepoGC pkg Nothing allinfos plain cfg repo gc =
case findLatestVersion cfg repo pkg False of case findLatestVersion cfg repo pkg False of
Nothing -> failIO $ Nothing -> failIO $
"Package '" ++ pkg ++ "' not found in package repository." "Package '" ++ pkg ++ "' not found in package repository."
Just p -> printInfo allinfos plain gc p Just p -> printInfo allinfos plain (Just (isPackageInstalled gc p)) p
infoCmd (InfoOptions (Just pkg) (Just v) allinfos plain) _ repo gc = infoCmdRepoGC pkg (Just v) allinfos plain _ repo gc =
case findVersion repo pkg v of case findVersion repo pkg v of
Nothing -> failIO $ "Package '" ++ pkg ++ "-" ++ showVersion v ++ Nothing -> failIO $ "Package '" ++ pkg ++ "-" ++ showVersion v ++
"' not found in package repository." "' not found in package repository."
Just p -> printInfo allinfos plain gc p Just p -> printInfo allinfos plain (Just (isPackageInstalled gc p)) p
infoCmd (InfoOptions Nothing (Just _) _ _) _ _ _ =
failIO "Must specify package name" printInfo :: Bool -> Bool -> Maybe Bool -> Package
printInfo :: Bool -> Bool -> GlobalCache -> Package
-> IO (ErrorLogger ()) -> IO (ErrorLogger ())
printInfo allinfos plain gc pkg = printInfo allinfos plain mbinstalled pkg =
putStrLn (renderPackageInfo allinfos plain gc pkg) >> succeedIO () putStrLn (renderPackageInfo allinfos plain mbinstalled pkg) >> succeedIO ()
------------------------------------------------------------------------------
-- `checkout` command:
checkout :: CheckoutOptions -> Config -> Repository -> GlobalCache checkout :: CheckoutOptions -> Config -> Repository -> GlobalCache
-> IO (ErrorLogger ()) -> IO (ErrorLogger ())
checkout (CheckoutOptions pkg Nothing pre) cfg repo gc = checkout (CheckoutOptions pkg Nothing pre) cfg repo gc =
......
...@@ -42,16 +42,18 @@ module CPM.Package ...@@ -42,16 +42,18 @@ module CPM.Package
) where ) where
import Char import Char
import List (intercalate, intersperse, isInfixOf, splitOn) import Either
import FilePath ((</>)) import FilePath ( (</>) )
import SetFunctions import IOExts ( readCompleteFile )
import JSON.Data import JSON.Data
import JSON.Parser import JSON.Parser
import JSON.Pretty (ppJSON) import JSON.Pretty ( ppJSON )
import Either import List ( intercalate, intersperse, isInfixOf, splitOn )
import Read ( readInt )
import SetFunctions
import Test.EasyCheck import Test.EasyCheck
import DetParse import DetParse
import Read (readInt)
import CPM.ErrorLogger import CPM.ErrorLogger
import CPM.FileUtil (ifFileExists) import CPM.FileUtil (ifFileExists)
...@@ -313,7 +315,7 @@ loadPackageSpec dir = do ...@@ -313,7 +315,7 @@ loadPackageSpec dir = do
let packageFile = dir </> "package.json" let packageFile = dir </> "package.json"
ifFileExists packageFile ifFileExists packageFile
(do debugMessage $ "Reading package specification '" ++ packageFile ++ "'..." (do debugMessage $ "Reading package specification '" ++ packageFile ++ "'..."
contents <- readFile packageFile contents <- readCompleteFile packageFile
case readPackageSpec contents of case readPackageSpec contents of
Left err -> failIO err Left err -> failIO err
Right v -> succeedIO v ) Right v -> succeedIO v )
......
...@@ -25,11 +25,12 @@ module CPM.PackageCache.Global ...@@ -25,11 +25,12 @@ module CPM.PackageCache.Global
import Directory import Directory
import Either import Either
import IOExts ( readCompleteFile )
import List import List
import Maybe (isJust) import Maybe (isJust)
import FilePath import FilePath
import CPM.Config (Config, packageInstallDir) import CPM.Config ( Config, packageInstallDir )
import CPM.ErrorLogger import CPM.ErrorLogger
import CPM.FileUtil ( copyDirectory, inTempDir, recreateDirectory, inDirectory import CPM.FileUtil ( copyDirectory, inTempDir, recreateDirectory, inDirectory
, removeDirectoryComplete, tempDir , removeDirectoryComplete, tempDir
...@@ -290,7 +291,7 @@ readInstalledPackagesFromDir repo path = do ...@@ -290,7 +291,7 @@ readInstalledPackagesFromDir repo path = do
readPackageSpecFromFile pkgdir = do readPackageSpecFromFile pkgdir = do
let f = path </> pkgdir </> "package.json" let f = path </> pkgdir </> "package.json"
debugMessage $ "Reading package spec from '" ++ f ++ "'..." debugMessage $ "Reading package spec from '" ++ f ++ "'..."
spec <- readPackageSpecIO $ readFile f spec <- readPackageSpecIO $ readCompleteFile f
return $ case spec of return $ case spec of
Left err -> Left $ err ++ " for file '" ++ f ++ "'" Left err -> Left $ err ++ " for file '" ++ f ++ "'"
Right v -> Right v Right v -> Right v
......
...@@ -22,17 +22,18 @@ module CPM.PackageCache.Local ...@@ -22,17 +22,18 @@ module CPM.PackageCache.Local
) where ) where
import Debug import Debug
import Directory (createDirectoryIfMissing, copyFile, getAbsolutePath import Directory ( createDirectoryIfMissing, copyFile, getAbsolutePath
, getDirectoryContents, doesDirectoryExist, doesFileExist) , getDirectoryContents, doesDirectoryExist, doesFileExist )
import Either (rights) import Either ( rights )
import FilePath ((</>)) import FilePath ( (</>) )
import List (isPrefixOf) import IOExts ( readCompleteFile )
import List ( isPrefixOf )
import CPM.Config (Config, packageInstallDir)
import CPM.Config ( Config, packageInstallDir )
import CPM.ErrorLogger import CPM.ErrorLogger
import CPM.FileUtil (isSymlink, removeSymlink, createSymlink, linkTarget) import CPM.FileUtil ( isSymlink, removeSymlink, createSymlink, linkTarget )
import CPM.Package (Package, packageId, readPackageSpec) import CPM.Package ( Package, packageId, readPackageSpec )
import CPM.PackageCache.Global (installedPackageDir) import CPM.PackageCache.Global ( installedPackageDir )
--- The cache directory of the local package cache. --- The cache directory of the local package cache.
--- ---
...@@ -53,7 +54,7 @@ allPackages pkgDir = do ...@@ -53,7 +54,7 @@ allPackages pkgDir = do
let pkgDirs = filter (not . isPrefixOf ".") cdircont let pkgDirs = filter (not . isPrefixOf ".") cdircont
pkgPaths <- mapIO removeIfIllegalSymLink $ map (cdir </>) pkgDirs pkgPaths <- mapIO removeIfIllegalSymLink $ map (cdir </>) pkgDirs
specPaths <- return $ map (</> "package.json") $ concat pkgPaths specPaths <- return $ map (</> "package.json") $ concat pkgPaths
specs <- mapIO (readPackageSpecIO . readFile) specPaths specs <- mapIO (readPackageSpecIO . readCompleteFile) specPaths
succeedIO $ rights specs succeedIO $ rights specs
else succeedIO [] else succeedIO []
where where
......
...@@ -210,12 +210,14 @@ resolveDependencies cfg repo gc dir = loadPackageSpec dir |-> ...@@ -210,12 +210,14 @@ resolveDependencies cfg repo gc dir = loadPackageSpec dir |->
\pkgSpec -> resolveDependenciesForPackageCopy cfg pkgSpec repo gc dir \pkgSpec -> resolveDependenciesForPackageCopy cfg pkgSpec repo gc dir
--- Renders information on a package. --- Renders information on a package.
renderPackageInfo :: Bool -> Bool -> GC.GlobalCache -> Package -> String renderPackageInfo :: Bool -> Bool -> Maybe Bool -> Package -> String
renderPackageInfo allinfos plain gc pkg = pPrint doc renderPackageInfo allinfos plain mbinstalled pkg = pPrint doc
where where
boldText s = (if plain then id else bold) $ text s boldText s = (if plain then id else bold) $ text s
maxLen = 12 maxLen = 12
doc = vcat $ [ heading, rule, installed, ver, auth, maintnr, synop doc = vcat $ [ heading, rule
, maybe empty instTxt mbinstalled
, ver, auth, maintnr, synop
, cats, deps, compilers, descr, execspec ] ++ , cats, deps, compilers, descr, execspec ] ++
if allinfos if allinfos
then [ srcdirs, expmods, cfgmod ] ++ testsuites ++ then [ srcdirs, expmods, cfgmod ] ++ testsuites ++
...@@ -224,11 +226,10 @@ renderPackageInfo allinfos plain gc pkg = pPrint doc ...@@ -224,11 +226,10 @@ renderPackageInfo allinfos plain gc pkg = pPrint doc
else [] else []
pkgId = packageId pkg pkgId = packageId pkg
isInstalled = GC.isPackageInstalled gc pkg
heading = text pkgId heading = text pkgId
installed = if isInstalled || plain then empty instTxt i = if i || plain then empty
else red $ text "Not installed" else red $ text "Not installed"
rule = text (take (length pkgId) $ repeat '-') rule = text (take (length pkgId) $ repeat '-')
ver = fill maxLen (boldText "Version") <+> ver = fill maxLen (boldText "Version") <+>
(text $ showVersion $ version pkg) (text $ showVersion $ version pkg)
......
...@@ -25,6 +25,7 @@ import Directory ...@@ -25,6 +25,7 @@ import Directory
import Either import Either
import FilePath import FilePath
import IO import IO
import IOExts ( readCompleteFile )
import List import List
import ReadShowTerm ( showQTerm, readQTerm ) import ReadShowTerm ( showQTerm, readQTerm )
import System ( exitWith ) import System ( exitWith )
...@@ -160,7 +161,7 @@ readRepositoryFrom path = do ...@@ -160,7 +161,7 @@ readRepositoryFrom path = do
readPackageSpecIO = liftIO readPackageSpec readPackageSpecIO = liftIO readPackageSpec
readPackageFile f = do readPackageFile f = do
spec <- readPackageSpecIO $ readFile f spec <- readPackageSpecIO $ readCompleteFile f
return $ case spec of return $ case spec of
Left err -> Left $ "Problem reading '" ++ f ++ "': " ++ err Left err -> Left $ "Problem reading '" ++ f ++ "': " ++ err
Right s -> Right s Right s -> Right s
......
...@@ -27,8 +27,8 @@ managed by the Curry Package Manager CPM. ...@@ -27,8 +27,8 @@ managed by the Curry Package Manager CPM.
Thus, to install the newest version of CASS, use the following commands: Thus, to install the newest version of CASS, use the following commands:
% %
\begin{curry} \begin{curry}
> cpm update > cypm update
> cpm install cass > cypm install cass
\end{curry} \end{curry}
% %
This downloads the newest package, compiles it, and places This downloads the newest package, compiles it, and places
......
...@@ -27,8 +27,8 @@ managed by the Curry Package Manager CPM. ...@@ -27,8 +27,8 @@ managed by the Curry Package Manager CPM.
Thus, to install the newest version of CASS, use the following commands: Thus, to install the newest version of CASS, use the following commands:
% %
\begin{curry} \begin{curry}
> cpm update > cypm update
> cpm install cass > cypm install cass
\end{curry} \end{curry}
% %
This downloads the newest package, compiles it, and places This downloads the newest package, compiles it, and places
......
Supports Markdown
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