51f3aa1 · stackage · git.iko.soy

git.iko.soy/stackage

Merge branch 'incremental' into new-upload

Conflicts: ChangeLog.md stackage.cabal

commit51f3aa1d102c7438305290f9fdb87acab9bb86b9 authorMichael Snoyman <michael@snoyman.com> dateFri 13 Mar 2015, 14:45 (12 years ago) parentd42f6bb e404fd2

22 files changed+1324−202

compare with master

unifiedsplit

.dir-locals.elnew file+3

@@ -0,0 +1,3 @@

1+((haskell-mode . ((haskell-process-type . cabal-repl)

2+ (haskell-indent-spaces . 4)

3+ (hindent-style . "johan-tibell"))))

.dockerignorenew file+8

@@ -0,0 +1,8 @@

1+dist

2+builds

3+logs

4+.cabal-sandbox

5+cabal.sandbox.config

6+tarballs

7+*.yaml

8+.git

.travis.ymlnew file+24

@@ -0,0 +1,24 @@

1+env:

2+ - CABALVER=1.20 GHCVER=7.8.4

4+cache:

5+ directories:

6+ - $HOME/.ghc

7+ - $HOME/.cabal

9+# Note: the distinction between `before_install` and `install` is not important.

10+before_install:

11+ - travis_retry sudo add-apt-repository -y ppa:hvr/ghc

12+ - travis_retry sudo apt-get update

13+ - travis_retry sudo apt-get install cabal-install-$CABALVER ghc-$GHCVER # see note about happy/alex

14+ - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH

15+

16+install:

17+ - cabal --version

18+ - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]"

19+ - travis_retry cabal update

20+ - cabal install -j

21+

22+# 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.

23+script:

24+ - ./dist/build/stackage/stackage check

ChangeLog.md+22−1

@@ -1,7 +1,28 @@

1−## 0.4.0

1+## Unreleased

33* Upload bundle V2 stuff

5+## 0.5.2

7+* Upload LTS to Hackage with the name LTSHaskell

9+## 0.5.1

10+

11+* `loadBuildConstraints`

12+* More command line options

13+

14+## 0.5.0

15+

16+* Print "Still Alive" while checking, to avoid Travis timeouts

17+* Include `stackage upload-nightly` command

18+* Optional plan checking

19+

20+## 0.4.0

21+

22+* Command line uses optparse-applicative with additional options

23+* Library profiling support during build

24+* Remove cfGlobalFlags (just use package-specific flags)

25+

526## 0.3.1

627

728* Added `justCheck` and `stackage check` command line.

Dockerfilenew file+25

@@ -0,0 +1,25 @@

1+FROM ubuntu:12.04

3+ENV HOME /home/stackage

4+ENV LANG en_US.UTF-8

6+RUN mkdir /home/stackage -p

7+RUN locale-gen en_US.UTF-8

9+RUN DEBIAN_FRONTEND=noninteractive apt-get update

10+RUN DEBIAN_FRONTEND=noninteractive apt-get install -y software-properties-common python-software-properties

11+RUN DEBIAN_FRONTEND=noninteractive add-apt-repository ppa:hvr/ghc -y

12+

13+ADD debian-bootstrap.sh /tmp/debian-bootstrap.sh

14+RUN DEBIAN_FRONTEND=noninteractive bash /tmp/debian-bootstrap.sh

15+RUN rm /tmp/debian-bootstrap.sh

16+

17+RUN DEBIAN_FRONTEND=noninteractive apt-get install -y cabal-install-1.20 ghc-7.8.4 alex-3.1.3 happy-1.19.4

18+

19+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

20+

21+RUN cabal update

22+ADD . /tmp/stackage

23+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

24+

25+RUN cd /home/stackage && cabal update && stackage check

README.md+22

@@ -49,6 +49,28 @@ build by running:

4949 cabal install stackage

5050 stackage nightly

5151

52+### Docker

53+

54+Note: This method is currently considered experimental.

55+

56+If you'd like to check a build plan, or perform an entire build, without

57+specially configuring your system, Docker may be a good approach. To check if

58+some modifications to `build-constraints.yaml` are valid, try the following:

59+

60+1. Create a local clone of the `stackage` repo

61+2. Make modifications to your local `build-constraints.yaml`

62+3. Inside the `stackage` working directory, run the following:

63+

64+ ```

65+ $ docker run -it --rm -v $(pwd):/stackage -w /stackage snoyberg/stackage /bin/bash -c 'cabal update && stackage check'

66+ ```

67+

68+Similarly, if you'd like to perform an entire build, you can replace the last step with:

69+

70+```

71+$ docker run -it --rm -v $(pwd):/stackage -w /stackage snoyberg/stackage /bin/bash -c 'cabal update && stackage nightly --skip-upload'

72+```

73+

5274## Processing

5375

5476The following describes at a high level the series of steps for processing

Stackage/BuildConstraints.hs+43−20

@@ -10,6 +10,9 @@ module Stackage.BuildConstraints

1010 , SystemInfo (..)

1111 , getSystemInfo

1212 , defaultBuildConstraints

13+ , toBC

14+ , BuildConstraintsSource (..)

15+ , loadBuildConstraints

1316 ) where

1417

1518import Control.Monad.Writer.Strict (execWriter, tell)

@@ -21,7 +24,7 @@ import Distribution.System (Arch, OS)

2124import qualified Distribution.System

2225import Distribution.Version (anyVersion)

2326import Filesystem (isFile)

24−import Network.HTTP.Client (Manager, httpLbs, responseBody)

27+import Network.HTTP.Client (Manager, httpLbs, responseBody, Request)

2528import Stackage.CorePackages

2629import Stackage.Prelude

2730

@@ -88,12 +91,13 @@ data BuildConstraints = BuildConstraints

8891 }

8992

9093data PackageConstraints = PackageConstraints

91− { pcVersionRange :: VersionRange

92− , pcMaintainer :: Maybe Maintainer

93− , pcTests :: TestState

94− , pcHaddocks :: TestState

95− , pcBuildBenchmarks :: Bool

96− , pcFlagOverrides :: Map FlagName Bool

94+ { pcVersionRange :: VersionRange

95+ , pcMaintainer :: Maybe Maintainer

96+ , pcTests :: TestState

97+ , pcHaddocks :: TestState

98+ , pcBuildBenchmarks :: Bool

99+ , pcFlagOverrides :: Map FlagName Bool

100+ , pcEnableLibProfile :: Bool

97101 }

98102 deriving (Show, Eq)

99103instance ToJSON PackageConstraints where

@@ -103,6 +107,7 @@ instance ToJSON PackageConstraints where

103107 , "haddocks" .= pcHaddocks

104108 , "build-benchmarks" .= pcBuildBenchmarks

105109 , "flags" .= Map.mapKeysWith const unFlagName pcFlagOverrides

110+ , "library-profiling" .= pcEnableLibProfile

106111 ]

107112 where

108113 addMaintainer = maybe id (\m -> (("maintainer" .= m):)) pcMaintainer

@@ -115,6 +120,7 @@ instance FromJSON PackageConstraints where

115120 pcBuildBenchmarks <- o .: "build-benchmarks"

116121 pcFlagOverrides <- Map.mapKeysWith const mkFlagName <$> o .: "flags"

117122 pcMaintainer <- o .:? "maintainer"

123+ pcEnableLibProfile <- fmap (fromMaybe True) (o .:? "library-profiling")

118124 return PackageConstraints {..}

119125

120126-- | The proposed plan from the requirements provided by contributors.

@@ -122,15 +128,32 @@ instance FromJSON PackageConstraints where

122128-- Checks the current directory for a build-constraints.yaml file and uses it

123129-- if present. If not, downloads from Github.

124130defaultBuildConstraints :: Manager -> IO BuildConstraints

125−defaultBuildConstraints man = do

126− e <- isFile fp

127− if e

128− then decodeFileEither (fpToString fp) >>= either throwIO toBC

129− else httpLbs req man >>=

130− either throwIO toBC . decodeEither' . toStrict . responseBody

131+defaultBuildConstraints = loadBuildConstraints BCSDefault

132+

133+data BuildConstraintsSource

134+ = BCSDefault

135+ | BCSFile FilePath

136+ | BCSWeb Request

137+ deriving (Show)

138+

139+loadBuildConstraints :: BuildConstraintsSource -> Manager -> IO BuildConstraints

140+loadBuildConstraints bcs man = do

141+ case bcs of

142+ BCSDefault -> do

143+ e <- isFile fp0

144+ if e

145+ then loadFile fp0

146+ else loadReq req0

147+ BCSFile fp -> loadFile fp

148+ BCSWeb req -> loadReq req

131149 where

132− fp = "build-constraints.yaml"

133− req = "https://raw.githubusercontent.com/fpco/stackage/master/build-constraints.yaml"

150+ fp0 = "build-constraints.yaml"

151+ req0 = "https://raw.githubusercontent.com/fpco/stackage/master/build-constraints.yaml"

152+

153+ loadFile fp = decodeFileEither (fpToString fp) >>= either throwIO toBC

154+ loadReq req = httpLbs req man >>=

155+ either throwIO toBC . decodeEither' . toStrict . responseBody

156+

134157

135158getSystemInfo :: IO SystemInfo

136159getSystemInfo = do

@@ -144,24 +167,24 @@ getSystemInfo = do

144167 siArch = Distribution.System.X86_64

145168

146169data ConstraintFile = ConstraintFile

147− { cfGlobalFlags :: Map FlagName Bool

148− , cfPackageFlags :: Map PackageName (Map FlagName Bool)

170+ { cfPackageFlags :: Map PackageName (Map FlagName Bool)

149171 , cfSkippedTests :: Set PackageName

150172 , cfExpectedTestFailures :: Set PackageName

151173 , cfExpectedHaddockFailures :: Set PackageName

152174 , cfSkippedBenchmarks :: Set PackageName

153175 , cfPackages :: Map Maintainer (Vector Dependency)

154176 , cfGithubUsers :: Map Text (Set Text)

177+ , cfSkippedLibProfiling :: Set PackageName

155178 }

156179

157180instance FromJSON ConstraintFile where

158181 parseJSON = withObject "ConstraintFile" $ \o -> do

159− cfGlobalFlags <- goFlagMap <$> o .: "global-flags"

160182 cfPackageFlags <- (goPackageMap . fmap goFlagMap) <$> o .: "package-flags"

161183 cfSkippedTests <- getPackages o "skipped-tests"

162184 cfExpectedTestFailures <- getPackages o "expected-test-failures"

163185 cfExpectedHaddockFailures <- getPackages o "expected-haddock-failures"

164186 cfSkippedBenchmarks <- getPackages o "skipped-benchmarks"

187+ cfSkippedLibProfiling <- getPackages o "skipped-profiling"

165188 cfPackages <- o .: "packages"

166189 >>= mapM (mapM toDep)

167190 . Map.mapKeysWith const Maintainer

@@ -196,6 +219,7 @@ toBC ConstraintFile {..} = do

196219 mpair = lookup name revmap

197220 pcMaintainer = fmap fst mpair

198221 pcVersionRange = maybe anyVersion snd mpair

222+ pcEnableLibProfile = not (name `member` cfSkippedLibProfiling)

199223 pcTests

200224 | name `member` cfSkippedTests = Don'tBuild

201225 | name `member` cfExpectedTestFailures = ExpectFailure

@@ -205,7 +229,6 @@ toBC ConstraintFile {..} = do

205229 | name `member` cfExpectedHaddockFailures = ExpectFailure

206230

207231 | otherwise = ExpectSuccess

208− pcFlagOverrides = fromMaybe mempty (lookup name cfPackageFlags) ++

209− cfGlobalFlags

232+ pcFlagOverrides = fromMaybe mempty $ lookup name cfPackageFlags

210233

211234 bcGithubUsers = cfGithubUsers

Stackage/BuildPlan.hs+10−3

@@ -14,6 +14,7 @@ module Stackage.BuildPlan

1414 , PackagePlan (..)

1515 , newBuildPlan

1616 , makeToolMap

17+ , getLatestAllowedPlans

1718 ) where

