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

CPM updated

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