Separate version selection and building #25

.gitignore

@@ -13,3 +13,4 @@ cabal-dev
 /sandbox/
 /build-tools.log
 /logs-tools/
+build-plan.txt

Stackage/Build.hs

@@ -34,30 +34,16 @@ import Stackage.CheckCabalVersion (checkCabalVersion)
 defaultBuildSettings :: BuildSettings
 defaultBuildSettings = BuildSettings
     { sandboxRoot = "sandbox"
-    , extraBuildArgs = []
+    , expectedFailuresBuild = defaultExpectedFailures
-    , extraCore = defaultExtraCore
-    , expectedFailures = defaultExpectedFailures
-    , stablePackages = defaultStablePackages
     , extraArgs = ["-fnetwork23"]
-    , haskellPlatformCabal = "haskell-platform/haskell-platform.cabal"
-    , requireHaskellPlatform = True
-    , excludedPackages = empty
     , testWorkerThreads = 4
-    , flags = Set.fromList $ words "blaze_html_0_5"
-    , allowedPackage = const $ Right ()
     }
 
-build :: BuildSettings -> IO ()
+build :: BuildSettings -> BuildPlan -> IO ()
-build settings' = do
+build settings' bp = do
     putStrLn "Checking Cabal version"
     libVersion <- checkCabalVersion
 
-    bp <- select settings'
-
-    putStrLn "Checking build plan"
-    checkPlan bp
-    putStrLn "No mismatches, starting the sandboxed build."
-
     putStrLn "Wiping out old sandbox folder"
     rm_r $ sandboxRoot settings'
     rm_r "logs"
@@ -84,8 +70,7 @@ build settings' = do
                          : "--build-log=logs-tools/$pkg.log"
                          : "-j"
                          : concat