1819

1920import Control.Monad.State.Strict (execState, get, put)

@@ -90,9 +91,9 @@ instance FromJSON PackagePlan where

9091 ppDesc <- o .: "description"

9192 return PackagePlan {..}

9293

93−newBuildPlan :: MonadIO m => BuildConstraints -> m BuildPlan

94−newBuildPlan bc@BuildConstraints {..} = liftIO $ do

95− packagesOrig <- getLatestDescriptions (isAllowed bc) (mkPackagePlan bc)

94+-- | Make a build plan given these package set and build constraints.

95+newBuildPlan :: MonadIO m => Map PackageName PackagePlan -> BuildConstraints -> m BuildPlan

96+newBuildPlan packagesOrig bc@BuildConstraints {..} = liftIO $ do

9697 let toolMap = makeToolMap packagesOrig

9798 packages = populateUsers $ removeUnincluded bc toolMap packagesOrig

9899 toolNames :: [ExeName]

@@ -205,3 +206,9 @@ mkPackagePlan bc gpd = do

205206 getFlag MkFlag {..} =

206207 (flagName, fromMaybe flagDefault $ lookup flagName overrides)

207208 flags = mapFromList $ map getFlag $ genPackageFlags gpd

209+

210+getLatestAllowedPlans :: MonadIO m => BuildConstraints -> m (Map PackageName PackagePlan)

211+getLatestAllowedPlans bc =

212+ getLatestDescriptions

213+ (isAllowed bc)

214+ (mkPackagePlan bc)

Stackage/CheckBuildPlan.hs+60−9

@@ -1,3 +1,4 @@

