Merge branch 'incremental' into new-upload

Conflicts:
	ChangeLog.md
	stackage.cabal

.dir-locals.el

@@ -0,0 +1,3 @@
+((haskell-mode . ((haskell-process-type . cabal-repl)
+                  (haskell-indent-spaces . 4)
+                  (hindent-style . "johan-tibell"))))

.dockerignore

@@ -0,0 +1,8 @@
+dist
+builds
+logs
+.cabal-sandbox
+cabal.sandbox.config
+tarballs
+*.yaml
+.git

.travis.yml

@@ -0,0 +1,24 @@
+env:
+ - CABALVER=1.20 GHCVER=7.8.4
+
+cache:
+ directories:
+ - $HOME/.ghc
+ - $HOME/.cabal
+
+# Note: the distinction between `before_install` and `install` is not important.
+before_install:
+ - travis_retry sudo add-apt-repository -y ppa:hvr/ghc
+ - travis_retry sudo apt-get update
+ - travis_retry sudo apt-get install cabal-install-$CABALVER ghc-$GHCVER # see note about happy/alex
+ - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH
+
+install:
+ - cabal --version
+ - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]"
+ - travis_retry cabal update
+ - cabal install -j
+
+# Here starts the actual work to be performed for the package under test; any command which exits with a non-zero exit code causes the build to fail.
+script:
+ - ./dist/build/stackage/stackage check

ChangeLog.md

@@ -1,7 +1,28 @@
-## 0.4.0
+## Unreleased
 
 * Upload bundle V2 stuff
 
+## 0.5.2
+
+* Upload LTS to Hackage with the name LTSHaskell
+
+## 0.5.1
+
+* `loadBuildConstraints`
+* More command line options
+
+## 0.5.0
+
+* Print "Still Alive" while checking, to avoid Travis timeouts
+* Include `stackage upload-nightly` command
+* Optional plan checking
+
+## 0.4.0
+
+* Command line uses optparse-applicative with additional options
+* Library profiling support during build
+* Remove cfGlobalFlags (just use package-specific flags)
+
 ## 0.3.1
 
 * Added `justCheck` and `stackage check` command line.

Dockerfile

