Commit 3805365b authored by Michael Hanus 's avatar Michael Hanus
Browse files

cpm updated

parent 56edcd2b
......@@ -94,6 +94,13 @@ using UTF-8 encoding by default. Haskell uses the system locale charmap for its
default encoding. You can check the current value using
\code{System.IO.localeEncoding} inside a \code{ghci} session.
It is also recommended that
SQLite\footnote{\url{https://www.sqlite.org}} is installed
so that the executable \code{sqlite3} is in your path.
In this case, CPM uses a SQLite database for caching
the central package index (see Section~\ref{sec:internals}).
This yields faster response times of various CPM commands.
To install CPM from the sources, enter the
root directory of the CPM source distribution.
The main executable \code{curry} of your Curry system must be in your
......
......@@ -12,7 +12,8 @@ module CPM.Config
, showConfiguration, showCompilerVersion ) where
import Char ( toUpper )
import Directory ( getHomeDirectory, createDirectoryIfMissing )
import Directory ( doesDirectoryExist, createDirectoryIfMissing
, getHomeDirectory )
import qualified Distribution as Dist
import FilePath ( (</>), isAbsolute )
import Function ( (***) )
......@@ -116,12 +117,14 @@ setHomePackageDir :: Config -> IO Config
setHomePackageDir cfg
| null (homePackageDir cfg)
= do homedir <- getHomeDirectory
if null homedir
then return cfg
else let (cname,cmaj,cmin) = compilerVersion cfg
let cpmdir = homedir </> ".cpm"
excpmdir <- doesDirectoryExist cpmdir
if excpmdir
then let (cname,cmaj,cmin) = compilerVersion cfg
cvname = cname ++ "-" ++ show cmaj ++ "." ++ show cmin
homepkgdir = homedir </> ".cpm" </> cvname ++ "-homepackage"
homepkgdir = cpmdir </> cvname ++ "-homepackage"
in return cfg { homePackageDir = homepkgdir }
else return cfg
| otherwise = return cfg
--- Sets the correct compiler version in the configuration.
......
......@@ -37,11 +37,12 @@ import CPM.PackageCache.Global ( GlobalCache, readGlobalCache, allPackages
, uninstallPackage, packageInstalled )
import CPM.Package
import CPM.Resolution ( isCompatibleToCompiler, showResult )
import CPM.Repository ( Repository, readRepository, findVersion, listPackages
, findAllVersions, findLatestVersion, updateRepository
import CPM.Repository ( Repository, findVersion, listPackages
, findAllVersions, findLatestVersion
, useUpdateHelp, searchPackages, cleanRepositoryCache
, readPackageFromRepository
, getAllPackageVersions, getPackageVersion )
, readPackageFromRepository )
import CPM.Repository.Update ( addPackageToRepository, updateRepository )
import CPM.Repository.Select
import CPM.PackageCache.Runtime ( dependencyPathsSeparate, writePackageConfig )
import CPM.PackageCopy
import CPM.Diff.API as APIDiff
......@@ -53,7 +54,7 @@ cpmBanner :: String
cpmBanner = unlines [bannerLine,bannerText,bannerLine]
where
bannerText =
"Curry Package Manager <curry-language.org/tools/cpm> (version of 15/01/2018)"
"Curry Package Manager <curry-language.org/tools/cpm> (version of 29/03/2018)"
bannerLine = take (length bannerText) (repeat '-')
main :: IO ()
......@@ -85,39 +86,31 @@ runWithArgs opts = do
debugMessage ("Current configuration:\n" ++ showConfiguration config)
(msgs, result) <- case optCommand opts of
NoCommand -> failIO "NoCommand"
Config o -> configCmd o config
Config o -> configCmd o config
Update -> updateCmd config
Compiler o -> compiler o config
Exec o -> execCmd o config
Doc o -> docCmd o config
Test o -> testCmd o config
Uninstall o -> uninstall o config
Deps o -> depsCmd o config
PkgInfo o -> infoCmd o config
Link o -> linkCmd o config
Add o -> addCmd o config
Compiler o -> compiler o config
Exec o -> execCmd o config
Doc o -> docCmd o config
Test o -> testCmd o config
Uninstall o -> uninstall o config
Deps o -> depsCmd o config
PkgInfo o -> infoCmd o config
Link o -> linkCmd o config
Add o -> addCmd o config
New o -> newPackage o
List o -> listCmd o config
Search o -> searchCmd o config
Upgrade o -> upgradeCmd o config
Diff o -> diffCmd o config
Checkout o -> checkoutCmd o config
Install o -> installCmd o config
Clean -> cleanPackage config Info
New o -> newPackage o
cmd -> do repo <- readRepository config (cmdWithLargeRepoCache cmd)
case optCommand opts of
List o -> listCmd o config repo
Search o -> searchCmd o config repo
Checkout o -> checkoutCmd o config repo
Install o -> installCmd o config repo
Upgrade o -> upgradeCmd o config repo
Diff o -> diffCmd o config repo
_ -> error "Internal command processing error!"
mapIO showLogEntry msgs
let allOk = all (levelGte Info) (map logLevelOf msgs) &&
either (\le -> levelGte Info (logLevelOf le))
(const True)
result
exitWith (if allOk then 0 else 1)
where
cmdWithLargeRepoCache cmd =
case cmd of List _ -> True
Search _ -> True
_ -> False
data Options = Options
{ optLogLevel :: LogLevel
......@@ -728,7 +721,7 @@ checkExecutables executables = do
configCmd :: ConfigOptions -> Config -> IO (ErrorLogger ())
configCmd opts cfg = do
if configAll opts
then readRepository cfg False >>= \repo ->
then getBaseRepository cfg >>= \repo ->
readGlobalCache cfg repo |>= \gc ->
putStrLn configS >>
putStrLn "Installed packages:\n" >>
......@@ -741,9 +734,8 @@ configCmd opts cfg = do
------------------------------------------------------------------------------
-- `update` command:
updateCmd :: Config -> IO (ErrorLogger ())
updateCmd cfg =
checkRequiredExecutables >> updateRepository cfg
updateCmd cfg = checkRequiredExecutables >> updateRepository cfg
------------------------------------------------------------------------------
-- `deps` command:
depsCmd :: DepsOptions -> Config -> IO (ErrorLogger ())
......@@ -792,40 +784,42 @@ printInfo cfg allinfos plain pkg =
------------------------------------------------------------------------------
-- `checkout` command:
checkoutCmd :: CheckoutOptions -> Config -> Repository -> IO (ErrorLogger ())
checkoutCmd (CheckoutOptions pkgname Nothing pre) cfg repo =
checkoutCmd :: CheckoutOptions -> Config -> IO (ErrorLogger ())
checkoutCmd (CheckoutOptions pkgname Nothing pre) cfg =
getRepoForPackages cfg [pkgname] >>= \repo ->
case findAllVersions repo pkgname pre of
[] -> packageNotFoundFailure pkgname
ps -> case filter (isCompatibleToCompiler cfg) ps of
[] -> compatPackageNotFoundFailure cfg pkgname useUpdateHelp
(p:_) -> acquireAndInstallPackageWithDependencies cfg repo p |>
checkoutPackage cfg p
checkoutCmd (CheckoutOptions pkg (Just ver) _) cfg repo =
case findVersion repo pkg ver of
Nothing -> packageNotFoundFailure $ pkg ++ "-" ++ showVersion ver
checkoutCmd (CheckoutOptions pkgname (Just ver) _) cfg =
getRepoForPackages cfg [pkgname] >>= \repo ->
case findVersion repo pkgname ver of
Nothing -> packageNotFoundFailure $ pkgname ++ "-" ++ showVersion ver
Just p -> acquireAndInstallPackageWithDependencies cfg repo p |>
checkoutPackage cfg p
installCmd :: InstallOptions -> Config -> Repository -> IO (ErrorLogger ())
installCmd (InstallOptions Nothing Nothing _ instexec False) cfg repo =
installCmd :: InstallOptions -> Config -> IO (ErrorLogger ())
installCmd (InstallOptions Nothing Nothing _ instexec False) cfg =
getLocalPackageSpec cfg "." |>= \pkgdir ->
cleanCurryPathCache pkgdir |>
installLocalDependencies cfg repo pkgdir |>= \ (pkg,_) ->
installLocalDependencies cfg pkgdir |>= \ (pkg,_) ->
saveBaseVersionToCache cfg pkgdir >>
getCurryLoadPath cfg pkgdir |>= \currypath ->
writePackageConfig cfg pkgdir pkg currypath |>
if instexec then installExecutable cfg pkg else succeedIO ()
-- Install executable only:
installCmd (InstallOptions Nothing Nothing _ _ True) cfg _ =
installCmd (InstallOptions Nothing Nothing _ _ True) cfg =
getLocalPackageSpec cfg "." |>= \pkgdir ->
loadPackageSpec pkgdir |>= \pkg ->
installExecutable cfg pkg
installCmd (InstallOptions (Just pkg) vers pre _ _) cfg repo = do
installCmd (InstallOptions (Just pkg) vers pre _ _) cfg = do
fileExists <- doesFileExist pkg
if fileExists
then installFromZip cfg pkg
else installapp (CheckoutOptions pkg vers pre) cfg repo
installCmd (InstallOptions Nothing (Just _) _ _ _) _ _ =
else installapp (CheckoutOptions pkg vers pre) cfg
installCmd (InstallOptions Nothing (Just _) _ _ _) _ =
failIO "Must specify package name"
--- Installs the application (i.e., binary) provided by a package.
......@@ -836,15 +830,15 @@ installCmd (InstallOptions Nothing (Just _) _ _ _) _ _ =
--- Internal note: the installed package should not be cleaned or removed
--- after the installation since its execution might refer (via the
--- config module) to some data stored in the package.
installapp :: CheckoutOptions -> Config -> Repository -> IO (ErrorLogger ())
installapp opts cfg repo = do
installapp :: CheckoutOptions -> Config -> IO (ErrorLogger ())
installapp opts cfg = do
let apppkgdir = appPackageDir cfg
copkgdir = apppkgdir </> coPackage opts
curdir <- getCurrentDirectory
removeDirectoryComplete copkgdir
debugMessage ("Change into directory " ++ apppkgdir)
inDirectory apppkgdir
( checkoutCmd opts cfg repo |>
( checkoutCmd opts cfg |>
log Debug ("Change into directory " ++ copkgdir) |>
(setCurrentDirectory copkgdir >> succeedIO ()) |>
loadPackageSpec "." |>= \pkg ->
......@@ -853,7 +847,7 @@ installapp opts cfg repo = do
failIO ("Package '" ++ name pkg ++
"' does not contain an executable, nothing installed."))
(\_ -> installCmd (InstallOptions Nothing Nothing False True False)
cfg repo)
cfg)
(executableSpec pkg)
)
......@@ -940,19 +934,21 @@ tryFindVersion pkg ver repo = case findVersion repo pkg ver of
--- Lists all (compiler-compatible if `lall` is false) packages
--- in the given repository.
listCmd :: ListOptions -> Config -> Repository -> IO (ErrorLogger ())
listCmd (ListOptions lv csv cat) cfg repo =
let listresult = if cat then renderCats catgroups
else renderPkgs allpkgs
in putStr listresult >> succeedIO ()
listCmd :: ListOptions -> Config -> IO (ErrorLogger ())
listCmd (ListOptions lv csv cat) cfg = do
repo <- if cat then getRepositoryWithNameVersionCategory cfg
else getRepositoryWithNameVersionSynopsis cfg
let listresult = if cat then renderCats (catgroups repo)
else renderPkgs (allpkgs repo)
putStr listresult >> succeedIO ()
where
-- all packages (and versions if `lv`)
allpkgs = concatMap (if lv then id else ((:[]) . filterCompatPkgs cfg))
(sortBy (\ps1 ps2 -> name (head ps1) <= name (head ps2))
(listPackages repo))
allpkgs repo = concatMap (if lv then id else ((:[]) . filterCompatPkgs cfg))
(sortBy (\ps1 ps2 -> name (head ps1) <= name (head ps2))
(listPackages repo))
-- all categories together with their package names:
catgroups =
catgroups repo =
let pkgid p = name p ++ '-' : showVersionIfCompatible cfg p
newpkgs = map (filterCompatPkgs cfg) (listPackages repo)
catpkgs = concatMap (\p -> map (\c -> (c, pkgid p)) (category p))
......@@ -1010,31 +1006,36 @@ cpmInfo = "Use 'cypm info PACKAGE' for more information about a package."
--- Search in all (compiler-compatible) packages in the given repository.
searchCmd :: SearchOptions -> Config -> Repository -> IO (ErrorLogger ())
searchCmd (SearchOptions q smod sexec) cfg repo =
putStr rendered >> succeedIO ()
where
results = sortBy (\p1 p2 -> name p1 <= name p2)
(map (filterCompatPkgs cfg)
(searchPackages repo smod sexec q))
(colsizes,rows) = packageVersionAsTable cfg results
rendered = unlines $
if null results
then [ "No packages found for '" ++ q ++ "'", useUpdateHelp ]
else [ render (table rows colsizes), cpmInfo, useUpdateHelp ]
searchCmd :: SearchOptions -> Config -> IO (ErrorLogger ())
searchCmd (SearchOptions q smod sexec) cfg = do
let searchaction = if smod then searchExportedModules
else if sexec then searchExecutable
else searchNameSynopsisModules
allpkgs <- searchaction cfg q
let results = sortBy (\p1 p2 -> name p1 <= name p2)
(map (filterCompatPkgs cfg)
(map (sortBy (\a b -> version a `vgt` version b))
(groupBy (\a b -> name a == name b)
allpkgs)))
(colsizes,rows) = packageVersionAsTable cfg results
putStr $ unlines $
if null results
then [ "No packages found for '" ++ q ++ "'", useUpdateHelp ]
else [ render (table rows colsizes), cpmInfo, useUpdateHelp ]
succeedIO ()
--- `upgrade` command.
upgradeCmd :: UpgradeOptions -> Config -> Repository -> IO (ErrorLogger ())
upgradeCmd (UpgradeOptions Nothing) cfg repo =
upgradeCmd :: UpgradeOptions -> Config -> IO (ErrorLogger ())
upgradeCmd (UpgradeOptions Nothing) cfg =
getLocalPackageSpec cfg "." |>= \specDir ->
cleanCurryPathCache specDir |>
log Info "Upgrading all packages" |>
upgradeAllPackages cfg repo specDir
upgradeCmd (UpgradeOptions (Just pkg)) cfg repo =
upgradeAllPackages cfg specDir
upgradeCmd (UpgradeOptions (Just pkg)) cfg =
getLocalPackageSpec cfg "." |>= \specDir ->
log Info ("Upgrade " ++ pkg) |>
upgradeSinglePackage cfg repo specDir pkg
upgradeSinglePackage cfg specDir pkg
--- `link` command.
......@@ -1045,50 +1046,18 @@ linkCmd (LinkOptions src) cfg =
log Info ("Linking '" ++ src ++ "' into local package cache...") |>
linkToLocalCache src specDir
--- `add` command: copy the given package to the repository index
--- `add` command:
--- Option `--package`: copy the given package to the repository index
--- and package installation directory so that it is available as
--- any other package.
--- Option `--dependency`: add the package name as a dependency to the
--- current package
addCmd :: AddOptions -> Config -> IO (ErrorLogger ())
addCmd (AddOptions addpkg adddep pkg force) config
| addpkg = addPackageCmd pkg force config
| addpkg = addPackageToRepository config pkg force True
| adddep = addDependencyCmd pkg force config
| otherwise = log Critical "Option --package or --dependency missing!"
--- `add --package` command: copy the given package to the repository index
--- and package installation directory so that it is available as
--- any other package.
addPackageCmd :: String -> Bool -> Config -> IO (ErrorLogger ())
addPackageCmd pkgdir force config = do
dirExists <- doesDirectoryExist pkgdir
if dirExists
then loadPackageSpec pkgdir |>= \pkgSpec ->
(copyPackage pkgSpec >> succeedIO ()) |>
log Info ("Package in directory '" ++ pkgdir ++
"' installed into local repository")
else log Critical ("Directory '" ++ pkgdir ++ "' does not exist.") |>
succeedIO ()
where
copyPackage pkg = do
let pkgName = name pkg
pkgVersion = version pkg
pkgIndexDir = pkgName </> showVersion pkgVersion
pkgRepositoryDir = repositoryDir config </> pkgIndexDir
pkgInstallDir = packageInstallDir config </> packageId pkg
exrepodir <- doesDirectoryExist pkgRepositoryDir
when (exrepodir && not force) $ error $
"Package repository directory '" ++
pkgRepositoryDir ++ "' already exists!\n" ++ useForce
expkgdir <- doesDirectoryExist pkgInstallDir
when expkgdir $
if force then removeDirectoryComplete pkgInstallDir
else error $ "Package installation directory '" ++
pkgInstallDir ++ "' already exists!\n" ++ useForce
infoMessage $ "Create directory: " ++ pkgRepositoryDir
createDirectoryIfMissing True pkgRepositoryDir
copyFile (pkgdir </> "package.json") (pkgRepositoryDir </> "package.json")
copyDirectory pkgdir pkgInstallDir
cleanRepositoryCache config
useForce :: String
useForce = "Use option '-f' or '--force' to overwrite it."
......@@ -1311,9 +1280,8 @@ curryModulesInDir dir = getModules "" dir
return $ map ((p ++) . stripCurrySuffix) newprogs ++ concat subdirentries
diffCmd :: DiffOptions -> Config -> Repository -> IO (ErrorLogger ())
diffCmd opts cfg repo =
readGlobalCache cfg repo |>= \gc ->
diffCmd :: DiffOptions -> Config -> IO (ErrorLogger ())
diffCmd opts cfg =
getLocalPackageSpec cfg "." |>= \specDir ->
loadPackageSpec specDir |>= \localSpec ->
checkCompiler cfg localSpec >>
......@@ -1321,15 +1289,17 @@ diffCmd opts cfg repo =
localv = version localSpec
showlocalv = showVersion localv
in
getDiffVersion localname |>= \diffv ->
getRepoForPackageSpec cfg localSpec >>= \repo ->
readGlobalCache cfg repo |>= \gc ->
getDiffVersion repo localname |>= \diffv ->
if diffv == localv
then failIO $ "Cannot diff identical package versions " ++ showlocalv
else putStrLn ("Comparing local version " ++ showlocalv ++
" and repository version " ++ showVersion diffv ++ ":\n") >>
diffAPIIfEnabled gc specDir localSpec diffv |>
diffBehaviorIfEnabled gc specDir localSpec diffv
diffAPIIfEnabled repo gc specDir localSpec diffv |>
diffBehaviorIfEnabled repo gc specDir localSpec diffv
where
getDiffVersion localname = case diffVersion opts of
getDiffVersion repo localname = case diffVersion opts of
Nothing -> case findLatestVersion cfg repo localname False of
Nothing -> failIO $
"No other version of local package '" ++ localname ++
......@@ -1338,7 +1308,7 @@ diffCmd opts cfg repo =
Just p -> succeedIO (version p)
Just v -> succeedIO v
diffAPIIfEnabled gc specDir localSpec diffversion =
diffAPIIfEnabled repo gc specDir localSpec diffversion =
if diffAPI opts
then (putStrLn "Running API diff...\n" >> succeedIO ()) |>
APIDiff.compareModulesFromPackageAndDir cfg repo gc specDir
......@@ -1350,7 +1320,7 @@ diffCmd opts cfg repo =
succeedIO ()
else succeedIO ()
diffBehaviorIfEnabled gc specDir localSpec diffversion =
diffBehaviorIfEnabled repo gc specDir localSpec diffversion =
if diffBehavior opts
then (putStrLn "Preparing behavior diff...\n" >> succeedIO ()) |>
BDiff.preparePackageAndDir cfg repo gc specDir (name localSpec)
......
......@@ -32,7 +32,8 @@ import Text.Pretty hiding ( (</>) )
import CPM.AbstractCurry
import CPM.Config ( Config, packageInstallDir, baseVersion, homePackageDir )
import CPM.Repository ( Repository, allPackages, readRepository )
import CPM.Repository ( Repository, allPackages )
import CPM.Repository.Select
import qualified CPM.LookupSet as LS
import CPM.ErrorLogger
import CPM.FileUtil ( copyDirectory, recreateDirectory )
......@@ -118,18 +119,18 @@ copyDependencies cfg pkg pkgs dir =
pkgs' = filter (/= pkg) pkgs
--- Upgrades all dependencies of a package copy.
upgradeAllPackages :: Config -> Repository -> String -> IO (ErrorLogger ())
upgradeAllPackages cfg repo dir =
upgradeAllPackages :: Config -> String -> IO (ErrorLogger ())
upgradeAllPackages cfg dir =
loadPackageSpec dir |>= \pkgSpec ->
LocalCache.clearCache dir >> succeedIO () |>
installLocalDependencies cfg repo dir |>= \ (_,deps) ->
installLocalDependencies cfg dir |>= \ (_,deps) ->
copyDependencies cfg pkgSpec deps dir |> succeedIO ()
--- Upgrades a single package and its transitive dependencies.
upgradeSinglePackage :: Config -> Repository -> String -> String
-> IO (ErrorLogger ())
upgradeSinglePackage cfg repo dir pkgName =
upgradeSinglePackage :: Config -> String -> String -> IO (ErrorLogger ())
upgradeSinglePackage cfg dir pkgName =
loadPackageSpec dir |>= \pkgSpec ->
getRepoForPackageSpec cfg pkgSpec >>= \repo ->
GC.readGlobalCache cfg repo |>= \gc ->
lookupSetForPackageCopy cfg pkgSpec repo gc dir |>= \originalLS ->
let transitiveDeps = pkgName : allTransitiveDependencies originalLS pkgName in
......@@ -140,10 +141,17 @@ upgradeSinglePackage cfg repo dir pkgName =
copyDependencies cfg pkgSpec (resolvedPackages result) dir |> succeedIO ()
--- Installs the dependencies of a package.
installLocalDependencies :: Config -> Repository -> String
installLocalDependencies :: Config -> String
-> IO (ErrorLogger (Package,[Package]))
installLocalDependencies cfg repo dir =
installLocalDependencies cfg dir =
loadPackageSpec dir |>= \pkgSpec ->
getRepoForPackageSpec cfg pkgSpec >>= \repo ->
installLocalDependenciesWithRepo cfg repo dir pkgSpec
--- Installs the dependencies of a package.
installLocalDependenciesWithRepo :: Config -> Repository -> String -> Package
-> IO (ErrorLogger (Package,[Package]))
installLocalDependenciesWithRepo cfg repo dir pkgSpec =
GC.readGlobalCache cfg repo |>= \gc ->
resolveDependenciesForPackageCopy cfg pkgSpec repo gc dir |>= \result ->
GC.installMissingDependencies cfg gc (resolvedPackages result) |>
......@@ -215,7 +223,7 @@ resolveAndCopyDependencies cfg repo gc dir =
resolveAndCopyDependenciesForPackage ::
Config -> String -> Package -> IO (ErrorLogger [Package])
resolveAndCopyDependenciesForPackage cfg dir pkgSpec =
readRepository cfg False >>= \repo ->
getRepoForPackageSpec cfg pkgSpec >>= \repo ->
GC.readGlobalCache cfg repo |>= \gc ->
resolveAndCopyDependenciesForPackage' cfg repo gc dir pkgSpec
......@@ -236,10 +244,10 @@ resolveAndCopyDependenciesForPackage' cfg repo gc dir pkgSpec =
--- Resolves the dependencies for a package copy.
resolveDependencies :: Config -> String -> IO (ErrorLogger ResolutionResult)
resolveDependencies cfg dir =
readRepository cfg False >>= \repo ->
GC.readGlobalCache cfg repo |>= \gc ->
loadPackageSpec dir |->
log Info ("Read package spec from " ++ dir) |>= \pkgSpec ->
getRepoForPackageSpec cfg pkgSpec >>= \repo ->
GC.readGlobalCache cfg repo |>= \gc ->
resolveDependenciesForPackageCopy cfg pkgSpec repo gc dir
--- Renders information on a package.
......
......@@ -9,14 +9,13 @@
module CPM.Repository
( Repository
, emptyRepository
, allPackages
, readRepository
, emptyRepository, allPackages, pkgsToRepository
, warnIfRepositoryOld, readRepositoryFrom
, findAllVersions, findVersion, findLatestVersion
, searchPackages
, listPackages
, useUpdateHelp, updateRepository, cleanRepositoryCache
, readPackageFromRepository, getAllPackageVersions, getPackageVersion
, searchPackages, listPackages
, useUpdateHelp, cleanRepositoryCache
, readPackageFromRepository
, repositoryCacheFilePrefix
) where
import Char ( toLower )
......@@ -35,16 +34,28 @@ import CPM.Config ( Config, repositoryDir, packageIndexRepository
import CPM.ConfigPackage ( packageVersion )
import CPM.ErrorLogger
import CPM.Package
import CPM.FileUtil ( checkAndGetVisibleDirectoryContents, inDirectory
, whenFileExists, removeDirectoryComplete )
import CPM.FileUtil ( checkAndGetVisibleDirectoryContents
, copyDirectory, inDirectory
, quote, whenFileExists, removeDirectoryComplete )
import CPM.Resolution ( isCompatibleToCompiler )
------------------------------------------------------------------------------
--- Abstract data type of a repository.
data Repository = Repository [Package]
--- Creates an empty repository.
emptyRepository :: Repository
emptyRepository = Repository []
--- Get all packages in the central package index.
allPackages :: Repository -> [Package]
allPackages (Repository ps) = ps
--- Construct a repository from a list of packages.
pkgsToRepository :: [Package] -> Repository
pkgsToRepository ps = Repository ps
------------------------------------------------------------------------------
--- Finds all versions of a package known to the repository. Returns the
--- packages sorted from newest to oldest.
---
......@@ -115,46 +126,14 @@ findLatestVersion cfg repo pn pre =
--- Finds a specific version of a package.
findVersion :: Repository -> String -> Version -> Maybe Package
findVersion repo p v =
maybeHead $ filter ((== v) . version) $ findAllVersions repo p True
findVersion repo pn v =
maybeHead $ filter ((== v) . version) $ findAllVersions repo pn True
where maybeHead [] = Nothing
maybeHead (x:_) = Just x
--- Get all packages in the central package index.
allPackages :: Repository -> [Package]
allPackages (Repository ps) = ps
--- Reads all package specifications from the default repository.
--- Uses the cache if it is present or update the cache after reading.
--- If some errors occur, show them and terminate with error exit status.
---
--- @param cfg - the configuration to use
--- @param large - if true reads the larger cache with more package information
--- (e.g., for searching all packages)
readRepository :: Config -> Bool -> IO Repository
readRepository cfg large = do
warnOldRepo cfg
mbrepo <- readRepositoryCache cfg large
case mbrepo of
Nothing -> do
infoMessage $ "Writing " ++ (if large then "large " else "") ++
"repository cache..."
(repo, repoErrors) <- readRepositoryFrom (repositoryDir cfg)
if null repoErrors
then writeRepositoryCache cfg large repo >> return repo
else do errorMessage "Problems while reading the package index:"
mapM_ errorMessage repoErrors
exitWith 1
Just repo -> return repo
--- Sets the date of the last update by touching README.md.
setLastUpdate :: Config -> IO ()
setLastUpdate cfg =
system (unwords ["touch", repositoryDir cfg </> "README.md"]) >> done
--- Prints a warning if the repository index is older than 10 days.
warnOldRepo :: Config -> IO ()
warnOldRepo cfg = do
warnIfRepositoryOld :: Config -> IO ()
warnIfRepositoryOld cfg = do
let updatefile = repositoryDir cfg </> "README.md"
updexists <- doesFileExist updatefile
if updexists
......@@ -175,10 +154,25 @@ useUpdateHelp :: String
useUpdateHelp = "Use 'cypm update' to download the newest package index."
--- Reads all package specifications from a repository.
--- If some errors occur, show them and terminate with error exit status.
---
--- @param path the location of the repository
readRepositoryFrom :: String -> IO (Repository, [String])
--- @return repository
readRepositoryFrom :: String -> IO Repository
readRepositoryFrom path = do
(repo, repoErrors) <- tryReadRepositoryFrom path
if null repoErrors
then return repo
else do errorMessage "Problems while reading the package index:"
mapM_ errorMessage repoErrors
exitWith 1
--- Reads all package specifications from a repository.
---
--- @param path the location of the repository
--- @return repository and possible repository reading errors
tryReadRepositoryFrom :: String -> IO (Repository, [String])
tryReadRepositoryFrom path = do
debugMessage $ "Reading repository index from '" ++ path ++ "'..."
repos <- checkAndGetVisibleDirectoryContents path
pkgPaths <- mapIO getDir (map (path </>) repos) >>= return . concat
......@@ -186,14 +180,15 @@ readRepositoryFrom path = do
verPaths <- return $ concatMap (\ (d, p) -> map (d </>) p)
$ zip pkgPaths verDirs
specPaths <- return $ map (</> "package.json") verPaths
putStr "Reading repository index"
specs <- mapIO readPackageFile specPaths
putChar '\n'
when (null (lefts specs)) $ debugMessage "Finished reading repository"
return $ (Repository $ rights specs, lefts specs)
where
readPackageSpecIO = liftIO readPackageSpec
readPackageFile f = do
spec <- readPackageSpecIO $ readCompleteFile f
spec <- liftM readPackageSpec $ readCompleteFile f
seq (id $!! spec) (putChar '.')
return $ case spec of
Left err -> Left $ "Problem reading '" ++ f ++ "': " ++ err
Right s -> Right s
......@@ -201,140 +196,18 @@ readRepositoryFrom path = do
getDir d = doesDirectoryExist d >>= \b -> return $ if b then [d] else []
--- Updates the package index from the central Git repository.
--- Cleans also the global package cache in order to support
--- downloading the newest versions.
updateRepository :: Config -> IO (ErrorLogger ())
updateRepository cfg = do
cleanRepositoryCache cfg
debugMessage $ "Deleting global package cache: '" ++
packageInstallDir cfg ++ "'"
removeDirectoryComplete (packageInstallDir cfg)