1+{-# LANGUAGE TupleSections #-}

12{-# LANGUAGE DeriveDataTypeable #-}

23{-# LANGUAGE GeneralizedNewtypeDeriving #-}

34{-# LANGUAGE NoImplicitPrelude #-}

@@ -7,28 +8,38 @@

78-- | Confirm that a build plan has a consistent set of dependencies.

89module Stackage.CheckBuildPlan

910 ( checkBuildPlan

11+ , BadBuildPlan

1012 ) where

1113

1214import Control.Monad.Writer.Strict (Writer, execWriter, tell)

13−import qualified Data.Text as T

15+import qualified Data.Map.Strict as M

16+import qualified Data.Text as T

1417import Stackage.BuildConstraints

1518import Stackage.BuildPlan

1619import Stackage.PackageDescription

1720import Stackage.Prelude

1821

19−-- FIXME check cycles in dependencies, only looking at libraries and

20−-- executables

21−

22−checkBuildPlan :: MonadThrow m => BuildPlan -> m ()

22+-- | Check the build plan for missing deps, wrong versions, etc.

23+checkBuildPlan :: (MonadThrow m) => BuildPlan -> m ()

2324checkBuildPlan BuildPlan {..}

2425 | null errs' = return ()

2526 | otherwise = throwM errs

2627 where

27− allPackages = siCorePackages bpSystemInfo ++ map ppVersion bpPackages

28+ allPackages = map (,mempty) (siCorePackages bpSystemInfo) ++

29+ map (ppVersion &&& M.keys . M.filter libAndExe . sdPackages . ppDesc) bpPackages

2830 errs@(BadBuildPlan errs') =

2931 execWriter $ mapM_ (checkDeps allPackages) $ mapToList bpPackages

32+ -- Only looking at libraries and executables, benchmarks and tests

33+ -- are allowed to create cycles (e.g. test-framework depends on

34+ -- text, which uses test-framework in its test-suite).

35+ libAndExe (DepInfo cs _) = any (flip elem [CompLibrary,CompExecutable]) cs

3036

31−checkDeps :: Map PackageName Version

37+-- | For a given package name and plan, check that its dependencies are:

38+--

39+-- 1. Existent (existing in the provided package map)

40+-- 2. Within version range

41+-- 3. Check for dependency cycles.

42+checkDeps :: Map PackageName (Version,[PackageName])

3243 -> (PackageName, PackagePlan)

3344 -> Writer BadBuildPlan ()

3445checkDeps allPackages (user, pb) =

@@ -37,8 +48,16 @@ checkDeps allPackages (user, pb) =

3748 go (dep, diRange -> range) =

3849 case lookup dep allPackages of

3950 Nothing -> tell $ BadBuildPlan $ singletonMap (dep, Nothing) errMap

40− Just version

41− | version `withinRange` range -> return ()

51+ Just (version,deps)

52+ | version `withinRange` range ->

53+ occursCheck allPackages

54+ (\d v ->

55+ tell $ BadBuildPlan $ singletonMap

56+ (d,v)

57+ errMap)

58+ dep

59+ deps

60+ []

4261 | otherwise -> tell $ BadBuildPlan $ singletonMap

4362 (dep, Just version)

4463 errMap

@@ -51,6 +70,38 @@ checkDeps allPackages (user, pb) =

5170 , puGithubPings = ppGithubPings pb

5271 }

5372

73+-- | Check whether the package(s) occurs within its own dependency

74+-- tree.

75+occursCheck

76+ :: Monad m

77+ => Map PackageName (Version,[PackageName])

78+ -- ^ All packages.

79+ -> (PackageName -> Maybe Version -> m ())

80+ -- ^ Report an erroneous package.

81+ -> PackageName

82+ -- ^ Starting package to check for cycles in.

83+ -> [PackageName]

84+ -- ^ Dependencies of the package.

85+ -> [PackageName]

86+ -- ^ Previously seen packages up the dependency tree.

87+ -> m ()

88+occursCheck allPackages reportError =

89+ go

90+ where

91+ go pkg deps seen =

92+ case find (flip elem seen) deps of

93+ Just cyclic ->

94+ reportError cyclic $

95+ fmap fst (lookup cyclic allPackages)

96+ Nothing ->

97+ forM_ deps $

98+ \pkg' ->

99+ case lookup pkg' allPackages of

100+ Just (_v,deps')

101+ | pkg' /= pkg -> go pkg' deps' seen'

102+ _ -> return ()

103+ where seen' = pkg : seen

104+

54105data PkgUser = PkgUser

55106 { puName :: PackageName

56107 , puVersion :: Version

Stackage/CompleteBuild.hs+124−41

@@ -4,9 +4,14 @@

44module Stackage.CompleteBuild

55 ( BuildType (..)

66 , BumpType (..)

7+ , BuildFlags (..)

78 , completeBuild

89 , justCheck

10+ , justUploadNightly

911 ) where

12+

13+import Control.Concurrent (threadDelay)

14+import Control.Concurrent.Async (withAsync)

1015import Data.Default.Class (def)

1116import Data.Semigroup (Max (..), Option (..))

1217import Data.Text.Read (decimal)

@@ -22,8 +27,20 @@ import Stackage.Prelude

2227import Stackage.ServerBundle

2328import Stackage.UpdateBuildPlan

2429import Stackage.Upload

30+import System.Environment (lookupEnv)

2531import System.IO (BufferMode (LineBuffering), hSetBuffering)

2632

33+-- | Flags passed in from the command line.

34+data BuildFlags = BuildFlags

35+ { bfEnableTests :: !Bool

36+ , bfEnableHaddock :: !Bool

37+ , bfDoUpload :: !Bool

38+ , bfEnableLibProfile :: !Bool

39+ , bfEnableExecDyn :: !Bool

40+ , bfVerbose :: !Bool

41+ , bfSkipCheck :: !Bool

42+ } deriving (Show)

43+

2744data BuildType = Nightly | LTS BumpType

2845 deriving (Show, Read, Eq, Ord)

2946

@@ -39,28 +56,42 @@ data Settings = Settings

3956 , slug :: Text

4057 , setArgs :: Text -> UploadBundle -> UploadBundle

4158 , postBuild :: IO ()

59+ , distroName :: Text -- ^ distro name on Hackage

60+ }

61+

62+nightlyPlanFile :: Text -- ^ day

63+ -> FilePath

64+nightlyPlanFile day = fpFromText ("nightly-" ++ day) <.> "yaml"

65+

66+nightlySettings :: Text -- ^ day

67+ -> BuildPlan

68+ -> Settings

69+nightlySettings day plan' = Settings

70+ { planFile = nightlyPlanFile day

71+ , buildDir = fpFromText $ "builds/nightly"

72+ , logDir = fpFromText $ "logs/stackage-nightly-" ++ day

73+ , title = \ghcVer -> concat

74+ [ "Stackage Nightly "

75+ , day

76+ , ", GHC "

77+ , ghcVer

78+ ]

79+ , slug = slug'

80+ , setArgs = \ghcVer ub -> ub { ubNightly = Just ghcVer }

81+ , plan = plan'

82+ , postBuild = return ()

83+ , distroName = "Stackage"

4284 }

85+ where

86+ slug' = "nightly-" ++ day

4387

4488getSettings :: Manager -> BuildType -> IO Settings

4589getSettings man Nightly = do

4690 day <- tshow . utctDay <$> getCurrentTime

47− let slug' = "nightly-" ++ day

48− plan' <- defaultBuildConstraints man >>= newBuildPlan

49− return Settings

50− { planFile = fpFromText ("nightly-" ++ day) <.> "yaml"

51− , buildDir = fpFromText $ "builds/stackage-nightly-" ++ day

52− , logDir = fpFromText $ "logs/stackage-nightly-" ++ day

53− , title = \ghcVer -> concat

54− [ "Stackage Nightly "

55− , day

56− , ", GHC "

57− , ghcVer

58− ]

59− , slug = slug'

60− , setArgs = \ghcVer ub -> ub { ubNightly = Just ghcVer }

61− , plan = plan'

62− , postBuild = return ()

63− }

91+ bc <- defaultBuildConstraints man

92+ pkgs <- getLatestAllowedPlans bc

93+ plan' <- newBuildPlan pkgs bc

94+ return $ nightlySettings day plan'

6495getSettings man (LTS bumpType) = do

6596 Option mlts <- fmap (fmap getMax) $ runResourceT

6697 $ sourceDirectory "."

@@ -72,21 +103,25 @@ getSettings man (LTS bumpType) = do

72103 case mlts of

73104 Nothing -> LTSVer 0 0

74105 Just (LTSVer x _) -> LTSVer (x + 1) 0

75− plan' <- defaultBuildConstraints man >>= newBuildPlan

106+ bc <- defaultBuildConstraints man

107+ pkgs <- getLatestAllowedPlans bc

108+ plan' <- newBuildPlan pkgs bc

76109 return (new, plan')

77110 Minor -> do

78111 old <- maybe (error "No LTS plans found in current directory") return mlts

79112 oldplan <- decodeFileEither (fpToString $ renderLTSVer old)

80113 >>= either throwM return

81114 let new = incrLTSVer old

82− plan' <- updateBuildPlan oldplan

115+ let bc = updateBuildConstraints oldplan

116+ pkgs <- getLatestAllowedPlans bc

117+ plan' <- newBuildPlan pkgs bc

83118 return (new, plan')

84119

85120 let newfile = renderLTSVer new

86121

87122 return Settings

88123 { planFile = newfile

89− , buildDir = fpFromText $ "builds/stackage-lts-" ++ tshow new

124+ , buildDir = fpFromText $ "builds/lts"

90125 , logDir = fpFromText $ "logs/stackage-lts-" ++ tshow new

91126 , title = \ghcVer -> concat

92127 [ "LTS Haskell "

@@ -106,6 +141,7 @@ getSettings man (LTS bumpType) = do

106141 git ["commit", "-m", "Added new LTS release: " ++ show new]

107142 putStrLn "Pushing to Git repository"

108143 git ["push"]

144+ , distroName = "LTSHaskell"

109145 }

110146

111147data LTSVer = LTSVer !Int !Int

@@ -130,16 +166,27 @@ renderLTSVer lts = fpFromText $ concat

130166 , ".yaml"

131167 ]

132168

169+-- | Just print a message saying "still alive" every minute, to appease Travis.

170+stillAlive :: IO () -> IO ()

171+stillAlive inner =

172+ withAsync (printer 1) $ const inner

173+ where

174+ printer i = forever $ do

175+ threadDelay 60000000

176+ putStrLn $ "Still alive: " ++ tshow i

177+ printer $! i + 1

178+

133179-- | Generate and check a new build plan, but do not execute it.

134180--

135181-- Since 0.3.1

136182justCheck :: IO ()

137−justCheck = withManager tlsManagerSettings $ \man -> do

183+justCheck = stillAlive $ withManager tlsManagerSettings $ \man -> do

138184 putStrLn "Loading build constraints"

139185 bc <- defaultBuildConstraints man

140186

141187 putStrLn "Creating build plan"

142− plan <- newBuildPlan bc

188+ plans <- getLatestAllowedPlans bc

189+ plan <- newBuildPlan plans bc

143190

144191 putStrLn $ "Writing build plan to check-plan.yaml"

145192 encodeFile "check-plan.yaml" plan

@@ -149,37 +196,71 @@ justCheck = withManager tlsManagerSettings $ \man -> do

149196

150197 putStrLn "Plan seems valid!"

151198

152−completeBuild :: BuildType -> IO ()

153−completeBuild buildType = withManager tlsManagerSettings $ \man -> do

199+getPerformBuild :: BuildFlags -> Settings -> PerformBuild

200+getPerformBuild buildFlags Settings {..} = PerformBuild

201+ { pbPlan = plan

202+ , pbInstallDest = buildDir

203+ , pbLogDir = logDir

204+ , pbLog = hPut stdout

205+ , pbJobs = 8

206+ , pbGlobalInstall = False

207+ , pbEnableTests = bfEnableTests buildFlags

208+ , pbEnableHaddock = bfEnableHaddock buildFlags

209+ , pbEnableLibProfiling = bfEnableLibProfile buildFlags

210+ , pbEnableExecDyn = bfEnableExecDyn buildFlags

211+ , pbVerbose = bfVerbose buildFlags

212+ , pbAllowNewer = bfSkipCheck buildFlags

213+ }

214+

215+-- | Make a complete plan, build, test and upload bundle, docs and

216+-- distro.

217+completeBuild :: BuildType -> BuildFlags -> IO ()

218+completeBuild buildType buildFlags = withManager tlsManagerSettings $ \man -> do

154219 hSetBuffering stdout LineBuffering

155220

156221 putStrLn $ "Loading settings for: " ++ tshow buildType

157− Settings {..} <- getSettings man buildType

222+ settings@Settings {..} <- getSettings man buildType

158223

159224 putStrLn $ "Writing build plan to: " ++ fpToText planFile

160225 encodeFile (fpToString planFile) plan

161226

162− putStrLn "Checking build plan"

163− checkBuildPlan plan

227+ if bfSkipCheck buildFlags

228+ then putStrLn "Skipping build plan check"

229+ else do

230+ putStrLn "Checking build plan"

231+ checkBuildPlan plan

164232

165233 putStrLn "Performing build"

166− let pb = PerformBuild

167− { pbPlan = plan

168− , pbInstallDest = buildDir

169− , pbLogDir = logDir

170− , pbLog = hPut stdout

171− , pbJobs = 8

172− , pbGlobalInstall = False

173− }

174− performBuild pb >>= mapM_ putStrLn

234+ performBuild (getPerformBuild buildFlags settings) >>= mapM_ putStrLn

235+

236+ when (bfDoUpload buildFlags) $

237+ finallyUpload settings man

238+

239+justUploadNightly

240+ :: Text -- ^ nightly date

241+ -> IO ()

242+justUploadNightly day = do

243+ plan <- decodeFileEither (fpToString $ nightlyPlanFile day)

244+ >>= either throwM return

245+ withManager tlsManagerSettings $ finallyUpload $ nightlySettings day plan

175246

247+-- | The final part of the complete build process: uploading a bundle,

248+-- docs and a distro to hackage.

249+finallyUpload :: Settings -> Manager -> IO ()

250+finallyUpload settings@Settings{..} man = do

176251 putStrLn "Uploading bundle to Stackage Server"

177− token <- readFile "/auth-token"

252+

253+ mtoken <- lookupEnv "STACKAGE_AUTH_TOKEN"

254+ token <-

255+ case mtoken of

256+ Nothing -> decodeUtf8 <$> readFile "/auth-token"

257+ Just token -> return $ pack token

258+

178259 now <- epochTime

179260 let ghcVer = display $ siGhcVersion $ bpSystemInfo plan

180261 (ident, mloc) <- flip uploadBundle man $ setArgs ghcVer def

181262 { ubContents = serverBundle now (title ghcVer) slug plan

182− , ubAuthToken = decodeUtf8 token

263+ , ubAuthToken = token

183264 }

184265 putStrLn $ "New ident: " ++ unSnapshotIdent ident

185266 forM_ mloc $ \loc ->

@@ -190,7 +271,7 @@ completeBuild buildType = withManager tlsManagerSettings $ \man -> do

190271 putStrLn "Uploading docs to Stackage Server"

191272 res1 <- uploadDocs UploadDocs

192273 { udServer = def

193− , udAuthToken = decodeUtf8 token

274+ , udAuthToken = token

194275 , udDocs = pbDocDir pb

195276 , udSnapshot = ident

196277 } man

@@ -200,15 +281,17 @@ completeBuild buildType = withManager tlsManagerSettings $ \man -> do

200281 case map encodeUtf8 $ words $ decodeUtf8 $ either (const "") id ecreds of

201282 [username, password] -> do

202283 putStrLn "Uploading as Hackage distro"

203− res2 <- uploadHackageDistro plan username password man

284+ res2 <- uploadHackageDistroNamed distroName plan username password man

204285 putStrLn $ "Distro upload response: " ++ tshow res2

205286 _ -> putStrLn "No creds found, skipping Hackage distro upload"

206287

207288 putStrLn "Uploading doc map"

208289 uploadDocMap UploadDocMap

209290 { udmServer = def

210− , udmAuthToken = decodeUtf8 token

291+ , udmAuthToken = token

211292 , udmSnapshot = ident

212293 , udmDocDir = pbDocDir pb

213294 , udmPlan = plan

214295 } man >>= print

296+ where

297+ pb = getPerformBuild (error "finallyUpload.buildFlags") settings

Stackage/GhcPkg.hsnew file+90

@@ -0,0 +1,90 @@

1+{-# LANGUAGE NoImplicitPrelude #-}

2+{-# LANGUAGE OverloadedStrings #-}

3+-- | General commands related to ghc-pkg.

5+module Stackage.GhcPkg

6+ ( setupPackageDatabase

7+ ) where

9+import Data.Conduit

10+import qualified Data.Conduit.List as CL

11+import Data.Conduit.Process

12+import qualified Data.Conduit.Text as CT

13+import Data.Maybe

14+import Data.Text (Text)

15+import qualified Data.Text as T

16+import Distribution.Compat.ReadP

17+import Distribution.Package

18+import Distribution.Text (parse)

19+import Filesystem.Path.CurrentOS (FilePath)

20+import qualified Filesystem.Path.CurrentOS as FP

21+import Data.Map (Map)

22+import Data.Version (Version)

23+import Stackage.Prelude

24+import Filesystem (removeTree)

25+

26+setupPackageDatabase

27+ :: Maybe FilePath -- ^ database location, Nothing if using global DB

28+ -> FilePath -- ^ documentation root

29+ -> (ByteString -> IO ()) -- ^ logging

30+ -> Map PackageName Version -- ^ packages and versions to be installed

31+ -> IO (Set PackageName) -- ^ packages remaining in the database after cleanup

32+setupPackageDatabase mdb docDir log' toInstall = do

33+ registered1 <- getRegisteredPackages flags

34+ forM_ registered1 $ \pi@(PackageIdentifier name version) ->

35+ case lookup name toInstall of

36+ Just version' | version /= version' -> unregisterPackage log' docDir flags pi

37+ _ -> return ()

38+ broken <- getBrokenPackages flags

39+ forM_ broken $ unregisterPackage log' docDir flags

40+ foldMap (\(PackageIdentifier name _) -> singletonSet name)

41+ <$> getRegisteredPackages flags

42+ where

43+ flags = ghcPkgFlags mdb

44+

45+ghcPkgFlags :: Maybe FilePath -> [String]

46+ghcPkgFlags mdb =

47+ "--no-user-package-db" :

48+ case mdb of

49+ Nothing -> ["--global"]

50+ Just fp -> ["--package-db=" ++ fpToString fp]

51+

52+-- | Get broken packages.

53+getBrokenPackages :: [String] -> IO [PackageIdentifier]

54+getBrokenPackages flags = do

55+ (_,ps) <- sourceProcessWithConsumer

56+ (proc

57+ "ghc-pkg"

58+ ("check" : "--simple-output" : flags))

59+ (CT.decodeUtf8 $= CT.lines $= CL.consume)

60+ return (mapMaybe parsePackageIdent (T.words (T.unlines ps)))

61+

62+-- | Get available packages.

63+getRegisteredPackages :: [String] -> IO [PackageIdentifier]

64+getRegisteredPackages flags = do

65+ (_,ps) <- sourceProcessWithConsumer

66+ (proc

67+ "ghc-pkg"

68+ ("list" : "--simple-output" : flags))

69+ (CT.decodeUtf8 $= CT.lines $= CL.consume)

70+ return (mapMaybe parsePackageIdent (T.words (T.unlines ps)))

71+

72+-- | Parse a package identifier: foo-1.2.3

73+parsePackageIdent :: Text -> Maybe PackageIdentifier

74+parsePackageIdent = fmap fst .

75+ listToMaybe .

76+ filter (null . snd) .

77+ readP_to_S parse . T.unpack

78+

79+-- | Unregister a package.

80+unregisterPackage :: (ByteString -> IO ()) -- ^ log func

81+ -> FilePath -- ^ doc directory

82+ -> [String] -> PackageIdentifier -> IO ()

83+unregisterPackage log' docDir flags ident@(PackageIdentifier name _) = do

84+ log' $ "Unregistering " ++ encodeUtf8 (display ident) ++ "\n"

85+ void (readProcessWithExitCode

86+ "ghc-pkg"

87+ ("unregister": flags ++ ["--force", unpack $ display name])

88+ "")

89+

90+ void $ tryIO $ removeTree $ docDir </> fpFromText (display ident)

Stackage/InstallBuild.hsnew file+100

@@ -0,0 +1,100 @@

1+{-# LANGUAGE DeriveDataTypeable #-}

2+{-# LANGUAGE NoImplicitPrelude #-}

3+{-# LANGUAGE OverloadedStrings #-}

4+{-# LANGUAGE RecordWildCards #-}

5+{-# LANGUAGE ScopedTypeVariables #-}

6+module Stackage.InstallBuild

7+ ( InstallFlags (..)

8+ , BuildPlanSource (..)

9+ , installBuild

10+ ) where

11+

12+import qualified Codec.Archive.Tar as Tar

13+import qualified Codec.Compression.GZip as GZip

14+import qualified Data.Yaml as Yaml

15+import Network.HTTP.Client

16+import Network.HTTP.Client.TLS (tlsManagerSettings)

17+import Stackage.BuildPlan

18+import Stackage.CheckBuildPlan

19+import Stackage.PerformBuild

20+import Stackage.Prelude

21+import System.IO (BufferMode (LineBuffering), hSetBuffering)

22+

23+-- | Flags passed in from the command line.

24+data InstallFlags = InstallFlags

25+ { ifPlanSource :: !BuildPlanSource

26+ , ifInstallDest :: !FilePath

27+ , ifLogDir :: !(Maybe FilePath)

28+ , ifJobs :: !Int

29+ , ifGlobalInstall :: !Bool

30+ , ifEnableTests :: !Bool

31+ , ifEnableHaddock :: !Bool

32+ , ifEnableLibProfiling :: !Bool

33+ , ifEnableExecDyn :: !Bool

34+ , ifVerbose :: !Bool

35+ , ifSkipCheck :: !Bool

36+ } deriving (Show)

37+

38+-- | Source for build plan.

39+data BuildPlanSource = BPSBundleWeb String

40+ | BPSFile FilePath

41+ deriving (Show)

42+

43+getPerformBuild :: BuildPlan -> InstallFlags -> PerformBuild

44+getPerformBuild plan InstallFlags{..} =

45+ PerformBuild

46+ { pbPlan = plan

47+ , pbInstallDest = ifInstallDest

48+ , pbLogDir = fromMaybe (ifInstallDest </> "logs") ifLogDir

49+ , pbLog = hPut stdout

50+ , pbJobs = ifJobs

51+ , pbGlobalInstall = ifGlobalInstall

52+ , pbEnableTests = ifEnableTests

53+ , pbEnableHaddock = ifEnableHaddock

54+ , pbEnableLibProfiling = ifEnableLibProfiling

55+ , pbEnableExecDyn = ifEnableExecDyn

56+ , pbVerbose = ifVerbose

57+ , pbAllowNewer = ifSkipCheck

58+ }

59+

60+-- | Install stackage from an existing build plan.

61+installBuild :: InstallFlags -> IO ()

62+installBuild installFlags@InstallFlags{..} = do

63+ hSetBuffering stdout LineBuffering

64+

65+ putStrLn $ "Loading build plan"

66+ plan <- case ifPlanSource of

67+ BPSBundleWeb url -> withManager tlsManagerSettings $ \man -> do

68+ req <- parseUrl url

69+ res <- httpLbs req man

70+ planBSL <- getPlanEntry $ Tar.read $ GZip.decompress (responseBody res)

71+ decodeBuildPlan planBSL

72+ BPSFile path -> Yaml.decodeFileEither (fpToString path) >>= either throwM return

73+

74+ if ifSkipCheck

75+ then putStrLn "Skipping build plan check"

76+ else do

77+ putStrLn "Checking build plan"

78+ checkBuildPlan plan

79+

80+ putStrLn "Performing build"

81+ performBuild (getPerformBuild plan installFlags) >>= mapM_ putStrLn

82+

83+ where

84+ getPlanEntry Tar.Done = throwIO NoBuildPlanException

85+ getPlanEntry (Tar.Fail e) = throwIO e

86+ getPlanEntry (Tar.Next entry entries)

87+ | Tar.entryPath entry == "build-plan.yaml" =

88+ case Tar.entryContent entry of

89+ Tar.NormalFile bs _ -> return bs

90+ _ -> throwIO NoBuildPlanException

91+ | otherwise = getPlanEntry entries

92+

93+ decodeBuildPlan =

94+ either throwIO return . Yaml.decodeEither' . toStrict

95+

96+data InstallBuildException = NoBuildPlanException

97+ deriving (Typeable)

98+instance Exception InstallBuildException

99+instance Show InstallBuildException where

100+ show NoBuildPlanException = "Bundle has missing or invalid build-plan.yaml"

Stackage/PerformBuild.hs+148−31

@@ -19,11 +19,12 @@ import qualified Data.Map as Map

1919import Data.NonNull (fromNullable)

2020import Filesystem (canonicalizePath, createTree,

2121 getWorkingDirectory, isDirectory,

22− removeTree, rename)

22+ removeTree, rename, isFile, removeFile)

2323import Filesystem.Path (parent)

2424import qualified Filesystem.Path as F

2525import Stackage.BuildConstraints

2626import Stackage.BuildPlan

27+import Stackage.GhcPkg

2728import Stackage.PackageDescription

2829import Stackage.Prelude hiding (pi)

2930import System.Directory (findExecutable)

@@ -61,6 +62,13 @@ data PerformBuild = PerformBuild

6162 , pbJobs :: Int

6263 , pbGlobalInstall :: Bool

6364 -- ^ Register packages in the global database

65+ , pbEnableTests :: Bool

66+ , pbEnableHaddock :: Bool

67+ , pbEnableLibProfiling :: Bool

68+ , pbEnableExecDyn :: Bool

69+ , pbVerbose :: Bool

70+ , pbAllowNewer :: Bool

71+ -- ^ Pass --allow-newer to cabal configure

6472 }

6573

6674data PackageInfo = PackageInfo

@@ -83,7 +91,9 @@ waitForDeps toolMap packageMap activeComps bp pi action = do

8391 case lookup exe toolMap >>= fromNullable . map checkPackage . setToList of

8492 Nothing

8593 | isCoreExe exe -> return ()

86− | otherwise -> throwSTM $ ToolMissing exe

94+ -- https://github.com/jgm/zip-archive/issues/23

95+ -- | otherwise -> throwSTM $ ToolMissing exe

96+ | otherwise -> return ()

8797 Just packages -> ofoldl1' (<|>) packages

8898 action

8999 where

@@ -126,6 +136,10 @@ pbLibDir pb = pbInstallDest pb </> "lib"

126136pbDataDir pb = pbInstallDest pb </> "share"

127137pbDocDir pb = pbInstallDest pb </> "doc"

128138

139+-- | Directory keeping previous result info

140+pbPrevResDir :: PerformBuild -> FilePath

141+pbPrevResDir pb = pbInstallDest pb </> "prevres"

142+

129143performBuild :: PerformBuild -> IO [Text]

130144performBuild pb = do

131145 cwd <- getWorkingDirectory

@@ -153,12 +167,13 @@ performBuild' pb@PerformBuild {..} = withBuildDir $ \builddir -> do

153167 $ \ClosedStream Inherited Inherited -> return ()

154168

155169 let removeTree' fp = whenM (isDirectory fp) (removeTree fp)

156− mapM_ removeTree' [pbInstallDest, pbLogDir]

170+ removeTree' pbLogDir

157171

158− forM_ (pbDatabase pb) $ \db -> do

159− createTree $ parent db

160− withCheckedProcess (proc "ghc-pkg" ["init", fpToString db])

161− $ \ClosedStream Inherited Inherited -> return ()

172+ forM_ (pbDatabase pb) $ \db ->

173+ unlessM (isFile $ db </> "package.cache") $ do

174+ createTree $ parent db

175+ withCheckedProcess (proc "ghc-pkg" ["init", fpToString db])

176+ $ \ClosedStream Inherited Inherited -> return ()

162177 pbLog $ encodeUtf8 "Copying built-in Haddocks\n"

163178 copyBuiltInHaddocks (pbDocDir pb)

164179

@@ -178,7 +193,14 @@ performBuild' pb@PerformBuild {..} = withBuildDir $ \builddir -> do

178193 env <- getEnvironment

179194 haddockFiles <- newTVarIO mempty

180195

181− forM_ packageMap $ \pi -> void $ async $ singleBuild pb SingleBuild

196+ registeredPackages <- setupPackageDatabase

197+ (pbDatabase pb)

198+ (pbDocDir pb)

199+ pbLog

200+ (ppVersion <$> bpPackages pbPlan)

201+

202+ forM_ packageMap $ \pi -> void $ async $ singleBuild pb registeredPackages

203+ SingleBuild

182204 { sbSem = sem

183205 , sbErrsVar = errsVar

184206 , sbWarningsVar = warningsVar

@@ -192,7 +214,7 @@ performBuild' pb@PerformBuild {..} = withBuildDir $ \builddir -> do

192214 id

193215 (\db -> (("HASKELL_PACKAGE_SANDBOX", fpToString db):))

194216 (pbDatabase pb)

195− (map fixEnv env)

217+ (filter allowedEnv $ map fixEnv env)

196218 , sbHaddockFiles = haddockFiles

197219 }

198220

@@ -210,6 +232,8 @@ performBuild' pb@PerformBuild {..} = withBuildDir $ \builddir -> do

210232 | toUpper p == "PATH" = (p, fpToString (pbBinDir pb) ++ pathSep : x)

211233 | otherwise = (p, x)

212234

235+ allowedEnv (k, _) = k `notMember` bannedEnvs

236+

213237 -- | Separate for the PATH environment variable

214238 pathSep :: Char

215239#ifdef mingw32_HOST_OS

@@ -218,6 +242,12 @@ performBuild' pb@PerformBuild {..} = withBuildDir $ \builddir -> do

218242 pathSep = ':'

219243#endif

220244

245+-- | Environment variables we don't allow to be passed on to child processes.

246+bannedEnvs :: Set String

247+bannedEnvs = setFromList

248+ [ "STACKAGE_AUTH_TOKEN"

249+ ]

250+

221251data SingleBuild = SingleBuild

222252 { sbSem :: TSem

223253 , sbErrsVar :: TVar (Map PackageName BuildFailure)

@@ -232,8 +262,10 @@ data SingleBuild = SingleBuild

232262 , sbHaddockFiles :: TVar (Map Text FilePath) -- ^ package-version, .haddock file

233263 }

234264

235−singleBuild :: PerformBuild -> SingleBuild -> IO ()

236−singleBuild pb@PerformBuild {..} SingleBuild {..} =

265+singleBuild :: PerformBuild

266+ -> Set PackageName -- ^ registered packages

267+ -> SingleBuild -> IO ()

268+singleBuild pb@PerformBuild {..} registeredPackages SingleBuild {..} =

237269 withCounter sbActive

238270 $ handle updateErrs

239271 $ (`finally` void (atomically $ tryPutTMVar (piResult sbPackageInfo) False))

@@ -245,11 +277,13 @@ singleBuild pb@PerformBuild {..} SingleBuild {..} =

245277 let wfd comps =

246278 waitForDeps sbToolMap sbPackageMap comps pbPlan sbPackageInfo

247279 . withTSem sbSem

248− wfd libComps buildLibrary

280+ withUnpacked <- wfd libComps buildLibrary

249281

250− wfd testComps runTests

282+ wfd testComps (runTests withUnpacked)

251283

252− name = display $ piName sbPackageInfo

284+ pname = piName sbPackageInfo

285+ pident = PackageIdentifier pname (ppVersion $ piPlan sbPackageInfo)

286+ name = display pname

253287 namever = concat

254288 [ name

255289 , "-"

@@ -290,6 +324,7 @@ singleBuild pb@PerformBuild {..} SingleBuild {..} =

290324 withBinaryFile (fpToString fp) WriteMode inner'

291325

292326 configArgs = ($ []) $ execWriter $ do

327+ when pbAllowNewer $ tell' "--allow-newer"

293328 tell' "--package-db=clear"

294329 tell' "--package-db=global"

295330 forM_ (pbDatabase pb) $ \db -> tell' $ "--package-db=" ++ fpToText db

@@ -298,6 +333,9 @@ singleBuild pb@PerformBuild {..} SingleBuild {..} =

298333 tell' $ "--datadir=" ++ fpToText (pbDataDir pb)

299334 tell' $ "--docdir=" ++ fpToText (pbDocDir pb)

300335 tell' $ "--flags=" ++ flags

336+ when (pbEnableLibProfiling && pcEnableLibProfile) $

337+ tell' "--enable-library-profiling"

338+ when pbEnableExecDyn $ tell' "--enable-executable-dynamic"

301339 where

302340 tell' x = tell (x:)

303341

@@ -312,20 +350,39 @@ singleBuild pb@PerformBuild {..} SingleBuild {..} =

312350 PackageConstraints {..} = ppConstraints $ piPlan sbPackageInfo

313351

314352 buildLibrary = wf libOut $ \outH -> do

315− let run = runChild outH

316− log' $ "Unpacking " ++ namever

317− runParent outH "cabal" ["unpack", namever]

318−

319− log' $ "Configuring " ++ namever

320− run "cabal" $ "configure" : configArgs

321−

322− log' $ "Building " ++ namever

323− run "cabal" ["build"]

324−

325− log' $ "Copying/registering " ++ namever

326− run "cabal" ["copy"]

327− withMVar sbRegisterMutex $ const $

328− run "cabal" ["register"]

353+ let run a b = do when pbVerbose $ log' (unwords (a : b))

354+ runChild outH a b

355+

356+ isUnpacked <- newIORef False

357+ let withUnpacked inner = do

358+ unlessM (readIORef isUnpacked) $ do

359+ log' $ "Unpacking " ++ namever

360+ runParent outH "cabal" ["unpack", namever]

361+ writeIORef isUnpacked True

362+ inner

363+

364+ isConfiged <- newIORef False

365+ let withConfiged inner = withUnpacked $ do

366+ unlessM (readIORef isConfiged) $ do

367+ log' $ "Configuring " ++ namever

368+ run "cabal" $ "configure" : configArgs

369+ writeIORef isConfiged True

370+ inner

371+

372+ prevBuildResult <- getPreviousResult pb Build pident

373+ unless (prevBuildResult == PRSuccess) $ withConfiged $ do

374+ assert (pname `notMember` registeredPackages) $ do

375+ deletePreviousResults pb pident

376+

377+ log' $ "Building " ++ namever

378+ run "cabal" ["build"]

379+

380+ log' $ "Copying/registering " ++ namever

381+ run "cabal" ["copy"]

382+ withMVar sbRegisterMutex $ const $

383+ run "cabal" ["register"]

384+

385+ savePreviousResult pb Build pident True

329386

330387 -- Even if the tests later fail, we can allow other libraries to build

331388 -- on top of our successful results

@@ -335,7 +392,11 @@ singleBuild pb@PerformBuild {..} SingleBuild {..} =

335392 -- dependency's haddocks before this finishes

336393 atomically $ putTMVar (piResult sbPackageInfo) True

337394

338− when (pcHaddocks /= Don'tBuild && not (null $ sdModules $ ppDesc $ piPlan sbPackageInfo)) $ do

395+ prevHaddockResult <- getPreviousResult pb Haddock pident

396+ let needHaddock = pbEnableHaddock

397+ && checkPrevResult prevHaddockResult pcHaddocks

398+ && not (null $ sdModules $ ppDesc $ piPlan sbPackageInfo)

399+ when needHaddock $ withConfiged $ do

339400 log' $ "Haddocks " ++ namever

340401 hfs <- readTVarIO sbHaddockFiles

341402 let hfsOpts = flip map (mapToList hfs) $ \(pkgVer, hf) -> concat

@@ -370,15 +431,21 @@ singleBuild pb@PerformBuild {..} SingleBuild {..} =

370431 $ modifyTVar sbHaddockFiles

371432 $ insertMap namever newPath

372433

434+ savePreviousResult pb Haddock pident $ either (const False) (const True) eres

373435 case (eres, pcHaddocks) of

374436 (Left e, ExpectSuccess) -> throwM e

375437 (Right (), ExpectFailure) -> warn $ namever ++ ": unexpected Haddock success"

376438 _ -> return ()

377439

378− runTests = wf testOut $ \outH -> do

440+ return withUnpacked

441+

442+ runTests withUnpacked = wf testOut $ \outH -> do

379443 let run = runChild outH

380444

381− when (pcTests /= Don'tBuild) $ do

445+ prevTestResult <- getPreviousResult pb Test pident

446+ let needTest = pbEnableTests

447+ && checkPrevResult prevTestResult pcTests

448+ when needTest $ withUnpacked $ do

382449 log' $ "Test configure " ++ namever

383450 run "cabal" $ "configure" : "--enable-tests" : configArgs

384451

@@ -389,6 +456,7 @@ singleBuild pb@PerformBuild {..} SingleBuild {..} =

389456 log' $ "Test run " ++ namever

390457 run "cabal" ["test", "--log=" ++ fpToText testRunOut]

391458

459+ savePreviousResult pb Test pident $ either (const False) (const True) eres

392460 case (eres, pcTests) of

393461 (Left e, ExpectSuccess) -> throwM e

394462 (Right (), ExpectFailure) -> warn $ namever ++ ": unexpected test success"

@@ -421,3 +489,52 @@ copyBuiltInHaddocks docdir = do

421489 src <- canonicalizePath

422490 (parent (fpFromString ghc) </> "../share/doc/ghc/html/libraries")

423491 copyDir src docdir

492+

493+------------- Previous results

494+

495+-- | The previous actions that can be run

496+data ResultType = Build | Haddock | Test

497+ deriving (Show, Enum, Eq, Ord, Bounded, Read)

498+

499+-- | The result generated on a previous run

500+data PrevResult = PRNoResult | PRSuccess | PRFailure

501+ deriving (Show, Enum, Eq, Ord, Bounded, Read)

502+

503+-- | Check if we should rerun based on a PrevResult and the expected status

504+checkPrevResult :: PrevResult -> TestState -> Bool

505+checkPrevResult _ Don'tBuild = False

506+checkPrevResult PRNoResult _ = True

507+checkPrevResult PRSuccess _ = False

508+checkPrevResult PRFailure ExpectSuccess = True

509+checkPrevResult PRFailure _ = False

510+

511+withPRPath :: PerformBuild -> ResultType -> PackageIdentifier -> (FilePath -> IO a) -> IO a

512+withPRPath pb rt ident inner = do

513+ createTree $ parent fp

514+ inner fp

515+ where

516+ fp = pbPrevResDir pb </> fpFromString (show rt) </> fpFromText (display ident)

517+

518+successBS, failureBS :: ByteString

519+successBS = "success"

520+failureBS = "failure"

521+

522+getPreviousResult :: PerformBuild -> ResultType -> PackageIdentifier -> IO PrevResult

523+getPreviousResult w x y = withPRPath w x y $ \fp -> do

524+ eres <- tryIO $ readFile fp

525+ return $ case eres of

526+ Right bs

527+ | bs == successBS -> PRSuccess

528+ | bs == failureBS -> PRFailure

529+ _ -> PRNoResult

530+

531+savePreviousResult :: PerformBuild -> ResultType -> PackageIdentifier -> Bool -> IO ()

532+savePreviousResult pb rt ident res =

533+ withPRPath pb rt ident $ \fp -> writeFile fp $

534+ if res then successBS else failureBS

535+

536+deletePreviousResults :: PerformBuild -> PackageIdentifier -> IO ()

537+deletePreviousResults pb name =

538+ forM_ [minBound..maxBound] $ \rt ->

539+ withPRPath pb rt name $ \fp ->

540+ void $ tryIO $ removeFile fp

Stackage/UpdateBuildPlan.hs+4−2

@@ -15,8 +15,9 @@ import Stackage.BuildConstraints

1515import Stackage.BuildPlan

1616import Stackage.Prelude

1717

18−updateBuildPlan :: BuildPlan -> IO BuildPlan

19−updateBuildPlan = newBuildPlan . updateBuildConstraints

18+updateBuildPlan :: Map PackageName PackagePlan -> BuildPlan -> IO BuildPlan

19+updateBuildPlan packagesOrig

20+ = newBuildPlan packagesOrig . updateBuildConstraints

2021

2122updateBuildConstraints :: BuildPlan -> BuildConstraints

2223updateBuildConstraints BuildPlan {..} =

@@ -33,6 +34,7 @@ updateBuildConstraints BuildPlan {..} =

3334 , pcHaddocks = maybe ExpectSuccess pcHaddocks moldPC

3435 , pcBuildBenchmarks = maybe True pcBuildBenchmarks moldPC

3536 , pcFlagOverrides = maybe mempty pcFlagOverrides moldPC

37+ , pcEnableLibProfile = maybe False pcEnableLibProfile moldPC

3638 }

3739 where

3840 moldBP = lookup name bpPackages

Stackage/Upload.hs+23−9

@@ -11,6 +11,7 @@ module Stackage.Upload

1111 , UploadDocs (..)

1212 , uploadDocs

1313 , uploadHackageDistro

14+ , uploadHackageDistroNamed

1415 , UploadDocMap (..)

1516 , uploadDocMap

1617 , uploadBundleV2

@@ -145,8 +146,28 @@ uploadHackageDistro :: BuildPlan

145146 -> ByteString -- ^ Hackage password

146147 -> Manager

147148 -> IO (Response LByteString)

148−uploadHackageDistro bp username password =

149− httpLbs (applyBasicAuth username password req)

149+uploadHackageDistro = uploadHackageDistroNamed "Stackage"

150+

151+uploadHackageDistroNamed

152+ :: Text -- ^ distro name

153+ -> BuildPlan

154+ -> ByteString -- ^ Hackage username

155+ -> ByteString -- ^ Hackage password

156+ -> Manager

157+ -> IO (Response LByteString)

158+uploadHackageDistroNamed name bp username password manager = do

159+ req1 <- parseUrl $ concat

160+ [ "http://hackage.haskell.org/distro/"

161+ , unpack name

162+ , "/packages.csv"

163+ ]

164+ let req2 = req1

165+ { requestHeaders = [("Content-Type", "text/csv")]

166+ , requestBody = RequestBodyLBS csv

167+ , checkStatus = \_ _ _ -> Nothing

168+ , method = "PUT"

169+ }

170+ httpLbs (applyBasicAuth username password req2) manager

150171 where

151172 csv = encodeUtf8

152173 $ builderToLazy

@@ -164,13 +185,6 @@ uploadHackageDistro bp username password =

164185 (toBuilder $ display name) ++

165186 "\""

166187

167− req = "http://hackage.haskell.org/distro/Stackage/packages.csv"

168− { requestHeaders = [("Content-Type", "text/csv")]

169− , requestBody = RequestBodyLBS csv

170− , checkStatus = \_ _ _ -> Nothing

171− , method = "PUT"

172− }

173−

174188data UploadDocMap = UploadDocMap

175189 { udmServer :: StackageServer

176190 , udmAuthToken :: Text

app/stackage.hs+159−12

@@ -1,16 +1,163 @@

1+{-# LANGUAGE TupleSections #-}

3+module Main where

5+import Control.Monad

6+import Data.Monoid

7+import Data.String (fromString)

8+import Data.Version

9+import Options.Applicative

10+import Filesystem.Path.CurrentOS (decodeString)

11+import Paths_stackage (version)

112import Stackage.CompleteBuild

2−import System.Environment (getArgs)

13+import Stackage.InstallBuild

314

415main :: IO ()

5−main = do

6− args <- getArgs

7− case args of

8− [x] | Just y <- lookup x m -> y

9− _ -> error $ "Expected one argument, one of: " ++ unwords (map fst m)

16+main =

17+ join $

18+ execParser $

19+ info

20+ (helpOption <*> versionOption <*> config)

21+ (header "Stackage" <>

22+ fullDesc)

1023 where

11− m =

12− [ ("nightly", completeBuild Nightly)

13− , ("lts-major", completeBuild $ LTS Major)

14− , ("lts-minor", completeBuild $ LTS Minor)

15− , ("check", justCheck)

16− ]

24+ helpOption =

25+ abortOption ShowHelpText $

26+ long "help" <>

27+ help "Show this help text"

28+ versionOption =

29+ infoOption

30+ ("stackage version " ++ showVersion version)

31+ (long "version" <>

32+ help "Show stackage version")

33+ config =

34+ subparser $

35+ mconcat

36+ [ cmnd

37+ (uncurry completeBuild)

38+ (fmap (Nightly, ) buildFlags)

39+ "nightly"

40+ "Build, test and upload the Nightly snapshot"

41+ , cmnd

42+ (uncurry completeBuild)

43+ (fmap (LTS Major, ) buildFlags)

44+ "lts-major"

45+ "Build, test and upload the LTS (major) snapshot"

46+ , cmnd

47+ (uncurry completeBuild)

48+ (fmap (LTS Minor, ) buildFlags)

49+ "lts-minor"

50+ "Build, test and upload the LTS (minor) snapshot"

51+ , cmnd

52+ justUploadNightly

53+ nightlyUploadFlags

54+ "upload-nightly"

55+ "Upload an already-built nightly snapshot"

56+ , cmnd

57+ (const justCheck)

58+ (pure ())

59+ "check"

60+ "Just check that the build plan is ok"

61+ , cmnd

62+ installBuild

63+ installFlags

64+ "install"

65+ "Install a snapshot from an existing build plan"]

66+

67+ cmnd exec parse name desc =

68+ command name $

69+ info

70+ (fmap exec (parse <**> helpOption))

71+ (progDesc desc)

72+

73+ buildFlags =

74+ BuildFlags <$>

75+ fmap

76+ not

77+ (switch

78+ (long "skip-tests" <>

79+ help "Skip build and running the test suites")) <*>

80+ fmap

81+ not

82+ (switch

83+ (long "skip-haddock" <>

84+ help "Skip generating haddock documentation")) <*>

85+ fmap

86+ not

87+ (switch

88+ (long "skip-upload" <>

89+ help "Skip uploading bundle, docs, etc.")) <*>

90+ switch

91+ (long "enable-library-profiling" <>

92+ help "Enable profiling when building") <*>

93+ switch

94+ (long "enable-executable-dynamic" <>

95+ help "Enable dynamic executables when building") <*>

96+ switch

97+ (long "verbose" <> short 'v' <>

98+ help "Output verbose detail about the build steps") <*>

99+ switch

100+ (long "skip-check" <>

101+ help "Skip the check phase, and pass --allow-newer to cabal configure")

102+

103+ nightlyUploadFlags = fromString <$> strArgument

104+ (metavar "DATE" <>

105+ help "Date, in YYYY-MM-DD format")

106+

107+ installFlags =

108+ InstallFlags <$>

109+ (fmap

110+ BPSBundleWeb

111+ (strOption

112+ (long "bundle" <>

113+ metavar "URL" <>

114+ help "Stackage bundle containing build plan")) <|>

115+ fmap

116+ (BPSFile . decodeString)

117+ (strOption

118+ (long "build-plan" <>

119+ metavar "PATH" <>

120+ help "Build-plan YAML file"))) <*>

121+ fmap

122+ decodeString

123+ (strArgument

124+ (metavar "DESTINATION-PATH" <>

125+ help "Destination directory path")) <*>

126+ (fmap

127+ (Just . decodeString)

128+ (strOption

129+ (long "log-dir" <>

130+ metavar "PATH" <>

131+ help "Location of log files (default DESTINATION-PATH/logs)")) <|>

132+ pure Nothing) <*>

133+ option

134+ auto

135+ (long "jobs" <>

136+ metavar "NUMBER" <>

137+ showDefault <> value 8 <>

138+ help "Number of threads") <*>

139+ switch

140+ (long "global" <>

141+ help "Install in global package database") <*>

142+ fmap

143+ not

144+ (switch

145+ (long "skip-tests" <>

146+ help "Skip build and running the test suites")) <*>

147+ fmap

148+ not

149+ (switch

150+ (long "skip-haddock" <>

151+ help "Skip generating haddock documentation")) <*>

152+ switch

153+ (long "enable-library-profiling" <>

154+ help "Enable profiling when building") <*>

155+ switch

156+ (long "enable-executable-dynamic" <>

157+ help "Enable dynamic executables when building") <*>

158+ switch

159+ (long "verbose" <> short 'v' <>

160+ help "Output verbose detail about the build steps") <*>

161+ switch

162+ (long "skip-check" <>

163+ help "Skip the check phase, and pass --allow-newer to cabal configure")

build-constraints.yaml+285−53

@@ -2,7 +2,7 @@

22packages:

33 "Michael Snoyman michael@snoyman.com @snoyberg":

44 - bzlib-conduit

5− - cabal-install < 1.19

5+ - cabal-install < 1.19 # GHC 7.10 bumpd to 1.22

66 - cabal-src

77 - case-insensitive

88 - classy-prelude-yesod

@@ -27,7 +27,10 @@ packages:

2727 - warp-tls

2828 - yackage

2929 - yesod

30+ - yesod-auth

31+ - yesod-auth-oauth

3032 - yesod-auth-deskcom

33+ - authenticate-oauth

3134 - yesod-bin

3235 - yesod-eventsource

3336 - yesod-fay

@@ -42,6 +45,11 @@ packages:

4245 - repa-algorithms

4346 - repa-devil

4447 - JuicyPixels-repa

48+ - cereal-conduit

49+ - binary-conduit

50+ - lzma-conduit

51+ - mutable-containers

52+ - hpc-coveralls

4553

4654 "FP Complete michael@fpcomplete.com @snoyberg":

4755 - alex

@@ -64,7 +72,7 @@ packages:

6472 - fixed-list

6573 - foreign-store

6674 - formatting

67− - fpco-api

75+ #- fpco-api

6876 - gtk2hs-buildtools

6977 - happy

7078 - histogram-fill

@@ -105,18 +113,18 @@ packages:

105113 - distributed-process-async

106114 - distributed-process-client-server

107115 - distributed-process-supervisor

108−

109− # https://github.com/fpco/stackage/issues/381

110− #- distributed-process-task

111− #- distributed-process-execution

116+ - distributed-process-task

117+ - distributed-process-execution

112118

113119 - kure

114120

115121 "Omari Norman <omari@smileystation.com>":

116122 - barecheck

117123 - rainbow

118− - rainbow-tests

119124 - quickpull

125+ - multiarg

126+ - prednote

127+ - cartel

120128

121129 "Neil Mitchell":

122130 - hlint

@@ -144,6 +152,7 @@ packages:

144152 "Jasper Van der Jeugt":

145153 - blaze-html

146154 - blaze-markup

155+ - hakyll

147156 - stylish-haskell

148157

149158 "Antoine Latter":

@@ -175,7 +184,6 @@ packages:

175184 - crypto-random-api

176185 - hit

177186 - language-java

178− - language-java

179187 - libgit

180188 - pem

181189 - siphash

@@ -202,8 +210,11 @@ packages:

202210 - scrobble

203211 - shell-conduit

204212 - sourcemap

213+ - hindent

214+ - descriptive

215+ - wrap

205216 # requires old haddock currently - haskell-docs

206− # TODO: Add hindent and structured-haskell-mode once they've been ported to HSE 1.16.

217+ # TODO: Add structured-haskell-mode once they've been ported to HSE 1.16.

207218

208219 # GHC 7.6

209220 # "Alberto G. Corona <agocorona@gmail.com>":

@@ -253,7 +264,7 @@ packages:

253264 - monad-products

254265 - monad-st

255266 - monad-st

256− - mtl < 2.2

267+ - mtl < 2.2 # GHC 7.10 bump

257268 - nats

258269 - numeric-extras

259270 - parsers

@@ -304,8 +315,9 @@ packages:

304315

305316 "Brent Yorgey <byorgey@gmail.com>":

306317 - active

307− - BlogLiterately

308− - BlogLiterately-diagrams

318+ # Temporarily disabled due to restrictive lens upper bound

319+ #- BlogLiterately

320+ #- BlogLiterately-diagrams

309321 - diagrams

310322 - diagrams-builder

311323 - diagrams-contrib

@@ -325,6 +337,8 @@ packages:

325337 - JuicyPixels

326338 - FontyFruity

327339 - Rasterific

340+ - svg-tree

341+ - rasterific-svg

328342

329343 "Patrick Brisbin":

330344 - gravatar

@@ -365,6 +379,7 @@ packages:

365379 - pipes

366380 - pipes-parse

367381 - pipes-concurrency

382+ - pipes-safe

368383

369384 "Chris Allen <cma@bitemyapp.com>":

370385 - bloodhound

@@ -378,6 +393,10 @@ packages:

378393 - fay-uri

379394 - snaplet-fay

380395

396+ "Sebastiaan Visser <haskell@fvisser.nl>":

397+ - clay

398+ - fclabels

399+

381400 "Rodrigo Setti <rodrigosetti@gmail.com>":

382401 - messagepack

383402 - messagepack-rpc

@@ -399,9 +418,11 @@ packages:

399418 - hPDB

400419 - hPDB-examples

401420

402− # https://github.com/fpco/stackage/pull/382#issuecomment-68182467

403− # - wordpass

404− # - json-autotype

421+ - wordpass

422+ - json-autotype

423+

424+ "Dominic Steinitz <dominic@steinitz.org>":

425+ - yarr

405426

406427 "Roman Cheplyaka <roma@ro-che.info>":

407428 - action-permutations

@@ -431,6 +452,7 @@ packages:

431452 "George Giorgidze <giorgidze@gmail.com>":

432453 - HCodecs

433454 - YampaSynth

455+ - set-monad

434456

435457 "Phil Hargett <phil@haphazardhouse.net>":

436458 - courier

@@ -444,6 +466,8 @@ packages:

444466 - circle-packing

445467 - arbtt

446468 - ghc-heap-view

469+ - tttool

470+ - gipeda

447471

448472 "Aditya Bhargava <adit@adit.io":

449473 - HandsomeSoup

@@ -453,7 +477,8 @@ packages:

453477 - openpgp-asciiarmor

454478 - MusicBrainz

455479 - DAV

456− - hopenpgp-tools

480+ # https://github.com/fpco/stackage/issues/463

481+ #- hopenpgp-tools

457482

458483 # https://github.com/fpco/stackage/issues/160

459484 "Ketil Malde":

@@ -483,9 +508,9 @@ packages:

483508 - code-builder

484509 - fay-builder

485510 - generic-aeson

511+ - generic-xmlpickler

486512 - hxt-pickle-utils

487513 - imagesize-conduit

488− - imagesize-conduit

489514 - json-schema

490515 - multipart

491516 - regular-xmlpickler

@@ -498,8 +523,6 @@ packages:

498523 - rest-types

499524 - rest-wai

500525 - tostring

501− - tostring

502− - uri-encode

503526 - uri-encode

504527

505528 "Simon Michael <simon@joyful.com>":

@@ -509,7 +532,10 @@ packages:

509532 - io-manager

510533

511534 "Dimitri Sabadie <dimitri.sabadie@gmail.com":

535+ # https://github.com/fpco/stackage/pull/461#issuecomment-76914158

536+ # - al

512537 - monad-journal

538+ - smoothie

513539

514540 "Thomas Schilling <nominolo@googlemail.com>":

515541 - ghc-syb-utils

@@ -543,6 +569,7 @@ packages:

543569

544570 "Emanuel Borsobom <manny@fpcomplete.com>":

545571 - BoundedChan

572+ - broadcast-chan

546573 - bytestring-lexing

547574 - bytestring-trie

548575 - data-accessor

@@ -553,6 +580,7 @@ packages:

553580 - haddock-api

554581 - here

555582 - hlibgit2

583+ - gitlib-libgit2

556584 - hostname-validate

557585 - interpolatedstring-perl6

558586 - iproute

@@ -561,6 +589,7 @@ packages:

561589 - multimap

562590 - parallel-io

563591 - text-binary

592+ - wl-pprint-text

564593

565594 "Michael Sloan <mgsloan@gmail.com":

566595 - th-orphans

@@ -574,7 +603,7 @@ packages:

574603 - hasql-backend

575604 - hasql-postgres

576605 - list-t

577− - mtl-prelude < 2

606+ - mtl-prelude < 2 # GHC 7.10 bump

578607 - neat-interpolation

579608 - partial-handler

580609 - postgresql-binary

@@ -588,6 +617,11 @@ packages:

588617 - graph-core

589618 - reroute

590619 - Spock

620+ - Spock-digestive

621+ - Spock-worker

622+ - users

623+ - users-test

624+ - users-postgresql-simple

591625

592626 "Joey Eremondi <joey@eremondi.com>":

593627 - aeson-pretty

@@ -617,43 +651,138 @@ packages:

617651 "Samplecount stefan@samplecount.com @kaoskorobase":

618652 - shake-language-c

619653

654+ "Marcin Mrotek <marcin.jan.mrotek@gmail.com>":

655+ - diagrams-hsqml

656+ - type-list

657+ - vinyl-utils

658+

620659 "Marcin Mrotek <marcin.jan.mrotek@gmail.com>":

621660 - type-list

622−

661+

623662 "David Turner <dave.c.turner@gmail.com>":

624663 - alarmclock

625664 - bank-holidays-england

626665

666+ "Haskell Servant jkarni@gmail.com @jkarni":

667+ - servant

668+ - servant-client

669+ - servant-docs

670+ - servant-jquery

671+ - servant-server

672+

673+ "Alexandr Ruchkin voidex@live.com @mvoidex":

674+ - hdocs

675+ - hsdev

676+

677+ "Aleksey Kliger aleksey@lambdageek.org @lambdageek":

678+ - unbound-generics

679+

680+ "Alois Cochard alois.cochard@gmail.com @aloiscochard":

681+ - codex

682+ - machines-directory

683+ - machines-io

684+ - machines-process

685+ # on behalf of Bryan O'Sullivan @bos

686+ - wreq

687+

688+ "Andraz Bajt andraz@bajt.me @edofic":

689+ - effect-handlers

690+ - koofr-client

691+ - snowflake

692+

693+ "Leza M. Lutonda lemol-c@hotmail.com @lemol":

694+ - HaskellNet

695+

696+ "Jens Petersen juhpetersen@gmail.com @juhp":

697+ - cabal-rpm

698+

699+ "Renzo Carbonara renzocarbonara@gmail.com @k0001":

700+ - network-simple

701+ - pipes-aeson

702+ - pipes-attoparsec

703+ - pipes-binary

704+ - pipes-network

705+

706+ "Tomas Carnecky":

707+ - rethinkdb-client-driver

708+

709+ "Alexandr Kurilin alex@kurilin.net @alex_kurilin":

710+ - bcrypt

711+

712+ "Jeffrey Rosenbluth jeffrey.rosenbluth@gmail.com":

713+ - palette

714+ - diagrams-canvas

715+ - diagrams-rasterific

716+ - lucid-svg

717+

718+ "Gabríel Arthúr Pétursson gabriel@system.is":

719+ - sdl2

720+

721+ "Leon Mergen leon@solatis.com @solatis":

722+ - network-attoparsec

723+ - network-anonymous-i2p

724+

725+ "Timothy Jones git@zmthy.io @zmthy":

726+ - cabal-test-quickcheck

727+ - http-media

728+

729+ "Greg V greg@unrelenting.technology @myfreeweb":

730+ - gitson

731+ - pcre-heavy

732+

733+ "Francesco Mazzoli f@mazzo.li @bitonic":

734+ - language-c-quote

735+

736+ "Sönke Hahn soenkehahn@gmail.com @soenkehahn":

737+ - string-conversions

738+

739+ "Oleg Grenrus oleg.grenrus@iki.fi @phadej":

740+ - waitra

741+

627742 "Stackage upper bounds":

628743

629744 # Force a specific version that's compatible with transformers 0.3

630− - transformers-compat == 0.3.3.3

631−

632− # https://github.com/fpco/stackage/issues/291

633− - random < 1.0.1.3

634−

635− # https://github.com/fpco/stackage/issues/318

636− - HaXml < 1.25

637−

638− # https://github.com/fpco/stackage/issues/319

639− - polyparse < 1.10

640−

641− # https://github.com/fpco/stackage/issues/370

642− - monad-control < 1

643− - hasql < 0.5

644− - list-t < 0.4

645−

646−# Global flags are applied to all packages

647−global-flags:

648− blaze_html_0_5: true

649− small_base: true

650− https: true

651− splitbase: true

652− old-locale: true

653− new-base: true

654− bytestring-in-base: false

655− test-hlint: false

656− network-uri: true

745+ - transformers-compat == 0.4.0.3

746+

747+ # https://github.com/fpco/stackage/issues/390

748+ # NOTE: When this issue is resolved, remove the expected test failure

749+ # for language-ecmascript as well.

750+ - language-ecmascript < 0.17

751+

752+ # https://github.com/fpco/stackage/issues/407

753+ - HStringTemplate < 0.8

754+

755+ # https://github.com/fpco/stackage/issues/410

756+ - elm-package < 0.4

757+

758+ # https://github.com/fpco/stackage/issues/415

759+ - hackage-db < 1.12

760+

761+ # https://github.com/fpco/stackage/issues/424

762+ - control-monad-free < 0.6

763+

764+ # https://github.com/fpco/stackage/issues/426

765+ - utf8-string < 1

766+

767+ # https://github.com/fpco/stackage/issues/440

768+ - th-orphans < 0.9

769+ - file-location < 0.4.7

770+

771+ # https://github.com/fpco/stackage/issues/442

772+ - blaze-builder < 0.4

773+ - blaze-markup < 0.7

774+ - blaze-html < 0.8

775+

776+ # https://github.com/fpco/stackage/issues/443

777+ - exceptions < 0.7

778+ - rest-client < 0.5

779+ - rest-types < 1.13

780+ - rest-core < 0.35

781+ - rest-gen < 0.17

782+ - rest-wai < 0.1.0.7

783+

784+ # https://github.com/fpco/stackage/issues/467

785+ - lens < 4.8

657786

658787# Package flags are applied to individual packages, and override the values of

659788# global-flags

@@ -672,6 +801,44 @@ package-flags:

672801 simplelocalnet: true

673802 p2p: true

674803

804+ # GHC 7.10: Remove this

805+ # Note that the flag is lower-cased, because that's what Cabal does

806+ # Perhaps the codebase should automatically lower case flag names?

807+ storable-complex:

808+ instanceinbase: false

809+

810+ logfloat:

811+ splitbase: true

812+

813+ curl:

814+ new-base: true

815+

816+ # GHC 7.10 remove

817+ aeson:

818+ old-locale: true

819+ tttool:

820+ old-locale: true

821+

822+ hxt:

823+ network-uri: true

824+ hxt-http:

825+ network-uri: true

826+ hxt-relaxng:

827+ network-uri: true

828+

829+ pandoc:

830+ https: true

831+

832+ text:

833+ integer-simple: false

834+

835+ tar:

836+ old-time: false

837+

838+ mtl-compat:

839+ two-point-one: true

840+ two-point-two: false

841+

675842# By skipping a test suite, we do not pull in the build dependencies

676843skipped-tests:

677844 - ReadArgs # old version of hspec

@@ -718,17 +885,15 @@ skipped-tests:

718885 # https://github.com/fpco/stackage/pull/380#issuecomment-68060871

719886 - Rasterific

720887

888+ # https://github.com/Soostone/retry/issues/18

889+ - retry

890+

721891# Tests which we should build and run, but which are expected to fail. We

722892# should not fail a build based on a test failure for one of these packages.

723893expected-test-failures:

724894 # Requires an old version of WAI and Warp for tests

725895 - HTTP

726896

727− # text and setenv have recursive dependencies in their tests, which

728− # cabal can't (yet) handle

729− - text

730− - setenv

731−

732897 # https://github.com/bos/statistics/issues/42

733898 - statistics

734899

@@ -852,6 +1017,61 @@ expected-test-failures:

8521017 - crypto-numbers

8531018 - distributed-process-task

8541019

1020+ # https://github.com/vincenthz/hs-crypto-pubkey/issues/17

1021+ - crypto-pubkey

1022+

1023+ # https://github.com/jswebtools/language-ecmascript/issues/60

1024+ - language-ecmascript

1025+

1026+ # https://github.com/kazu-yamamoto/unix-time/issues/29

1027+ - unix-time

1028+

1029+ # Tests can fail when the build plan fails, which happens arbitrarily.

1030+ - stackage

1031+

1032+ # https://github.com/TomMD/DRBG/issues/7

1033+ - DRBG

1034+

1035+ # https://github.com/bos/wreq/issues/53

1036+ - wreq

1037+

1038+ # Requires local database running

1039+ - rethinkdb-client-driver

1040+

1041+ # https://github.com/haskell-distributed/distributed-process-execution/issues/2

1042+ - distributed-process-execution

1043+

1044+ # Seems to depend on mtl being installed in user package database, which

1045+ # isn't always the case (e.g., build server)

1046+ - happy

1047+

1048+ # https://github.com/jberryman/directory-tree/issues/4

1049+ - directory-tree

1050+

1051+ # https://github.com/zmthy/http-media/issues/11

1052+ - http-media

1053+

1054+ # https://github.com/ekmett/semigroupoids/issues/18

1055+ - semigroupoids

1056+

1057+ # https://github.com/ndmitchell/hoogle/issues/101

1058+ - hoogle

1059+

1060+ # https://github.com/myfreeweb/gitson/issues/1

1061+ - gitson

1062+

1063+ # https://github.com/jcristovao/enclosed-exceptions/issues/6

1064+ - enclosed-exceptions

1065+

1066+ # Expects a running PostgreSQL server

1067+ - users-postgresql-simple

1068+

1069+ # Problems with linking with system libraries on Ubuntu 12.04

1070+ - nettle

1071+

1072+ # Requires locally running services

1073+ - network-anonymous-i2p

1074+

8551075# Haddocks which are expected to fail. Same concept as expected test failures.

8561076expected-haddock-failures:

8571077 # https://github.com/acw/bytestring-progress/issues/4

@@ -860,6 +1080,12 @@ expected-haddock-failures:

8601080 # https://github.com/ekmett/gl/issues/4

8611081 - gl

8621082

1083+ # https://github.com/leventov/yarr/issues/5

1084+ - yarr

1085+

1086+ # https://github.com/wereHamster/rethinkdb-client-driver/issues/1

1087+ - rethinkdb-client-driver

1088+

8631089# Benchmarks which should not be built. Note that Stackage does *not* generally

8641090# build benchmarks. The difference here will be whether dependencies for these

8651091# benchmarks are included or not.

@@ -886,6 +1112,10 @@ skipped-benchmarks:

8861112 # sometimes falls out-of-sync on hasql-postgres

8871113 - hasql

8881114

1115+skipped-profiling:

1116+ # https://github.com/nomeata/ghc-heap-view/commit/8d198eb8fbbad2ce0c4527c781659f35b8909c04#diff-8288955e209cfbead5b318a8598be9c0R10

1117+ - ghc-heap-view

1118+

8891119# Mapping from Github account holding a package to the Github users who should

8901120# be pinged on failure. If no value is specified here, then the owning account

8911121# will be pinged.

@@ -908,3 +1138,5 @@ github-users:

9081138 - mightybyte

9091139 haskell-ro:

9101140 - mihaimaruseac

1141+ elm-lang:

1142+ - JoeyEremondi

cabal.config+1−1

@@ -647,7 +647,7 @@ constraints: abstract-deque ==0.3,

647647 semigroups ==0.16.0.1,

648648 sendfile ==0.7.9,

649649 seqloc ==0.6,

650− setenv ==0.1.1.1,

650+ setenv ==0.1.1.2,

651651 SHA ==1.6.4.1,

652652 shake ==0.14.2,

653653 shake-language-c ==0.6.3,

debian-bootstrap.sh+27−5

@@ -10,13 +10,17 @@

1010# instructions, see:

1111# http://www.stackage.org/install

1212

13−sudo add-apt-repository -y ppa:chris-lea/zeromq

14−sudo add-apt-repository -y ppa:floe/libtisch

15−sudo apt-get update

16−sudo apt-get install -y \

13+add-apt-repository -y ppa:chris-lea/zeromq

14+add-apt-repository -y ppa:floe/libtisch

15+add-apt-repository -y ppa:zoogie/sdl2-snapshots

16+apt-get update

17+apt-get install -y \

1718 build-essential \

1819 libncurses-dev \

1920 git \

21+ wget \

22+ m4 \

23+ texlive-full \

2024 libgmp3c2 \

2125 libgmp3-dev \

2226 zlib1g-dev \

@@ -33,11 +37,11 @@ sudo apt-get install -y \

3337 llvm \

3438 libbz2-dev \

3539 libjudy-dev \

40+ libsqlite3-dev \

3641 libmysqlclient-dev \

3742 libpq-dev \

3843 libicu-dev \

3944 libssl-dev \

40− nettle-dev \

4145 libgsl0-dev \

4246 libblas-dev \

4347 liblapack-dev \

@@ -46,4 +50,22 @@ sudo apt-get install -y \

4650 libnotify-dev \

4751 libgd2-xpm-dev \

4852 libyaml-dev \

53+ liblzma-dev \

54+ libsdl2-dev \

55+ libxss-dev \

4956 libzmq3-dev

57+

58+mkdir /tmp/nettle-build

59+(

60+cd /tmp/nettle-build

61+wget https://ftp.gnu.org/gnu/nettle/nettle-2.7.1.tar.gz

62+tar zxf nettle-2.7.1.tar.gz

63+cd nettle-2.7.1

64+./configure --prefix=/usr

65+make

66+make install

67+

68+mkdir -p /usr/lib/x86_64-linux-gnu/

69+ln -sfv /usr/lib/libnettle.so.4.7 /usr/lib/x86_64-linux-gnu/libnettle.so.4

70+)

71+rm -rf /tmp/nettle-build

stackage.cabal+7−1

@@ -1,5 +1,5 @@

11name: stackage

2−version: 0.4.0

2+version: 0.5.2

33synopsis: "Stable Hackage," tools for creating a vetted set of packages from Hackage.

44description: Please see <http://www.stackage.org/package/stackage> for a description and documentation.

55homepage: https://github.com/fpco/stackage

@@ -12,6 +12,7 @@ build-type: Simple

1212cabal-version: >=1.10

1313extra-source-files: README.md

1414 ChangeLog.md

15+ test/test-build-constraints.yaml

1516

1617library

1718 default-language: Haskell2010

@@ -22,7 +23,9 @@ library

2223 Stackage.BuildPlan

2324 Stackage.CheckBuildPlan

2425 Stackage.UpdateBuildPlan

26+ Stackage.GhcPkg

2527 Stackage.GithubPings

28+ Stackage.InstallBuild

2629 Stackage.PackageDescription

2730 Stackage.ServerBundle

2831 Stackage.Upload

@@ -62,6 +65,7 @@ library

6265 , streaming-commons >= 0.1.7.1

6366 , semigroups

6467 , xml-conduit

68+ , conduit

6569

6670executable stackage

6771 default-language: Haskell2010

@@ -69,6 +73,8 @@ executable stackage

6973 main-is: stackage.hs

7074 build-depends: base

7175 , stackage

76+ , optparse-applicative >= 0.11

77+ , system-filepath

7278 ghc-options: -rtsopts -threaded -with-rtsopts=-N

7379

7480test-suite spec

test/Stackage/BuildPlanSpec.hs+119−14

@@ -1,21 +1,66 @@

1+{-# LANGUAGE ScopedTypeVariables #-}

12{-# LANGUAGE OverloadedStrings, NoImplicitPrelude #-}

23module Stackage.BuildPlanSpec (spec) where

4−import Stackage.BuildPlan

5−import Stackage.Prelude

6−import Stackage.BuildConstraints

7−import Stackage.UpdateBuildPlan

8−import Test.Hspec

9−import qualified Data.Yaml as Y

10−import Distribution.Version (anyVersion)

115import qualified Data.Map as Map

12−import Network.HTTP.Client (withManager)

13−import Network.HTTP.Client.TLS (tlsManagerSettings)

6+import qualified Data.Map.Strict as M

7+import qualified Data.Set as S

8+import Data.Yaml

9+import qualified Data.Yaml as Y

10+import Distribution.Version

11+import Network.HTTP.Client

12+import Network.HTTP.Client.TLS (tlsManagerSettings)

13+import Stackage.BuildConstraints

14+import Stackage.BuildPlan

15+import Stackage.CheckBuildPlan

16+import Stackage.PackageDescription

17+import Stackage.Prelude

18+import Stackage.UpdateBuildPlan

19+import Test.Hspec

1420

1521spec :: Spec

16−spec = it "works" $ withManager tlsManagerSettings $ \man -> do

17− bc <- defaultBuildConstraints man

18− bp <- newBuildPlan bc

22+spec = do

23+ it "simple package set" $ check testBuildConstraints $ makePackageSet

24+ [("foo", [0, 0, 0], [("bar", thisV [0, 0, 0])])

25+ ,("bar", [0, 0, 0], [])]

26+ it "bad version range on depdendency fails" $ badBuildPlan $ makePackageSet

27+ [("foo", [0, 0, 0], [("bar", thisV [1, 1, 0])])

28+ ,("bar", [0, 0, 0], [])]

29+ it "nonexistent package fails to check" $ badBuildPlan $ makePackageSet

30+ [("foo", [0, 0, 0], [("nonexistent", thisV [0, 0, 0])])

31+ ,("bar", [0, 0, 0], [])]

32+ it "mutual cycles fail to check" $ badBuildPlan $ makePackageSet

33+ [("foo", [0, 0, 0], [("bar", thisV [0, 0, 0])])

34+ ,("bar", [0, 0, 0], [("foo", thisV [0, 0, 0])])]

35+ it "nested cycles fail to check" $ badBuildPlan $ makePackageSet

36+ [("foo", [0, 0, 0], [("bar", thisV [0, 0, 0])])

37+ ,("bar", [0, 0, 0], [("mu", thisV [0, 0, 0])])

38+ ,("mu", [0, 0, 0], [("foo", thisV [0, 0, 0])])]

39+ {- Shouldn't be testing this actually

40+ it "default package set checks ok" $

41+ check defaultBuildConstraints getLatestAllowedPlans

42+ -}

43+

44+-- | Checking should be considered a bad build plan.

45+badBuildPlan :: (BuildConstraints -> IO (Map PackageName PackagePlan))

46+ -> void

47+ -> IO ()

48+badBuildPlan m _ = do

49+ mu <- try (check testBuildConstraints m)

50+ case mu of

51+ Left (_ :: BadBuildPlan) ->

52+ return ()

53+ Right () ->

54+ error "Expected bad build plan."

55+

56+-- | Check build plan with the given package set getter.

57+check :: (Manager -> IO BuildConstraints)

58+ -> (BuildConstraints -> IO (Map PackageName PackagePlan))

59+ -> IO ()

60+check readPlanFile getPlans = withManager tlsManagerSettings $ \man -> do

61+ bc <- readPlanFile man

62+ plans <- getPlans bc

63+ bp <- newBuildPlan plans bc

1964 let bs = Y.encode bp

2065 ebp' = Y.decodeEither bs

2166

@@ -25,14 +70,74 @@ spec = it "works" $ withManager tlsManagerSettings $ \man -> do

2570 forM_ allPackages $ \name ->

2671 (name, lookup name (bpPackages bp')) `shouldBe`

2772 (name, lookup name (bpPackages bp))

28−

2973 bpGithubUsers bp' `shouldBe` bpGithubUsers bp

74+

3075 when (bp' /= bp) $ error "bp' /= bp"

31− bp2 <- updateBuildPlan bp

76+ bp2 <- updateBuildPlan plans bp

3277 when (dropVersionRanges bp2 /= dropVersionRanges bp) $ error "bp2 /= bp"

78+ checkBuildPlan bp

3379 where

3480 dropVersionRanges bp =

3581 bp { bpPackages = map go $ bpPackages bp }

3682 where

3783 go pb = pb { ppConstraints = go' $ ppConstraints pb }

3884 go' pc = pc { pcVersionRange = anyVersion }

85+

86+-- | Make a package set from a convenient data structure.

87+makePackageSet

88+ :: [(String,[Int],[(String,VersionRange)])]

89+ -> BuildConstraints

90+ -> IO (Map PackageName PackagePlan)

91+makePackageSet ps _ =

92+ return $

93+ M.fromList $

94+ map

95+ (\(name,ver,deps) ->

96+ ( PackageName name

97+ , dummyPackage ver $

98+ M.fromList $

99+ map

100+ (\(dname,dver) ->

101+ ( PackageName dname

102+ , DepInfo {diComponents = S.fromList

103+ [CompLibrary]

104+ ,diRange = dver}))

105+ deps))

106+ ps

107+ where

108+ dummyPackage v deps =

109+ PackagePlan

110+ {ppVersion = Version v []

111+ ,ppGithubPings = mempty

112+ ,ppUsers = mempty

113+ ,ppConstraints =

114+ PackageConstraints

115+ {pcVersionRange = anyV

116+ ,pcMaintainer = Nothing

117+ ,pcTests = Don'tBuild

118+ ,pcHaddocks = Don'tBuild

119+ ,pcBuildBenchmarks = False

120+ ,pcFlagOverrides = mempty

121+ ,pcEnableLibProfile = False}

122+ ,ppDesc =

123+ SimpleDesc

124+ {sdPackages = deps

125+ ,sdTools = mempty

126+ ,sdProvidedExes = mempty

127+ ,sdModules = mempty}}

128+

129+-- | This exact version is required.

130+thisV :: [Int] -> VersionRange

131+thisV ver = thisVersion (Version ver [])

132+

133+-- | Accept any version.

134+anyV :: VersionRange

135+anyV = anyVersion

136+

137+-- | Test plan.

138+testBuildConstraints :: void -> IO BuildConstraints

139+testBuildConstraints _ =

140+ decodeFileEither

141+ (fpToString fp) >>=

142+ either throwIO toBC

143+ where fp = "test/test-build-constraints.yaml"

test/test-build-constraints.yamlnew file+20

@@ -0,0 +1,20 @@

1+packages:

2+ "Test":

3+ - foo

4+ - bar

6+global-flags: []

8+skipped-tests: []

9+expected-test-failures: []

10+expected-haddock-failures: []

11+skipped-benchmarks: []

12+skipped-profiling: []

13+

14+github-users:

15+ bar:

16+ - demo

17+

18+package-flags:

19+ foo:

20+ demo: true