Commit 5184a878 authored by Michael Hanus 's avatar Michael Hanus
Browse files

CPM updated

parent 4817297b
...@@ -37,7 +37,8 @@ import CPM.Package ...@@ -37,7 +37,8 @@ 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
, findAllVersions, findLatestVersion, updateRepository , findAllVersions, findLatestVersion, updateRepository
, searchPackages, updateRepositoryCache ) , searchPackages, updateRepositoryCache
, readPackageFromRepository )
import CPM.PackageCache.Runtime ( dependencyPathsSeparate, writePackageConfig ) import CPM.PackageCache.Runtime ( dependencyPathsSeparate, writePackageConfig )
import CPM.PackageCopy import CPM.PackageCopy
import CPM.Diff.API as APIDiff import CPM.Diff.API as APIDiff
...@@ -49,7 +50,7 @@ cpmBanner :: String ...@@ -49,7 +50,7 @@ cpmBanner :: String
cpmBanner = unlines [bannerLine,bannerText,bannerLine] cpmBanner = unlines [bannerLine,bannerText,bannerLine]
where where
bannerText = bannerText =
"Curry Package Manager <curry-language.org/tools/cpm> (version of 28/11/2017)" "Curry Package Manager <curry-language.org/tools/cpm> (version of 29/11/2017)"
bannerLine = take (length bannerText) (repeat '-') bannerLine = take (length bannerText) (repeat '-')
main :: IO () main :: IO ()
...@@ -101,7 +102,6 @@ runWithArgs opts = do ...@@ -101,7 +102,6 @@ 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
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
...@@ -731,11 +731,13 @@ infoCmdRepoGC pkgname Nothing allinfos plain cfg repo gc = ...@@ -731,11 +731,13 @@ infoCmdRepoGC pkgname Nothing allinfos plain cfg repo gc =
in compatPackageNotFoundFailure cfg pkgname in compatPackageNotFoundFailure cfg pkgname
("Use 'info " ++ pkgname ++ " " ++ lvers ++ ("Use 'info " ++ pkgname ++ " " ++ lvers ++
"' to print info about the latest version.") "' to print info about the latest version.")
(p:_) -> printInfo allinfos plain (Just (isPackageInstalled gc p)) p (rp:_) -> readPackageFromRepository cfg rp |>= \p ->
infoCmdRepoGC pkg (Just v) allinfos plain _ repo gc = printInfo allinfos plain (Just (isPackageInstalled gc p)) p
infoCmdRepoGC pkg (Just v) allinfos plain cfg repo gc =
case findVersion repo pkg v of case findVersion repo pkg v of
Nothing -> packageNotFoundFailure $ pkg ++ "-" ++ showVersion v Nothing -> packageNotFoundFailure $ pkg ++ "-" ++ showVersion v
Just p -> printInfo allinfos plain (Just (isPackageInstalled gc p)) p Just rp -> readPackageFromRepository cfg rp |>= \p ->
printInfo allinfos plain (Just (isPackageInstalled gc p)) p
printInfo :: Bool -> Bool -> Maybe Bool -> Package printInfo :: Bool -> Bool -> Maybe Bool -> Package
-> IO (ErrorLogger ()) -> IO (ErrorLogger ())
......
...@@ -75,7 +75,8 @@ findNewestVersion db p = if length pkgs > 0 ...@@ -75,7 +75,8 @@ findNewestVersion db p = if length pkgs > 0
--- Finds a specific version of a package. --- Finds a specific version of a package.
findVersion :: GlobalCache -> String -> Version -> Maybe Package findVersion :: GlobalCache -> String -> Version -> Maybe Package
findVersion (GlobalCache ps) p v = if length hits == 0 findVersion (GlobalCache ps) p v =
if null hits
then Nothing then Nothing
else Just $ head hits else Just $ head hits
where where
...@@ -106,7 +107,9 @@ copyPackage cfg pkg dir = do ...@@ -106,7 +107,9 @@ copyPackage cfg pkg dir = do
--- Acquires a package from the source specified in its specification and --- Acquires a package from the source specified in its specification and
--- installs it to the global package cache. --- installs it to the global package cache.
acquireAndInstallPackage :: Config -> Package -> IO (ErrorLogger ()) acquireAndInstallPackage :: Config -> Package -> IO (ErrorLogger ())
acquireAndInstallPackage cfg pkg = case (source pkg) of acquireAndInstallPackage cfg reppkg =
readPackageFromRepository cfg reppkg |>= \pkg ->
case source pkg of
Nothing -> failIO $ "No source specified for " ++ packageId pkg Nothing -> failIO $ "No source specified for " ++ packageId pkg
Just s -> log Info ("Installing package from " ++ showPackageSource pkg) |> Just s -> log Info ("Installing package from " ++ showPackageSource pkg) |>
installFromSource cfg pkg s installFromSource cfg pkg s
...@@ -284,9 +287,7 @@ readInstalledPackagesFromDir repo path = do ...@@ -284,9 +287,7 @@ readInstalledPackagesFromDir repo path = do
Nothing -> readPackageSpecFromFile pkgdir Nothing -> readPackageSpecFromFile pkgdir
Just (pn,pv) -> case CPM.Repository.findVersion repo pn pv of Just (pn,pv) -> case CPM.Repository.findVersion repo pn pv of
Nothing -> readPackageSpecFromFile pkgdir Nothing -> readPackageSpecFromFile pkgdir
Just p -> do debugMessage $ "Package spec '" ++ packageId p ++ Just p -> return (Right p)
"' loaded from repository"
return (Right p)
readPackageSpecFromFile pkgdir = do readPackageSpecFromFile pkgdir = do
let f = path </> pkgdir </> "package.json" let f = path </> pkgdir </> "package.json"
......
...@@ -17,6 +17,7 @@ module CPM.Repository ...@@ -17,6 +17,7 @@ module CPM.Repository
, listPackages , listPackages
, updateRepository , updateRepository
, updateRepositoryCache , updateRepositoryCache
, readPackageFromRepository
) where ) where
import Char ( toLower, toUpper ) import Char ( toLower, toUpper )
...@@ -169,6 +170,7 @@ readRepositoryFrom path = do ...@@ -169,6 +170,7 @@ readRepositoryFrom path = do
dirOrSpec d = (not $ isPrefixOf "." d) && takeExtension d /= ".md" && dirOrSpec d = (not $ isPrefixOf "." d) && takeExtension d /= ".md" &&
(not $ isPrefixOf repositoryCacheFileName (map toUpper d)) (not $ isPrefixOf repositoryCacheFileName (map toUpper d))
--- Updates the package index from the central Git repository. --- Updates the package index from the central Git repository.
--- Cleans also the global package cache in order to support --- Cleans also the global package cache in order to support
--- downloading the newest versions. --- downloading the newest versions.
...@@ -199,6 +201,13 @@ updateRepository cfg = do ...@@ -199,6 +201,13 @@ updateRepository cfg = do
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- Operations implementing the repository cache for faster reading. -- Operations implementing the repository cache for faster reading.
-- The repository cache contains reduced package specifications
-- for faster reading/writing by removing some information
-- which is not relevant for the repository data structure.
--
-- The relevant package fields are:
-- name version synopsis category dependencies
-- compilerCompatibility sourceDirs exportedModules
--- The local file name containing the repository cache as a Curry term. --- The local file name containing the repository cache as a Curry term.
repositoryCacheFileName :: String repositoryCacheFileName :: String
...@@ -219,7 +228,19 @@ updateRepositoryCache cfg = do ...@@ -219,7 +228,19 @@ updateRepositoryCache cfg = do
writeRepositoryCache :: Config -> Repository -> IO () writeRepositoryCache :: Config -> Repository -> IO ()
writeRepositoryCache cfg repo = writeRepositoryCache cfg repo =
writeFile (repositoryCache cfg) writeFile (repositoryCache cfg)
(packageVersion ++ "\n" ++ showQTerm repo) (packageVersion ++ "\n" ++
showQTerm (map package2tuple (allPackages repo)))
where
package2tuple p =
( name p
, version p
, synopsis p
, category p
, dependencies p
, compilerCompatibility p
, sourceDirs p
, exportedModules p
)
--- Reads the given repository from the cache. --- Reads the given repository from the cache.
readRepositoryCache :: Config -> IO (Maybe Repository) readRepositoryCache :: Config -> IO (Maybe Repository)
...@@ -238,11 +259,24 @@ readRepositoryCache cfg = do ...@@ -238,11 +259,24 @@ readRepositoryCache cfg = do
h <- openFile cf ReadMode h <- openFile cf ReadMode
pv <- hGetLine h pv <- hGetLine h
if pv == packageVersion if pv == packageVersion
then hGetContents h >>= \t -> return $!! Just (readQTerm t) then hGetContents h >>= \t ->
return $!! Just (Repository (map tuple2package (readQTerm t)))
else do infoMessage "Cleaning repository cache (wrong version)..." else do infoMessage "Cleaning repository cache (wrong version)..."
cleanRepositoryCache cfg cleanRepositoryCache cfg
return Nothing return Nothing
tuple2package (nm,vs,sy,cat,dep,cmp,srcs,exps) =
emptyPackage { name = nm
, version = vs
, synopsis = sy
, category = cat
, dependencies = dep
, compilerCompatibility = cmp
, sourceDirs = srcs
, exportedModules = exps
}
--- Cleans the repository cache. --- Cleans the repository cache.
cleanRepositoryCache :: Config -> IO () cleanRepositoryCache :: Config -> IO ()
cleanRepositoryCache cfg = do cleanRepositoryCache cfg = do
...@@ -250,3 +284,12 @@ cleanRepositoryCache cfg = do ...@@ -250,3 +284,12 @@ cleanRepositoryCache cfg = do
whenFileExists cachefile $ removeFile cachefile whenFileExists cachefile $ removeFile cachefile
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
--- Reads a given package from the default repository directory.
--- This is useful to obtain the complete package specification
--- from a possibly incomplete package specification.
readPackageFromRepository :: Config -> Package -> IO (ErrorLogger Package)
readPackageFromRepository cfg pkg =
let pkgdir = repositoryDir cfg </> name pkg </> showVersion (version pkg)
in loadPackageSpec pkgdir
------------------------------------------------------------------------------
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