-                            [ extraBuildArgs settings
+                            [ extraArgs settings
-                            , extraArgs settings
                             , tools
                             ]
                 hPutStrLn handle ("cabal " ++ unwords (map (\s -> "'" ++ s ++ "'") args))
@@ -103,8 +88,7 @@ build settings' = do
                  : "--build-log=logs/$pkg.log"
                  : "-j"
                  : concat
-                    [ extraBuildArgs settings
+                    [ extraArgs settings
-                    , extraArgs settings
                     , bpPackageList bp
                     ]
         hPutStrLn handle ("cabal " ++ unwords (map (\s -> "'" ++ s ++ "'") args))
@@ -114,12 +98,6 @@ build settings' = do
         putStrLn "Build failed, please see build.log"
         exitWith ec
 
-    putStrLn "Sandbox built, beginning individual test suites"
-    runTestSuites settings $ bpPackages bp
-
-    putStrLn "All test suites that were expected to pass did pass, building tarballs."
-    makeTarballs bp
-
 -- | Get all of the build tools required.
 iiBuildTools :: InstallInfo -> [String]
 iiBuildTools InstallInfo { iiPackageDB = PackageDB m, iiPackages = packages } =

Stackage/CheckPlan.hs

@@ -18,6 +18,7 @@ data Mismatch = OnlyDryRun String | OnlySimpleList String
 
 checkPlan :: BuildPlan -> IO ()
 checkPlan bp = do
+    putStrLn "Checking build plan"
     (ec, dryRun', stderr) <- readProcessWithExitCode "cabal" (addCabalArgsOnlyGlobal $ "install":"--dry-run":bpPackageList bp) ""
     when (ec /= ExitSuccess || "Warning:" `isPrefixOf` stderr) $ do
         putStr stderr
@@ -30,6 +31,7 @@ checkPlan bp = do
         putStrLn "Found the following mismatches"
         mapM_ print mismatches
         exitWith $ ExitFailure 1
+    putStrLn "Build plan checked, no mismatches"
   where
     optionalCore = Set.fromList $ map packageVersionString $ Map.toList $ bpOptionalCore bp
     notOptionalCore s = not $ s `Set.member` optionalCore

Stackage/HaskellPlatform.hs

@@ -11,7 +11,7 @@ import           Data.Set          (singleton)
 import           Distribution.Text (simpleParse)
 import           Stackage.Types
 
-loadHaskellPlatform :: BuildSettings -> IO HaskellPlatform
+loadHaskellPlatform :: SelectSettings -> IO HaskellPlatform
 loadHaskellPlatform = fmap parseHP . readFile . haskellPlatformCabal
 
 data HPLine = HPLPackage PackageIdentifier

Stackage/InstallInfo.hs

@@ -17,13 +17,13 @@ import           Stackage.NarrowDatabase
 import           Stackage.Types
 import           Stackage.Util
 
-dropExcluded :: BuildSettings
+dropExcluded :: SelectSettings
              -> Map PackageName (VersionRange, Maintainer)
              -> Map PackageName (VersionRange, Maintainer)
 dropExcluded bs m0 =
     Set.foldl' (flip Map.delete) m0 (excludedPackages bs)
 
-getInstallInfo :: BuildSettings -> IO InstallInfo
+getInstallInfo :: SelectSettings -> IO InstallInfo
 getInstallInfo settings = do
     putStrLn "Loading Haskell Platform"
     hp <- loadHaskellPlatform settings
@@ -96,14 +96,14 @@ bpPackageList :: BuildPlan -> [String]
 bpPackageList = map packageVersionString . Map.toList . Map.map spiVersion . bpPackages
 
 -- | Check for internal mismatches in required and actual package versions.
-checkBadVersions :: BuildSettings
+checkBadVersions :: SelectSettings
                  -> PackageDB
                  -> Map PackageName BuildInfo
                  -> Map String (Map PackageName (Version, VersionRange))
 checkBadVersions settings (PackageDB pdb) buildPlan =
     Map.unions $ map getBadVersions $ Map.toList $ Map.filterWithKey unexpectedFailure buildPlan
   where
-    unexpectedFailure name _ = name `Set.notMember` expectedFailures settings
+    unexpectedFailure name _ = name `Set.notMember` expectedFailuresSelect settings
 
     getBadVersions :: (PackageName, BuildInfo) -> Map String (Map PackageName (Version, VersionRange))
     getBadVersions (name, bi)

Stackage/LoadDatabase.hs

@@ -53,7 +53,7 @@ import           Stackage.Util
 -- version.
 --
 -- * For other packages, select the maximum version number.
-loadPackageDB :: BuildSettings
+loadPackageDB :: SelectSettings
               -> Set PackageName -- ^ core packages
               -> Map PackageName (VersionRange, Maintainer) -- ^ additional deps
               -> IO PackageDB

Stackage/NarrowDatabase.hs

@@ -10,7 +10,7 @@ import           System.Exit (exitFailure)
 
 -- | Narrow down the database to only the specified packages and all of
 -- their dependencies.
-narrowPackageDB :: BuildSettings
+narrowPackageDB :: SelectSettings
                 -> PackageDB
                 -> Set (PackageName, Maintainer)
                 -> IO (Map PackageName BuildInfo)

Stackage/Select.hs

@@ -1,5 +1,6 @@
 module Stackage.Select
     ( select
+    , defaultSelectSettings
     ) where
 
 import           Control.Exception    (assert)
@@ -28,20 +29,28 @@ import           System.Process       (rawSystem, readProcess, runProcess,
                                        waitForProcess)
 import Stackage.BuildPlan
 
-select :: BuildSettings -> IO BuildPlan
+defaultSelectSettings :: SelectSettings
+defaultSelectSettings = SelectSettings
+    { extraCore = defaultExtraCore
+    , expectedFailuresSelect = defaultExpectedFailures
+    , stablePackages = defaultStablePackages
+    , haskellPlatformCabal = "haskell-platform/haskell-platform.cabal"
+    , requireHaskellPlatform = True
+    , excludedPackages = empty
+    , flags = Set.fromList $ words "blaze_html_0_5"
+    , allowedPackage = const $ Right ()
+    }
+
+select :: SelectSettings -> IO BuildPlan
 select settings' = do
     ii <- getInstallInfo settings'
 
-    let bp = BuildPlan
+    return BuildPlan
-            { bpTools = iiBuildTools ii
+        { bpTools = iiBuildTools ii
-            , bpPackages = iiPackages ii
+        , bpPackages = iiPackages ii
-            , bpOptionalCore = iiOptionalCore ii
+        , bpOptionalCore = iiOptionalCore ii
-            , bpCore = iiCore ii
+        , bpCore = iiCore ii
-            }
+        }
-
-    writeBuildPlan "build-plan.txt" bp -- FIXME
-    readBuildPlan "build-plan.txt"
-    --return bp
 
 -- | Get all of the build tools required.
 iiBuildTools :: InstallInfo -> [String]

Stackage/Tarballs.hs

@@ -13,6 +13,7 @@ import           System.FilePath      (takeDirectory)
 
 makeTarballs :: BuildPlan -> IO ()
 makeTarballs bp = do
+    putStrLn "Building tarballs"
     tarName <- getTarballName
     origEntries <- fmap Tar.read $ L.readFile tarName
     (stableEntries, extraEntries) <- loop id id origEntries

Stackage/Test.hs

@@ -19,8 +19,10 @@ import           System.IO          (IOMode (WriteMode, AppendMode),
                                      withBinaryFile)
 import           System.Process     (runProcess, waitForProcess)
 
-runTestSuites :: BuildSettings -> Map PackageName SelectedPackageInfo -> IO ()
+runTestSuites :: BuildSettings -> BuildPlan -> IO ()
-runTestSuites settings selected = do
+runTestSuites settings bp = do
+    let selected = bpPackages bp
+    putStrLn "Running test suites"
     let testdir = "runtests"
     rm_r testdir
     createDirectory testdir
@@ -99,7 +101,7 @@ runTestSuite settings testdir (packageName, SelectedPackageInfo {..}) = do
             getHandle AppendMode $ runGhcPackagePath "cabal" ["test"] dir
         getHandle AppendMode $ run "cabal" ["haddock"] dir
         return True
-    let expectedFailure = packageName `Set.member` expectedFailures settings
+    let expectedFailure = packageName `Set.member` expectedFailuresBuild settings
     if passed
         then do
             removeFile logfile

Stackage/Types.hs

@@ -89,23 +89,12 @@ data BuildPlan = BuildPlan
 newtype Maintainer = Maintainer { unMaintainer :: String }
     deriving (Show, Eq, Ord, Read)
 
-data BuildSettings = BuildSettings
+data SelectSettings = SelectSettings
-    { sandboxRoot            :: FilePath
+    { haskellPlatformCabal   :: FilePath
-    , extraBuildArgs         :: [String]
-    , extraCore              :: Set PackageName
-    , expectedFailures       :: Set PackageName
-    , stablePackages         :: Map PackageName (VersionRange, Maintainer)
-    , extraArgs              :: [String]
-    , haskellPlatformCabal   :: FilePath
-    , requireHaskellPlatform :: Bool
-    , excludedPackages       :: Set PackageName
-    -- ^ Packages which should be dropped from the list of stable packages,
-    -- even if present via the Haskell Platform or @stablePackages@. If these
-    -- packages are dependencies of others, they will still be included.
-    , testWorkerThreads      :: Int
-    -- ^ How many threads to spawn for running test suites.
     , flags                  :: Set String
     -- ^ Compile flags which should be turned on.
+    , extraCore              :: Set PackageName
+    , requireHaskellPlatform :: Bool
     , allowedPackage         :: GenericPackageDescription -> Either String ()
     -- ^ Checks if a package is allowed into the distribution. By default, we
     -- allow all packages in, though this could be used to filter out certain
@@ -113,6 +102,20 @@ data BuildSettings = BuildSettings
     --
     -- Returns a reason for stripping in Left, or Right if the package is
     -- allowed.
+    , expectedFailuresSelect :: Set PackageName
+    , excludedPackages       :: Set PackageName
+    -- ^ Packages which should be dropped from the list of stable packages,
+    -- even if present via the Haskell Platform or @stablePackages@. If these
+    -- packages are dependencies of others, they will still be included.
+    , stablePackages         :: Map PackageName (VersionRange, Maintainer)
+    }
+
+data BuildSettings = BuildSettings
+    { sandboxRoot            :: FilePath
+    , extraArgs              :: [String]
+    , expectedFailuresBuild  :: Set PackageName
+    , testWorkerThreads      :: Int
+    -- ^ How many threads to spawn for running test suites.
     }
 
 -- | A wrapper around a @Map@ providing a better @Monoid@ instance.

app/stackage.hs

@@ -3,24 +3,31 @@ import           Stackage.Types
 import           Stackage.Build     (build, defaultBuildSettings)
 import           Stackage.Init      (stackageInit)
 import           Stackage.Util      (allowPermissive)
+import           Stackage.Select    (defaultSelectSettings, select)
+import           Stackage.CheckPlan (checkPlan)
 import           System.Environment (getArgs, getProgName)
 import           Data.Set           (fromList)
 import           System.IO          (hFlush, stdout)
+import Stackage.BuildPlan (readBuildPlan, writeBuildPlan)
+import Stackage.Test (runTestSuites)
+import Stackage.Tarballs (makeTarballs)
 
-data BuildArgs = BuildArgs
+data SelectArgs = SelectArgs
     { excluded :: [String]
     , noPlatform :: Bool
     , onlyPermissive :: Bool
     , allowed :: [String]
+    , buildPlanDest :: FilePath
     }
 
-parseBuildArgs :: [String] -> IO BuildArgs
+parseSelectArgs :: [String] -> IO SelectArgs
-parseBuildArgs =
+parseSelectArgs =
-    loop BuildArgs
+    loop SelectArgs
         { excluded = []
         , noPlatform = False
         , onlyPermissive = False
         , allowed = []
+        , buildPlanDest = defaultBuildPlan
         }
   where
     loop x [] = return x
@@ -28,22 +35,35 @@ parseBuildArgs =
     loop x ("--no-platform":rest) = loop x { noPlatform = True } rest
     loop x ("--only-permissive":rest) = loop x { onlyPermissive = True } rest
     loop x ("--allow":y:rest) = loop x { allowed = y : allowed x } rest
+    loop x ("--build-plan":y:rest) = loop x { buildPlanDest = y } rest
     loop _ (y:_) = error $ "Did not understand argument: " ++ y
 
+defaultBuildPlan :: FilePath
+defaultBuildPlan = "build-plan.txt"
+
 main :: IO ()
 main = do
     args <- getArgs
     case args of
-        "build":rest -> do
+        "select":rest -> do
-            BuildArgs {..} <- parseBuildArgs rest
+            SelectArgs {..} <- parseSelectArgs rest
-            build defaultBuildSettings
+            bp <- select
-                { excludedPackages = fromList $ map PackageName excluded
+                defaultSelectSettings
-                , requireHaskellPlatform = not noPlatform
+                    { excludedPackages = fromList $ map PackageName excluded
-                , allowedPackage =
+                    , requireHaskellPlatform = not noPlatform
-                    if onlyPermissive
+                    , allowedPackage =
-                        then allowPermissive allowed
+                        if onlyPermissive
-                        else const $ Right ()
+                            then allowPermissive allowed
-                }
+                            else const $ Right ()
+                    }
+            writeBuildPlan buildPlanDest bp
+        ["check"] -> checkHelper defaultBuildPlan
+        ["check", fp] -> checkHelper fp
+        ["build"] -> buildHelper defaultBuildPlan
+        ["build", fp] -> buildHelper fp
+        ["test"] -> testHelper defaultBuildPlan
+        ["test", fp] -> testHelper fp
+        ["tarballs"] -> tbHelper defaultBuildPlan
         ["init"] -> do
             putStrLn "Note: init isn't really ready for prime time use."
             putStrLn "Using it may make it impossible to build stackage."
@@ -58,7 +78,14 @@ main = do
             pn <- getProgName
             putStrLn $ "Usage: " ++ pn ++ " <command>"
             putStrLn "Available commands:"
-            putStrLn "    update              Download updated Stackage databases. Automatically calls init."
+            --putStrLn "    update              Download updated Stackage databases. Automatically calls init."
-            putStrLn "    init                Initialize your cabal file to use Stackage"
+            --putStrLn "    init                Initialize your cabal file to use Stackage"
-            putStrLn "    build [--no-clean] [--no-platform] [--exclude package...] [--only-permissive] [--allow package]"
+            putStrLn "    select [--no-clean] [--no-platform] [--exclude package...] [--only-permissive] [--allow package] [--build-plan file]"
-            putStrLn "                        Build the package databases (maintainers only)"
+            putStrLn "    check [build plan file]"
+            putStrLn "    build [build plan file]"
+            putStrLn "    test [build plan file]"
+  where
+    checkHelper fp = readBuildPlan fp >>= checkPlan
+    buildHelper fp = readBuildPlan fp >>= build defaultBuildSettings
+    testHelper fp = readBuildPlan fp >>= runTestSuites defaultBuildSettings
+    tbHelper fp = readBuildPlan fp >>= makeTarballs