Commit 0186d1e1 authored by bjorn@bringert.net's avatar bjorn@bringert.net
Browse files

Rewrote the package dependency analysis code.

It is now about half as much code, and uses fewer and simpler
functions and data types. The external interface is now much smaller,
which meant that I had to change quite a bit of other code.
I orignally wrote this in parallel with dons' clean-up changes,
and had to merge by hand since darcs went into mad exponential conflict mode.
I hope I didn't revert too many of dons' changes.
parent c4ed6f2d
......@@ -53,7 +53,7 @@ import Distribution.Version (showVersion)
import Distribution.Verbosity (Verbosity, normal)
import Hackage.Tar (readTarArchive, tarFileName)
import Hackage.Types (ConfigFlags (..), PkgInfo (..), Repo(..))
import Hackage.Types (ConfigFlags (..), PkgInfo (..), Repo(..), pkgInfoId)
import Hackage.Utils
......@@ -63,17 +63,18 @@ repoCacheDir cfg repo = configCacheDir cfg </> repoName repo
-- |Generate the full path to the locally cached copy of
-- the tarball for a given @PackageIdentifer@.
packageFile :: ConfigFlags -> PackageIdentifier -> Repo -> FilePath
packageFile cfg pkg repo = packageDir cfg pkg repo
</> showPackageId pkg
<.> "tar.gz"
packageFile :: ConfigFlags -> PkgInfo -> FilePath
packageFile cfg pkg = packageDir cfg pkg
</> showPackageId (pkgInfoId pkg)
<.> "tar.gz"
-- |Generate the full path to the directory where the local cached copy of
-- the tarball for a given @PackageIdentifer@ is stored.
packageDir :: ConfigFlags -> PackageIdentifier -> Repo -> FilePath
packageDir cfg pkg repo = repoCacheDir cfg repo
</> pkgName pkg
</> showVersion (pkgVersion pkg)
packageDir :: ConfigFlags -> PkgInfo -> FilePath
packageDir cfg pkg = repoCacheDir cfg (pkgRepo pkg)
</> pkgName p
</> showVersion (pkgVersion p)
where p = pkgInfoId pkg
listInstalledPackages :: ConfigFlags -> Compiler -> ProgramConfiguration -> IO [PackageIdentifier]
listInstalledPackages cfg comp conf =
......@@ -117,10 +118,11 @@ message :: ConfigFlags -> Verbosity -> String -> IO ()
message cfg v s = when (configVerbose cfg >= v) (putStrLn s)
-- | Generate the URL of the tarball for a given package.
pkgURL :: PackageIdentifier -> Repo -> String
pkgURL pkg repo = joinWith "/" [repoURL repo, pkgName pkg, showVersion (pkgVersion pkg), showPackageId pkg]
++ ".tar.gz"
where joinWith tok = concat . intersperse tok
pkgURL :: PkgInfo -> String
pkgURL pkg = joinWith "/" [repoURL (pkgRepo pkg), pkgName p, showVersion (pkgVersion p),
showPackageId p ++ ".tar.gz"]
where joinWith tok = concat . intersperse tok
p = pkgInfoId pkg
--
-- * Compiler and programs
......
-----------------------------------------------------------------------------
-- |
-- Module : Hackage.Dependency
-- Copyright : (c) David Himmelstrup 2005
-- Copyright : (c) David Himmelstrup 2005, Bjorn Bringert 2007
-- License : BSD-like
--
-- Maintainer : lemmih@gmail.com
......@@ -12,112 +12,103 @@
-----------------------------------------------------------------------------
module Hackage.Dependency
(
-- * Dependency resolution
resolveDependencies
-- * Utilities
, depToUnresolvedDep
, getPackages -- :: [ResolvedPackage] -> [(PackageIdentifier,[String],String)]
, getBuildDeps -- :: [PackageIdentifier] -> [ResolvedPackage] -> [ResolvedPackage]
, filterFetchables -- :: [ResolvedPackage] -> [(PackageIdentifier,String)]
, fulfillDependency -- :: Dependency -> PackageIdentifier -> Bool
, packagesToInstall
) where
import Hackage.Config (listInstalledPackages, getKnownPackages)
import Hackage.Types
(ResolvedPackage(..), UnresolvedDependency(..), ConfigFlags (..), PkgInfo (..), pkgInfoId)
import Distribution.Version (Dependency(..), withinRange)
import Distribution.Package (PackageIdentifier(..))
import Distribution.PackageDescription
(PackageDescription(package, buildDepends)
, GenericPackageDescription(packageDescription)
(PackageDescription(buildDepends)
, finalizePackageDescription)
import Distribution.ParseUtils (showDependency)
import Distribution.Simple.Compiler (Compiler, showCompilerId, compilerVersion)
import Distribution.Simple.Compiler (Compiler, showCompilerId, compilerVersion)
import Distribution.Simple.Program (ProgramConfiguration)
import Control.Monad (mplus)
import Data.Char (toLower)
import Data.List (nub, maximumBy, isPrefixOf)
import Data.List (nubBy, maximumBy, isPrefixOf)
import Data.Maybe (fromMaybe)
import qualified System.Info (arch,os)
import Hackage.Config (listInstalledPackages, getKnownPackages)
import Hackage.Types ( ResolvedPackage(..), UnresolvedDependency(..)
, ConfigFlags (..), PkgInfo (..), ResolvedDependency(..), Repo(..))
import Text.Printf (printf)
-- |Flattens a list of dependencies, filtering out installed packages.
-- Packages dependencies are placed before the packages and duplicate entries
-- are removed.
flattenDepList :: [PackageIdentifier] -- ^List of installed packages.
-> [ResolvedPackage] -- ^List of resolved packages.
-> [ResolvedPackage]
flattenDepList ps
= nub . filter (not . isInstalled ps . fulfilling) . concatMap flatten
where flatten pkgInfo = getBuildDeps ps [pkgInfo] ++ [pkgInfo]
-- | Flattens a dependency list, keeping only the transitive closure of the
-- dependencies of the top-level packages.
-- This is used for installing all the dependencies of set of packages but not the packages
-- themselves. Filters out installed packages and duplicates.
getBuildDeps :: [PackageIdentifier] -> [ResolvedPackage]
-> [ResolvedPackage]
getBuildDeps ps
= nub . filter (not . isInstalled ps . fulfilling) . concatMap flattenDeps
where flattenDeps pkgInfo
= case resolvedData pkgInfo of
Just (_,_,subDeps) -> flattenDepList ps subDeps
Nothing -> []
depToUnresolvedDep :: Dependency -> UnresolvedDependency
depToUnresolvedDep dep
= UnresolvedDependency
{ dependency = dep
, depOptions = [] }
resolvedDepToResolvedPkg :: (Dependency,Maybe ResolvedDependency) -> ResolvedPackage
resolvedDepToResolvedPkg (dep,rDep)
= ResolvedPackage
{ fulfilling = dep
, resolvedData = rData
, pkgOptions = [] }
where rData = do ResolvedDependency pkg repo subDeps <- rDep
return ( pkg
, repo
, map resolvedDepToResolvedPkg subDeps )
-- |Locates a @PkgInfo@ which satisfies a given @Dependency@.
-- Fails with "cannot satisfy dependency: %s." where %s == the given dependency.
getLatestPkg :: (Monad m) => [PkgInfo] -> Dependency -> m PkgInfo
getLatestPkg ps dep
= case filter (fulfillDependency dep . pkdId) ps of
[] -> fail $ printf "cannot satisfy dependency: %s." (show (showDependency dep))
qs -> return $ maximumBy compareVersions qs
where compareVersions a b = pkgVersion (pkdId a) `compare` pkgVersion (pkdId b)
pkdId = package . packageDescription . pkgDesc
resolveDependencies :: ConfigFlags
-> Compiler
-> ProgramConfiguration
-> [UnresolvedDependency]
-> IO [ResolvedPackage]
resolveDependencies cfg comp conf deps
= do installed <- listInstalledPackages cfg comp conf
available <- getKnownPackages cfg
return [resolveDependency comp installed available dep opts
| UnresolvedDependency dep opts <- deps]
-- |Evaluates to @True@ if the given @Dependency@ is satisfied by the given @PackageIdentifer@.
fulfillDependency :: Dependency -> PackageIdentifier -> Bool
fulfillDependency (Dependency depName vrange) pkg
resolveDependency :: Compiler
-> [PackageIdentifier] -- ^ Installed packages.
-> [PkgInfo] -- ^ Installable packages
-> Dependency
-> [String] -- ^ Options for this dependency
-> ResolvedPackage
resolveDependency comp installed available dep opts
= fromMaybe (Unavailable dep) $ resolveFromInstalled `mplus` resolveFromAvailable
where
resolveFromInstalled = fmap (Installed dep) $ latestInstalledSatisfying installed dep
resolveFromAvailable =
do pkg <- latestAvailableSatisfying available dep
let deps = getDependencies comp installed available pkg opts
resolved = map (\d -> resolveDependency comp installed available d []) deps
return $ Available dep pkg opts resolved
-- | Gets the latest installed package satisfying a dependency.
latestInstalledSatisfying :: [PackageIdentifier]
-> Dependency -> Maybe PackageIdentifier
latestInstalledSatisfying = latestSatisfying id
-- | Gets the latest available package satisfying a dependency.
latestAvailableSatisfying :: [PkgInfo]
-> Dependency -> Maybe PkgInfo
latestAvailableSatisfying = latestSatisfying pkgInfoId
latestSatisfying :: (a -> PackageIdentifier)
-> [a]
-> Dependency
-> Maybe a
latestSatisfying f xs dep =
case filter ((`satisfies` dep) . f) xs of
[] -> Nothing
ys -> Just $ maximumBy (comparing (pkgVersion . f)) ys
where comparing g a b = g a `compare` g b
-- | Checks if a package satisfies a dependency.
satisfies :: PackageIdentifier -> Dependency -> Bool
satisfies pkg (Dependency depName vrange)
= pkgName pkg == depName && pkgVersion pkg `withinRange` vrange
-- | Checks whether there is an installed package that satisfies the
-- given dependency.
isInstalled :: [PackageIdentifier] -- ^Installed packages.
-> Dependency -> Bool
isInstalled ps dep = any (fulfillDependency dep) ps
getDependency :: Compiler
-> [PackageIdentifier]
-> [PkgInfo]
-> UnresolvedDependency -> ResolvedPackage
getDependency comp installed available (UnresolvedDependency { dependency=dep, depOptions=opts})
= ResolvedPackage { fulfilling = dep
, resolvedData = fmap pkgData (getLatestPkg available dep)
, pkgOptions = opts }
where pkgData p = ( package d
, pkgRepo p
, map (getDependency comp installed available . depToUnresolvedDep) (buildDepends d))
where d = finalizePackage comp installed available (configurationsFlags opts) p
-- | Gets the dependencies of an available package.
getDependencies :: Compiler
-> [PackageIdentifier] -- ^ Installed packages.
-> [PkgInfo] -- ^ Available packages
-> PkgInfo
-> [String] -- ^ Options
-> [Dependency]
getDependencies comp _installed _available pkg opts
= case e of
Left missing -> error $ "finalizePackage complained about missing dependencies " ++ show missing
Right (desc,_) -> buildDepends desc
where
flags = configurationsFlags opts
e = finalizePackageDescription
flags
Nothing --(Just $ nub $ installed ++ map pkgInfoId available)
System.Info.os
System.Info.arch
(showCompilerId comp, compilerVersion comp)
(pkgDesc pkg)
-- | Extracts configurations flags from a list of options.
configurationsFlags :: [String] -> [(String, Bool)]
configurationsFlags opts =
case filter ("--flags=" `isPrefixOf`) opts of
......@@ -129,61 +120,18 @@ configurationsFlags opts =
where tagWithValue ('-':name) = (map toLower name, False)
tagWithValue name = (map toLower name, True)
-- |Get the PackageIdentifier, build options and location from a list of resolved packages.
-- Throws an exception if a package couldn't be resolved.
getPackages :: [ResolvedPackage] -> [(PackageIdentifier,[String],Repo)]
getPackages = map worker
where worker dep
= case resolvedData dep of
Nothing
-> error $ printf "Couldn't satisfy dependency: '%s'." (show $ showDependency (fulfilling dep))
Just (pkg,repo,_)
-> (pkg,pkgOptions dep,repo)
-- |List all packages which can be fetched.
filterFetchables :: [ResolvedPackage] -> [(PackageIdentifier,Repo)]
filterFetchables pkgs = [(pkg,repo) | Just (pkg,repo,_) <- map resolvedData pkgs]
finalizePackage :: Compiler
-> [PackageIdentifier] -- ^ All installed packages
-> [PkgInfo] -- ^ All available packages
-> [(String,Bool)] -- ^ Configurations flags
-> PkgInfo
-> PackageDescription
finalizePackage comp installed available flags desc
= case e of
Left missing -> error $ "Can't resolve dependencies: " ++ show missing
Right (d,_flags) -> d
packagesToInstall :: [ResolvedPackage]
-> Either [Dependency] [(PkgInfo, [String])]
-- ^ Either a list of missing dependencies, or a list
-- of packages to install, with their options.
packagesToInstall xs | null missing = Right toInstall
| otherwise = Left missing
where
e = finalizePackageDescription
flags
(Just $ nub $ installed ++ map (package . packageDescription . pkgDesc) available)
System.Info.os
System.Info.arch
(showCompilerId comp, compilerVersion comp)
(pkgDesc desc)
resolveDependency :: Compiler
-> [PackageIdentifier] -- ^ Installed packages.
-> [PkgInfo] -- ^ Installable packages
-> UnresolvedDependency
-> ResolvedPackage
resolveDependency comp installed available dep
= let rDep = getDependency comp installed available dep
in case resolvedData rDep of
Nothing -> resolvedDepToResolvedPkg (dependency dep,Nothing)
_ -> rDep
flattened = concatMap flatten xs
missing = [d | Left d <- flattened]
toInstall = nubBy samePackage [x | Right x <- flattened]
samePackage a b = pkgInfoId (fst a) == pkgInfoId (fst b)
flatten (Installed _ _) = []
flatten (Available _ p opts deps) = concatMap flatten deps ++ [Right (p,opts)]
flatten (Unavailable dep) = [Left dep]
-- |Resolve some dependencies from the known packages while filtering out installed packages.
-- The result has been modified to put the dependencies in front of the packages.
resolveDependencies :: ConfigFlags
-> Compiler
-> ProgramConfiguration
-> [UnresolvedDependency] -- ^Dependencies in need of resolution.
-> IO [ResolvedPackage]
resolveDependencies cfg comp conf deps
= do installed <- listInstalledPackages cfg comp conf
available <- getKnownPackages cfg
return $ flattenDepList installed $
map (resolveDependency comp installed available) $
filter (not . isInstalled installed . dependency) deps
......@@ -16,7 +16,6 @@ module Hackage.Fetch
fetch
, -- * Utilities
fetchPackage
, packageFile
, isFetched
, readURI
, downloadIndex
......@@ -31,17 +30,15 @@ import Control.Monad (filterM)
import Text.Printf (printf)
import System.Directory (doesFileExist, createDirectoryIfMissing)
import Hackage.Types (ConfigFlags (..), UnresolvedDependency (..), Repo(..))
import Hackage.Types (ConfigFlags (..), UnresolvedDependency (..), Repo(..), PkgInfo, pkgInfoId)
import Hackage.Config (repoCacheDir, packageFile, packageDir, pkgURL, message, findCompiler)
import Hackage.Dependency (filterFetchables, resolveDependencies)
import Hackage.Dependency (resolveDependencies, packagesToInstall)
import Distribution.Package (PackageIdentifier(..), showPackageId)
import Distribution.Package (showPackageId)
import Distribution.Verbosity
import System.FilePath ((</>), (<.>))
import System.Directory (copyFile)
import System.IO (IOMode(..), hPutStr, Handle, hClose, openBinaryFile)
import Distribution.Compat.ReadP (readP_to_S)
import Distribution.ParseUtils (parseDependency)
readURI :: URI -> IO String
......@@ -84,16 +81,16 @@ downloadFile path url
-- Downloads a package to [config-dir/packages/package-id] and returns the path to the package.
downloadPackage :: ConfigFlags -> PackageIdentifier -> Repo -> IO String
downloadPackage cfg pkg repo
= do let url = pkgURL pkg repo
dir = packageDir cfg pkg repo
path = packageFile cfg pkg repo
downloadPackage :: ConfigFlags -> PkgInfo -> IO String
downloadPackage cfg pkg
= do let url = pkgURL pkg
dir = packageDir cfg pkg
path = packageFile cfg pkg
message cfg verbose $ "GET " ++ show url
createDirectoryIfMissing True dir
mbError <- downloadFile path url
case mbError of
Just err -> fail $ printf "Failed to download '%s': %s" (showPackageId pkg) (show err)
Just err -> fail $ printf "Failed to download '%s': %s" (showPackageId (pkgInfoId pkg)) (show err)
Nothing -> return path
-- Downloads an index file to [config-dir/packages/serv-id].
......@@ -109,38 +106,28 @@ downloadIndex cfg repo
Nothing -> return path
-- |Returns @True@ if the package has already been fetched.
isFetched :: ConfigFlags -> PackageIdentifier -> Repo -> IO Bool
isFetched cfg pkg repo
= doesFileExist (packageFile cfg pkg repo)
isFetched :: ConfigFlags -> PkgInfo -> IO Bool
isFetched cfg pkg = doesFileExist (packageFile cfg pkg)
-- |Fetch a package if we don't have it already.
fetchPackage :: ConfigFlags -> PackageIdentifier -> Repo -> IO String
fetchPackage cfg pkg repo
= do fetched <- isFetched cfg pkg repo
fetchPackage :: ConfigFlags -> PkgInfo -> IO String
fetchPackage cfg pkg
= do fetched <- isFetched cfg pkg
if fetched
then do printf "'%s' is present.\n" (showPackageId pkg)
return (packageFile cfg pkg repo)
else do printf "Downloading '%s'...\n" (showPackageId pkg)
downloadPackage cfg pkg repo
then do printf "'%s' is present.\n" (showPackageId (pkgInfoId pkg))
return (packageFile cfg pkg)
else do printf "Downloading '%s'...\n" (showPackageId (pkgInfoId pkg))
downloadPackage cfg pkg
-- |Fetch a list of packages and their dependencies.
fetch :: ConfigFlags -> [String] -> IO ()
fetch cfg pkgs
fetch :: ConfigFlags -> [String] -> [UnresolvedDependency] -> IO ()
fetch cfg _globalArgs deps
= do (comp,conf) <- findCompiler cfg
apkgs <- fmap filterFetchables (resolveDependencies cfg comp conf (map parseDep pkgs))
mapM_ (\(pkg,repo)
-> fetchPackage cfg pkg repo
) =<< filterM isNotFetched apkgs
where parseDep dep
= case readP_to_S parseDependency dep of
[] -> error ("Failed to parse package dependency: " ++ show dep)
x -> UnresolvedDependency
{ dependency = (fst (last x))
, depOptions = [] }
isNotFetched (pkg,repo)
= do fetched <- isFetched cfg pkg repo
printf "'%s' is present.\n" (showPackageId pkg)
return (not fetched)
depTree <- resolveDependencies cfg comp conf deps
case packagesToInstall depTree of
Left missing -> fail $ "Unresolved dependencies: " ++ show missing
Right pkgs -> do ps <- filterM (fmap not . isFetched cfg) $ map fst pkgs
mapM_ (fetchPackage cfg) ps
withBinaryFile :: FilePath -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile name mode = bracket (openBinaryFile name mode) hClose
......@@ -17,57 +17,50 @@ import Hackage.Dependency
import Hackage.Fetch
import Hackage.Types
import Distribution.Package (PackageIdentifier, showPackageId)
import Distribution.Package (showPackageId)
import Distribution.ParseUtils (showDependency)
import Distribution.Version (Dependency)
import Data.Maybe (listToMaybe, fromMaybe)
import Data.List (intersperse, nubBy)
import Text.Printf (printf)
info :: ConfigFlags -> [String] -> [UnresolvedDependency] -> IO ()
info cfg globalArgs deps
info cfg _globalArgs deps
= do (comp,conf) <- findCompiler cfg
ipkgs <- listInstalledPackages cfg comp conf
apkgs <- resolveDependencies cfg comp conf deps
mapM_ (infoPkg cfg ipkgs globalArgs) apkgs
mapM_ (infoPkg cfg) $ flattenResolvedPackages apkgs
case packagesToInstall apkgs of
Left missing ->
do putStrLn "The requested packages cannot be installed, because of missing dependencies:"
putStrLn $ showDependencies missing
Right pkgs ->
do putStrLn "These packages would be installed:"
putStrLn $ concat $ intersperse ", " [showPackageId (pkgInfoId pkg) | (pkg,_) <- pkgs]
{-|
'infoPkg' displays various information about a package.
This information can be used to figure out what packages will be installed, from where they'll be downloaded
and what options will be parsed to them.
-}
infoPkg :: ConfigFlags -> [PackageIdentifier] -> [String] -> ResolvedPackage -> IO ()
infoPkg _cfg ipkgs _ (ResolvedPackage { fulfilling = dep
, resolvedData = Nothing })
= showOtherPkg installedPkg dep
where installedPkg = listToMaybe (filter (fulfillDependency dep) ipkgs)
flattenResolvedPackages :: [ResolvedPackage] -> [ResolvedPackage]
flattenResolvedPackages = nubBy fulfillSame. concatMap flatten
where flatten p@(Available _ _ _ deps) = p : flattenResolvedPackages deps
flatten p = [p]
fulfillSame a b = fulfills a == fulfills b
infoPkg cfg ipkgs globalArgs (ResolvedPackage { fulfilling = dep
, pkgOptions = ops
, resolvedData = (Just (pkg,repo,deps)) })
= do fetched <- isFetched cfg pkg repo
let pkgFile = if fetched then Just (packageFile cfg pkg repo) else Nothing
showPkgInfo pkgFile isInstalled (globalArgs ++ ops) dep (pkg,repo,deps)
infoPkg :: ConfigFlags -> ResolvedPackage -> IO ()
infoPkg _ (Installed dep p)
= do printf " Requested: %s\n" (show $ showDependency dep)
printf " Installed: %s\n\n" (showPackageId p)
infoPkg cfg (Available dep pkg opts deps)
= do fetched <- isFetched cfg pkg
let pkgFile = if fetched then packageFile cfg pkg
else "*Not downloaded"
printf " Requested: %s\n" (show $ showDependency dep)
printf " Using: %s\n" (showPackageId (pkgInfoId pkg))
printf " Depends: %s\n" (showDependencies $ map fulfills deps)
printf " Options: %s\n" (unwords opts)
printf " Location: %s\n" (pkgURL pkg)
printf " Local: %s\n\n" pkgFile
infoPkg _ (Unavailable dep)
= do printf " Requested: %s\n" (show $ showDependency dep)
printf " Not available!\n\n"
where isInstalled = pkg `elem` ipkgs
showPkgInfo :: Maybe [Char] -> Bool -> [String] -> Dependency -> (PackageIdentifier, Repo, [ResolvedPackage]) -> IO ()
showPkgInfo mbPath installed ops dep (pkg,repo,deps)
= do printf " Package: '%s'\n" (show $ showDependency dep)
printf " Using: %s\n" (showPackageId pkg)
printf " Installed: %s\n" (if installed then "Yes" else "No")
printf " Depends: %s\n" (showDeps deps)
printf " Options: %s\n" (unwords ops)
printf " Location: %s\n" (pkgURL pkg repo)
printf " Local: %s\n\n" (fromMaybe "*Not downloaded" mbPath)
where
showDeps = show . map showDep
showDep = show . showDependency . fulfilling
showOtherPkg :: Maybe PackageIdentifier -> Dependency -> IO ()
showOtherPkg mbPkg dep
= do printf " Package: '%s'\n" (show $ showDependency dep)
case mbPkg of
Nothing -> printf " Not available!\n\n"
Just pkg -> do printf " Using: %s\n" (showPackageId pkg)
printf " Installed: Yes\n\n"
showDependencies :: [Dependency] -> String
showDependencies = concat . intersperse ", " . map (show . showDependency)
......@@ -26,11 +26,11 @@ import Text.Printf (printf)
import Hackage.Config (findCompiler, message)
import Hackage.Dependency (getPackages, resolveDependencies)
import Hackage.Fetch (isFetched, packageFile, fetchPackage)
import Hackage.Dependency (resolveDependencies, packagesToInstall)
import Hackage.Fetch (fetchPackage)
import Hackage.Tar (extractTarGzFile)
import Hackage.Types (ConfigFlags(..), UnresolvedDependency(..)
, Repo(..))
, PkgInfo(..), pkgInfoId)
import Distribution.Simple.Compiler (Compiler(..))
import Distribution.Simple.InstallDirs (InstallDirs(..), absoluteInstallDirs)
......@@ -47,19 +47,9 @@ install :: ConfigFlags -> [String] -> [UnresolvedDependency] -> IO ()
install cfg globalArgs deps
= do (comp,conf) <- findCompiler cfg
resolvedDeps <- resolveDependencies cfg comp conf deps
let apkgs = getPackages resolvedDeps
if null apkgs
then putStrLn "All requested packages already installed. Nothing to do."
else installPackages cfg comp globalArgs apkgs
-- Fetch a package and output nice messages.
downloadPkg :: ConfigFlags -> PackageIdentifier -> Repo -> IO FilePath
downloadPkg cfg pkg repo
= do fetched <- isFetched cfg pkg repo
if fetched
then do printf "'%s' is present.\n" (showPackageId pkg)
return (packageFile cfg pkg repo)
else fetchPackage cfg pkg repo
case packagesToInstall resolvedDeps of
Left missing -> fail $ "Unresolved dependencies: " ++ show missing
Right pkgs -> installPackages cfg comp globalArgs pkgs
-- Attach the correct prefix flag to configure commands,
-- correct --user flag to install commands and no options to other commands.
......@@ -90,10 +80,11 @@ installDirFlags dirs =
installPackages :: ConfigFlags
-> Compiler
-> [String] -- ^Options which will be parse to every package.
-> [(PackageIdentifier,[String],Repo)] -- ^(Package, list of configure options, package location)
-> [(PkgInfo,[String])] -- ^ (Package, list of configure options)
-> IO ()
installPackages cfg comp globalArgs pkgs =
mapM_ (installPkg cfg comp globalArgs) pkgs
installPackages cfg comp globalArgs pkgs
| null pkgs = putStrLn "All requested packages already installed. Nothing to do."
| otherwise = mapM_ (installPkg cfg comp globalArgs) pkgs
{-|
Download, build and install a given package with some given flags.
......@@ -117,15 +108,16 @@ installPackages cfg comp globalArgs pkgs =
installPkg :: ConfigFlags
-> Compiler
-> [String] -- ^Options which will be parse to every package.
-> (PackageIdentifier,[String],Repo) -- ^(Package, list of configure options, package location)
-> (PkgInfo,[String]) -- ^(Package, list of configure options)
-> IO ()
installPkg cfg comp globalArgs (pkg,ops,repo)
= do pkgPath <- downloadPkg cfg pkg repo
installPkg cfg comp globalArgs (pkg,opts)
= do pkgPath <- fetchPackage cfg pkg
tmp <- getTemporaryDirectory
let tmpDirPath = tmp </> printf "TMP%sTMP" (showPackageId pkg)
let p = pkgInfoId pkg
tmpDirPath = tmp </> printf "TMP%sTMP" (showPackageId p)