@@ -0,0 +1,25 @@
+FROM ubuntu:12.04
+
+ENV HOME /home/stackage
+ENV LANG en_US.UTF-8
+
+RUN mkdir /home/stackage -p
+RUN locale-gen en_US.UTF-8
+
+RUN DEBIAN_FRONTEND=noninteractive apt-get update
+RUN DEBIAN_FRONTEND=noninteractive apt-get install -y software-properties-common python-software-properties
+RUN DEBIAN_FRONTEND=noninteractive add-apt-repository ppa:hvr/ghc -y
+
+ADD debian-bootstrap.sh /tmp/debian-bootstrap.sh
+RUN DEBIAN_FRONTEND=noninteractive bash /tmp/debian-bootstrap.sh
+RUN rm /tmp/debian-bootstrap.sh
+
+RUN DEBIAN_FRONTEND=noninteractive apt-get install -y cabal-install-1.20 ghc-7.8.4 alex-3.1.3 happy-1.19.4
+
+ENV PATH /home/stackage/.cabal/bin:/usr/local/sbin:/usr/local/bin:/opt/ghc/7.8.4/bin:/opt/cabal/1.20/bin:/opt/alex/3.1.3/bin:/opt/happy/1.19.4/bin:/usr/sbin:/usr/bin:/sbin:/bin
+
+RUN cabal update
+ADD . /tmp/stackage
+RUN cd /tmp/stackage && cabal install . hscolour cabal-install --constraint "Cabal < 1.22" && cp $HOME/.cabal/bin/* /usr/local/bin && rm -rf $HOME/.cabal $HOME/.ghc /tmp/stackage
+
+RUN cd /home/stackage && cabal update && stackage check

README.md

@@ -49,6 +49,28 @@ build by running:
     cabal install stackage
     stackage nightly
 
+### Docker
+
+Note: This method is currently considered experimental.
+
+If you'd like to check a build plan, or perform an entire build, without
+specially configuring your system, Docker may be a good approach. To check if
+some modifications to `build-constraints.yaml` are valid, try the following:
+
+1. Create a local clone of the `stackage` repo
+2. Make modifications to your local `build-constraints.yaml`
+3. Inside the `stackage` working directory, run the following:
+
+   ```
+   $ docker run -it --rm -v $(pwd):/stackage -w /stackage snoyberg/stackage /bin/bash -c 'cabal update && stackage check'
+   ```
+
+Similarly, if you'd like to perform an entire build, you can replace the last step with:
+
+```
+$ docker run -it --rm -v $(pwd):/stackage -w /stackage snoyberg/stackage /bin/bash -c 'cabal update && stackage nightly --skip-upload'
+```
+
 ## Processing
 
 The following describes at a high level the series of steps for processing

Stackage/BuildConstraints.hs

@@ -10,6 +10,9 @@ module Stackage.BuildConstraints
     , SystemInfo (..)
     , getSystemInfo
     , defaultBuildConstraints
+    , toBC
+    , BuildConstraintsSource (..)
+    , loadBuildConstraints
     ) where
 
 import           Control.Monad.Writer.Strict (execWriter, tell)
@@ -21,7 +24,7 @@ import           Distribution.System         (Arch, OS)
 import qualified Distribution.System
 import           Distribution.Version        (anyVersion)
 import           Filesystem                  (isFile)
-import           Network.HTTP.Client         (Manager, httpLbs, responseBody)
+import           Network.HTTP.Client         (Manager, httpLbs, responseBody, Request)
 import           Stackage.CorePackages
 import           Stackage.Prelude
 
@@ -88,12 +91,13 @@ data BuildConstraints = BuildConstraints
     }
 
 data PackageConstraints = PackageConstraints
-    { pcVersionRange    :: VersionRange
+    { pcVersionRange     :: VersionRange
-    , pcMaintainer      :: Maybe Maintainer
+    , pcMaintainer       :: Maybe Maintainer
-    , pcTests           :: TestState
+    , pcTests            :: TestState
-    , pcHaddocks        :: TestState
+    , pcHaddocks         :: TestState
-    , pcBuildBenchmarks :: Bool
+    , pcBuildBenchmarks  :: Bool
-    , pcFlagOverrides   :: Map FlagName Bool
+    , pcFlagOverrides    :: Map FlagName Bool
+    , pcEnableLibProfile :: Bool
     }
     deriving (Show, Eq)
 instance ToJSON PackageConstraints where
@@ -103,6 +107,7 @@ instance ToJSON PackageConstraints where
         , "haddocks" .= pcHaddocks
         , "build-benchmarks" .= pcBuildBenchmarks
         , "flags" .= Map.mapKeysWith const unFlagName pcFlagOverrides
+        , "library-profiling" .= pcEnableLibProfile
         ]
       where
         addMaintainer = maybe id (\m -> (("maintainer" .= m):)) pcMaintainer
@@ -115,6 +120,7 @@ instance FromJSON PackageConstraints where
         pcBuildBenchmarks <- o .: "build-benchmarks"
         pcFlagOverrides <- Map.mapKeysWith const mkFlagName <$> o .: "flags"
         pcMaintainer <- o .:? "maintainer"
+        pcEnableLibProfile <- fmap (fromMaybe True) (o .:? "library-profiling")
         return PackageConstraints {..}
 
 -- | The proposed plan from the requirements provided by contributors.
@@ -122,15 +128,32 @@ instance FromJSON PackageConstraints where
 -- Checks the current directory for a build-constraints.yaml file and uses it
 -- if present. If not, downloads from Github.
 defaultBuildConstraints :: Manager -> IO BuildConstraints
-defaultBuildConstraints man = do
+defaultBuildConstraints = loadBuildConstraints BCSDefault
-    e <- isFile fp
+
-    if e
+data BuildConstraintsSource
-        then decodeFileEither (fpToString fp) >>= either throwIO toBC
+    = BCSDefault
-        else httpLbs req man >>=
+    | BCSFile FilePath
-             either throwIO toBC . decodeEither' . toStrict . responseBody
+    | BCSWeb Request
+    deriving (Show)
+
+loadBuildConstraints :: BuildConstraintsSource -> Manager -> IO BuildConstraints
+loadBuildConstraints bcs man = do
+    case bcs of
+        BCSDefault -> do
+            e <- isFile fp0
+            if e
+                then loadFile fp0
+                else loadReq req0
+        BCSFile fp -> loadFile fp
+        BCSWeb req -> loadReq req
   where
-    fp = "build-constraints.yaml"
+    fp0 = "build-constraints.yaml"
-    req = "https://raw.githubusercontent.com/fpco/stackage/master/build-constraints.yaml"
+    req0 = "https://raw.githubusercontent.com/fpco/stackage/master/build-constraints.yaml"
+
+    loadFile fp = decodeFileEither (fpToString fp) >>= either throwIO toBC
+    loadReq req = httpLbs req man >>=
+                  either throwIO toBC . decodeEither' . toStrict . responseBody
+
 
 getSystemInfo :: IO SystemInfo
 getSystemInfo = do
@@ -144,24 +167,24 @@ getSystemInfo = do
     siArch = Distribution.System.X86_64
 
 data ConstraintFile = ConstraintFile
-    { cfGlobalFlags             :: Map FlagName Bool
+    { cfPackageFlags            :: Map PackageName (Map FlagName Bool)
-    , cfPackageFlags            :: Map PackageName (Map FlagName Bool)
     , cfSkippedTests            :: Set PackageName
     , cfExpectedTestFailures    :: Set PackageName
     , cfExpectedHaddockFailures :: Set PackageName
     , cfSkippedBenchmarks       :: Set PackageName
     , cfPackages                :: Map Maintainer (Vector Dependency)
     , cfGithubUsers             :: Map Text (Set Text)
+    , cfSkippedLibProfiling     :: Set PackageName
     }
 
 instance FromJSON ConstraintFile where
     parseJSON = withObject "ConstraintFile" $ \o -> do
-        cfGlobalFlags <- goFlagMap <$> o .: "global-flags"
         cfPackageFlags <- (goPackageMap . fmap goFlagMap) <$> o .: "package-flags"
         cfSkippedTests <- getPackages o "skipped-tests"
         cfExpectedTestFailures <- getPackages o "expected-test-failures"
         cfExpectedHaddockFailures <- getPackages o "expected-haddock-failures"
         cfSkippedBenchmarks <- getPackages o "skipped-benchmarks"
+        cfSkippedLibProfiling <- getPackages o "skipped-profiling"
         cfPackages <- o .: "packages"
                   >>= mapM (mapM toDep)
                     . Map.mapKeysWith const Maintainer
@@ -196,6 +219,7 @@ toBC ConstraintFile {..} = do
         mpair = lookup name revmap
         pcMaintainer = fmap fst mpair
         pcVersionRange = maybe anyVersion snd mpair
+        pcEnableLibProfile = not (name `member` cfSkippedLibProfiling)
         pcTests
             | name `member` cfSkippedTests = Don'tBuild
             | name `member` cfExpectedTestFailures = ExpectFailure
@@ -205,7 +229,6 @@ toBC ConstraintFile {..} = do
             | name `member` cfExpectedHaddockFailures = ExpectFailure
 
             | otherwise = ExpectSuccess
-        pcFlagOverrides = fromMaybe mempty (lookup name cfPackageFlags) ++
+        pcFlagOverrides = fromMaybe mempty $ lookup name cfPackageFlags
-                          cfGlobalFlags
 
     bcGithubUsers = cfGithubUsers

Stackage/BuildPlan.hs

@@ -14,6 +14,7 @@ module Stackage.BuildPlan
     , PackagePlan (..)
     , newBuildPlan
     , makeToolMap
+    , getLatestAllowedPlans
     ) where
 
 import           Control.Monad.State.Strict      (execState, get, put)
@@ -90,9 +91,9 @@ instance FromJSON PackagePlan where
         ppDesc <- o .: "description"
         return PackagePlan {..}
 
-newBuildPlan :: MonadIO m => BuildConstraints -> m BuildPlan
+-- | Make a build plan given these package set and build constraints.
-newBuildPlan bc@BuildConstraints {..} = liftIO $ do
+newBuildPlan :: MonadIO m => Map PackageName PackagePlan -> BuildConstraints -> m BuildPlan
-    packagesOrig <- getLatestDescriptions (isAllowed bc) (mkPackagePlan bc)
+newBuildPlan packagesOrig bc@BuildConstraints {..} = liftIO $ do
     let toolMap = makeToolMap packagesOrig
         packages = populateUsers $ removeUnincluded bc toolMap packagesOrig
         toolNames :: [ExeName]
@@ -205,3 +206,9 @@ mkPackagePlan bc gpd = do
     getFlag MkFlag {..} =
         (flagName, fromMaybe flagDefault $ lookup flagName overrides)
     flags = mapFromList $ map getFlag $ genPackageFlags gpd
+
+getLatestAllowedPlans :: MonadIO m => BuildConstraints -> m (Map PackageName PackagePlan)
+getLatestAllowedPlans bc =
+    getLatestDescriptions
+        (isAllowed bc)
+        (mkPackagePlan bc)

Stackage/CheckBuildPlan.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE DeriveDataTypeable         #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE NoImplicitPrelude          #-}
@@ -7,28 +8,38 @@
 -- | Confirm that a build plan has a consistent set of dependencies.
 module Stackage.CheckBuildPlan
     ( checkBuildPlan
+    , BadBuildPlan
     ) where
 
 import           Control.Monad.Writer.Strict (Writer, execWriter, tell)
-import qualified Data.Text                   as T
+import qualified Data.Map.Strict as M
+import qualified Data.Text as T
 import           Stackage.BuildConstraints
 import           Stackage.BuildPlan
 import           Stackage.PackageDescription
 import           Stackage.Prelude
 
--- FIXME check cycles in dependencies, only looking at libraries and
+-- | Check the build plan for missing deps, wrong versions, etc.
--- executables
+checkBuildPlan :: (MonadThrow m) => BuildPlan -> m ()
-
-checkBuildPlan :: MonadThrow m => BuildPlan -> m ()
 checkBuildPlan BuildPlan {..}
     | null errs' = return ()
     | otherwise = throwM errs
   where
-    allPackages = siCorePackages bpSystemInfo ++ map ppVersion bpPackages
+    allPackages = map (,mempty) (siCorePackages bpSystemInfo) ++
+                  map (ppVersion &&& M.keys . M.filter libAndExe . sdPackages . ppDesc) bpPackages
     errs@(BadBuildPlan errs') =
         execWriter $ mapM_ (checkDeps allPackages) $ mapToList bpPackages
+    -- Only looking at libraries and executables, benchmarks and tests
+    -- are allowed to create cycles (e.g. test-framework depends on
+    -- text, which uses test-framework in its test-suite).
+    libAndExe (DepInfo cs _) = any (flip elem [CompLibrary,CompExecutable]) cs
 
-checkDeps :: Map PackageName Version
+-- | For a given package name and plan, check that its dependencies are:
+--
+-- 1. Existent (existing in the provided package map)
+-- 2. Within version range
+-- 3. Check for dependency cycles.
+checkDeps :: Map PackageName (Version,[PackageName])
           -> (PackageName, PackagePlan)
           -> Writer BadBuildPlan ()
 checkDeps allPackages (user, pb) =
@@ -37,8 +48,16 @@ checkDeps allPackages (user, pb) =
     go (dep, diRange -> range) =
         case lookup dep allPackages of
             Nothing -> tell $ BadBuildPlan $ singletonMap (dep, Nothing) errMap
-            Just version
+            Just (version,deps)
-                | version `withinRange` range -> return ()
+                | version `withinRange` range ->
+                    occursCheck allPackages
+                                (\d v ->
+                                     tell $ BadBuildPlan $ singletonMap
+                                     (d,v)
+                                     errMap)
+                                dep
+                                deps
+                                []
                 | otherwise -> tell $ BadBuildPlan $ singletonMap
                     (dep, Just version)
                     errMap
@@ -51,6 +70,38 @@ checkDeps allPackages (user, pb) =
             , puGithubPings = ppGithubPings pb
             }
 
+-- | Check whether the package(s) occurs within its own dependency
+-- tree.
+occursCheck
+    :: Monad m
+    => Map PackageName (Version,[PackageName])
+    -- ^ All packages.
+    -> (PackageName -> Maybe Version -> m ())
+    -- ^ Report an erroneous package.
+    -> PackageName
+    -- ^ Starting package to check for cycles in.
+    -> [PackageName]
+    -- ^ Dependencies of the package.
+    -> [PackageName]
+    -- ^ Previously seen packages up the dependency tree.
+    -> m ()
+occursCheck allPackages reportError =
+    go
+    where
+        go pkg deps seen =
+            case find (flip elem seen) deps of
+                Just cyclic ->
+                    reportError cyclic $
+                    fmap fst (lookup cyclic allPackages)
+                Nothing ->
+                    forM_ deps $
+                    \pkg' ->
+                         case lookup pkg' allPackages of
+                             Just (_v,deps')
+                                 | pkg' /= pkg -> go pkg' deps' seen'
+                             _ -> return ()
+            where seen' = pkg : seen
+
 data PkgUser = PkgUser
     { puName        :: PackageName
     , puVersion     :: Version

Stackage/CompleteBuild.hs

@@ -4,9 +4,14 @@
 module Stackage.CompleteBuild
     ( BuildType (..)
     , BumpType (..)
+    , BuildFlags (..)
     , completeBuild
     , justCheck
+    , justUploadNightly
     ) where
+
+import Control.Concurrent        (threadDelay)
+import Control.Concurrent.Async  (withAsync)
 import Data.Default.Class        (def)
 import Data.Semigroup            (Max (..), Option (..))
 import Data.Text.Read            (decimal)
@@ -22,8 +27,20 @@ import Stackage.Prelude
 import Stackage.ServerBundle
 import Stackage.UpdateBuildPlan
 import Stackage.Upload
+import System.Environment        (lookupEnv)
 import System.IO                 (BufferMode (LineBuffering), hSetBuffering)
 
+-- | Flags passed in from the command line.
+data BuildFlags = BuildFlags
+    { bfEnableTests      :: !Bool
+    , bfEnableHaddock    :: !Bool
+    , bfDoUpload         :: !Bool
+    , bfEnableLibProfile :: !Bool
+    , bfEnableExecDyn    :: !Bool
+    , bfVerbose          :: !Bool
+    , bfSkipCheck        :: !Bool
+    } deriving (Show)
+
 data BuildType = Nightly | LTS BumpType
     deriving (Show, Read, Eq, Ord)
 
@@ -39,28 +56,42 @@ data Settings = Settings
     , slug      :: Text
     , setArgs   :: Text -> UploadBundle -> UploadBundle
     , postBuild :: IO ()
+    , distroName :: Text -- ^ distro name on Hackage
     }
 
+nightlyPlanFile :: Text -- ^ day
+                -> FilePath
+nightlyPlanFile day = fpFromText ("nightly-" ++ day) <.> "yaml"
+
+nightlySettings :: Text -- ^ day
+                -> BuildPlan
+                -> Settings
+nightlySettings day plan' = Settings
+    { planFile = nightlyPlanFile day
+    , buildDir = fpFromText $ "builds/nightly"
+    , logDir = fpFromText $ "logs/stackage-nightly-" ++ day
+    , title = \ghcVer -> concat
+        [ "Stackage Nightly "
+        , day
+        , ", GHC "
+        , ghcVer
+        ]
+    , slug = slug'
+    , setArgs = \ghcVer ub -> ub { ubNightly = Just ghcVer }
+    , plan = plan'
+    , postBuild = return ()
+    , distroName = "Stackage"
+    }
+  where
+    slug' = "nightly-" ++ day
+
 getSettings :: Manager -> BuildType -> IO Settings
 getSettings man Nightly = do
     day <- tshow . utctDay <$> getCurrentTime
-    let slug' = "nightly-" ++ day
+    bc <- defaultBuildConstraints man
-    plan' <- defaultBuildConstraints man >>= newBuildPlan
+    pkgs <- getLatestAllowedPlans bc
-    return Settings
+    plan' <- newBuildPlan pkgs bc
-        { planFile = fpFromText ("nightly-" ++ day) <.> "yaml"
+    return $ nightlySettings day plan'
-        , buildDir = fpFromText $ "builds/stackage-nightly-" ++ day
-        , logDir = fpFromText $ "logs/stackage-nightly-" ++ day
-        , title = \ghcVer -> concat
-            [ "Stackage Nightly "
-            , day
-            , ", GHC "
-            , ghcVer
-            ]
-        , slug = slug'
-        , setArgs = \ghcVer ub -> ub { ubNightly = Just ghcVer }
-        , plan = plan'
-        , postBuild = return ()
-        }
 getSettings man (LTS bumpType) = do
     Option mlts <- fmap (fmap getMax) $ runResourceT
         $ sourceDirectory "."
@@ -72,21 +103,25 @@ getSettings man (LTS bumpType) = do
                     case mlts of
                         Nothing -> LTSVer 0 0
                         Just (LTSVer x _) -> LTSVer (x + 1) 0
-            plan' <- defaultBuildConstraints man >>= newBuildPlan
+            bc <- defaultBuildConstraints man
+            pkgs <- getLatestAllowedPlans bc
+            plan' <- newBuildPlan pkgs bc
             return (new, plan')
         Minor -> do
             old <- maybe (error "No LTS plans found in current directory") return mlts
             oldplan <- decodeFileEither (fpToString $ renderLTSVer old)
                    >>= either throwM return
             let new = incrLTSVer old
-            plan' <- updateBuildPlan oldplan
+            let bc = updateBuildConstraints oldplan
+            pkgs <- getLatestAllowedPlans bc
+            plan' <- newBuildPlan pkgs bc
             return (new, plan')
 
     let newfile = renderLTSVer new
 
     return Settings
         { planFile = newfile
-        , buildDir = fpFromText $ "builds/stackage-lts-" ++ tshow new
+        , buildDir = fpFromText $ "builds/lts"
         , logDir = fpFromText $ "logs/stackage-lts-" ++ tshow new
         , title = \ghcVer -> concat
             [ "LTS Haskell "
@@ -106,6 +141,7 @@ getSettings man (LTS bumpType) = do
             git ["commit", "-m", "Added new LTS release: " ++ show new]
             putStrLn "Pushing to Git repository"
             git ["push"]
+        , distroName = "LTSHaskell"
         }
 
 data LTSVer = LTSVer !Int !Int
@@ -130,16 +166,27 @@ renderLTSVer lts = fpFromText $ concat
     , ".yaml"
     ]
 
+-- | Just print a message saying "still alive" every minute, to appease Travis.
+stillAlive :: IO () -> IO ()
+stillAlive inner =
+    withAsync (printer 1) $ const inner
+  where
+    printer i = forever $ do
+        threadDelay 60000000
+        putStrLn $ "Still alive: " ++ tshow i
+        printer $! i + 1
+
 -- | Generate and check a new build plan, but do not execute it.
 --
 -- Since 0.3.1
 justCheck :: IO ()
-justCheck = withManager tlsManagerSettings $ \man -> do
+justCheck = stillAlive $ withManager tlsManagerSettings $ \man -> do
     putStrLn "Loading build constraints"
     bc <- defaultBuildConstraints man
 
     putStrLn "Creating build plan"
-    plan <- newBuildPlan bc
+    plans <- getLatestAllowedPlans bc
+    plan <- newBuildPlan plans bc
 
     putStrLn $ "Writing build plan to check-plan.yaml"
     encodeFile "check-plan.yaml" plan
@@ -149,37 +196,71 @@ justCheck = withManager tlsManagerSettings $ \man -> do
 
     putStrLn "Plan seems valid!"
 
-completeBuild :: BuildType -> IO ()
+getPerformBuild :: BuildFlags -> Settings -> PerformBuild
-completeBuild buildType = withManager tlsManagerSettings $ \man -> do
+getPerformBuild buildFlags Settings {..} = PerformBuild
+    { pbPlan = plan
+    , pbInstallDest = buildDir
+    , pbLogDir = logDir
+    , pbLog = hPut stdout
+    , pbJobs = 8
+    , pbGlobalInstall = False
+    , pbEnableTests = bfEnableTests buildFlags
+    , pbEnableHaddock = bfEnableHaddock buildFlags
+    , pbEnableLibProfiling = bfEnableLibProfile buildFlags
+    , pbEnableExecDyn = bfEnableExecDyn buildFlags
+    , pbVerbose = bfVerbose buildFlags
+    , pbAllowNewer = bfSkipCheck buildFlags
+    }
+
+-- | Make a complete plan, build, test and upload bundle, docs and
+-- distro.
+completeBuild :: BuildType -> BuildFlags -> IO ()
+completeBuild buildType buildFlags = withManager tlsManagerSettings $ \man -> do
     hSetBuffering stdout LineBuffering
 
     putStrLn $ "Loading settings for: " ++ tshow buildType
-    Settings {..} <- getSettings man buildType
+    settings@Settings {..} <- getSettings man buildType
 
     putStrLn $ "Writing build plan to: " ++ fpToText planFile
     encodeFile (fpToString planFile) plan
 
-    putStrLn "Checking build plan"
+    if bfSkipCheck buildFlags
-    checkBuildPlan plan
+        then putStrLn "Skipping build plan check"
+        else do
+            putStrLn "Checking build plan"
+            checkBuildPlan plan
 
     putStrLn "Performing build"
-    let pb = PerformBuild
+    performBuild (getPerformBuild buildFlags settings) >>= mapM_ putStrLn
-            { pbPlan = plan
-            , pbInstallDest = buildDir
-            , pbLogDir = logDir
-            , pbLog = hPut stdout
-            , pbJobs = 8
-            , pbGlobalInstall = False
-            }
-    performBuild pb >>= mapM_ putStrLn
 
+    when (bfDoUpload buildFlags) $
+        finallyUpload settings man
+
+justUploadNightly
+    :: Text -- ^ nightly date
+    -> IO ()
+justUploadNightly day = do
+    plan <- decodeFileEither (fpToString $ nightlyPlanFile day)
+        >>= either throwM return
+    withManager tlsManagerSettings $ finallyUpload $ nightlySettings day plan
+
+-- | The final part of the complete build process: uploading a bundle,
+-- docs and a distro to hackage.
+finallyUpload :: Settings -> Manager -> IO ()
+finallyUpload settings@Settings{..} man = do
     putStrLn "Uploading bundle to Stackage Server"
-    token <- readFile "/auth-token"
+
+    mtoken <- lookupEnv "STACKAGE_AUTH_TOKEN"
+    token <-
+        case mtoken of
+            Nothing -> decodeUtf8 <$> readFile "/auth-token"
+            Just token -> return $ pack token
+
     now <- epochTime
     let ghcVer = display $ siGhcVersion $ bpSystemInfo plan
     (ident, mloc) <- flip uploadBundle man $ setArgs ghcVer def
         { ubContents = serverBundle now (title ghcVer) slug plan
-        , ubAuthToken = decodeUtf8 token
+        , ubAuthToken = token
         }
     putStrLn $ "New ident: " ++ unSnapshotIdent ident
     forM_ mloc $ \loc ->
@@ -190,7 +271,7 @@ completeBuild buildType = withManager tlsManagerSettings $ \man -> do
     putStrLn "Uploading docs to Stackage Server"
     res1 <- uploadDocs UploadDocs
         { udServer = def
-        , udAuthToken = decodeUtf8 token
+        , udAuthToken = token
         , udDocs = pbDocDir pb
         , udSnapshot = ident
         } man
@@ -200,15 +281,17 @@ completeBuild buildType = withManager tlsManagerSettings $ \man -> do
     case map encodeUtf8 $ words $ decodeUtf8 $ either (const "") id ecreds of
         [username, password] -> do
             putStrLn "Uploading as Hackage distro"
-            res2 <- uploadHackageDistro plan username password man
+            res2 <- uploadHackageDistroNamed distroName plan username password man
             putStrLn $ "Distro upload response: " ++ tshow res2
         _ -> putStrLn "No creds found, skipping Hackage distro upload"
 
     putStrLn "Uploading doc map"
     uploadDocMap UploadDocMap
         { udmServer = def
-        , udmAuthToken = decodeUtf8 token
+        , udmAuthToken = token
         , udmSnapshot = ident
         , udmDocDir = pbDocDir pb
         , udmPlan = plan
         } man >>= print
+  where
+    pb = getPerformBuild (error "finallyUpload.buildFlags") settings

Stackage/GhcPkg.hs

@@ -0,0 +1,90 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+-- | General commands related to ghc-pkg.
+
+module Stackage.GhcPkg
+    ( setupPackageDatabase
+    ) where
+
+import           Data.Conduit
+import qualified Data.Conduit.List as CL
+import           Data.Conduit.Process
+import qualified Data.Conduit.Text as CT
+import           Data.Maybe
+import           Data.Text (Text)
+import qualified Data.Text as T
+import           Distribution.Compat.ReadP
+import           Distribution.Package
+import           Distribution.Text (parse)
+import           Filesystem.Path.CurrentOS (FilePath)
+import qualified Filesystem.Path.CurrentOS as FP
+import Data.Map (Map)
+import Data.Version (Version)
+import Stackage.Prelude
+import Filesystem (removeTree)
+
+setupPackageDatabase
+    :: Maybe FilePath -- ^ database location, Nothing if using global DB
+    -> FilePath -- ^ documentation root
+    -> (ByteString -> IO ()) -- ^ logging
+    -> Map PackageName Version -- ^ packages and versions to be installed
+    -> IO (Set PackageName) -- ^ packages remaining in the database after cleanup
+setupPackageDatabase mdb docDir log' toInstall = do
+    registered1 <- getRegisteredPackages flags
+    forM_ registered1 $ \pi@(PackageIdentifier name version) ->
+        case lookup name toInstall of
+            Just version' | version /= version' -> unregisterPackage log' docDir flags pi
+            _ -> return ()
+    broken <- getBrokenPackages flags
+    forM_ broken $ unregisterPackage log' docDir flags
+    foldMap (\(PackageIdentifier name _) -> singletonSet name)
+        <$> getRegisteredPackages flags
+  where
+    flags = ghcPkgFlags mdb
+
+ghcPkgFlags :: Maybe FilePath -> [String]
+ghcPkgFlags mdb =
+    "--no-user-package-db" :
+    case mdb of
+        Nothing -> ["--global"]
+        Just fp -> ["--package-db=" ++ fpToString fp]
+
+-- | Get broken packages.
+getBrokenPackages :: [String] -> IO [PackageIdentifier]
+getBrokenPackages flags = do
+    (_,ps) <- sourceProcessWithConsumer
+                  (proc
+                       "ghc-pkg"
+                       ("check" : "--simple-output" : flags))
+                  (CT.decodeUtf8 $= CT.lines $= CL.consume)
+    return (mapMaybe parsePackageIdent (T.words (T.unlines ps)))
+
+-- | Get available packages.
+getRegisteredPackages :: [String] -> IO [PackageIdentifier]
+getRegisteredPackages flags = do
+    (_,ps) <- sourceProcessWithConsumer
+                  (proc
+                       "ghc-pkg"
+                       ("list" : "--simple-output" : flags))
+                  (CT.decodeUtf8 $= CT.lines $= CL.consume)
+    return (mapMaybe parsePackageIdent (T.words (T.unlines ps)))
+
+-- | Parse a package identifier: foo-1.2.3
+parsePackageIdent :: Text -> Maybe PackageIdentifier
+parsePackageIdent = fmap fst .
+    listToMaybe .
+    filter (null . snd) .
+    readP_to_S parse . T.unpack
+
+-- | Unregister a package.
+unregisterPackage :: (ByteString -> IO ()) -- ^ log func
+                  -> FilePath -- ^ doc directory
+                  -> [String] -> PackageIdentifier -> IO ()
+unregisterPackage log' docDir flags ident@(PackageIdentifier name _) = do
+    log' $ "Unregistering " ++ encodeUtf8 (display ident) ++ "\n"
+    void (readProcessWithExitCode
+              "ghc-pkg"
+              ("unregister": flags ++ ["--force", unpack $ display name])
+              "")
+
+    void $ tryIO $ removeTree $ docDir </> fpFromText (display ident)

Stackage/InstallBuild.hs

@@ -0,0 +1,100 @@
+{-# LANGUAGE DeriveDataTypeable  #-}
+{-# LANGUAGE NoImplicitPrelude   #-}
+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE RecordWildCards     #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+module Stackage.InstallBuild
+    ( InstallFlags (..)
+    , BuildPlanSource (..)
+    , installBuild
+    ) where
+
+import qualified Codec.Archive.Tar         as Tar
+import qualified Codec.Compression.GZip    as GZip
+import qualified Data.Yaml                 as Yaml
+import           Network.HTTP.Client
+import           Network.HTTP.Client.TLS   (tlsManagerSettings)
+import           Stackage.BuildPlan
+import           Stackage.CheckBuildPlan
+import           Stackage.PerformBuild
+import           Stackage.Prelude
+import           System.IO                 (BufferMode (LineBuffering), hSetBuffering)
+
+-- | Flags passed in from the command line.
+data InstallFlags = InstallFlags
+    { ifPlanSource         :: !BuildPlanSource
+    , ifInstallDest        :: !FilePath
+    , ifLogDir             :: !(Maybe FilePath)
+    , ifJobs               :: !Int
+    , ifGlobalInstall      :: !Bool
+    , ifEnableTests        :: !Bool
+    , ifEnableHaddock      :: !Bool
+    , ifEnableLibProfiling :: !Bool
+    , ifEnableExecDyn      :: !Bool
+    , ifVerbose            :: !Bool
+    , ifSkipCheck          :: !Bool
+    } deriving (Show)
+
+-- | Source for build plan.
+data BuildPlanSource = BPSBundleWeb String
+                     | BPSFile FilePath
+    deriving (Show)
+
+getPerformBuild :: BuildPlan -> InstallFlags -> PerformBuild
+getPerformBuild plan InstallFlags{..} =
+    PerformBuild
+    { pbPlan               = plan
+    , pbInstallDest        = ifInstallDest
+    , pbLogDir             = fromMaybe (ifInstallDest </> "logs") ifLogDir
+    , pbLog                = hPut stdout
+    , pbJobs               = ifJobs
+    , pbGlobalInstall      = ifGlobalInstall
+    , pbEnableTests        = ifEnableTests
+    , pbEnableHaddock      = ifEnableHaddock
+    , pbEnableLibProfiling = ifEnableLibProfiling
+    , pbEnableExecDyn      = ifEnableExecDyn
+    , pbVerbose            = ifVerbose
+    , pbAllowNewer         = ifSkipCheck
+    }
+
+-- | Install stackage from an existing build plan.
+installBuild :: InstallFlags -> IO ()
+installBuild installFlags@InstallFlags{..} = do
+    hSetBuffering stdout LineBuffering
+
+    putStrLn $ "Loading build plan"
+    plan <- case ifPlanSource of
+        BPSBundleWeb url -> withManager tlsManagerSettings $ \man -> do
+            req <- parseUrl url
+            res <- httpLbs req man
+            planBSL <- getPlanEntry $ Tar.read $ GZip.decompress (responseBody res)
+            decodeBuildPlan planBSL
+        BPSFile path -> Yaml.decodeFileEither (fpToString path) >>= either throwM return
+
+    if ifSkipCheck
+        then putStrLn "Skipping build plan check"
+        else do
+            putStrLn "Checking build plan"
+            checkBuildPlan plan
+
+    putStrLn "Performing build"
+    performBuild (getPerformBuild plan installFlags) >>= mapM_ putStrLn
+
+  where
+    getPlanEntry Tar.Done = throwIO NoBuildPlanException
+    getPlanEntry (Tar.Fail e) = throwIO e
+    getPlanEntry (Tar.Next entry entries)
+        | Tar.entryPath entry == "build-plan.yaml" =
+            case Tar.entryContent entry of
+                Tar.NormalFile bs _ -> return bs
+                _ -> throwIO NoBuildPlanException
+        | otherwise = getPlanEntry entries
+
+    decodeBuildPlan =
+        either throwIO return . Yaml.decodeEither' . toStrict
+
+data InstallBuildException = NoBuildPlanException
+    deriving (Typeable)
+instance Exception InstallBuildException
+instance Show InstallBuildException where
+    show NoBuildPlanException = "Bundle has missing or invalid build-plan.yaml"

Stackage/PerformBuild.hs

@@ -19,11 +19,12 @@ import qualified Data.Map                    as Map
 import           Data.NonNull                (fromNullable)
 import           Filesystem                  (canonicalizePath, createTree,
                                               getWorkingDirectory, isDirectory,
-                                              removeTree, rename)
+                                              removeTree, rename, isFile, removeFile)
 import           Filesystem.Path             (parent)
 import qualified Filesystem.Path             as F
 import           Stackage.BuildConstraints
 import           Stackage.BuildPlan
+import           Stackage.GhcPkg
 import           Stackage.PackageDescription
 import           Stackage.Prelude            hiding (pi)
 import           System.Directory            (findExecutable)
@@ -61,6 +62,13 @@ data PerformBuild = PerformBuild
     , pbJobs          :: Int
     , pbGlobalInstall :: Bool
     -- ^ Register packages in the global database
+    , pbEnableTests        :: Bool
+    , pbEnableHaddock      :: Bool
+    , pbEnableLibProfiling :: Bool
+    , pbEnableExecDyn      :: Bool
+    , pbVerbose            :: Bool
+    , pbAllowNewer         :: Bool
+    -- ^ Pass --allow-newer to cabal configure
     }
 
 data PackageInfo = PackageInfo
@@ -83,7 +91,9 @@ waitForDeps toolMap packageMap activeComps bp pi action = do
             case lookup exe toolMap >>= fromNullable . map checkPackage . setToList of
                 Nothing
                     | isCoreExe exe -> return ()
-                    | otherwise -> throwSTM $ ToolMissing exe
+                    -- https://github.com/jgm/zip-archive/issues/23
+                    -- | otherwise -> throwSTM $ ToolMissing exe
+                    | otherwise -> return ()
                 Just packages -> ofoldl1' (<|>) packages
     action
   where
@@ -126,6 +136,10 @@ pbLibDir pb = pbInstallDest pb </> "lib"
 pbDataDir pb = pbInstallDest pb </> "share"
 pbDocDir pb = pbInstallDest pb </> "doc"
 
+-- | Directory keeping previous result info
+pbPrevResDir :: PerformBuild -> FilePath
+pbPrevResDir pb = pbInstallDest pb </> "prevres"
+
 performBuild :: PerformBuild -> IO [Text]
 performBuild pb = do
     cwd <- getWorkingDirectory
@@ -153,12 +167,13 @@ performBuild' pb@PerformBuild {..} = withBuildDir $ \builddir -> do
         $ \ClosedStream Inherited Inherited -> return ()
 
     let removeTree' fp = whenM (isDirectory fp) (removeTree fp)
-    mapM_ removeTree' [pbInstallDest, pbLogDir]
+    removeTree' pbLogDir
 
-    forM_ (pbDatabase pb) $ \db -> do
+    forM_ (pbDatabase pb) $ \db ->
-        createTree $ parent db
+        unlessM (isFile $ db </> "package.cache") $ do
-        withCheckedProcess (proc "ghc-pkg" ["init", fpToString db])
+            createTree $ parent db
-            $ \ClosedStream Inherited Inherited -> return ()
+            withCheckedProcess (proc "ghc-pkg" ["init", fpToString db])
+                $ \ClosedStream Inherited Inherited -> return ()
     pbLog $ encodeUtf8 "Copying built-in Haddocks\n"
     copyBuiltInHaddocks (pbDocDir pb)
 
@@ -178,7 +193,14 @@ performBuild' pb@PerformBuild {..} = withBuildDir $ \builddir -> do
     env <- getEnvironment
     haddockFiles <- newTVarIO mempty
 
-    forM_ packageMap $ \pi -> void $ async $ singleBuild pb SingleBuild
+    registeredPackages <- setupPackageDatabase
+        (pbDatabase pb)
+        (pbDocDir pb)
+        pbLog
+        (ppVersion <$> bpPackages pbPlan)
+
+    forM_ packageMap $ \pi -> void $ async $ singleBuild pb registeredPackages
+      SingleBuild
         { sbSem = sem
         , sbErrsVar = errsVar
         , sbWarningsVar = warningsVar
@@ -192,7 +214,7 @@ performBuild' pb@PerformBuild {..} = withBuildDir $ \builddir -> do
             id
             (\db -> (("HASKELL_PACKAGE_SANDBOX", fpToString db):))
             (pbDatabase pb)
-            (map fixEnv env)
+            (filter allowedEnv $ map fixEnv env)
         , sbHaddockFiles = haddockFiles
         }
 
@@ -210,6 +232,8 @@ performBuild' pb@PerformBuild {..} = withBuildDir $ \builddir -> do
         | toUpper p == "PATH" = (p, fpToString (pbBinDir pb) ++ pathSep : x)
         | otherwise = (p, x)
 
+    allowedEnv (k, _) = k `notMember` bannedEnvs
+
     -- | Separate for the PATH environment variable
     pathSep :: Char
 #ifdef mingw32_HOST_OS
@@ -218,6 +242,12 @@ performBuild' pb@PerformBuild {..} = withBuildDir $ \builddir -> do
     pathSep = ':'
 #endif
 
+-- | Environment variables we don't allow to be passed on to child processes.
+bannedEnvs :: Set String
+bannedEnvs = setFromList
+    [ "STACKAGE_AUTH_TOKEN"
+    ]
+
 data SingleBuild = SingleBuild
     { sbSem           :: TSem
     , sbErrsVar       :: TVar (Map PackageName BuildFailure)
@@ -232,8 +262,10 @@ data SingleBuild = SingleBuild
     , sbHaddockFiles  :: TVar (Map Text FilePath) -- ^ package-version, .haddock file
     }
 
-singleBuild :: PerformBuild -> SingleBuild -> IO ()
+singleBuild :: PerformBuild
-singleBuild pb@PerformBuild {..} SingleBuild {..} =
+            -> Set PackageName -- ^ registered packages
+            -> SingleBuild -> IO ()
+singleBuild pb@PerformBuild {..} registeredPackages SingleBuild {..} =
       withCounter sbActive
     $ handle updateErrs
     $ (`finally` void (atomically $ tryPutTMVar (piResult sbPackageInfo) False))
@@ -245,11 +277,13 @@ singleBuild pb@PerformBuild {..} SingleBuild {..} =
         let wfd comps =
                 waitForDeps sbToolMap sbPackageMap comps pbPlan sbPackageInfo
                 . withTSem sbSem
-        wfd libComps buildLibrary
+        withUnpacked <- wfd libComps buildLibrary
 
-        wfd testComps runTests
+        wfd testComps (runTests withUnpacked)
 
-    name = display $ piName sbPackageInfo
+    pname = piName sbPackageInfo
+    pident = PackageIdentifier pname (ppVersion $ piPlan sbPackageInfo)
+    name = display pname
     namever = concat
         [ name
         , "-"
@@ -290,6 +324,7 @@ singleBuild pb@PerformBuild {..} SingleBuild {..} =
         withBinaryFile (fpToString fp) WriteMode inner'
 
     configArgs = ($ []) $ execWriter $ do
+        when pbAllowNewer $ tell' "--allow-newer"
         tell' "--package-db=clear"
         tell' "--package-db=global"
         forM_ (pbDatabase pb) $ \db -> tell' $ "--package-db=" ++ fpToText db
@@ -298,6 +333,9 @@ singleBuild pb@PerformBuild {..} SingleBuild {..} =
         tell' $ "--datadir=" ++ fpToText (pbDataDir pb)
         tell' $ "--docdir=" ++ fpToText (pbDocDir pb)
         tell' $ "--flags=" ++ flags
+        when (pbEnableLibProfiling && pcEnableLibProfile) $
+            tell' "--enable-library-profiling"
+        when pbEnableExecDyn $ tell' "--enable-executable-dynamic"
       where
         tell' x = tell (x:)
 
@@ -312,20 +350,39 @@ singleBuild pb@PerformBuild {..} SingleBuild {..} =
     PackageConstraints {..} = ppConstraints $ piPlan sbPackageInfo
 
     buildLibrary = wf libOut $ \outH -> do
-        let run = runChild outH
+        let run a b = do when pbVerbose $ log' (unwords (a : b))
-        log' $ "Unpacking " ++ namever
+                         runChild outH a b
-        runParent outH "cabal" ["unpack", namever]
 
-        log' $ "Configuring " ++ namever
+        isUnpacked <- newIORef False
-        run "cabal" $ "configure" : configArgs
+        let withUnpacked inner = do
+                unlessM (readIORef isUnpacked) $ do
+                    log' $ "Unpacking " ++ namever
+                    runParent outH "cabal" ["unpack", namever]
+                    writeIORef isUnpacked True
+                inner
 
-        log' $ "Building " ++ namever
+        isConfiged <- newIORef False
-        run "cabal" ["build"]
+        let withConfiged inner = withUnpacked $ do
+                unlessM (readIORef isConfiged) $ do
+                    log' $ "Configuring " ++ namever
+                    run "cabal" $ "configure" : configArgs
+                    writeIORef isConfiged True
+                inner
 
-        log' $ "Copying/registering " ++ namever
+        prevBuildResult <- getPreviousResult pb Build pident
-        run "cabal" ["copy"]
+        unless (prevBuildResult == PRSuccess) $ withConfiged $ do
-        withMVar sbRegisterMutex $ const $
+          assert (pname `notMember` registeredPackages) $ do
-            run "cabal" ["register"]
+            deletePreviousResults pb pident
+
+            log' $ "Building " ++ namever
+            run "cabal" ["build"]
+
+            log' $ "Copying/registering " ++ namever
+            run "cabal" ["copy"]
+            withMVar sbRegisterMutex $ const $
+                run "cabal" ["register"]
+
+            savePreviousResult pb Build pident True
 
         -- Even if the tests later fail, we can allow other libraries to build
         -- on top of our successful results
@@ -335,7 +392,11 @@ singleBuild pb@PerformBuild {..} SingleBuild {..} =
         -- dependency's haddocks before this finishes
         atomically $ putTMVar (piResult sbPackageInfo) True
 
-        when (pcHaddocks /= Don'tBuild && not (null $ sdModules $ ppDesc $ piPlan sbPackageInfo)) $ do
+        prevHaddockResult <- getPreviousResult pb Haddock pident
+        let needHaddock = pbEnableHaddock
+                       && checkPrevResult prevHaddockResult pcHaddocks
+                       && not (null $ sdModules $ ppDesc $ piPlan sbPackageInfo)
+        when needHaddock $ withConfiged $ do
             log' $ "Haddocks " ++ namever
             hfs <- readTVarIO sbHaddockFiles
             let hfsOpts = flip map (mapToList hfs) $ \(pkgVer, hf) -> concat
@@ -370,15 +431,21 @@ singleBuild pb@PerformBuild {..} SingleBuild {..} =
                                    $ modifyTVar sbHaddockFiles
                                    $ insertMap namever newPath
 
+            savePreviousResult pb Haddock pident $ either (const False) (const True) eres
             case (eres, pcHaddocks) of
                 (Left e, ExpectSuccess) -> throwM e
                 (Right (), ExpectFailure) -> warn $ namever ++ ": unexpected Haddock success"
                 _ -> return ()
 
-    runTests = wf testOut $ \outH -> do
+        return withUnpacked
+
+    runTests withUnpacked = wf testOut $ \outH -> do
         let run = runChild outH
 
-        when (pcTests /= Don'tBuild) $ do
+        prevTestResult <- getPreviousResult pb Test pident
+        let needTest = pbEnableTests
+                    && checkPrevResult prevTestResult pcTests
+        when needTest $ withUnpacked $ do
             log' $ "Test configure " ++ namever
             run "cabal" $ "configure" : "--enable-tests" : configArgs
 
@@ -389,6 +456,7 @@ singleBuild pb@PerformBuild {..} SingleBuild {..} =
                 log' $ "Test run " ++ namever
                 run "cabal" ["test", "--log=" ++ fpToText testRunOut]
 
+            savePreviousResult pb Test pident $ either (const False) (const True) eres
             case (eres, pcTests) of
                 (Left e, ExpectSuccess) -> throwM e
                 (Right (), ExpectFailure) -> warn $ namever ++ ": unexpected test success"
@@ -421,3 +489,52 @@ copyBuiltInHaddocks docdir = do
             src <- canonicalizePath
                 (parent (fpFromString ghc) </> "../share/doc/ghc/html/libraries")
             copyDir src docdir
+
+------------- Previous results
+
+-- | The previous actions that can be run
+data ResultType = Build | Haddock | Test
+    deriving (Show, Enum, Eq, Ord, Bounded, Read)
+
+-- | The result generated on a previous run
+data PrevResult = PRNoResult | PRSuccess | PRFailure
+    deriving (Show, Enum, Eq, Ord, Bounded, Read)
+
+-- | Check if we should rerun based on a PrevResult and the expected status
+checkPrevResult :: PrevResult -> TestState -> Bool
+checkPrevResult _          Don'tBuild    = False
+checkPrevResult PRNoResult _             = True
+checkPrevResult PRSuccess  _             = False
+checkPrevResult PRFailure  ExpectSuccess = True
+checkPrevResult PRFailure  _             = False
+
+withPRPath :: PerformBuild -> ResultType -> PackageIdentifier -> (FilePath -> IO a) -> IO a
+withPRPath pb rt ident inner = do
+    createTree $ parent fp
+    inner fp
+  where
+    fp = pbPrevResDir pb </> fpFromString (show rt) </> fpFromText (display ident)
+
+successBS, failureBS :: ByteString
+successBS = "success"
+failureBS = "failure"
+
+getPreviousResult :: PerformBuild -> ResultType -> PackageIdentifier -> IO PrevResult
+getPreviousResult w x y = withPRPath w x y $ \fp -> do
+    eres <- tryIO $ readFile fp
+    return $ case eres of
+        Right bs
+            | bs == successBS -> PRSuccess
+            | bs == failureBS -> PRFailure
+        _                     -> PRNoResult
+
+savePreviousResult :: PerformBuild -> ResultType -> PackageIdentifier -> Bool -> IO ()
+savePreviousResult pb rt ident res =
+    withPRPath pb rt ident $ \fp -> writeFile fp $
+        if res then successBS else failureBS
+
+deletePreviousResults :: PerformBuild -> PackageIdentifier -> IO ()
+deletePreviousResults pb name =
+    forM_ [minBound..maxBound] $ \rt ->
+    withPRPath pb rt name $ \fp ->
+    void $ tryIO $ removeFile fp

Stackage/UpdateBuildPlan.hs

@@ -15,8 +15,9 @@ import           Stackage.BuildConstraints
 import           Stackage.BuildPlan
 import           Stackage.Prelude
 
-updateBuildPlan :: BuildPlan -> IO BuildPlan
+updateBuildPlan :: Map PackageName PackagePlan -> BuildPlan -> IO BuildPlan
-updateBuildPlan = newBuildPlan . updateBuildConstraints
+updateBuildPlan packagesOrig
+ = newBuildPlan packagesOrig . updateBuildConstraints
 
 updateBuildConstraints :: BuildPlan -> BuildConstraints
 updateBuildConstraints BuildPlan {..} =
@@ -33,6 +34,7 @@ updateBuildConstraints BuildPlan {..} =
         , pcHaddocks = maybe ExpectSuccess pcHaddocks moldPC
         , pcBuildBenchmarks = maybe True pcBuildBenchmarks moldPC
         , pcFlagOverrides = maybe mempty pcFlagOverrides moldPC
+        , pcEnableLibProfile = maybe False pcEnableLibProfile moldPC
         }
       where
         moldBP = lookup name bpPackages

Stackage/Upload.hs

@@ -11,6 +11,7 @@ module Stackage.Upload
     , UploadDocs (..)
     , uploadDocs
     , uploadHackageDistro
+    , uploadHackageDistroNamed
     , UploadDocMap (..)
     , uploadDocMap
     , uploadBundleV2
@@ -145,8 +146,28 @@ uploadHackageDistro :: BuildPlan
                     -> ByteString -- ^ Hackage password
                     -> Manager
                     -> IO (Response LByteString)
-uploadHackageDistro bp username password =
+uploadHackageDistro = uploadHackageDistroNamed "Stackage"
-    httpLbs (applyBasicAuth username password req)
+
+uploadHackageDistroNamed
+    :: Text -- ^ distro name
+    -> BuildPlan
+    -> ByteString -- ^ Hackage username
+    -> ByteString -- ^ Hackage password
+    -> Manager
+    -> IO (Response LByteString)
+uploadHackageDistroNamed name bp username password manager = do
+    req1 <- parseUrl $ concat
+        [ "http://hackage.haskell.org/distro/"
+        , unpack name
+        , "/packages.csv"
+        ]
+    let req2 = req1
+                { requestHeaders = [("Content-Type", "text/csv")]
+                , requestBody = RequestBodyLBS csv
+                , checkStatus = \_ _ _ -> Nothing
+                , method = "PUT"
+                }
+    httpLbs (applyBasicAuth username password req2) manager
   where
     csv = encodeUtf8
         $ builderToLazy
@@ -164,13 +185,6 @@ uploadHackageDistro bp username password =
         (toBuilder $ display name) ++
         "\""
 
-    req = "http://hackage.haskell.org/distro/Stackage/packages.csv"
-        { requestHeaders = [("Content-Type", "text/csv")]
-        , requestBody = RequestBodyLBS csv
-        , checkStatus = \_ _ _ -> Nothing
-        , method = "PUT"
-        }
-
 data UploadDocMap = UploadDocMap
     { udmServer    :: StackageServer
     , udmAuthToken :: Text

app/stackage.hs

@@ -1,16 +1,163 @@
+{-# LANGUAGE TupleSections #-}
+
+module Main where
+
+import Control.Monad
+import Data.Monoid
+import Data.String (fromString)
+import Data.Version
+import Options.Applicative
+import Filesystem.Path.CurrentOS (decodeString)
+import Paths_stackage (version)
 import Stackage.CompleteBuild
-import System.Environment (getArgs)
+import Stackage.InstallBuild
 
 main :: IO ()
-main = do
+main =
-    args <- getArgs
+    join $
-    case args of
+    execParser $
-        [x] | Just y <- lookup x m -> y
+    info
-        _ -> error $ "Expected one argument, one of: " ++ unwords (map fst m)
+        (helpOption <*> versionOption <*> config)
+        (header "Stackage" <>
+         fullDesc)
   where
-    m =
+    helpOption =
-        [ ("nightly", completeBuild Nightly)
+        abortOption ShowHelpText $
-        , ("lts-major", completeBuild $ LTS Major)
+        long "help" <>
-        , ("lts-minor", completeBuild $ LTS Minor)
+        help "Show this help text"
-        , ("check", justCheck)
+    versionOption =
-        ]
+        infoOption
+            ("stackage version " ++ showVersion version)
+            (long "version" <>
+             help "Show stackage version")
+    config =
+        subparser $
+        mconcat
+            [ cmnd
+                  (uncurry completeBuild)
+                  (fmap (Nightly, ) buildFlags)
+                  "nightly"
+                  "Build, test and upload the Nightly snapshot"
+            , cmnd
+                  (uncurry completeBuild)
+                  (fmap (LTS Major, ) buildFlags)
+                  "lts-major"
+                  "Build, test and upload the LTS (major) snapshot"
+            , cmnd
+                  (uncurry completeBuild)
+                  (fmap (LTS Minor, ) buildFlags)
+                  "lts-minor"
+                  "Build, test and upload the LTS (minor) snapshot"
+            , cmnd
+                  justUploadNightly
+                  nightlyUploadFlags
+                  "upload-nightly"
+                  "Upload an already-built nightly snapshot"
+            , cmnd
+                  (const justCheck)
+                  (pure ())
+                  "check"
+                  "Just check that the build plan is ok"
+            , cmnd
+                  installBuild
+                  installFlags
+                  "install"
+                  "Install a snapshot from an existing build plan"]
+
+    cmnd exec parse name desc =
+        command name $
+        info
+            (fmap exec (parse <**> helpOption))
+            (progDesc desc)
+
+    buildFlags =
+        BuildFlags <$>
+        fmap
+            not
+            (switch
+                 (long "skip-tests" <>
+                  help "Skip build and running the test suites")) <*>
+        fmap
+            not
+            (switch
+                 (long "skip-haddock" <>
+                  help "Skip generating haddock documentation")) <*>
+        fmap
+            not
+            (switch
+                 (long "skip-upload" <>
+                  help "Skip uploading bundle, docs, etc.")) <*>
+        switch
+            (long "enable-library-profiling" <>
+             help "Enable profiling when building") <*>
+        switch
+            (long "enable-executable-dynamic" <>
+             help "Enable dynamic executables when building") <*>
+        switch
+            (long "verbose" <> short 'v' <>
+             help "Output verbose detail about the build steps") <*>
+        switch
+            (long "skip-check" <>
+             help "Skip the check phase, and pass --allow-newer to cabal configure")
+
+    nightlyUploadFlags = fromString <$> strArgument
+        (metavar "DATE" <>
+         help "Date, in YYYY-MM-DD format")
+
+    installFlags =
+        InstallFlags <$>
+        (fmap
+            BPSBundleWeb
+            (strOption
+                (long "bundle" <>
+                 metavar "URL" <>
+                 help "Stackage bundle containing build plan")) <|>
+         fmap
+            (BPSFile . decodeString)
+            (strOption
+                (long "build-plan" <>
+                 metavar "PATH" <>
+                 help "Build-plan YAML file"))) <*>
+        fmap
+            decodeString
+            (strArgument
+                (metavar "DESTINATION-PATH" <>
+                 help "Destination directory path")) <*>
+        (fmap
+            (Just . decodeString)
+            (strOption
+                (long "log-dir" <>
+                 metavar "PATH" <>
+                 help "Location of log files (default DESTINATION-PATH/logs)")) <|>
+         pure Nothing) <*>
+        option
+            auto
+            (long "jobs" <>
+             metavar "NUMBER" <>
+             showDefault <> value 8 <>
+             help "Number of threads") <*>
+        switch
+            (long "global" <>
+             help "Install in global package database") <*>
+        fmap
+            not
+            (switch
+                (long "skip-tests" <>
+                 help "Skip build and running the test suites")) <*>
+        fmap
+            not
+            (switch
+                 (long "skip-haddock" <>
+                  help "Skip generating haddock documentation")) <*>
+        switch
+            (long "enable-library-profiling" <>
+             help "Enable profiling when building") <*>
+        switch
+            (long "enable-executable-dynamic" <>
+             help "Enable dynamic executables when building") <*>
+        switch
+            (long "verbose" <> short 'v' <>
+             help "Output verbose detail about the build steps") <*>
+        switch
+            (long "skip-check" <>
+             help "Skip the check phase, and pass --allow-newer to cabal configure")

build-constraints.yaml

@@ -2,7 +2,7 @@
 packages:
     "Michael Snoyman michael@snoyman.com @snoyberg":
         - bzlib-conduit
-        - cabal-install < 1.19
+        - cabal-install < 1.19 # GHC 7.10 bumpd to 1.22
         - cabal-src
         - case-insensitive
         - classy-prelude-yesod
@@ -27,7 +27,10 @@ packages:
         - warp-tls
         - yackage
         - yesod
+        - yesod-auth
+        - yesod-auth-oauth
         - yesod-auth-deskcom
+        - authenticate-oauth
         - yesod-bin
         - yesod-eventsource
         - yesod-fay
@@ -42,6 +45,11 @@ packages:
         - repa-algorithms
         - repa-devil
         - JuicyPixels-repa
+        - cereal-conduit
+        - binary-conduit
+        - lzma-conduit
+        - mutable-containers
+        - hpc-coveralls
 
     "FP Complete michael@fpcomplete.com @snoyberg":
         - alex
@@ -64,7 +72,7 @@ packages:
         - fixed-list
         - foreign-store
         - formatting
-        - fpco-api
+        #- fpco-api
         - gtk2hs-buildtools
         - happy
         - histogram-fill
@@ -105,18 +113,18 @@ packages:
         - distributed-process-async
         - distributed-process-client-server
         - distributed-process-supervisor
-
+        - distributed-process-task
-        # https://github.com/fpco/stackage/issues/381
+        - distributed-process-execution
-        #- distributed-process-task
-        #- distributed-process-execution
 
         - kure
 
     "Omari Norman <omari@smileystation.com>":
         - barecheck
         - rainbow
-        - rainbow-tests
         - quickpull
+        - multiarg
+        - prednote
+        - cartel
 
     "Neil Mitchell":
         - hlint
@@ -144,6 +152,7 @@ packages:
     "Jasper Van der Jeugt":
         - blaze-html
         - blaze-markup
+        - hakyll
         - stylish-haskell
 
     "Antoine Latter":
@@ -175,7 +184,6 @@ packages:
         - crypto-random-api
         - hit
         - language-java
-        - language-java
         - libgit
         - pem
         - siphash
@@ -202,8 +210,11 @@ packages:
         - scrobble
         - shell-conduit
         - sourcemap
+        - hindent
+        - descriptive
+        - wrap
         # requires old haddock currently - haskell-docs
-        # TODO: Add hindent and structured-haskell-mode once they've been ported to HSE 1.16.
+        # TODO: Add structured-haskell-mode once they've been ported to HSE 1.16.
 
     # GHC 7.6
     # "Alberto G. Corona <agocorona@gmail.com>":
@@ -253,7 +264,7 @@ packages:
         - monad-products
         - monad-st
         - monad-st
-        - mtl < 2.2
+        - mtl < 2.2 # GHC 7.10 bump
         - nats
         - numeric-extras
         - parsers
@@ -304,8 +315,9 @@ packages:
 
     "Brent Yorgey <byorgey@gmail.com>":
         - active
-        - BlogLiterately
+        # Temporarily disabled due to restrictive lens upper bound
-        - BlogLiterately-diagrams
+        #- BlogLiterately
+        #- BlogLiterately-diagrams
         - diagrams
         - diagrams-builder
         - diagrams-contrib
@@ -325,6 +337,8 @@ packages:
         - JuicyPixels
         - FontyFruity
         - Rasterific
+        - svg-tree
+        - rasterific-svg
 
     "Patrick Brisbin":
         - gravatar
@@ -365,6 +379,7 @@ packages:
         - pipes
         - pipes-parse
         - pipes-concurrency
+        - pipes-safe
 
     "Chris Allen <cma@bitemyapp.com>":
         - bloodhound
@@ -378,6 +393,10 @@ packages:
         - fay-uri
         - snaplet-fay
 
+    "Sebastiaan Visser <haskell@fvisser.nl>":
+        - clay
+        - fclabels
+
     "Rodrigo Setti <rodrigosetti@gmail.com>":
         - messagepack
         - messagepack-rpc
@@ -399,9 +418,11 @@ packages:
         - hPDB
         - hPDB-examples
 
-        # https://github.com/fpco/stackage/pull/382#issuecomment-68182467
+        - wordpass
-        # - wordpass
+        - json-autotype
-        # - json-autotype
+
+    "Dominic Steinitz <dominic@steinitz.org>":
+        - yarr
 
     "Roman Cheplyaka <roma@ro-che.info>":
         - action-permutations
@@ -431,6 +452,7 @@ packages:
     "George Giorgidze <giorgidze@gmail.com>":
         - HCodecs
         - YampaSynth
+        - set-monad
 
     "Phil Hargett <phil@haphazardhouse.net>":
         - courier
@@ -444,6 +466,8 @@ packages:
         - circle-packing
         - arbtt
         - ghc-heap-view
+        - tttool
+        - gipeda
 
     "Aditya Bhargava <adit@adit.io":
         - HandsomeSoup
@@ -453,7 +477,8 @@ packages:
         - openpgp-asciiarmor
         - MusicBrainz
         - DAV
-        - hopenpgp-tools
+        # https://github.com/fpco/stackage/issues/463
+        #- hopenpgp-tools
 
     # https://github.com/fpco/stackage/issues/160
     "Ketil Malde":
@@ -483,9 +508,9 @@ packages:
         - code-builder
         - fay-builder
         - generic-aeson
+        - generic-xmlpickler
         - hxt-pickle-utils
         - imagesize-conduit
-        - imagesize-conduit
         - json-schema
         - multipart
         - regular-xmlpickler
@@ -498,8 +523,6 @@ packages:
         - rest-types
         - rest-wai
         - tostring
-        - tostring
-        - uri-encode
         - uri-encode
 
     "Simon Michael <simon@joyful.com>":
@@ -509,7 +532,10 @@ packages:
         - io-manager
 
     "Dimitri Sabadie <dimitri.sabadie@gmail.com":
+        # https://github.com/fpco/stackage/pull/461#issuecomment-76914158
+        # - al
         - monad-journal
+        - smoothie
 
     "Thomas Schilling <nominolo@googlemail.com>":
         - ghc-syb-utils
@@ -543,6 +569,7 @@ packages:
 
     "Emanuel Borsobom <manny@fpcomplete.com>":
         - BoundedChan
+        - broadcast-chan
         - bytestring-lexing
         - bytestring-trie
         - data-accessor
@@ -553,6 +580,7 @@ packages:
         - haddock-api
         - here
         - hlibgit2
+        - gitlib-libgit2
         - hostname-validate
         - interpolatedstring-perl6
         - iproute
@@ -561,6 +589,7 @@ packages:
         - multimap
         - parallel-io
         - text-binary
+        - wl-pprint-text
 
     "Michael Sloan <mgsloan@gmail.com":
         - th-orphans
@@ -574,7 +603,7 @@ packages:
         - hasql-backend
         - hasql-postgres
         - list-t
-        - mtl-prelude < 2
+        - mtl-prelude < 2 # GHC 7.10 bump
         - neat-interpolation
         - partial-handler
         - postgresql-binary
@@ -588,6 +617,11 @@ packages:
        - graph-core
        - reroute
        - Spock
+       - Spock-digestive
+       - Spock-worker
+       - users
+       - users-test
+       - users-postgresql-simple
 
     "Joey Eremondi <joey@eremondi.com>":
         - aeson-pretty
@@ -618,42 +652,137 @@ packages:
         - shake-language-c
 
     "Marcin Mrotek <marcin.jan.mrotek@gmail.com>":
+        - diagrams-hsqml
         - type-list
-        
+        - vinyl-utils
+
+    "Marcin Mrotek <marcin.jan.mrotek@gmail.com>":
+        - type-list
+
     "David Turner <dave.c.turner@gmail.com>":
         - alarmclock
         - bank-holidays-england
 
+    "Haskell Servant jkarni@gmail.com @jkarni":
+        - servant
+        - servant-client
+        - servant-docs
+        - servant-jquery
+        - servant-server
+
+    "Alexandr Ruchkin voidex@live.com @mvoidex":
+        - hdocs
+        - hsdev
+
+    "Aleksey Kliger aleksey@lambdageek.org @lambdageek":
+        - unbound-generics
+
+    "Alois Cochard alois.cochard@gmail.com @aloiscochard":
+        - codex
+        - machines-directory
+        - machines-io
+        - machines-process
+        # on behalf of Bryan O'Sullivan @bos
+        - wreq
+
+    "Andraz Bajt andraz@bajt.me @edofic":
+        - effect-handlers
+        - koofr-client
+        - snowflake
+
+    "Leza M. Lutonda lemol-c@hotmail.com @lemol":
+        - HaskellNet
+
+    "Jens Petersen juhpetersen@gmail.com @juhp":
+        - cabal-rpm
+
+    "Renzo Carbonara renzocarbonara@gmail.com @k0001":
+        - network-simple
+        - pipes-aeson
+        - pipes-attoparsec
+        - pipes-binary
+        - pipes-network
+
+    "Tomas Carnecky":
+        - rethinkdb-client-driver
+
+    "Alexandr Kurilin alex@kurilin.net @alex_kurilin":
+        - bcrypt
+
+    "Jeffrey Rosenbluth jeffrey.rosenbluth@gmail.com":
+        - palette
+        - diagrams-canvas
+        - diagrams-rasterific
+        - lucid-svg
+
+    "Gabríel Arthúr Pétursson gabriel@system.is":
+        - sdl2
+
+    "Leon Mergen leon@solatis.com @solatis":
+        - network-attoparsec
+        - network-anonymous-i2p
+
+    "Timothy Jones git@zmthy.io @zmthy":
+        - cabal-test-quickcheck
+        - http-media
+
+    "Greg V greg@unrelenting.technology @myfreeweb":
+        - gitson
+        - pcre-heavy
+
+    "Francesco Mazzoli f@mazzo.li @bitonic":
+        - language-c-quote
+
+    "Sönke Hahn soenkehahn@gmail.com @soenkehahn":
+        - string-conversions
+
+    "Oleg Grenrus oleg.grenrus@iki.fi @phadej":
+        - waitra
+
     "Stackage upper bounds":
 
         # Force a specific version that's compatible with transformers 0.3
-        - transformers-compat == 0.3.3.3
+        - transformers-compat == 0.4.0.3
 
-        # https://github.com/fpco/stackage/issues/291
+        # https://github.com/fpco/stackage/issues/390
-        - random < 1.0.1.3
+        # NOTE: When this issue is resolved, remove the expected test failure
+        # for language-ecmascript as well.
+        - language-ecmascript < 0.17
 
-        # https://github.com/fpco/stackage/issues/318
+        # https://github.com/fpco/stackage/issues/407
-        - HaXml < 1.25
+        - HStringTemplate < 0.8
 
-        # https://github.com/fpco/stackage/issues/319
+        # https://github.com/fpco/stackage/issues/410
-        - polyparse < 1.10
+        - elm-package < 0.4
 
-        # https://github.com/fpco/stackage/issues/370
+        # https://github.com/fpco/stackage/issues/415
-        - monad-control < 1
+        - hackage-db < 1.12
-        - hasql < 0.5
-        - list-t < 0.4
 
-# Global flags are applied to all packages
+        # https://github.com/fpco/stackage/issues/424
-global-flags:
+        - control-monad-free < 0.6
-    blaze_html_0_5: true
+
-    small_base: true
+        # https://github.com/fpco/stackage/issues/426
-    https: true
+        - utf8-string < 1
-    splitbase: true
+
-    old-locale: true
+        # https://github.com/fpco/stackage/issues/440
-    new-base: true
+        - th-orphans < 0.9
-    bytestring-in-base: false
+        - file-location < 0.4.7
-    test-hlint: false
+
-    network-uri: true
+        # https://github.com/fpco/stackage/issues/442
+        - blaze-builder < 0.4
+        - blaze-markup < 0.7
+        - blaze-html < 0.8
+
+        # https://github.com/fpco/stackage/issues/443
+        - exceptions < 0.7
+        - rest-client < 0.5
+        - rest-types < 1.13
+        - rest-core < 0.35
+        - rest-gen < 0.17
+        - rest-wai < 0.1.0.7
+
+        # https://github.com/fpco/stackage/issues/467
+        - lens < 4.8
 
 # Package flags are applied to individual packages, and override the values of
 # global-flags
@@ -672,6 +801,44 @@ package-flags:
         simplelocalnet: true
         p2p: true
 
+    # GHC 7.10: Remove this
+    # Note that the flag is lower-cased, because that's what Cabal does
+    # Perhaps the codebase should automatically lower case flag names?
+    storable-complex:
+        instanceinbase: false
+
+    logfloat:
+        splitbase: true
+
+    curl:
+        new-base: true
+
+    # GHC 7.10 remove
+    aeson:
+        old-locale: true
+    tttool:
+        old-locale: true
+
+    hxt:
+        network-uri: true
+    hxt-http:
+        network-uri: true
+    hxt-relaxng:
+        network-uri: true
+
+    pandoc:
+        https: true
+
+    text:
+        integer-simple: false
+
+    tar:
+        old-time: false
+
+    mtl-compat:
+        two-point-one: true
+        two-point-two: false
+
 # By skipping a test suite, we do not pull in the build dependencies
 skipped-tests:
     - ReadArgs # old version of hspec
@@ -718,17 +885,15 @@ skipped-tests:
     # https://github.com/fpco/stackage/pull/380#issuecomment-68060871
     - Rasterific
 
+    # https://github.com/Soostone/retry/issues/18
+    - retry
+
 # Tests which we should build and run, but which are expected to fail. We
 # should not fail a build based on a test failure for one of these packages.
 expected-test-failures:
     # Requires an old version of WAI and Warp for tests
     - HTTP
 
-    # text and setenv have recursive dependencies in their tests, which
-    # cabal can't (yet) handle
-    - text
-    - setenv
-
     # https://github.com/bos/statistics/issues/42
     - statistics
 
@@ -852,6 +1017,61 @@ expected-test-failures:
     - crypto-numbers
     - distributed-process-task
 
+    # https://github.com/vincenthz/hs-crypto-pubkey/issues/17
+    - crypto-pubkey
+
+    # https://github.com/jswebtools/language-ecmascript/issues/60
+    - language-ecmascript
+
+    # https://github.com/kazu-yamamoto/unix-time/issues/29
+    - unix-time
+
+    # Tests can fail when the build plan fails, which happens arbitrarily.
+    - stackage
+
+    # https://github.com/TomMD/DRBG/issues/7
+    - DRBG
+
+    # https://github.com/bos/wreq/issues/53
+    - wreq
+
+    # Requires local database running
+    - rethinkdb-client-driver
+
+    # https://github.com/haskell-distributed/distributed-process-execution/issues/2
+    - distributed-process-execution
+
+    # Seems to depend on mtl being installed in user package database, which
+    # isn't always the case (e.g., build server)
+    - happy
+
+    # https://github.com/jberryman/directory-tree/issues/4
+    - directory-tree
+
+    # https://github.com/zmthy/http-media/issues/11
+    - http-media
+
+    # https://github.com/ekmett/semigroupoids/issues/18
+    - semigroupoids
+
+    # https://github.com/ndmitchell/hoogle/issues/101
+    - hoogle
+
+    # https://github.com/myfreeweb/gitson/issues/1
+    - gitson
+
+    # https://github.com/jcristovao/enclosed-exceptions/issues/6
+    - enclosed-exceptions
+
+    # Expects a running PostgreSQL server
+    - users-postgresql-simple
+
+    # Problems with linking with system libraries on Ubuntu 12.04
+    - nettle
+
+    # Requires locally running services
+    - network-anonymous-i2p
+
 # Haddocks which are expected to fail. Same concept as expected test failures.
 expected-haddock-failures:
     # https://github.com/acw/bytestring-progress/issues/4
@@ -860,6 +1080,12 @@ expected-haddock-failures:
     # https://github.com/ekmett/gl/issues/4
     - gl
 
+    # https://github.com/leventov/yarr/issues/5
+    - yarr
+
+    # https://github.com/wereHamster/rethinkdb-client-driver/issues/1
+    - rethinkdb-client-driver
+
 # Benchmarks which should not be built. Note that Stackage does *not* generally
 # build benchmarks. The difference here will be whether dependencies for these
 # benchmarks are included or not.
@@ -886,6 +1112,10 @@ skipped-benchmarks:
     # sometimes falls out-of-sync on hasql-postgres
     - hasql
 
+skipped-profiling:
+    # https://github.com/nomeata/ghc-heap-view/commit/8d198eb8fbbad2ce0c4527c781659f35b8909c04#diff-8288955e209cfbead5b318a8598be9c0R10
+    - ghc-heap-view
+
 # Mapping from Github account holding a package to the Github users who should
 # be pinged on failure. If no value is specified here, then the owning account
 # will be pinged.
@@ -908,3 +1138,5 @@ github-users:
         - mightybyte
     haskell-ro:
         - mihaimaruseac
+    elm-lang:
+        - JoeyEremondi

cabal.config

@@ -647,7 +647,7 @@ constraints: abstract-deque ==0.3,
              semigroups ==0.16.0.1,
              sendfile ==0.7.9,
              seqloc ==0.6,
-             setenv ==0.1.1.1,
+             setenv ==0.1.1.2,
              SHA ==1.6.4.1,
              shake ==0.14.2,
              shake-language-c ==0.6.3,

debian-bootstrap.sh

@@ -10,13 +10,17 @@
 # instructions, see:
 #    http://www.stackage.org/install
 
-sudo add-apt-repository -y ppa:chris-lea/zeromq
+add-apt-repository -y ppa:chris-lea/zeromq
-sudo add-apt-repository -y ppa:floe/libtisch
+add-apt-repository -y ppa:floe/libtisch
-sudo apt-get update
+add-apt-repository -y ppa:zoogie/sdl2-snapshots
-sudo apt-get install -y \
+apt-get update
+apt-get install -y \
     build-essential \
     libncurses-dev \
     git \
+    wget \
+    m4 \
+    texlive-full \
     libgmp3c2 \
     libgmp3-dev \
     zlib1g-dev \
@@ -33,11 +37,11 @@ sudo apt-get install -y \
     llvm \
     libbz2-dev \
     libjudy-dev \
+    libsqlite3-dev \
     libmysqlclient-dev \
     libpq-dev \
     libicu-dev \
     libssl-dev \
-    nettle-dev \
     libgsl0-dev \
     libblas-dev \
     liblapack-dev \
@@ -46,4 +50,22 @@ sudo apt-get install -y \
     libnotify-dev \
     libgd2-xpm-dev \
     libyaml-dev \
+    liblzma-dev \
+    libsdl2-dev \
+    libxss-dev \
     libzmq3-dev
+
+mkdir /tmp/nettle-build
+(
+cd /tmp/nettle-build
+wget https://ftp.gnu.org/gnu/nettle/nettle-2.7.1.tar.gz
+tar zxf nettle-2.7.1.tar.gz
+cd nettle-2.7.1
+./configure --prefix=/usr
+make
+make install
+
+mkdir -p /usr/lib/x86_64-linux-gnu/
+ln -sfv /usr/lib/libnettle.so.4.7 /usr/lib/x86_64-linux-gnu/libnettle.so.4
+)
+rm -rf /tmp/nettle-build

stackage.cabal

@@ -1,5 +1,5 @@
 name:                stackage
-version:             0.4.0
+version:             0.5.2
 synopsis:            "Stable Hackage," tools for creating a vetted set of packages from Hackage.
 description:         Please see <http://www.stackage.org/package/stackage> for a description and documentation.
 homepage:            https://github.com/fpco/stackage
@@ -12,6 +12,7 @@ build-type:          Simple
 cabal-version:       >=1.10
 extra-source-files:  README.md
                      ChangeLog.md
+                     test/test-build-constraints.yaml
 
 library
   default-language:    Haskell2010
@@ -22,7 +23,9 @@ library
                        Stackage.BuildPlan
                        Stackage.CheckBuildPlan
                        Stackage.UpdateBuildPlan
+                       Stackage.GhcPkg
                        Stackage.GithubPings
+                       Stackage.InstallBuild
                        Stackage.PackageDescription
                        Stackage.ServerBundle
                        Stackage.Upload
@@ -62,6 +65,7 @@ library
                      , streaming-commons >= 0.1.7.1
                      , semigroups
                      , xml-conduit
+                     , conduit
 
 executable stackage
   default-language:    Haskell2010
@@ -69,6 +73,8 @@ executable stackage
   main-is:             stackage.hs
   build-depends:       base
                      , stackage
+                     , optparse-applicative >= 0.11
+                     , system-filepath
   ghc-options:         -rtsopts -threaded -with-rtsopts=-N
 
 test-suite spec

test/Stackage/BuildPlanSpec.hs

@@ -1,21 +1,66 @@
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE OverloadedStrings, NoImplicitPrelude #-}
 module Stackage.BuildPlanSpec (spec) where
 
-import Stackage.BuildPlan
-import Stackage.Prelude
-import Stackage.BuildConstraints
-import Stackage.UpdateBuildPlan
-import Test.Hspec
-import qualified Data.Yaml as Y
-import Distribution.Version (anyVersion)
 import qualified Data.Map as Map
-import Network.HTTP.Client (withManager)
+import qualified Data.Map.Strict as M
-import Network.HTTP.Client.TLS (tlsManagerSettings)
+import qualified Data.Set as S
+import           Data.Yaml
+import qualified Data.Yaml as Y
+import           Distribution.Version
+import           Network.HTTP.Client
+import           Network.HTTP.Client.TLS (tlsManagerSettings)
+import           Stackage.BuildConstraints
+import           Stackage.BuildPlan
+import           Stackage.CheckBuildPlan
+import           Stackage.PackageDescription
+import           Stackage.Prelude
+import           Stackage.UpdateBuildPlan
+import           Test.Hspec
 
 spec :: Spec
-spec = it "works" $ withManager tlsManagerSettings $ \man -> do
+spec = do
-    bc <- defaultBuildConstraints man
+    it "simple package set" $ check testBuildConstraints $ makePackageSet
-    bp <- newBuildPlan bc
+        [("foo", [0, 0, 0], [("bar", thisV [0, 0, 0])])
+        ,("bar", [0, 0, 0], [])]
+    it "bad version range on depdendency fails" $ badBuildPlan $ makePackageSet
+        [("foo", [0, 0, 0], [("bar", thisV [1, 1, 0])])
+        ,("bar", [0, 0, 0], [])]
+    it "nonexistent package fails to check" $ badBuildPlan $ makePackageSet
+        [("foo", [0, 0, 0], [("nonexistent", thisV [0, 0, 0])])
+        ,("bar", [0, 0, 0], [])]
+    it "mutual cycles fail to check" $ badBuildPlan $ makePackageSet
+        [("foo", [0, 0, 0], [("bar", thisV [0, 0, 0])])
+        ,("bar", [0, 0, 0], [("foo", thisV [0, 0, 0])])]
+    it "nested cycles fail to check" $ badBuildPlan $ makePackageSet
+        [("foo", [0, 0, 0], [("bar", thisV [0, 0, 0])])
+        ,("bar", [0, 0, 0], [("mu", thisV [0, 0, 0])])
+        ,("mu", [0, 0, 0], [("foo", thisV [0, 0, 0])])]
+    {- Shouldn't be testing this actually
+    it "default package set checks ok" $
+      check defaultBuildConstraints getLatestAllowedPlans
+    -}
+
+-- | Checking should be considered a bad build plan.
+badBuildPlan :: (BuildConstraints -> IO (Map PackageName PackagePlan))
+             -> void
+             -> IO ()
+badBuildPlan m _ = do
+    mu <- try (check testBuildConstraints m)
+    case mu of
+        Left (_ :: BadBuildPlan) ->
+            return ()
+        Right () ->
+            error "Expected bad build plan."
+
+-- | Check build plan with the given package set getter.
+check :: (Manager -> IO BuildConstraints)
+      -> (BuildConstraints -> IO (Map PackageName PackagePlan))
+      -> IO ()
+check readPlanFile getPlans = withManager tlsManagerSettings $ \man -> do
+    bc <- readPlanFile man
+    plans <- getPlans bc
+    bp <- newBuildPlan plans bc
     let bs = Y.encode bp
         ebp' = Y.decodeEither bs
 
@@ -25,14 +70,74 @@ spec = it "works" $ withManager tlsManagerSettings $ \man -> do
     forM_ allPackages $ \name ->
         (name, lookup name (bpPackages bp')) `shouldBe`
         (name, lookup name (bpPackages bp))
-
     bpGithubUsers bp' `shouldBe` bpGithubUsers bp
+
     when (bp' /= bp) $ error "bp' /= bp"
-    bp2 <- updateBuildPlan bp
+    bp2 <- updateBuildPlan plans bp
     when (dropVersionRanges bp2 /= dropVersionRanges bp) $ error "bp2 /= bp"
+    checkBuildPlan bp
   where
     dropVersionRanges bp =
         bp { bpPackages = map go $ bpPackages bp }
       where
         go pb = pb { ppConstraints = go' $ ppConstraints pb }
         go' pc = pc { pcVersionRange = anyVersion }
+
+-- | Make a package set from a convenient data structure.
+makePackageSet
+    :: [(String,[Int],[(String,VersionRange)])]
+    -> BuildConstraints
+    -> IO (Map PackageName PackagePlan)
+makePackageSet ps _ =
+    return $
+    M.fromList $
+    map
+        (\(name,ver,deps) ->
+              ( PackageName name
+              , dummyPackage ver $
+                M.fromList $
+                map
+                    (\(dname,dver) ->
+                          ( PackageName dname
+                          , DepInfo {diComponents = S.fromList
+                                             [CompLibrary]
+                                    ,diRange = dver}))
+                    deps))
+        ps
+    where
+        dummyPackage v deps =
+            PackagePlan
+                {ppVersion = Version v []
+                ,ppGithubPings = mempty
+                ,ppUsers = mempty
+                ,ppConstraints =
+                    PackageConstraints
+                        {pcVersionRange = anyV
+                        ,pcMaintainer = Nothing
+                        ,pcTests = Don'tBuild
+                        ,pcHaddocks = Don'tBuild
+                        ,pcBuildBenchmarks = False
+                        ,pcFlagOverrides = mempty
+                        ,pcEnableLibProfile = False}
+                ,ppDesc =
+                    SimpleDesc
+                        {sdPackages = deps
+                        ,sdTools = mempty
+                        ,sdProvidedExes = mempty
+                        ,sdModules = mempty}}
+
+-- | This exact version is required.
+thisV :: [Int] -> VersionRange
+thisV ver = thisVersion (Version ver [])
+
+-- | Accept any version.
+anyV :: VersionRange
+anyV = anyVersion
+
+-- | Test plan.
+testBuildConstraints :: void -> IO BuildConstraints
+testBuildConstraints _ =
+    decodeFileEither
+        (fpToString fp) >>=
+    either throwIO toBC
+    where fp = "test/test-build-constraints.yaml"

test/test-build-constraints.yaml

@@ -0,0 +1,20 @@
+packages:
+    "Test":
+       - foo
+       - bar
+
+global-flags: []
+
+skipped-tests: []
+expected-test-failures: []
+expected-haddock-failures: []
+skipped-benchmarks: []
+skipped-profiling: []
+
+github-users:
+  bar:
+    - demo
+
+package-flags:
+  foo:
+    demo: true