From 0a951f2601adeb967945e9bafc4d817d9798b30e Mon Sep 17 00:00:00 2001 From: Emanuel Borsboom Date: Sun, 20 Jul 2014 15:21:48 -0700 Subject: [PATCH] Support for building "overlay" package databases --- Stackage/Build.hs | 1 + Stackage/CheckPlan.hs | 2 +- Stackage/GhcPkg.hs | 18 +++++++++++++++--- Stackage/InstallInfo.hs | 11 ++++++----- Stackage/LoadDatabase.hs | 10 ++++++++-- Stackage/Select.hs | 1 + Stackage/Types.hs | 4 ++++ Stackage/Util.hs | 15 ++++++++------- 8 files changed, 44 insertions(+), 18 deletions(-) diff --git a/Stackage/Build.hs b/Stackage/Build.hs index d8f26e31..16778e37 100644 --- a/Stackage/Build.hs +++ b/Stackage/Build.hs @@ -39,6 +39,7 @@ defaultBuildSettings cores version = BuildSettings , buildDocs = True , tarballDir = "patching/tarballs" , cabalFileDir = Nothing + , underlayPackageDirs = [] } build :: BuildSettings -> BuildPlan -> IO () diff --git a/Stackage/CheckPlan.hs b/Stackage/CheckPlan.hs index 454a394c..c60f0996 100644 --- a/Stackage/CheckPlan.hs +++ b/Stackage/CheckPlan.hs @@ -24,7 +24,7 @@ checkPlan settings bp = do putStrLn "Checking build plan" packages <- mapM (replaceTarball $ tarballDir settings) (bpPackageList bp) (ec, dryRun', stderr) <- readProcessWithExitCode "cabal" - ( addCabalArgsOnlyGlobal + ( addCabalArgsOnlyGlobal settings $ "install" : "--dry-run" : "--max-backjumps=-1" diff --git a/Stackage/GhcPkg.hs b/Stackage/GhcPkg.hs index 4379dcbb..92099c31 100644 --- a/Stackage/GhcPkg.hs +++ b/Stackage/GhcPkg.hs @@ -7,9 +7,9 @@ import Distribution.Version (Version (Version)) import Data.Char (isSpace) import qualified Data.Set as Set -getGlobalPackages :: GhcMajorVersion -> IO (Set PackageIdentifier) -getGlobalPackages version = do - output <- readProcess "ghc-pkg" [arg, "list"] "" +getPackages :: [String] -> GhcMajorVersion -> IO (Set PackageIdentifier) +getPackages extraArgs version = do + output <- readProcess "ghc-pkg" (extraArgs ++ [arg, "list"]) "" fmap Set.unions $ mapM parse $ drop 1 $ lines output where -- Account for a change in command line option name @@ -28,6 +28,18 @@ getGlobalPackages version = do | last x == ')' = tail $ init $ x stripParens x = x +getGlobalPackages :: GhcMajorVersion -> IO (Set PackageIdentifier) +getGlobalPackages version = getPackages [] version + +getDBPackages :: [FilePath] -> GhcMajorVersion -> IO (Set PackageIdentifier) +getDBPackages [] _ = return Set.empty +getDBPackages packageDirs version = + getPackages (map packageDbArg packageDirs) version + where + packageDbArg db + | version >= GhcMajorVersion 7 6 = "--package-db=" ++ db + | otherwise = "--package-conf" ++ db + getGhcVersion :: IO GhcMajorVersion getGhcVersion = do versionOutput <- readProcess "ghc-pkg" ["--version"] "" diff --git a/Stackage/InstallInfo.hs b/Stackage/InstallInfo.hs index 61c7ff9a..9755f8fb 100644 --- a/Stackage/InstallInfo.hs +++ b/Stackage/InstallInfo.hs @@ -44,18 +44,19 @@ getInstallInfo settings = do _ -> do putStrLn "Loading core packages from global database" getGlobalPackages $ selectGhcVersion settings - let coreMap = Map.unions + underlay <- getDBPackages (selectUnderlayPackageDirs settings) (selectGhcVersion settings) + let underlaySet = Set.map pkgName underlay + coreMap = Map.unions $ map (\(PackageIdentifier k v) -> Map.singleton k v) $ Set.toList core - - let allPackages' = + allPackages' = case mhp of Just hp | requireHaskellPlatform settings -> Map.union (stablePackages settings $ requireHaskellPlatform settings) $ identsToRanges (hplibs hp) _ -> stablePackages settings $ requireHaskellPlatform settings allPackages = dropExcluded settings allPackages' - let totalCore + totalCore | ignoreUpgradeableCore settings = Map.fromList $ map (\n -> (PackageName n, Nothing)) $ words "base containers template-haskell" | otherwise = @@ -63,7 +64,7 @@ getInstallInfo settings = do `Map.union` Map.fromList (map (, Nothing) (Set.toList $ extraCore settings)) putStrLn "Loading package database" - pdb <- loadPackageDB settings coreMap (Map.keysSet totalCore) allPackages + pdb <- loadPackageDB settings coreMap (Map.keysSet totalCore) allPackages underlaySet putStrLn "Narrowing package database" (final, errs) <- narrowPackageDB settings (Map.keysSet totalCore) pdb $ Set.fromList $ Map.toList $ Map.map snd $ allPackages diff --git a/Stackage/LoadDatabase.hs b/Stackage/LoadDatabase.hs index 087f2f83..441d797d 100644 --- a/Stackage/LoadDatabase.hs +++ b/Stackage/LoadDatabase.hs @@ -64,14 +64,16 @@ loadPackageDB :: SelectSettings -> Map PackageName Version -- ^ core packages from HP file -> Set PackageName -- ^ all core packages, including extras -> Map PackageName (VersionRange, Maintainer) -- ^ additional deps + -> Set PackageName -- ^ underlay packages to exclude -> IO PackageDB -loadPackageDB settings coreMap core deps = do +loadPackageDB settings coreMap core deps underlay = do tarName <- getTarballName lbs <- L.readFile tarName pdb <- addEntries mempty $ Tar.read lbs contents <- handle (\(_ :: IOException) -> return []) $ getDirectoryContents $ selectTarballDir settings - foldM addTarball pdb $ mapMaybe stripTarGz contents + pdb' <- foldM addTarball pdb $ mapMaybe stripTarGz contents + return $ excludeUnderlay pdb' where addEntries _ (Tar.Fail e) = error $ show e addEntries db Tar.Done = return db @@ -117,6 +119,10 @@ loadPackageDB settings coreMap core deps = do where tarball = selectTarballDir settings tarball' <.> "tar.gz" + excludeUnderlay :: PackageDB -> PackageDB + excludeUnderlay (PackageDB pdb) = + PackageDB $ Map.filterWithKey (\k _ -> Set.notMember k underlay) pdb + skipTests p = p `Set.member` skippedTests settings -- Find the relevant cabal file in the given entries and add its contents diff --git a/Stackage/Select.hs b/Stackage/Select.hs index bf9e1d5d..3a2eed9a 100644 --- a/Stackage/Select.hs +++ b/Stackage/Select.hs @@ -53,6 +53,7 @@ defaultSelectSettings version = SelectSettings else Set.empty , selectGhcVersion = version , selectTarballDir = "patching/tarballs" + , selectUnderlayPackageDirs = [] } select :: SelectSettings -> IO BuildPlan diff --git a/Stackage/Types.hs b/Stackage/Types.hs index a5edd9cb..1af91f4c 100644 --- a/Stackage/Types.hs +++ b/Stackage/Types.hs @@ -126,6 +126,8 @@ data SelectSettings = SelectSettings , selectGhcVersion :: GhcMajorVersion , selectTarballDir :: FilePath -- ^ Directory containing replacement tarballs. + , selectUnderlayPackageDirs :: [FilePath] + -- ^ Additional package directories to reference } data BuildStage = BSTools | BSBuild | BSTest @@ -142,6 +144,8 @@ data BuildSettings = BuildSettings -- ^ Directory containing replacement tarballs. , cabalFileDir :: Maybe FilePath -- ^ Directory to place cabal files in + , underlayPackageDirs :: [FilePath] + -- ^ Additional package directories to reference } -- | A wrapper around a @Map@ providing a better @Monoid@ instance. diff --git a/Stackage/Util.hs b/Stackage/Util.hs index 51f3269f..2a7293a2 100644 --- a/Stackage/Util.hs +++ b/Stackage/Util.hs @@ -17,9 +17,9 @@ import Distribution.Text (display, simpleParse) import Distribution.Version (thisVersion) import Stackage.Types import System.Directory (doesDirectoryExist, - removeDirectoryRecursive) -import System.Directory (getAppUserDataDirectory - ,canonicalizePath, + removeDirectoryRecursive, + getAppUserDataDirectory, + canonicalizePath, createDirectoryIfMissing, doesFileExist) import System.Environment (getEnvironment) import System.FilePath ((), (<.>)) @@ -106,15 +106,16 @@ binDir = ( "bin") . sandboxRoot dataDir = ( "share") . sandboxRoot docDir x = sandboxRoot x "share" "doc" "$pkgid" -addCabalArgsOnlyGlobal :: [String] -> [String] -addCabalArgsOnlyGlobal rest +addCabalArgsOnlyGlobal :: BuildSettings -> [String] -> [String] +addCabalArgsOnlyGlobal settings rest = "--package-db=clear" : "--package-db=global" - : rest + : map ("--package-db=" ++) (underlayPackageDirs settings) + ++ rest addCabalArgs :: BuildSettings -> BuildStage -> [String] -> [String] addCabalArgs settings bs rest - = addCabalArgsOnlyGlobal + = addCabalArgsOnlyGlobal settings $ ("--package-db=" ++ packageDir settings ++ toolsSuffix) : ("--libdir=" ++ libDir settings ++ toolsSuffix) : ("--bindir=" ++ binDir settings)