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 ...@@ -87,7 +87,8 @@ To install and use CPM, a working installation of either
PAKCS in version 1.14.1 or greater, or PAKCS in version 1.14.1 or greater, or
KiCS2 in version 0.5.1 or greater is required. Additionally, CPM requires KiCS2 in version 0.5.1 or greater is required. Additionally, CPM requires
\emph{Git}\footnote{\url{http://www.git-scm.com}}, \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 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 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 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 ...@@ -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 package accessible somewhere, add the location to the package specification, and
add the package specification to the central package index. 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 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, Git repository is preferred. To add the location to the package specification,
use the \code{source} key. For a HTTP source, use: use the \code{source} key. For a HTTP source, use:
......
...@@ -36,6 +36,8 @@ import CPM.PackageCache.Global ( GlobalCache, readGlobalCache, allPackages ...@@ -36,6 +36,8 @@ import CPM.PackageCache.Global ( GlobalCache, readGlobalCache, allPackages
, installFromZip, checkoutPackage , installFromZip, checkoutPackage
, uninstallPackage, packageInstalled ) , uninstallPackage, packageInstalled )
import CPM.Package import CPM.Package
import CPM.Package.Helpers ( cleanPackage, getLocalPackageSpec
, renderPackageInfo )
import CPM.Resolution ( isCompatibleToCompiler, showResult ) import CPM.Resolution ( isCompatibleToCompiler, showResult )
import CPM.Repository ( Repository, findVersion, listPackages import CPM.Repository ( Repository, findVersion, listPackages
, findAllVersions, findLatestVersion , findAllVersions, findLatestVersion
...@@ -54,7 +56,7 @@ cpmBanner :: String ...@@ -54,7 +56,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 04/04/2018)" "Curry Package Manager <curry-language.org/tools/cpm> (version of 27/04/2018)"
bannerLine = take (length bannerText) (repeat '-') bannerLine = take (length bannerText) (repeat '-')
main :: IO () main :: IO ()
...@@ -706,6 +708,7 @@ checkRequiredExecutables = do ...@@ -706,6 +708,7 @@ checkRequiredExecutables = do
[ "curl" [ "curl"
, "git" , "git"
, "unzip" , "unzip"
, "tar"
, "cp" , "cp"
, "rm" , "rm"
, "ln" , "ln"
...@@ -1103,15 +1106,14 @@ docCmd opts cfg = ...@@ -1103,15 +1106,14 @@ docCmd opts cfg =
let docdir = maybe "cdoc" id (docDir opts) </> packageId pkg let docdir = maybe "cdoc" id (docDir opts) </> packageId pkg
absdocdir <- getAbsolutePath docdir absdocdir <- getAbsolutePath docdir
createDirectoryIfMissing True absdocdir createDirectoryIfMissing True absdocdir
(if docManual opts then genPackageManual opts cfg pkg absdocdir (if docManual opts then genPackageManual pkg specDir absdocdir
else succeedIO ()) |> else succeedIO ()) |>
(if docPrograms opts then genDocForPrograms opts cfg absdocdir specDir pkg (if docPrograms opts then genDocForPrograms opts cfg absdocdir specDir pkg
else succeedIO ()) else succeedIO ())
--- Generate manual according to documentation specification of package. --- Generate manual according to documentation specification of package.
genPackageManual :: DocOptions -> Config -> Package -> String genPackageManual :: Package -> String -> String -> IO (ErrorLogger ())
-> IO (ErrorLogger ()) genPackageManual pkg specDir outputdir = case documentation pkg of
genPackageManual _ _ pkg outputdir = case documentation pkg of
Nothing -> succeedIO () Nothing -> succeedIO ()
Just (PackageDocumentation docdir docmain doccmd) -> do Just (PackageDocumentation docdir docmain doccmd) -> do
let formatcmd = replaceSubString "OUTDIR" outputdir $ let formatcmd = replaceSubString "OUTDIR" outputdir $
...@@ -1122,7 +1124,7 @@ genPackageManual _ _ pkg outputdir = case documentation pkg of ...@@ -1122,7 +1124,7 @@ genPackageManual _ _ pkg outputdir = case documentation pkg of
docmain ++ "' (unknown kind)" docmain ++ "' (unknown kind)"
else do else do
debugMessage $ "Executing command: " ++ formatcmd debugMessage $ "Executing command: " ++ formatcmd
inDirectory docdir $ system formatcmd inDirectory (specDir </> docdir) $ system formatcmd
let outfile = outputdir </> replaceExtension docmain ".pdf" let outfile = outputdir </> replaceExtension docmain ".pdf"
system ("chmod -f 644 " ++ quote outfile) -- make it readable system ("chmod -f 644 " ++ quote outfile) -- make it readable
infoMessage $ "Package documentation written to '" ++ outfile ++ "'." infoMessage $ "Package documentation written to '" ++ outfile ++ "'."
...@@ -1373,21 +1375,6 @@ computePackageLoadPath cfg pkgdir = ...@@ -1373,21 +1375,6 @@ computePackageLoadPath cfg pkgdir =
notCurrentBase pkg = name pkg /= "base" || notCurrentBase pkg = name pkg /= "base" ||
showVersion (version pkg) /= compilerBaseVersion cfg 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. --- Creates a new package.
newPackage :: NewOptions -> IO (ErrorLogger ()) 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 ...@@ -33,9 +33,10 @@ 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, whenFileExists
, checkAndGetVisibleDirectoryContents, quote ) , checkAndGetVisibleDirectoryContents, quote )
import CPM.Package import CPM.Package
import CPM.Package.Helpers ( installPackageSourceTo )
import CPM.Repository import CPM.Repository
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
...@@ -115,73 +116,20 @@ acquireAndInstallPackage cfg reppkg = ...@@ -115,73 +116,20 @@ acquireAndInstallPackage cfg reppkg =
readPackageFromRepository cfg reppkg |>= \pkg -> readPackageFromRepository cfg reppkg |>= \pkg ->
case source pkg of 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 '" ++ packageId pkg ++ "'...") |>
installFromSource cfg pkg s installFromSource cfg pkg s
------------------------------------------------------------------------------
--- Installs a package from the given package source to the global package --- Installs a package from the given package source to the global package
--- cache. --- cache.
installFromSource :: Config -> Package -> PackageSource -> IO (ErrorLogger ()) installFromSource :: Config -> Package -> PackageSource -> IO (ErrorLogger ())
installFromSource cfg pkg (Git url rev) = do installFromSource cfg pkg pkgsource = 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
pkgDirExists <- doesDirectoryExist pkgDir pkgDirExists <- doesDirectoryExist pkgDir
if pkgDirExists if pkgDirExists
then then
log Info $ "Package '" ++ packageId pkg ++ "' already installed, skipping" log Info $ "Package '" ++ packageId pkg ++ "' already installed, skipping"
else do else log Info ("Installing package from " ++ showPackageSource pkg) |>
createDirectory pkgDir installPackageSourceTo pkg pkgsource (packageInstallDir cfg)
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)
where where
pkgDir = installedPackageDir cfg pkg pkgDir = installedPackageDir cfg pkg
...@@ -193,24 +141,12 @@ installFromZip cfg zip = do ...@@ -193,24 +141,12 @@ installFromZip cfg zip = do
absZip <- getAbsolutePath zip absZip <- getAbsolutePath zip
c <- inTempDir $ showExecCmd $ "unzip -qq -d installtmp " ++ quote absZip c <- inTempDir $ showExecCmd $ "unzip -qq -d installtmp " ++ quote absZip
if c == 0 if c == 0
then do then
loadPackageSpec (t </> "installtmp") |>= loadPackageSpec (t </> "installtmp") |>= \pkgSpec ->
\pkgSpec -> log Debug ("ZIP contains " ++ (packageId pkgSpec)) |> log Debug ("ZIP contains " ++ packageId pkgSpec) |>
installFromSource cfg pkgSpec (FileSource zip) installFromSource cfg pkgSpec (FileSource zip)
else failIO "failed to extract ZIP file" 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. --- Installs a package's missing dependencies.
installMissingDependencies :: Config -> GlobalCache -> [Package] installMissingDependencies :: Config -> GlobalCache -> [Package]
-> IO (ErrorLogger ()) -> IO (ErrorLogger ())
......
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
--- Contains functions that operate on a package copy. And some functions that --- This module contains operations that operate on a package copy.
--- don't quite fit anywhere else.
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
module CPM.PackageCopy module CPM.PackageCopy
...@@ -9,35 +8,20 @@ module CPM.PackageCopy ...@@ -9,35 +8,20 @@ module CPM.PackageCopy
, resolveDependencies , resolveDependencies
, upgradeAllPackages , upgradeAllPackages
, upgradeSinglePackage , upgradeSinglePackage
, getLocalPackageSpec
, linkToLocalCache , linkToLocalCache
, acquireAndInstallPackageWithDependencies , acquireAndInstallPackageWithDependencies
, installLocalDependencies , installLocalDependencies
, renderPackageInfo
) where ) where
import Debug import Directory ( doesDirectoryExist )
import Directory ( doesFileExist, getAbsolutePath, createDirectoryIfMissing import List ( intercalate )
, doesDirectoryExist, getTemporaryDirectory import Maybe ( mapMaybe )
, 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 Text.Pretty hiding ( (</>) ) import CPM.Config ( Config, baseVersion )
import CPM.AbstractCurry
import CPM.Config ( Config, packageInstallDir, baseVersion, homePackageDir )
import CPM.Repository ( Repository, allPackages ) import CPM.Repository ( Repository, allPackages )
import CPM.Repository.Select import CPM.Repository.Select
import qualified CPM.LookupSet as LS import qualified CPM.LookupSet as LS
import CPM.ErrorLogger import CPM.ErrorLogger
import CPM.FileUtil ( copyDirectory, recreateDirectory )
import CPM.Helpers ( strip )
import qualified CPM.PackageCache.Global as GC import qualified CPM.PackageCache.Global as GC
import qualified CPM.PackageCache.Runtime as RuntimeCache import qualified CPM.PackageCache.Runtime as RuntimeCache
import qualified CPM.PackageCache.Local as LocalCache import qualified CPM.PackageCache.Local as LocalCache
...@@ -68,7 +52,7 @@ lookupSetForPackageCopy cfg _ repo gc dir = ...@@ -68,7 +52,7 @@ lookupSetForPackageCopy cfg _ repo gc dir =