Merge pull request #268 from fpco/overlay

Support for building "overlay" package databases

Stackage/Build.hs

@@ -39,6 +39,7 @@ defaultBuildSettings cores version = BuildSettings
     , buildDocs = True
     , tarballDir = "patching/tarballs"
     , cabalFileDir = Nothing
+    , underlayPackageDirs = []
     }
 
 build :: BuildSettings -> BuildPlan -> IO ()

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"

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"] ""

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

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

Stackage/Select.hs

@@ -53,6 +53,7 @@ defaultSelectSettings version = SelectSettings
             else Set.empty
     , selectGhcVersion = version
     , selectTarballDir = "patching/tarballs"
+    , selectUnderlayPackageDirs = []
     }
 
 select :: SelectSettings -> IO BuildPlan

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.

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)