Build plan created separately (partway to #25)

Stackage/Build.hs

@@ -28,6 +28,8 @@ import           System.IO            (IOMode (WriteMode), hPutStrLn,
                                        withBinaryFile)
 import           System.Process       (rawSystem, readProcess, runProcess,
                                        waitForProcess)
+import Stackage.Select (select)
+import Stackage.CheckCabalVersion (checkCabalVersion)
 
 defaultBuildSettings :: BuildSettings
 defaultBuildSettings = BuildSettings
@@ -39,7 +41,6 @@ defaultBuildSettings = BuildSettings
     , extraArgs = ["-fnetwork23"]
     , haskellPlatformCabal = "haskell-platform/haskell-platform.cabal"
     , requireHaskellPlatform = True
-    , cleanBeforeBuild = True
     , excludedPackages = empty
     , testWorkerThreads = 4
     , flags = Set.fromList $ words "blaze_html_0_5"
@@ -48,49 +49,31 @@ defaultBuildSettings = BuildSettings
 
 build :: BuildSettings -> IO ()
 build settings' = do
-    ii <- getInstallInfo settings'
+    putStrLn "Checking Cabal version"
+    libVersion <- checkCabalVersion
 
-    let root' = sandboxRoot settings'
+    bp <- select settings'
-    initPkgDb <- if cleanBeforeBuild settings'
-       then do
-         putStrLn "Wiping out old sandbox folder"
-         rm_r root'
-         rm_r "logs"
-         return True
-       else do
-         b <- doesDirectoryExist root'
-         when b (putStrLn "Re-using existing sandbox")
-         return (not b)
-    createDirectoryIfMissing True root'
-    root <- canonicalizePath root'
-    let settings = settings' { sandboxRoot = root }
 
-    when initPkgDb $ do
+    putStrLn "Checking build plan"
-        ec1 <- rawSystem "ghc-pkg" ["init", packageDir settings]
+    checkPlan bp
-        unless (ec1 == ExitSuccess) $ do
+    putStrLn "No mismatches, starting the sandboxed build."
-            putStrLn "Unable to create package database via ghc-pkg init"
-            exitWith ec1
-        checkPlan settings ii
-        putStrLn "No mismatches, starting the sandboxed build."
 
-    versionString <- readProcess "cabal" ["--version"] ""
+    putStrLn "Wiping out old sandbox folder"
-    libVersion <-
+    rm_r $ sandboxRoot settings'
-        case map words $ lines versionString of
+    rm_r "logs"
-            [_,["using","version",libVersion,"of","the","Cabal","library"]] -> return libVersion
+    settings <- fixBuildSettings settings'
-            _ -> error "Did not understand cabal --version output"
 
-    case (simpleParse libVersion, simpleParse ">= 1.16") of
+    putStrLn "Creating new package database"
-        (Nothing, _) -> error $ "Invalid Cabal library version: " ++ libVersion
+    ec1 <- rawSystem "ghc-pkg" ["init", packageDir settings]
-        (_, Nothing) -> assert False $ return ()
+    unless (ec1 == ExitSuccess) $ do
-        (Just v, Just vr)
+        putStrLn "Unable to create package database via ghc-pkg init"
-            | v `withinRange` vr -> return ()
+        exitWith ec1
-            | otherwise -> error $ "Unsupported Cabal version: " ++ libVersion
 
     menv <- fmap Just $ getModifiedEnv settings
     let runCabal args handle = runProcess "cabal" args Nothing menv Nothing (Just handle) (Just handle)
 
     -- First install build tools so they can be used below.
-    case iiBuildTools ii of
+    case bpTools bp of
         [] -> putStrLn "No build tools required"
         tools -> do
             putStrLn $ "Installing the following build tools: " ++ unwords tools
@@ -103,7 +86,7 @@ build settings' = do
                          : concat
                             [ extraBuildArgs settings
                             , extraArgs settings
-                            , iiBuildTools ii
+                            , tools
                             ]
                 hPutStrLn handle ("cabal " ++ unwords (map (\s -> "'" ++ s ++ "'") args))
                 runCabal args handle
@@ -122,7 +105,7 @@ build settings' = do
                  : concat
                     [ extraBuildArgs settings
                     , extraArgs settings
-                    , iiPackageList ii
+                    , bpPackageList bp
                     ]
         hPutStrLn handle ("cabal " ++ unwords (map (\s -> "'" ++ s ++ "'") args))
         runCabal args handle
@@ -132,10 +115,10 @@ build settings' = do
         exitWith ec
 
     putStrLn "Sandbox built, beginning individual test suites"
-    runTestSuites settings ii
+    runTestSuites settings $ bpPackages bp
 
     putStrLn "All test suites that were expected to pass did pass, building tarballs."
-    makeTarballs ii
+    makeTarballs bp
 
 -- | Get all of the build tools required.
 iiBuildTools :: InstallInfo -> [String]

Stackage/BuildPlan.hs

@@ -0,0 +1,139 @@
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE FlexibleInstances #-}
+module Stackage.BuildPlan
+    ( readBuildPlan
+    , writeBuildPlan
+    ) where
+
+import Stackage.Types
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+import           Distribution.Text       (simpleParse, display)
+import           Distribution.Package (PackageName (..))
+import Control.Applicative ((<$>), (<*>))
+
+readBuildPlan :: FilePath -> IO BuildPlan
+readBuildPlan fp = do
+    str <- readFile fp
+    case fromString str of
+        Left s -> error $ "Could not read build plan: " ++ s
+        Right (x, "") -> return x
+        Right (_, _:_) -> error "Trailing content when reading build plan"
+
+writeBuildPlan :: FilePath -> BuildPlan -> IO ()
+writeBuildPlan fp bp = writeFile fp $ toString bp
+
+class AsString a where
+    toString :: a -> String
+    fromString :: String -> Either String (a, String)
+
+instance AsString BuildPlan where
+    toString BuildPlan {..} = concat
+        [ makeSection "tools" bpTools
+        , makeSection "packages" $ Map.toList bpPackages
+        , makeSection "core" $ Set.toList bpCore
+        , makeSection "optional-core" $ Map.toList bpOptionalCore
+        ]
+    fromString s1 = do
+        (tools, s2) <- getSection "tools" s1
+        (packages, s3) <- getSection "packages" s2
+        (core, s4) <- getSection "core" s3
+        (optionalCore, s5) <- getSection "optional-core" s4
+        let bp = BuildPlan
+                { bpTools = tools
+                , bpPackages = Map.fromList packages
+                , bpCore = Set.fromList core
+                , bpOptionalCore = Map.fromList optionalCore
+                }
+        return (bp, s5)
+
+makeSection :: AsString a => String -> [a] -> String
+makeSection title contents = unlines
+    $ ("-- BEGIN " ++ title)
+    : map toString contents
+   ++ ["-- END " ++ title, ""]
+
+instance AsString String where
+    toString = id
+    fromString s = Right (s, "")
+
+instance AsString PackageName where
+    toString (PackageName pn) = pn
+    fromString s = Right (PackageName s, "")
+
+instance AsString a => AsString (PackageName, a) where
+    toString (PackageName pn, s) = concat [pn, " ", toString s]
+    fromString s = do
+        (pn, rest) <- takeWord s
+        (rest', s') <- fromString rest
+        return ((PackageName pn, rest'), s')
+
+takeWord :: AsString a => String -> Either String (a, String)
+takeWord s =
+    case break (== ' ') s of
+        (x, _:y) -> do
+            (x', s') <- fromString x
+            if null s'
+                then Right (x', y)
+                else Left $ "Unconsumed input in takeWord call"
+
+instance AsString SelectedPackageInfo where
+    toString SelectedPackageInfo {..} = unwords
+        [ display spiVersion
+        , toString spiHasTests
+        , maybe "@" ("@" ++) spiGithubUser
+        , unMaintainer spiMaintainer
+        ]
+    fromString s1 = do
+        (version, s2) <- takeWord s1
+        (hasTests, s3) <- takeWord s2
+        (gu, m) <- takeWord s3
+        Right (SelectedPackageInfo
+            { spiVersion = version
+            , spiHasTests = hasTests
+            , spiGithubUser = gu
+            , spiMaintainer = Maintainer m
+            }, "")
+
+instance AsString (Maybe String) where
+    toString Nothing = "@"
+    toString (Just x) = "@" ++ x
+    fromString "@" = Right (Nothing, "")
+    fromString ('@':rest) = Right (Just rest, "")
+    fromString x = Left $ "Invalid Github user: " ++ x
+
+instance AsString Bool where
+    toString True = "test"
+    toString False = "notest"
+    fromString "test" = Right (True, "")
+    fromString "notest" = Right (False, "")
+    fromString x = Left $ "Invalid test value: " ++ x
+
+instance AsString Version where
+    toString = display
+    fromString s =
+        case simpleParse s of
+            Nothing -> Left $ "Invalid version: " ++ s
+            Just v -> Right (v, "")
+
+getSection :: AsString a => String -> String -> Either String ([a], String)
+getSection title orig =
+    case lines orig of
+        [] -> Left "Unexpected EOF when looking for a section"
+        l1:ls1
+            | l1 == begin ->
+                case break (== end) ls1 of
+                    (here, _:"":rest) -> do
+                        here' <- mapM fromString' here
+                        Right (here', unlines rest)
+                    (_, _) -> Left $ "Could not find section end: " ++ title
+            | otherwise -> Left $ "Could not find section start: " ++ title
+  where
+    begin = "-- BEGIN " ++ title
+    end = "-- END " ++ title
+
+    fromString' x = do
+        (y, z) <- fromString x
+        if null z
+            then return y
+            else Left $ "Unconsumed input on line: " ++ x

Stackage/CheckCabalVersion.hs

@@ -0,0 +1,45 @@
+module Stackage.CheckCabalVersion
+    ( checkCabalVersion
+    ) where
+
+import           Control.Exception    (assert)
+import           Control.Monad        (unless, when)
+import qualified Data.Map             as Map
+import           Data.Maybe           (mapMaybe)
+import           Data.Set             (empty)
+import qualified Data.Set             as Set
+import           Distribution.Text    (simpleParse)
+import           Distribution.Version (withinRange)
+import           Prelude              hiding (pi)
+import           Stackage.CheckPlan
+import           Stackage.Config
+import           Stackage.InstallInfo
+import           Stackage.Tarballs
+import           Stackage.Test
+import           Stackage.Types
+import           Stackage.Util
+import           System.Directory     (canonicalizePath,
+                                       createDirectoryIfMissing,
+                                       doesDirectoryExist)
+import           System.Exit          (ExitCode (ExitSuccess), exitWith)
+import           System.IO            (IOMode (WriteMode), hPutStrLn,
+                                       withBinaryFile)
+import           System.Process       (rawSystem, readProcess, runProcess,
+                                       waitForProcess)
+
+checkCabalVersion :: IO String
+checkCabalVersion = do
+    versionString <- readProcess "cabal" ["--version"] ""
+    libVersion <-
+        case map words $ lines versionString of
+            [_,["using","version",libVersion,"of","the","Cabal","library"]] -> return libVersion
+            _ -> error "Did not understand cabal --version output"
+
+    case (simpleParse libVersion, simpleParse ">= 1.16") of
+        (Nothing, _) -> error $ "Invalid Cabal library version: " ++ libVersion
+        (_, Nothing) -> assert False $ return ()
+        (Just v, Just vr)
+            | v `withinRange` vr -> return ()
+            | otherwise -> error $ "Unsupported Cabal version: " ++ libVersion
+
+    return libVersion

Stackage/CheckPlan.hs

@@ -16,22 +16,22 @@ import           System.Process       (readProcessWithExitCode)
 data Mismatch = OnlyDryRun String | OnlySimpleList String
     deriving Show
 
-checkPlan :: BuildSettings -> InstallInfo -> IO ()
+checkPlan :: BuildPlan -> IO ()
-checkPlan settings ii = do
+checkPlan bp = do
-    (ec, dryRun', stderr) <- readProcessWithExitCode "cabal" (addCabalArgs settings $ "install":"--dry-run":iiPackageList ii) ""
+    (ec, dryRun', stderr) <- readProcessWithExitCode "cabal" (addCabalArgsOnlyGlobal $ "install":"--dry-run":bpPackageList bp) ""
     when (ec /= ExitSuccess || "Warning:" `isPrefixOf` stderr) $ do
         putStr stderr
         putStr dryRun'
         putStrLn "cabal returned a bad result, exiting"
         exitWith ec
     let dryRun = sort $ filter notOptionalCore $ map (takeWhile (/= ' ')) $ drop 2 $ lines dryRun'
-    let mismatches = getMismatches dryRun (filter notOptionalCore $ iiPackageList ii)
+    let mismatches = getMismatches dryRun (filter notOptionalCore $ bpPackageList bp)
     unless (null mismatches) $ do
         putStrLn "Found the following mismatches"
         mapM_ print mismatches
         exitWith $ ExitFailure 1
   where
-    optionalCore = Set.fromList $ map packageVersionString $ Map.toList $ iiOptionalCore ii
+    optionalCore = Set.fromList $ map packageVersionString $ Map.toList $ bpOptionalCore bp
     notOptionalCore s = not $ s `Set.member` optionalCore
 
 getMismatches :: [String] -> [String] -> [Mismatch]

Stackage/InstallInfo.hs

@@ -1,6 +1,7 @@
+{-# LANGUAGE RecordWildCards #-}
 module Stackage.InstallInfo
     ( getInstallInfo
-    , iiPackageList
+    , bpPackageList
     ) where
 
 import           Control.Arrow            ((&&&))
@@ -60,28 +61,39 @@ getInstallInfo settings = do
 
     return InstallInfo
         { iiCore = totalCore
-        , iiPackages = Map.map (biVersion &&& biMaintainer) final
+        , iiPackages = Map.map biToSPI final
         , iiOptionalCore = Map.fromList $ map (\(PackageIdentifier p v) -> (p, v)) $ Set.toList $ hplibs hp
         , iiPackageDB = pdb
         }
 
+biToSPI :: BuildInfo -> SelectedPackageInfo
+biToSPI BuildInfo {..} = SelectedPackageInfo
+    { spiVersion = biVersion
+    , spiMaintainer = biMaintainer
+    , spiGithubUser = biGithubUser
+    , spiHasTests = biHasTests
+    }
+
 showDep :: (PackageName, BuildInfo) -> String
-showDep (PackageName name, (BuildInfo version deps (Maintainer m) _)) =
+showDep (PackageName name, BuildInfo {..}) =
     concat
         [ name
         , "-"
-        , showVersion version
+        , showVersion biVersion
         , " ("
-        , m
+        , unMaintainer biMaintainer
+        , case biGithubUser of
+            Nothing -> ""
+            Just x -> " @" ++ x
         , ")"
         , ": "
-        , unwords $ map unP deps
+        , unwords $ map unP biUsers
         ]
   where
     unP (PackageName p) = p
 
-iiPackageList :: InstallInfo -> [String]
+bpPackageList :: BuildPlan -> [String]
-iiPackageList = map packageVersionString . Map.toList . Map.map fst . iiPackages
+bpPackageList = map packageVersionString . Map.toList . Map.map spiVersion . bpPackages
 
 -- | Check for internal mismatches in required and actual package versions.
 checkBadVersions :: BuildSettings

Stackage/NarrowDatabase.hs

@@ -38,6 +38,8 @@ narrowPackageDB settings (PackageDB pdb) packageSet = do
                                 , biUsers      = users
                                 , biMaintainer = maintainer
                                 , biDeps       = piDeps pi
+                                , biGithubUser = piGithubUser pi
+                                , biHasTests   = piHasTests pi
                                 } result
                         case piGPD pi of
                             Nothing -> return ()

Stackage/Select.hs

@@ -0,0 +1,74 @@
+module Stackage.Select
+    ( select
+    ) where
+
+import           Control.Exception    (assert)
+import           Control.Monad        (unless, when)
+import qualified Data.Map             as Map
+import           Data.Maybe           (mapMaybe)
+import           Data.Set             (empty)
+import qualified Data.Set             as Set
+import           Distribution.Text    (simpleParse)
+import           Distribution.Version (withinRange)
+import           Prelude              hiding (pi)
+import           Stackage.CheckPlan
+import           Stackage.Config
+import           Stackage.InstallInfo
+import           Stackage.Tarballs
+import           Stackage.Test
+import           Stackage.Types
+import           Stackage.Util
+import           System.Directory     (canonicalizePath,
+                                       createDirectoryIfMissing,
+                                       doesDirectoryExist)
+import           System.Exit          (ExitCode (ExitSuccess), exitWith)
+import           System.IO            (IOMode (WriteMode), hPutStrLn,
+                                       withBinaryFile)
+import           System.Process       (rawSystem, readProcess, runProcess,
+                                       waitForProcess)
+import Stackage.BuildPlan
+
+select :: BuildSettings -> IO BuildPlan
+select settings' = do
+    ii <- getInstallInfo settings'
+
+    let bp = BuildPlan
+            { bpTools = iiBuildTools ii
+            , bpPackages = iiPackages ii
+            , bpOptionalCore = iiOptionalCore 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]
+iiBuildTools InstallInfo { iiPackageDB = PackageDB m, iiPackages = packages } =
+    -- FIXME possible improvement: track the dependencies between the build
+    -- tools themselves, and install them in the correct order.
+    map packageVersionString
+  $ filter (flip Set.notMember coreTools . fst)
+  $ mapMaybe (flip Map.lookup buildToolMap)
+  $ Set.toList
+  $ Set.unions
+  $ map piBuildTools
+  $ Map.elems
+  $ Map.filterWithKey isSelected m
+  where
+    unPackageName (PackageName pn) = pn
+    isSelected name _ = name `Set.member` selected
+    selected = Set.fromList $ Map.keys packages
+
+    -- Build tools shipped with GHC which we should not attempt to build
+    -- ourselves.
+    coreTools = Set.fromList $ map PackageName $ words "hsc2hs"
+
+    -- The map from build tool name to the package it comes from.
+    buildToolMap = Map.unions $ map toBuildToolMap $ Map.toList m
+    toBuildToolMap :: (PackageName, PackageInfo) -> Map Executable (PackageName, Version)
+    toBuildToolMap (pn, pi) = Map.unions
+                            $ map (flip Map.singleton (pn, piVersion pi))
+                            $ Set.toList
+                            $ piExecs pi

Stackage/Tarballs.hs

@@ -11,8 +11,8 @@ import           Stackage.Util
 import           System.Directory     (createDirectoryIfMissing)
 import           System.FilePath      (takeDirectory)
 
-makeTarballs :: InstallInfo -> IO ()
+makeTarballs :: BuildPlan -> IO ()
-makeTarballs ii = do
+makeTarballs bp = do
     tarName <- getTarballName
     origEntries <- fmap Tar.read $ L.readFile tarName
     (stableEntries, extraEntries) <- loop id id origEntries
@@ -35,10 +35,10 @@ makeTarballs ii = do
             case getPackageVersion e of
                 Nothing -> (stable, extra)
                 Just (package, version) ->
-                    case Map.lookup package $ iiPackages ii of
+                    case Map.lookup package $ bpPackages bp of
-                        Just (version', _maintainer)
+                        Just spi
-                            | version == version' -> (stable . (e:), extra)
+                            | version == spiVersion spi -> (stable . (e:), extra)
                             | otherwise -> (stable, extra)
                         Nothing
-                            | package `Set.member` iiCore ii -> (stable, extra)
+                            | package `Set.member` bpCore bp -> (stable, extra)
                             | otherwise -> (stable, extra . (e:))

Stackage/Test.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE RecordWildCards    #-}
 module Stackage.Test
     ( runTestSuites
     ) where
@@ -18,17 +19,13 @@ import           System.IO          (IOMode (WriteMode, AppendMode),
                                      withBinaryFile)
 import           System.Process     (runProcess, waitForProcess)
 
-runTestSuites :: BuildSettings -> InstallInfo -> IO ()
+runTestSuites :: BuildSettings -> Map PackageName SelectedPackageInfo -> IO ()
-runTestSuites settings ii = do
+runTestSuites settings selected = do
     let testdir = "runtests"
     rm_r testdir
     createDirectory testdir
-    allPass <- parFoldM (testWorkerThreads settings) (runTestSuite settings testdir hasTestSuites) (&&) True $ Map.toList $ iiPackages ii
+    allPass <- parFoldM (testWorkerThreads settings) (runTestSuite settings testdir) (&&) True $ Map.toList selected
     unless allPass $ error $ "There were failures, please see the logs in " ++ testdir
-  where
-    PackageDB pdb = iiPackageDB ii
-
-    hasTestSuites name = maybe defaultHasTestSuites piHasTests $ Map.lookup name pdb
 
 parFoldM :: Int -- ^ number of threads
          -> (b -> IO c)
@@ -76,10 +73,9 @@ instance Exception TestException
 
 runTestSuite :: BuildSettings
              -> FilePath
-             -> (PackageName -> Bool) -- ^ do we have any test suites?
+             -> (PackageName, SelectedPackageInfo)
-             -> (PackageName, (Version, Maintainer))
              -> IO Bool
-runTestSuite settings testdir hasTestSuites (packageName, (version, Maintainer maintainer)) = do
+runTestSuite settings testdir (packageName, SelectedPackageInfo {..}) = do
     -- Set up a new environment that includes the sandboxed bin folder in PATH.
     env' <- getModifiedEnv settings
     let menv addGPP
@@ -98,7 +94,7 @@ runTestSuite settings testdir hasTestSuites (packageName, (version, Maintainer m
     passed <- handle (\TestException -> return False) $ do
         getHandle WriteMode  $ run "cabal" ["unpack", package] testdir
         getHandle AppendMode $ run "cabal" (addCabalArgs settings ["configure", "--enable-tests"]) dir
-        when (hasTestSuites packageName) $ do
+        when spiHasTests $ do
             getHandle AppendMode $ run "cabal" ["build"] dir
             getHandle AppendMode $ runGhcPackagePath "cabal" ["test"] dir
         getHandle AppendMode $ run "cabal" ["haddock"] dir
@@ -108,11 +104,20 @@ runTestSuite settings testdir hasTestSuites (packageName, (version, Maintainer m
         then do
             removeFile logfile
             when expectedFailure $ putStrLn $ package ++ " passed, but I didn't think it would."
-        else unless expectedFailure $ putStrLn $ "Test suite failed: " ++ package ++ "(" ++ maintainer ++ ")"
+        else unless expectedFailure $ putStrLn $ concat
+                [ "Test suite failed: "
+                , package
+                , "("
+                , unMaintainer spiMaintainer
+                , case spiGithubUser of
+                    Nothing -> ""
+                    Just x -> " @" ++ x
+                , ")"
+                ]
     rm_r dir
     return $! passed || expectedFailure
   where
     logfile = testdir </> package <.> "log"
     dir = testdir </> package
     getHandle mode = withBinaryFile logfile mode
-    package = packageVersionString (packageName, version)
+    package = packageVersionString (packageName, spiVersion)

Stackage/Types.hs

@@ -46,6 +46,8 @@ data BuildInfo = BuildInfo
     , biUsers      :: [PackageName]
     , biMaintainer :: Maintainer
     , biDeps       :: Map PackageName VersionRange
+    , biGithubUser :: Maybe String
+    , biHasTests   :: Bool
     }
 
 data HaskellPlatform = HaskellPlatform
@@ -59,7 +61,7 @@ instance Monoid HaskellPlatform where
 
 data InstallInfo = InstallInfo
     { iiCore         :: Set PackageName
-    , iiPackages     :: Map PackageName (Version, Maintainer)
+    , iiPackages     :: Map PackageName SelectedPackageInfo
     , iiOptionalCore :: Map PackageName Version
       -- ^ This is intended to hold onto packages which might be automatically
       -- provided in the global package database. In practice, this would be
@@ -67,9 +69,25 @@ data InstallInfo = InstallInfo
     , iiPackageDB    :: PackageDB
     }
 
+data SelectedPackageInfo = SelectedPackageInfo
+    { spiVersion :: Version
+    , spiMaintainer :: Maintainer
+    , spiGithubUser :: Maybe String
+    , spiHasTests :: Bool
+    }
+    deriving (Show, Read)
+
+data BuildPlan = BuildPlan
+    { bpTools :: [String]
+    , bpPackages :: Map PackageName SelectedPackageInfo
+    , bpCore :: Set PackageName
+    , bpOptionalCore :: Map PackageName Version
+      -- ^ See 'iiOptionalCore'
+    }
+
 -- | Email address of a Stackage maintainer.
 newtype Maintainer = Maintainer { unMaintainer :: String }
-    deriving (Show, Eq, Ord)
+    deriving (Show, Eq, Ord, Read)
 
 data BuildSettings = BuildSettings
     { sandboxRoot            :: FilePath
@@ -80,7 +98,6 @@ data BuildSettings = BuildSettings
     , extraArgs              :: [String]
     , haskellPlatformCabal   :: FilePath
     , requireHaskellPlatform :: Bool
-    , cleanBeforeBuild       :: 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

Stackage/Util.hs

@@ -19,6 +19,9 @@ import           System.FilePath         ((</>))
 import qualified Distribution.Package as P
 import qualified Distribution.PackageDescription as PD
 import           Distribution.License    (License (..))
+import           System.Directory     (canonicalizePath,
+                                       createDirectoryIfMissing,
+                                       doesDirectoryExist)
 
 -- | Allow only packages with permissive licenses.
 allowPermissive :: [String] -- ^ list of explicitly allowed packages
@@ -94,11 +97,16 @@ binDir = (</> "bin") . sandboxRoot
 dataDir = (</> "share") . sandboxRoot
 docDir x = sandboxRoot x </> "share" </> "doc" </> "$pkgid"
 
-addCabalArgs :: BuildSettings -> [String] -> [String]
+addCabalArgsOnlyGlobal :: [String] -> [String]
-addCabalArgs settings rest
+addCabalArgsOnlyGlobal rest
     = "--package-db=clear"
     : "--package-db=global"
-    : ("--package-db=" ++ packageDir settings)
+    : rest
+
+addCabalArgs :: BuildSettings -> [String] -> [String]
+addCabalArgs settings rest
+    = addCabalArgsOnlyGlobal
+    $ ("--package-db=" ++ packageDir settings)
     : ("--libdir=" ++ libDir settings)
     : ("--bindir=" ++ binDir settings)
     : ("--datadir=" ++ dataDir settings)
@@ -121,3 +129,13 @@ getModifiedEnv settings = do
 #else
     pathSep = ':'
 #endif
+
+-- | Minor fixes, such as making paths absolute.
+--
+-- Note: creates the sandbox root in the process.
+fixBuildSettings :: BuildSettings -> IO BuildSettings
+fixBuildSettings settings' = do
+    let root' = sandboxRoot settings'
+    createDirectoryIfMissing True root'
+    root <- canonicalizePath root'
+    return settings' { sandboxRoot = root }

app/stackage.hs

@@ -8,8 +8,7 @@ import           Data.Set           (fromList)
 import           System.IO          (hFlush, stdout)
 
 data BuildArgs = BuildArgs
-    { noClean :: Bool
+    { excluded :: [String]
-    , excluded :: [String]
     , noPlatform :: Bool
     , onlyPermissive :: Bool
     , allowed :: [String]
@@ -18,15 +17,13 @@ data BuildArgs = BuildArgs
 parseBuildArgs :: [String] -> IO BuildArgs
 parseBuildArgs =
     loop BuildArgs
-        { noClean = False
+        { excluded = []
-        , excluded = []
         , noPlatform = False
         , onlyPermissive = False
         , allowed = []
         }
   where
     loop x [] = return x
-    loop x ("--no-clean":rest) = loop x { noClean = True } rest
     loop x ("--exclude":y:rest) = loop x { excluded = y : excluded x } rest
     loop x ("--no-platform":rest) = loop x { noPlatform = True } rest
     loop x ("--only-permissive":rest) = loop x { onlyPermissive = True } rest
@@ -40,8 +37,7 @@ main = do
         "build":rest -> do
             BuildArgs {..} <- parseBuildArgs rest
             build defaultBuildSettings
-                { cleanBeforeBuild = not noClean
+                { excludedPackages = fromList $ map PackageName excluded
-                , excludedPackages = fromList $ map PackageName excluded
                 , requireHaskellPlatform = not noPlatform
                 , allowedPackage =
                     if onlyPermissive

stackage.cabal

@@ -24,6 +24,9 @@ library
                        Stackage.Test
                        Stackage.Build
                        Stackage.Init
+                       Stackage.BuildPlan
+                       Stackage.CheckCabalVersion
+                       Stackage.Select
   build-depends:       base >= 4 && < 5
                      , containers
                      , Cabal