-------------------------------------------------------------------------------- --- Contains functions that operate on a package copy. And some functions that --- don't quite fit anywhere else. -------------------------------------------------------------------------------- module CPM.PackageCopy ( resolveDependenciesForPackageCopy , resolveAndCopyDependencies, resolveAndCopyDependenciesForPackage , resolveDependencies , upgradeAllPackages , upgradeSinglePackage , tryFindLocalPackageSpec , 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, takeDirectory) import AbstractCurry.Types (CurryProg) import List (intercalate, splitOn) import Maybe (mapMaybe, fromJust) import System (system) import Pretty hiding (()) import CPM.AbstractCurry import CPM.Config (Config, packageInstallDir) import CPM.Repository (Repository, allPackages) 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 import CPM.Package ( Package (..) , readPackageSpec, packageId, readVersion, Version , showVersion, PackageSource (..), showDependency , showCompilerDependency, showPackageSource , Dependency, GitRevision (..), PackageExecutable (..) , PackageTest (..) , packageIdEq, loadPackageSpec) import CPM.Resolution --- Resolves dependencies for a package copy. resolveDependenciesForPackageCopy :: Config -> Package -> Repository -> GC.GlobalCache -> String -> IO (ErrorLogger ResolutionResult) resolveDependenciesForPackageCopy cfg pkg repo gc dir = lookupSetForPackageCopy cfg pkg repo gc dir |>= \lookupSet -> resolveDependenciesFromLookupSet cfg pkg lookupSet --- Calculates the lookup set needed for dependency resolution on a package --- copy. lookupSetForPackageCopy :: Config -> Package -> Repository -> GC.GlobalCache -> String -> IO (ErrorLogger LS.LookupSet) lookupSetForPackageCopy cfg _ repo gc dir = LocalCache.allPackages dir |>= \localPkgs -> do diffInLC <- mapIO filterGCLinked localPkgs let lsLC = LS.addPackages lsGC localPkgs LS.FromLocalCache in mapEL logSymlinkedPackage (mapMaybe id diffInLC) |> succeedIO lsLC where logSymlinkedPackage p = log Debug $ "Using symlinked version of '" ++ (packageId p) ++ "' from local cache." lsRepo = LS.addPackages LS.emptySet (allPackages repo) LS.FromRepository -- Find all packages that are in the global cache, but not in the repo newInGC = filter (\p -> not $ elemBy (packageIdEq p) (allPackages repo)) $ GC.allPackages gc lsGC = LS.addPackages lsRepo newInGC LS.FromGlobalCache filterGCLinked p = do points <- LocalCache.doesLinkPointToGlobalCache cfg gc dir (packageId p) return $ if points then Nothing else Just p --- Resolves dependencies for a package. resolveDependenciesForPackage :: Config -> Package -> Repository -> GC.GlobalCache -> IO (ErrorLogger ResolutionResult) resolveDependenciesForPackage cfg pkg repo gc = resolveDependenciesFromLookupSet cfg pkg lookupSet where lsRepo = LS.addPackages LS.emptySet (allPackages repo) 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) lookupSet = LS.addPackages lsRepo newInGC LS.FromGlobalCache --- Acquires a package and its dependencies and installs them to the global --- package cache. acquireAndInstallPackageWithDependencies :: Config -> Repository -> GC.GlobalCache -> Package -> IO (ErrorLogger ()) acquireAndInstallPackageWithDependencies cfg repo gc pkg = resolveDependenciesForPackage cfg pkg repo gc |>= \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. copyDependencies :: Config -> GC.GlobalCache -> Package -> [Package] -> String -> IO (ErrorLogger ()) copyDependencies cfg gc pkg pkgs dir = LocalCache.linkPackages cfg dir gc pkgs |> RuntimeCache.copyPackages cfg pkgs' dir >> succeedIO () where pkgs' = filter (/= pkg) pkgs --- Upgrades all dependencies of a package copy. upgradeAllPackages :: Config -> Repository -> GC.GlobalCache -> String -> IO (ErrorLogger ()) upgradeAllPackages cfg repo gc dir = loadPackageSpec dir |>= \pkgSpec -> LocalCache.clearCache dir >> succeedIO () |> installLocalDependencies cfg repo gc dir |>= \ (_,deps) -> copyDependencies cfg gc pkgSpec deps dir --- Upgrades a single dependencies and its transitive dependencies. upgradeSinglePackage :: Config -> Repository -> GC.GlobalCache -> String -> String -> IO (ErrorLogger ()) upgradeSinglePackage cfg repo gc dir pkgName = loadPackageSpec dir |>= \pkgSpec -> lookupSetForPackageCopy cfg pkgSpec repo gc dir |>= \originalLS -> let transitiveDeps = pkgName : allTransitiveDependencies originalLS pkgName in resolveDependenciesFromLookupSet cfg pkgSpec (LS.setLocallyIgnored originalLS transitiveDeps) |>= \result -> GC.installMissingDependencies cfg gc (resolvedPackages result) |> log Info (showDependencies result) |> copyDependencies cfg gc pkgSpec (resolvedPackages result) dir --- Installs the dependencies of a package. installLocalDependencies :: Config -> Repository -> GC.GlobalCache -> String -> IO (ErrorLogger (Package,[Package])) installLocalDependencies cfg repo gc dir = loadPackageSpec dir |>= \pkgSpec -> resolveDependenciesForPackageCopy cfg pkgSpec repo gc dir |>= \result -> GC.installMissingDependencies cfg gc (resolvedPackages result) |> log Info (showDependencies result) |> copyDependencies cfg gc pkgSpec (resolvedPackages result) dir |> succeedIO (pkgSpec, resolvedPackages result) --- Links a directory into the local package cache. Used for `cpm link`. linkToLocalCache :: String -> String -> IO (ErrorLogger ()) linkToLocalCache src pkgDir = do dirExists <- doesDirectoryExist src if dirExists then loadPackageSpec src |>= \pkgSpec -> LocalCache.createLink pkgDir src (packageId pkgSpec) True |> succeedIO () else log Critical ("Directory '" ++ src ++ "' does not exist.") |> succeedIO () --- Tries to find a package specification in the current directory or one of its --- ancestors. tryFindLocalPackageSpec :: String -> IO (ErrorLogger String) tryFindLocalPackageSpec dir = do existsLocal <- doesFileExist $ dir "package.json" if existsLocal then succeedIO dir else log Debug ("No package.json in " ++ show dir ++ ", trying " ++ show (dir "..")) |> do parentExists <- doesDirectoryExist $ dir ".." if parentExists then tryFindLocalPackageSpec $ dir ".." else failIO "No package.json found" --- Resolves the dependencies for a package copy and fills the package caches. resolveAndCopyDependencies :: Config -> Repository -> GC.GlobalCache -> String -> IO (ErrorLogger [Package]) resolveAndCopyDependencies cfg repo gc dir = loadPackageSpec dir |>= resolveAndCopyDependenciesForPackage cfg repo gc dir --- Resolves the dependencies for a package copy and fills the package caches. resolveAndCopyDependenciesForPackage :: Config -> Repository -> GC.GlobalCache -> String -> Package -> IO (ErrorLogger [Package]) resolveAndCopyDependenciesForPackage cfg repo gc dir pkgSpec = resolveDependenciesForPackageCopy cfg pkgSpec repo gc dir |>= \result -> let deps = resolvedPackages result missingDeps = GC.missingPackages gc deps failMsg = "Missing dependencies " ++ (intercalate "," $ map packageId missingDeps) ++ "\nUse `cpm install` to install missing dependencies." in if length missingDeps > 0 then failIO failMsg else copyDependencies cfg gc pkgSpec deps dir |>= \_ -> succeedIO deps --- Resolves the dependencies for a package copy. resolveDependencies :: Config -> Repository -> GC.GlobalCache -> String -> IO (ErrorLogger ResolutionResult) resolveDependencies cfg repo gc dir = loadPackageSpec dir |-> log Info ("Read package spec from " ++ 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 where boldText s = (if plain then id else bold) $ text s maxLen = 12 doc = vcat $ [ heading, rule, installed, ver, auth, maintnr, synop , cats, deps, compilers, descr ] ++ if allinfos then [ srcdirs, expmods, cfgmod, execspec] ++ testsuites ++ [ src, licns, licfl, copyrt, homepg, reposy, bugrep] else [] pkgId = packageId pkg isInstalled = GC.isPackageInstalled gc pkg heading = text pkgId installed = if isInstalled || 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) -> 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)) 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 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)))