Commit dd7572d4 authored by Michael Hanus 's avatar Michael Hanus
Browse files

CPM updated

parent 7d390c8a
......@@ -87,7 +87,8 @@ To install and use CPM, a working installation of either
PAKCS in version 1.14.1 or greater, or
KiCS2 in version 0.5.1 or greater is required. Additionally, CPM requires
\emph{Git}\footnote{\url{http://www.git-scm.com}},
\emph{curl}\footnote{\url{https://curl.haxx.se}}
\emph{curl}\footnote{\url{https://curl.haxx.se}},
\emph{tar},
and \emph{unzip} to be available on the \code{PATH} during installation and
operation. You also need to ensure that your Haskell installations reads files
using UTF-8 encoding by default. Haskell uses the system locale charmap for its
......@@ -570,7 +571,9 @@ There are three things that need to be done to publish a package: make the
package accessible somewhere, add the location to the package specification, and
add the package specification to the central package index.
CPM supports ZIP files accessible over HTTP as well as Git repositories as
CPM supports ZIP (suffix \ccode{.zip}) or
compressed TAR (suffix \ccode{.tar.gz}) files
accessible over HTTP as well as Git repositories as
package sources. You are free to choose one of those, but a publicly accessible
Git repository is preferred. To add the location to the package specification,
use the \code{source} key. For a HTTP source, use:
......
......@@ -36,6 +36,8 @@ import CPM.PackageCache.Global ( GlobalCache, readGlobalCache, allPackages
, installFromZip, checkoutPackage
, uninstallPackage, packageInstalled )
import CPM.Package
import CPM.Package.Helpers ( cleanPackage, getLocalPackageSpec
, renderPackageInfo )
import CPM.Resolution ( isCompatibleToCompiler, showResult )
import CPM.Repository ( Repository, findVersion, listPackages
, findAllVersions, findLatestVersion
......@@ -54,7 +56,7 @@ cpmBanner :: String
cpmBanner = unlines [bannerLine,bannerText,bannerLine]
where
bannerText =
"Curry Package Manager <curry-language.org/tools/cpm> (version of 04/04/2018)"
"Curry Package Manager <curry-language.org/tools/cpm> (version of 27/04/2018)"
bannerLine = take (length bannerText) (repeat '-')
main :: IO ()
......@@ -706,6 +708,7 @@ checkRequiredExecutables = do
[ "curl"
, "git"
, "unzip"
, "tar"
, "cp"
, "rm"
, "ln"
......@@ -1103,15 +1106,14 @@ docCmd opts cfg =
let docdir = maybe "cdoc" id (docDir opts) </> packageId pkg
absdocdir <- getAbsolutePath docdir
createDirectoryIfMissing True absdocdir
(if docManual opts then genPackageManual opts cfg pkg absdocdir
(if docManual opts then genPackageManual pkg specDir absdocdir
else succeedIO ()) |>
(if docPrograms opts then genDocForPrograms opts cfg absdocdir specDir pkg
else succeedIO ())
--- Generate manual according to documentation specification of package.
genPackageManual :: DocOptions -> Config -> Package -> String
-> IO (ErrorLogger ())
genPackageManual _ _ pkg outputdir = case documentation pkg of
genPackageManual :: Package -> String -> String -> IO (ErrorLogger ())
genPackageManual pkg specDir outputdir = case documentation pkg of
Nothing -> succeedIO ()
Just (PackageDocumentation docdir docmain doccmd) -> do
let formatcmd = replaceSubString "OUTDIR" outputdir $
......@@ -1122,7 +1124,7 @@ genPackageManual _ _ pkg outputdir = case documentation pkg of
docmain ++ "' (unknown kind)"
else do
debugMessage $ "Executing command: " ++ formatcmd
inDirectory docdir $ system formatcmd
inDirectory (specDir </> docdir) $ system formatcmd
let outfile = outputdir </> replaceExtension docmain ".pdf"
system ("chmod -f 644 " ++ quote outfile) -- make it readable
infoMessage $ "Package documentation written to '" ++ outfile ++ "'."
......@@ -1373,21 +1375,6 @@ computePackageLoadPath cfg pkgdir =
notCurrentBase pkg = name pkg /= "base" ||
showVersion (version pkg) /= compilerBaseVersion cfg
-- Clean auxiliary files in the current package
cleanPackage :: Config -> LogLevel -> IO (ErrorLogger ())
cleanPackage cfg ll =
getLocalPackageSpec cfg "." |>= \specDir ->
loadPackageSpec specDir |>= \pkg ->
let dotcpm = specDir </> ".cpm"
srcdirs = map (specDir </>) (sourceDirsOf pkg)
testdirs = map (specDir </>)
(maybe []
(map (\ (PackageTest m _ _ _) -> m))
(testSuite pkg))
rmdirs = nub (dotcpm : map addCurrySubdir (srcdirs ++ testdirs))
in log ll ("Removing directories: " ++ unwords rmdirs) |>
(showExecCmd (unwords $ ["rm", "-rf"] ++ rmdirs) >> succeedIO ())
--- Creates a new package.
newPackage :: NewOptions -> IO (ErrorLogger ())
......
--------------------------------------------------------------------------------
--- This module contains some operations for processing packages,
--- like installing package sources, cleaning packages,
--- rendering package infos.
--------------------------------------------------------------------------------
module CPM.Package.Helpers
( installPackageSourceTo
, renderPackageInfo
, cleanPackage
, getLocalPackageSpec
) where
import Directory
import Distribution ( addCurrySubdir )
import FilePath
import List ( splitOn, nub )
import Text.Pretty hiding ( (</>) )
import CPM.Config ( Config, homePackageDir )
import CPM.ErrorLogger
import CPM.FileUtil ( inDirectory, inTempDir, quote
, removeDirectoryComplete, tempDir, whenFileExists )
import CPM.Helpers ( strip )
import CPM.Package
------------------------------------------------------------------------------
--- Installs the source of the package from the given source location
--- into the subdirectory `packageId pkg` of the given directory.
installPackageSourceTo :: Package -> PackageSource -> String
-> IO (ErrorLogger ())
---
--- @param pkg - the package specification of the package
--- @param source - the source of the package
--- @param installdir - the directory where the package subdirectory should be
--- installed
installPackageSourceTo pkg (Git url rev) installdir = do
let pkgDir = installdir </> pkgid
c <- inDirectory installdir $ execQuietCmd cloneCommand
if c == 0
then case rev of
Nothing -> checkoutGitRef pkgDir "HEAD"
Just (Tag tag) -> checkoutGitRef pkgDir
(replaceVersionInTag pkg tag)
Just (Ref ref) -> checkoutGitRef pkgDir ref
Just VersionAsTag ->
let tag = "v" ++ (showVersion $ version pkg)
in checkoutGitRef pkgDir tag |>
log Info ("Package '" ++ packageId pkg ++ "' installed")
else removeDirectoryComplete pkgDir >>
failIO ("Failed to clone repository from '" ++ url ++
"', return code " ++ show c)
where
pkgid = packageId pkg
cloneCommand q = unwords ["git clone", q, quote url, quote $ pkgid]
installPackageSourceTo pkg (FileSource zipfile) installdir =
installPkgFromFile pkg zipfile (installdir </> packageId pkg) False
installPackageSourceTo pkg (Http url) installdir = do
let pkgDir = installdir </> packageId pkg
revurl = reverse url
pkgfile = if take 4 revurl == "piz." then "package.zip" else
if take 7 revurl == "zg.rat." then "package.tar.gz" else ""
if null pkgfile
then failIO $ "Illegal URL (only .zip or .tar.gz allowed):\n" ++ url
else do
tmpdir <- tempDir
let tmppkgfile = tmpdir </> pkgfile
c <- inTempDir $ showExecCmd $ "curl -s -o " ++ tmppkgfile ++
" " ++ quote url
if c == 0
then installPkgFromFile pkg tmppkgfile pkgDir True
else failIO $ "`curl` failed with exit status " ++ show c
--- Installs a package from a .zip or .tar.gz file into the specified
--- package directory. If the last argument is true, the file will be
--- deleted after unpacking.
installPkgFromFile :: Package -> String -> String -> Bool -> IO (ErrorLogger ())
installPkgFromFile pkg pkgfile pkgDir rmfile = do
let iszip = take 4 (reverse pkgfile) == "piz."
absfile <- getAbsolutePath pkgfile
createDirectory pkgDir
c <- if iszip
then inTempDir $ showExecCmd $ "unzip -qq -d " ++ quote pkgDir ++
" " ++ quote absfile
else inDirectory pkgDir $ showExecCmd $
"tar -xzf " ++ quote absfile
when rmfile (showExecCmd ("rm -f " ++ absfile) >> done)
if c == 0
then log Info $ "Installed " ++ packageId pkg
else do removeDirectoryComplete pkgDir
failIO ("Failed to unzip package, return code " ++ show c)
--- Checks out a specific ref of a Git repository and deletes
--- the Git auxiliary files (i.e., `.git` and `.gitignore`).
---
--- @param dir - the directory containing the repo
--- @param ref - the ref to check out
checkoutGitRef :: String -> String -> IO (ErrorLogger ())
checkoutGitRef dir ref = do
c <- inDirectory dir $ execQuietCmd (\q -> unwords ["git checkout", q, ref])
if c == 0
then removeGitFiles >> succeedIO ()
else removeDirectoryComplete dir >>
failIO ("Failed to check out " ++ ref ++ ", return code " ++ show c)
where
removeGitFiles = do
removeDirectoryComplete (dir </> ".git")
let gitignore = dir </> ".gitignore"
whenFileExists gitignore (removeFile gitignore)
------------------------------------------------------------------------------
--- Cleans auxiliary files in the local package, i.e., the package
--- containing the current working directory.
cleanPackage :: Config -> LogLevel -> IO (ErrorLogger ())
cleanPackage cfg ll =
getLocalPackageSpec cfg "." |>= \specDir ->
loadPackageSpec specDir |>= \pkg ->
let dotcpm = specDir </> ".cpm"
srcdirs = map (specDir </>) (sourceDirsOf pkg)
testdirs = map (specDir </>)
(maybe []
(map (\ (PackageTest m _ _ _) -> m))
(testSuite pkg))
rmdirs = nub (dotcpm : map addCurrySubdir (srcdirs ++ testdirs))
in log ll ("Removing directories: " ++ unwords rmdirs) |>
(showExecCmd (unwords $ ["rm", "-rf"] ++ rmdirs) >> succeedIO ())
------------------------------------------------------------------------------
--- Renders information about a package.
renderPackageInfo :: Bool -> Bool -> Bool -> Package -> String
renderPackageInfo allinfos plain installed pkg = pPrint doc
where
boldText s = (if plain then id else bold) $ text s
maxLen = 12
doc = vcat $ [ heading, rule
, if allinfos then instTxt installed else empty
, ver, auth, maintnr, synop
, cats, deps, compilers, descr, execspec ] ++
if allinfos
then [ srcdirs, expmods, cfgmod ] ++ testsuites ++
[ docuspec, src, licns, licfl, copyrt, homepg
, reposy, bugrep ]
else []
pkgId = packageId pkg
heading = text pkgId
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)
auth = fill maxLen (boldText "Author") <+>
indent 0 (fillSep (map (text . strip) (splitOn "," $ author pkg)))
synop = fill maxLen (boldText "Synopsis") <+>
indent 0 (fillSep (map text (words (synopsis pkg))))
deps = boldText "Dependencies" <$$>
(vcat $ map (indent 4 . text . showDependency) $ dependencies pkg)
maintnr = case maintainer pkg of
Nothing -> empty
Just s -> fill maxLen (boldText "Maintainer") <+>
indent 0 (fillSep (map (text . strip) (splitOn "," s)))
cats =
if null (category pkg)
then empty
else fill maxLen (boldText "Category") <+>
indent 0 (fillSep (map text (category pkg)))
execspec = case executableSpec pkg of
Nothing -> empty
Just (PackageExecutable n m eopts) ->
if allinfos
then boldText "Executable" <$$>
indent 4 (boldText "Name " <+> text n) <$$>
indent 4 (boldText "Main module " <+> text m) <$$>
if null eopts
then empty
else indent 4 (boldText "Options ") <+>
align (vsep (map (\ (c,o) -> text $ c ++ ": " ++ o) eopts))
else fill maxLen (boldText "Executable") <+> text n
testsuites = case testSuite pkg of
Nothing -> []
Just tests ->
map (\ (PackageTest dir mods opts script) ->
let check = if null script then "Check" else "Test" in
boldText "Test suite" <$$>
indent 4 (boldText "Directory " <+> text dir) <$$>
(if null script
then empty
else indent 4 (boldText "Test script " <+> text script)) <$$>
(if null opts
then empty
else indent 4 (boldText (check++" options") <+>
text opts)) <$$>
(if null mods
then empty
else indent 4 (boldText "Test modules " <+>
align (fillSep (map text mods)))))
tests
docuspec = case documentation pkg of
Nothing -> empty
Just (PackageDocumentation docdir docmain doccmd) ->
boldText "Documentation" <$$>
indent 4 (boldText "Directory " <+> text docdir) <$$>
indent 4 (boldText "Main file " <+> text docmain) <$$>
if null doccmd
then empty
else indent 4 (boldText "Command ") <+> text doccmd
descr = showParaField description "Description"
licns = showLineField license "License"
licfl = showLineField licenseFile "License file"
copyrt = showParaField copyright "Copyright"
homepg = showLineField homepage "Homepage"
reposy = showLineField repository "Repository"
bugrep = showLineField bugReports "Bug reports"
cfgmod = showLineField configModule "Config module"
src = maybe empty
(\_ -> boldText "Source" <$$>
indent 4 (text $ showPackageSource pkg))
(source pkg)
srcdirs =
if null (sourceDirs pkg)
then empty
else boldText "Source directories" <$$>
indent 4 (fillSep (map text (sourceDirs pkg)))
expmods =
if null (exportedModules pkg)
then empty
else boldText "Exported modules" <$$>
indent 4 (fillSep (map text (exportedModules pkg)))
compilers =
if null (compilerCompatibility pkg)
then empty
else boldText "Compiler compatibility" <$$>
(vcat $ map (indent 4 . text . showCompilerDependency)
$ compilerCompatibility pkg)
showLineField fgetter fname = case fgetter pkg of
Nothing -> empty
Just s -> boldText fname <$$> indent 4 (text s)
showParaField fgetter fname = case fgetter pkg of
Nothing -> empty
Just s -> boldText fname <$$>
indent 4 (fillSep (map text (words s)))
------------------------------------------------------------------------------
--- Tries to find a package specification in the given directory or one of its
--- ancestors. If there is no package specifiction in these directories,
--- the home package specification (i.e., `~/.cpm/home-package/package.json`
--- is returned (and created if it does not exist).
--- In order to avoid infinite loops due to cyclic file structures,
--- the search is limited to the number of directories occurring in the
--- current absolute path.
getLocalPackageSpec :: Config -> String -> IO (ErrorLogger String)
getLocalPackageSpec cfg dir = do
adir <- getAbsolutePath dir
searchLocalSpec (length (splitPath adir)) dir
>>= maybe returnHomePackage succeedIO
where
returnHomePackage = do
let homepkgdir = homePackageDir cfg
homepkgspec = homepkgdir </> "package.json"
specexists <- doesFileExist homepkgspec
unless (specexists || null homepkgdir) $ do
createDirectoryIfMissing True homepkgdir
let newpkg = emptyPackage
{ name = snd (splitFileName homepkgdir)
, version = initialVersion
, author = "CPM"
, synopsis = "Default home package"
, dependencies = []
}
writePackageSpec newpkg homepkgspec
infoMessage $ "New empty package specification '" ++ homepkgspec ++
"' generated"
succeedIO homepkgdir
searchLocalSpec m sdir = do
existsLocal <- doesFileExist $ sdir </> "package.json"
if existsLocal
then return (Just sdir)
else do
debugMessage ("No package.json in " ++ show sdir ++ ", trying " ++
show (sdir </> ".."))
parentExists <- doesDirectoryExist $ sdir </> ".."
if m>0 && parentExists
then searchLocalSpec (m-1) $ sdir </> ".."
else return Nothing
------------------------------------------------------------------------------
......@@ -33,9 +33,10 @@ import FilePath
import CPM.Config ( Config, packageInstallDir )
import CPM.ErrorLogger
import CPM.FileUtil ( copyDirectory, inTempDir, recreateDirectory, inDirectory
, removeDirectoryComplete, tempDir
, removeDirectoryComplete, tempDir, whenFileExists
, checkAndGetVisibleDirectoryContents, quote )
import CPM.Package
import CPM.Package.Helpers ( installPackageSourceTo )
import CPM.Repository
------------------------------------------------------------------------------
......@@ -115,73 +116,20 @@ acquireAndInstallPackage cfg reppkg =
readPackageFromRepository cfg reppkg |>= \pkg ->
case source pkg of
Nothing -> failIO $ "No source specified for " ++ packageId pkg
Just s -> log Info ("Installing package from " ++ showPackageSource pkg) |>
Just s -> log Info ("Installing package '" ++ packageId pkg ++ "'...") |>
installFromSource cfg pkg s
------------------------------------------------------------------------------
--- Installs a package from the given package source to the global package
--- cache.
installFromSource :: Config -> Package -> PackageSource -> IO (ErrorLogger ())
installFromSource cfg pkg (Git url rev) = do
pkgDirExists <- doesDirectoryExist pkgDir
if pkgDirExists
then
log Info $ "Package '" ++ packageId pkg ++ "' already installed, skipping"
else do
c <- inDirectory (packageInstallDir cfg) $ execQuietCmd cloneCommand
if c == 0
then case rev of
Nothing -> checkoutGitRef pkgDir "HEAD"
Just (Tag tag) -> checkoutGitRef pkgDir
(replaceVersionInTag pkg tag)
Just (Ref ref) -> checkoutGitRef pkgDir ref
Just VersionAsTag ->
let tag = "v" ++ (showVersion $ version pkg)
in checkoutGitRef pkgDir tag |>
log Info ("Package '" ++ packageId pkg ++ "' installed")
else removeDirectoryComplete pkgDir >>
failIO ("Failed to clone repository from '" ++ url ++
"', return code " ++ show c)
where
pkgDir = installedPackageDir cfg pkg
cloneCommand q = unwords ["git clone", q, quote url, quote $ packageId pkg]
installFromSource cfg pkg (FileSource zip) = do
absZip <- getAbsolutePath zip
installFromSource cfg pkg pkgsource = do
pkgDirExists <- doesDirectoryExist pkgDir
if pkgDirExists
then
log Info $ "Package '" ++ packageId pkg ++ "' already installed, skipping"
else do
createDirectory pkgDir
c <- inTempDir $ showExecCmd $ "unzip -qq -d " ++ quote pkgDir ++
" " ++ quote absZip
if c == 0
then log Info $ "Installed " ++ (packageId pkg)
else removeDirectoryComplete pkgDir >>
failIO ("Failed to unzip package, return code " ++ show c)
where
pkgDir = installedPackageDir cfg pkg
installFromSource cfg pkg (Http url) = do
c <- inTempDir $ showExecCmd $ "curl -s -o package.zip " ++ quote url
if c == 0
then do
pkgDirExists <- doesDirectoryExist pkgDir
if pkgDirExists
then log Info $ "Package '" ++ packageId pkg ++
"' already installed, skipping"
else do
createDirectory pkgDir
c' <- inTempDir $ showExecCmd $ "unzip -qq -d " ++ quote pkgDir ++
" package.zip"
if c' == 0
then do
c'' <- inTempDir $ showExecCmd ("rm package.zip")
if c'' == 0
then log Info ("Installed " ++ packageId pkg)
else failIO $ "failed to delete package.zip"
else failIO $ "failed to unzip package.zip " ++ (show c')
else failIO $ "curl failed with " ++ (show c)
else log Info ("Installing package from " ++ showPackageSource pkg) |>
installPackageSourceTo pkg pkgsource (packageInstallDir cfg)
where
pkgDir = installedPackageDir cfg pkg
......@@ -193,24 +141,12 @@ installFromZip cfg zip = do
absZip <- getAbsolutePath zip
c <- inTempDir $ showExecCmd $ "unzip -qq -d installtmp " ++ quote absZip
if c == 0
then do
loadPackageSpec (t </> "installtmp") |>=
\pkgSpec -> log Debug ("ZIP contains " ++ (packageId pkgSpec)) |>
installFromSource cfg pkgSpec (FileSource zip)
then
loadPackageSpec (t </> "installtmp") |>= \pkgSpec ->
log Debug ("ZIP contains " ++ packageId pkgSpec) |>
installFromSource cfg pkgSpec (FileSource zip)
else failIO "failed to extract ZIP file"
--- Checks out a specific ref of a Git repository
---
--- @param dir - the directory containing the repo
--- @param ref - the ref to check out
checkoutGitRef :: String -> String -> IO (ErrorLogger ())
checkoutGitRef dir ref = do
c <- inDirectory dir $ execQuietCmd (\q -> unwords ["git checkout", q, ref])
if c == 0
then succeedIO ()
else removeDirectoryComplete dir >>
failIO ("Failed to check out " ++ ref ++ ", return code " ++ show c)
--- Installs a package's missing dependencies.
installMissingDependencies :: Config -> GlobalCache -> [Package]
-> IO (ErrorLogger ())
......
--------------------------------------------------------------------------------
--- Contains functions that operate on a package copy. And some functions that
--- don't quite fit anywhere else.
--- This module contains operations that operate on a package copy.
--------------------------------------------------------------------------------
module CPM.PackageCopy
......@@ -9,35 +8,20 @@ module CPM.PackageCopy
, resolveDependencies
, upgradeAllPackages
, upgradeSinglePackage
, getLocalPackageSpec
, linkToLocalCache
, acquireAndInstallPackageWithDependencies
, installLocalDependencies
, renderPackageInfo
) where
import Debug
import Directory ( doesFileExist, getAbsolutePath, createDirectoryIfMissing
, doesDirectoryExist, getTemporaryDirectory
, getCurrentDirectory, setCurrentDirectory, createDirectory
, removeDirectory, getDirectoryContents, copyFile )
import FilePath ( (</>), takeExtension, takeBaseName, joinPath, splitPath
, splitFileName, takeDirectory )
import AbstractCurry.Types (CurryProg)
import List ( intercalate, splitOn )
import Maybe ( mapMaybe, fromJust )
import System ( system )
import Directory ( doesDirectoryExist )
import List ( intercalate )
import Maybe ( mapMaybe )
import Text.Pretty hiding ( (</>) )
import CPM.AbstractCurry
import CPM.Config ( Config, packageInstallDir, baseVersion, homePackageDir )
import CPM.Config ( Config, baseVersion )
import CPM.Repository ( Repository, allPackages )
import CPM.Repository.Select
import qualified CPM.LookupSet as LS
import CPM.ErrorLogger
import CPM.FileUtil ( copyDirectory, recreateDirectory )
import CPM.Helpers ( strip )
import qualified CPM.PackageCache.Global as GC
import qualified CPM.PackageCache.Runtime as RuntimeCache
import qualified CPM.PackageCache.Local as LocalCache
......@@ -68,7 +52,7 @@ lookupSetForPackageCopy cfg _ repo gc dir =
packageId p ++ "' from local cache."
lsRepo = addPackagesWOBase cfg LS.emptySet allRepoPackages LS.FromRepository
-- Find all packages that are in the global cache, but not in the repo
newInGC = filter (\p -> not $ elemBy (packageIdEq p) allRepoPackages)
newInGC = filter (\p -> not $ any (packageIdEq p) allRepoPackages)
(GC.allPackages gc)
lsGC = addPackagesWOBase cfg lsRepo newInGC LS.FromGlobalCache
filterGCLinked p = do
......@@ -88,7 +72,7 @@ resolveDependenciesForPackage cfg pkg repo gc =
LS.FromRepository
-- Find all packages that are in the global cache, but not in the repo
newInGC = filter inGCButNotInRepo $ GC.allPackages gc
inGCButNotInRepo p = not $ elemBy (packageIdEq p) (allPackages repo)
inGCButNotInRepo p = not $ any (packageIdEq p) (allPackages repo)
lookupSet = addPackagesWOBase cfg lsRepo newInGC LS.FromGlobalCache
--- Acquires a package and its dependencies and installs them to the global
......@@ -101,12 +85,6 @@ acquireAndInstallPackageWithDependencies cfg repo pkg =
\result -> GC.installMissingDependencies cfg gc (resolvedPackages result) |>
GC.acquireAndInstallPackage cfg pkg
elemBy :: (a -> Bool) -> [a] -> Bool
elemBy _ [] = False
elemBy f (x:xs) = if f x
then True
else elemBy f xs
--- Links the dependencies of a package to its local cache and copies them to
--- its runtime cache. Returns the package specifications of the dependencies.
copyDependencies :: Config -> Package -> [Package] -> String
......@@ -170,49 +148,6 @@ linkToLocalCache src pkgDir = do
else log Critical ("Directory '" ++ src ++ "' does not exist.") |>
succeedIO ()
--- Tries to find a package specification in the given directory or one of its
--- ancestors. If there is no package specifiction in these directories,
--- the home package specification (i.e., `~/.cpm/home-package/package.json`
--- is returned (and created if it does not exist).
--- In order to avoid infinite loops due to cyclic file structures,
--- the search is limited to the number of directories occurring in the
--- current absolute path.
getLocalPackageSpec :: Config -> String -> IO (ErrorLogger String)
getLocalPackageSpec cfg dir = do
adir <- getAbsolutePath dir
searchLocalSpec (length (splitPath adir)) dir
>>= maybe returnHomePackage succeedIO
where
returnHomePackage = do
let homepkgdir = homePackageDir cfg
homepkgspec = homepkgdir </> "package.json"
specexists <- doesFileExist homepkgspec
unless (specexists || null homepkgdir) $ do
createDirectoryIfMissing True homepkgdir
let newpkg = emptyPackage
{ name = snd (splitFileName homepkgdir)
, version = initialVersion
, author = "CPM"
, synopsis = "Default home package"
, dependencies = []
}
writePackageSpec newpkg homepkgspec
infoMessage $ "New empty package specification '" ++ homepkgspec ++
"' generated"
succeedIO homepkgdir
searchLocalSpec m sdir = do
existsLocal <- doesFileExist $ sdir </> "package.json"
if existsLocal
then return (Just sdir)
else do
debugMessage ("No package.json in " ++ show sdir ++ ", trying " ++
show (sdir </> ".."))
parentExists <- doesDirectoryExist $ sdir </> ".."
if m>0 && parentExists
then searchLocalSpec (m-1) $ sdir </> ".."
else return Nothing
--- Resolves the dependencies for a package copy and fills the package caches.
resolveAndCopyDependencies :: Config -> Repository -> GC.GlobalCache -> String