4e5ba05 · stackage · git.iko.soy

git.iko.soy/stackage

on master help sign in

Merge branch 'master' into ghc7.10

4e5ba05Michael Snoyman12 years ago

ChangeLog.md+8

compare with master

unifiedsplit

@@ -1,3 +1,11 @@

1+## 0.6.1

3+* Switch to V2 upload by default

5+## 0.6.0

7+* Upload bundle V2 stuff

1## 0.5.2

9## 0.5.2

3* Upload LTS to Hackage with the name LTSHaskell

11* Upload LTS to Hackage with the name LTSHaskell

Dockerfile+2−2

@@ -14,9 +14,9 @@ ADD debian-bootstrap.sh /tmp/debian-bootstrap.sh

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

15RUN rm /tmp/debian-bootstrap.sh

17−RUN DEBIAN_FRONTEND=noninteractive apt-get install -y cabal-install-1.20 ghc-7.8.4

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

19−ENV PATH /home/stackage/.cabal/bin:/usr/local/sbin:/usr/local/bin:/opt/ghc/7.8.4/bin:/opt/cabal/1.20/bin:/usr/sbin:/usr/bin:/sbin:/bin

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

21RUN cabal update

22ADD . /tmp/stackage

Stackage/BuildConstraints.hs+1−1

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

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

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

122 pcMaintainer <- o .:? "maintainer"

123− pcEnableLibProfile <- fmap (fromMaybe False) (o .:? "library-profiling")

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

124 return PackageConstraints {..}

125

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

Stackage/CompleteBuild.hs+82−40

@@ -8,6 +8,7 @@ module Stackage.CompleteBuild

8 , completeBuild

9 , justCheck

10 , justUploadNightly

11+ , getStackageAuthToken

11 ) where

12 ) where

13import Control.Concurrent (threadDelay)

14import Control.Concurrent (threadDelay)

@@ -33,10 +34,14 @@ import System.IO (BufferMode (LineBuffering), hSetBuffering)

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

34-- | Flags passed in from the command line.

34data BuildFlags = BuildFlags

35data BuildFlags = BuildFlags

35 { bfEnableTests :: !Bool

36 { bfEnableTests :: !Bool

37+ , bfEnableHaddock :: !Bool

36 , bfDoUpload :: !Bool

38 , bfDoUpload :: !Bool

37 , bfEnableLibProfile :: !Bool

39 , bfEnableLibProfile :: !Bool

40+ , bfEnableExecDyn :: !Bool

38 , bfVerbose :: !Bool

41 , bfVerbose :: !Bool

39 , bfSkipCheck :: !Bool

42 , bfSkipCheck :: !Bool

43+ , bfUploadV1 :: !Bool

44+ , bfServer :: !StackageServer

40 } deriving (Show)

45 } deriving (Show)

42data BuildType = Nightly | LTS BumpType

47data BuildType = Nightly | LTS BumpType

@@ -55,6 +60,8 @@ data Settings = Settings

55 , setArgs :: Text -> UploadBundle -> UploadBundle

60 , setArgs :: Text -> UploadBundle -> UploadBundle

56 , postBuild :: IO ()

61 , postBuild :: IO ()

57 , distroName :: Text -- ^ distro name on Hackage

62 , distroName :: Text -- ^ distro name on Hackage

63+ , snapshotType :: SnapshotType

64+ , bundleDest :: FilePath

58 }

65 }

60nightlyPlanFile :: Text -- ^ day

67nightlyPlanFile :: Text -- ^ day

@@ -66,7 +73,7 @@ nightlySettings :: Text -- ^ day

66 -> Settings

73 -> Settings

67nightlySettings day plan' = Settings

74nightlySettings day plan' = Settings

68 { planFile = nightlyPlanFile day

75 { planFile = nightlyPlanFile day

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

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

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

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

71 , title = \ghcVer -> concat

78 , title = \ghcVer -> concat

72 [ "Stackage Nightly "

79 [ "Stackage Nightly "

@@ -79,6 +86,8 @@ nightlySettings day plan' = Settings

79 , plan = plan'

86 , plan = plan'

80 , postBuild = return ()

87 , postBuild = return ()

81 , distroName = "Stackage"

88 , distroName = "Stackage"

89+ , snapshotType = STNightly

90+ , bundleDest = fpFromText $ "stackage-nightly-" ++ day ++ ".bundle"

82 }

91 }

83 where

92 where

84 slug' = "nightly-" ++ day

93 slug' = "nightly-" ++ day

@@ -119,7 +128,7 @@ getSettings man (LTS bumpType) = do

119

128

120 return Settings

129 return Settings

121 { planFile = newfile

130 { planFile = newfile

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

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

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

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

124 , title = \ghcVer -> concat

133 , title = \ghcVer -> concat

125 [ "LTS Haskell "

134 [ "LTS Haskell "

@@ -140,6 +149,10 @@ getSettings man (LTS bumpType) = do

140 putStrLn "Pushing to Git repository"

149 putStrLn "Pushing to Git repository"

141 git ["push"]

150 git ["push"]

142 , distroName = "LTSHaskell"

151 , distroName = "LTSHaskell"

152+ , snapshotType =

153+ case new of

154+ LTSVer x y -> STLTS x y

155+ , bundleDest = fpFromText $ "stackage-lts-" ++ tshow new ++ ".bundle"

143 }

156 }

144

157

145data LTSVer = LTSVer !Int !Int

158data LTSVer = LTSVer !Int !Int

@@ -203,7 +216,9 @@ getPerformBuild buildFlags Settings {..} = PerformBuild

203 , pbJobs = 8

216 , pbJobs = 8

204 , pbGlobalInstall = False

217 , pbGlobalInstall = False

205 , pbEnableTests = bfEnableTests buildFlags

218 , pbEnableTests = bfEnableTests buildFlags

219+ , pbEnableHaddock = bfEnableHaddock buildFlags

206 , pbEnableLibProfiling = bfEnableLibProfile buildFlags

220 , pbEnableLibProfiling = bfEnableLibProfile buildFlags

221+ , pbEnableExecDyn = bfEnableExecDyn buildFlags

207 , pbVerbose = bfVerbose buildFlags

222 , pbVerbose = bfVerbose buildFlags

208 , pbAllowNewer = bfSkipCheck buildFlags

223 , pbAllowNewer = bfSkipCheck buildFlags

209 }

224 }

@@ -227,10 +242,23 @@ completeBuild buildType buildFlags = withManager tlsManagerSettings $ \man -> do

227 checkBuildPlan plan

242 checkBuildPlan plan

228

243

229 putStrLn "Performing build"

244 putStrLn "Performing build"

230− performBuild (getPerformBuild buildFlags settings) >>= mapM_ putStrLn

245+ let pb = getPerformBuild buildFlags settings

246+ performBuild pb >>= mapM_ putStrLn

247+

248+ putStrLn $ "Creating bundle (v2) at: " ++ fpToText bundleDest

249+ createBundleV2 CreateBundleV2

250+ { cb2Plan = plan

251+ , cb2Type = snapshotType

252+ , cb2DocsDir = pbDocDir pb

253+ , cb2Dest = bundleDest

254+ }

231

255

232 when (bfDoUpload buildFlags) $

256 when (bfDoUpload buildFlags) $

233− finallyUpload settings man

257+ finallyUpload

258+ (not $ bfUploadV1 buildFlags)

259+ (bfServer buildFlags)

260+ settings

261+ man

234

262

235justUploadNightly

263justUploadNightly

236 :: Text -- ^ nightly date

264 :: Text -- ^ nightly date

@@ -238,40 +266,63 @@ justUploadNightly

238justUploadNightly day = do

266justUploadNightly day = do

239 plan <- decodeFileEither (fpToString $ nightlyPlanFile day)

267 plan <- decodeFileEither (fpToString $ nightlyPlanFile day)

240 >>= either throwM return

268 >>= either throwM return

241− withManager tlsManagerSettings $ finallyUpload $ nightlySettings day plan

269+ withManager tlsManagerSettings $ finallyUpload False def $ nightlySettings day plan

270+

271+getStackageAuthToken :: IO Text

272+getStackageAuthToken = do

273+ mtoken <- lookupEnv "STACKAGE_AUTH_TOKEN"

274+ case mtoken of

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

276+ Just token -> return $ pack token

242

277

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

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

244-- docs and a distro to hackage.

279-- docs and a distro to hackage.

280+finallyUpload :: Bool -- ^ use v2 upload

281+ -> StackageServer

245−finallyUpload :: Settings -> Manager -> IO ()

282+ -> Settings -> Manager -> IO ()

246−finallyUpload settings@Settings{..} man = do

283+finallyUpload useV2 server settings@Settings{..} man = do

247 putStrLn "Uploading bundle to Stackage Server"

284 putStrLn "Uploading bundle to Stackage Server"

248

285

249− mtoken <- lookupEnv "STACKAGE_AUTH_TOKEN"

286+ token <- getStackageAuthToken

250− token <-

251− case mtoken of

252− Nothing -> decodeUtf8 <$> readFile "/auth-token"

253− Just token -> return $ pack token

254−

255− now <- epochTime

256− let ghcVer = display $ siGhcVersion $ bpSystemInfo plan

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

258− { ubContents = serverBundle now (title ghcVer) slug plan

259− , ubAuthToken = token

260− }

261− putStrLn $ "New ident: " ++ unSnapshotIdent ident

262− forM_ mloc $ \loc ->

263− putStrLn $ "Track progress at: " ++ loc

264

287

265− postBuild `catchAny` print

288+ if useV2

289+ then do

290+ res <- flip uploadBundleV2 man UploadBundleV2

291+ { ub2Server = server

292+ , ub2AuthToken = token

293+ , ub2Bundle = bundleDest

294+ }

295+ putStrLn $ "New snapshot available at: " ++ res

296+ else do

297+ now <- epochTime

298+ let ghcVer = display $ siGhcVersion $ bpSystemInfo plan

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

300+ { ubContents = serverBundle now (title ghcVer) slug plan

301+ , ubAuthToken = token

302+ }

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

304+ forM_ mloc $ \loc ->

305+ putStrLn $ "Track progress at: " ++ loc

306+

307+ putStrLn "Uploading docs to Stackage Server"

308+ res1 <- tryAny $ uploadDocs UploadDocs

309+ { udServer = def

310+ , udAuthToken = token

311+ , udDocs = pbDocDir pb

312+ , udSnapshot = ident

313+ } man

314+ putStrLn $ "Doc upload response: " ++ tshow res1

315+

316+ putStrLn "Uploading doc map"

317+ tryAny (uploadDocMap UploadDocMap

318+ { udmServer = def

319+ , udmAuthToken = token

320+ , udmSnapshot = ident

321+ , udmDocDir = pbDocDir pb

322+ , udmPlan = plan

323+ } man) >>= print

266

324

267− putStrLn "Uploading docs to Stackage Server"

325+ postBuild `catchAny` print

268− res1 <- uploadDocs UploadDocs

269− { udServer = def

270− , udAuthToken = token

271− , udDocs = pbDocDir pb

272− , udSnapshot = ident

273− } man

274− putStrLn $ "Doc upload response: " ++ tshow res1

275

326

276 ecreds <- tryIO $ readFile "/hackage-creds"

327 ecreds <- tryIO $ readFile "/hackage-creds"

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

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

@@ -280,14 +331,5 @@ finallyUpload settings@Settings{..} man = do

280 res2 <- uploadHackageDistroNamed distroName plan username password man

331 res2 <- uploadHackageDistroNamed distroName plan username password man

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

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

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

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

283−

284− putStrLn "Uploading doc map"

285− uploadDocMap UploadDocMap

286− { udmServer = def

287− , udmAuthToken = token

288− , udmSnapshot = ident

289− , udmDocDir = pbDocDir pb

290− , udmPlan = plan

291− } man >>= print

292 where

334 where

293 pb = getPerformBuild (error "finallyUpload.buildFlags") settings

335 pb = getPerformBuild (error "finallyUpload.buildFlags") settings

Stackage/GhcPkg.hsnew file+104

@@ -0,0 +1,104 @@

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+ -> (PackageIdentifier -> IO ()) -- ^ callback to be used when unregistering a package

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

33+setupPackageDatabase mdb docDir log' toInstall onUnregister = do

34+ registered1 <- getRegisteredPackages flags

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

36+ case lookup name toInstall of

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

38+ _ -> return ()

39+ broken <- getBrokenPackages flags

40+ forM_ broken $ unregisterPackage log' onUnregister docDir flags

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

42+ <$> getRegisteredPackages flags

43+ where

44+ flags = ghcPkgFlags mdb

45+

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

47+ghcPkgFlags mdb =

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

49+ case mdb of

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

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

52+

53+-- | Get broken packages.

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

55+getBrokenPackages flags = do

56+ (_,ps) <- sourceProcessWithConsumer

57+ (proc

58+ "ghc-pkg"

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

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

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

62+

63+-- | Get available packages.

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

65+getRegisteredPackages flags = do

66+ (_,ps) <- sourceProcessWithConsumer

67+ (proc

68+ "ghc-pkg"

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

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

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

72+

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

74+parsePackageIdent :: Text -> Maybe PackageIdentifier

75+parsePackageIdent = fmap fst .

76+ listToMaybe .

77+ filter (null . snd) .

78+ readP_to_S parse . T.unpack

79+

80+-- | Unregister a package.

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

82+ -> (PackageIdentifier -> IO ()) -- ^ callback to be used when unregistering a package

83+ -> FilePath -- ^ doc directory

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

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

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

87+ onUnregister ident

88+

89+ -- Delete libraries

90+ sourceProcessWithConsumer

91+ (proc "ghc-pkg" ("describe" : flags ++ [unpack $ display ident]))

92+ (CT.decodeUtf8

93+ $= CT.lines

94+ $= CL.mapMaybe parseLibraryDir

95+ $= CL.mapM_ (void . tryIO . removeTree))

96+

97+ void (readProcessWithExitCode

98+ "ghc-pkg"

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

100+ "")

101+

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

103+ where

104+ parseLibraryDir = fmap fpFromText . stripPrefix "library-dirs: "

Stackage/InstallBuild.hs+4

@@ -28,7 +28,9 @@ data InstallFlags = InstallFlags

28 , ifJobs :: !Int

29 , ifGlobalInstall :: !Bool

30 , ifEnableTests :: !Bool

31+ , ifEnableHaddock :: !Bool

31 , ifEnableLibProfiling :: !Bool

32 , ifEnableLibProfiling :: !Bool

33+ , ifEnableExecDyn :: !Bool

32 , ifVerbose :: !Bool

34 , ifVerbose :: !Bool

33 , ifSkipCheck :: !Bool

35 , ifSkipCheck :: !Bool

34 } deriving (Show)

36 } deriving (Show)

@@ -48,7 +50,9 @@ getPerformBuild plan InstallFlags{..} =

48 , pbJobs = ifJobs

50 , pbJobs = ifJobs

49 , pbGlobalInstall = ifGlobalInstall

51 , pbGlobalInstall = ifGlobalInstall

50 , pbEnableTests = ifEnableTests

52 , pbEnableTests = ifEnableTests

53+ , pbEnableHaddock = ifEnableHaddock

51 , pbEnableLibProfiling = ifEnableLibProfiling

54 , pbEnableLibProfiling = ifEnableLibProfiling

55+ , pbEnableExecDyn = ifEnableExecDyn

52 , pbVerbose = ifVerbose

56 , pbVerbose = ifVerbose

53 , pbAllowNewer = ifSkipCheck

57 , pbAllowNewer = ifSkipCheck

54 }

58 }

Stackage/PerformBuild.hs+151−48

@@ -19,17 +19,18 @@ import qualified Data.Map as Map

19import Data.NonNull (fromNullable)

20import Filesystem (canonicalizePath, createTree,

21 getWorkingDirectory, isDirectory,

22− removeTree, rename)

22+ removeTree, rename, isFile, removeFile)

23import Filesystem.Path (parent)

24import qualified Filesystem.Path as F

25import Stackage.BuildConstraints

26import Stackage.BuildPlan

27+import Stackage.GhcPkg

27import Stackage.PackageDescription

28import Stackage.PackageDescription

28import Stackage.Prelude hiding (pi)

29import Stackage.Prelude hiding (pi)

29import System.Directory (findExecutable)

30import System.Directory (findExecutable)

30import System.Environment (getEnvironment)

31import System.Environment (getEnvironment)

31import System.IO (IOMode (WriteMode),

32import System.IO (IOMode (WriteMode),

32− withBinaryFile)

33+ openBinaryFile)

33import System.IO.Temp (withSystemTempDirectory)

34import System.IO.Temp (withSystemTempDirectory)

35data BuildException = BuildException (Map PackageName BuildFailure) [Text]

36data BuildException = BuildException (Map PackageName BuildFailure) [Text]

@@ -62,7 +63,9 @@ data PerformBuild = PerformBuild

62 , pbGlobalInstall :: Bool

63 , pbGlobalInstall :: Bool

63 -- ^ Register packages in the global database

64 -- ^ Register packages in the global database

64 , pbEnableTests :: Bool

65 , pbEnableTests :: Bool

66+ , pbEnableHaddock :: Bool

65 , pbEnableLibProfiling :: Bool

67 , pbEnableLibProfiling :: Bool

68+ , pbEnableExecDyn :: Bool

66 , pbVerbose :: Bool

69 , pbVerbose :: Bool

67 , pbAllowNewer :: Bool

70 , pbAllowNewer :: Bool

68 -- ^ Pass --allow-newer to cabal configure

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

@@ -89,7 +92,7 @@ waitForDeps toolMap packageMap activeComps bp pi action = do

89 Nothing

92 Nothing

90 | isCoreExe exe -> return ()

93 | isCoreExe exe -> return ()

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

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

92− -- | otherwise -> throwSTM $ ToolMissing exe

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

93 | otherwise -> return ()

96 | otherwise -> return ()

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

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

95 action

98 action

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

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

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

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

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

135

138

139+-- | Directory keeping previous result info

140+pbPrevResDir :: PerformBuild -> FilePath

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

142+

136performBuild :: PerformBuild -> IO [Text]

143performBuild :: PerformBuild -> IO [Text]

137performBuild pb = do

144performBuild pb = do

138 cwd <- getWorkingDirectory

145 cwd <- getWorkingDirectory

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

160 $ \ClosedStream Inherited Inherited -> return ()

167 $ \ClosedStream Inherited Inherited -> return ()

161

168

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

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

163− mapM_ removeTree' [pbInstallDest, pbLogDir]

170+ removeTree' pbLogDir

164

171

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

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

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

166− createTree $ parent db

174+ createTree $ parent db

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

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

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

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

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

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

170 copyBuiltInHaddocks (pbDocDir pb)

178 copyBuiltInHaddocks (pbDocDir pb)

171 pbLog $ encodeUtf8 "Finished copying built-in Haddocks\n"

179 pbLog $ encodeUtf8 "Finished copying built-in Haddocks\n"

@@ -186,7 +194,15 @@ performBuild' pb@PerformBuild {..} = withBuildDir $ \builddir -> do

186 env <- getEnvironment

194 env <- getEnvironment

187 haddockFiles <- newTVarIO mempty

195 haddockFiles <- newTVarIO mempty

188

196

197+ registeredPackages <- setupPackageDatabase

198+ (pbDatabase pb)

199+ (pbDocDir pb)

200+ pbLog

201+ (ppVersion <$> bpPackages pbPlan)

202+ (deletePreviousResults pb)

203+

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

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

205+ SingleBuild

190 { sbSem = sem

206 { sbSem = sem

191 , sbErrsVar = errsVar

207 , sbErrsVar = errsVar

192 , sbWarningsVar = warningsVar

208 , sbWarningsVar = warningsVar

@@ -248,8 +264,10 @@ data SingleBuild = SingleBuild

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

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

249 }

265 }

250

266

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

267+singleBuild :: PerformBuild

268+ -> Set PackageName -- ^ registered packages

269+ -> SingleBuild -> IO ()

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

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

253 withCounter sbActive

271 withCounter sbActive

254 $ handle updateErrs

272 $ handle updateErrs

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

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

@@ -261,22 +279,25 @@ singleBuild pb@PerformBuild {..} SingleBuild {..} =

261 let wfd comps =

279 let wfd comps =

262 waitForDeps sbToolMap sbPackageMap comps pbPlan sbPackageInfo

280 waitForDeps sbToolMap sbPackageMap comps pbPlan sbPackageInfo

263 . withTSem sbSem

281 . withTSem sbSem

264− wfd libComps buildLibrary

282+ withUnpacked <- wfd libComps buildLibrary

265

283

266− wfd testComps runTests

284+ wfd testComps (runTests withUnpacked)

267

285

286+ pname = piName sbPackageInfo

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

268− name = display $ piName sbPackageInfo

288+ name = display pname

269 namever = concat

289 namever = concat

270 [ name

290 [ name

271 , "-"

291 , "-"

272 , display $ ppVersion $ piPlan sbPackageInfo

292 , display $ ppVersion $ piPlan sbPackageInfo

273 ]

293 ]

274

294

275− runIn wdir outH cmd args =

295+ runIn wdir getOutH cmd args = do

296+ outH <- getOutH

276− withCheckedProcess cp $ \ClosedStream UseProvidedHandle UseProvidedHandle ->

297+ withCheckedProcess (cp outH) $ \ClosedStream UseProvidedHandle UseProvidedHandle ->

277 (return () :: IO ())

298 (return () :: IO ())

278 where

299 where

279− cp = (proc (unpack $ asText cmd) (map (unpack . asText) args))

300+ cp outH = (proc (unpack $ asText cmd) (map (unpack . asText) args))

280 { cwd = Just $ fpToString wdir

301 { cwd = Just $ fpToString wdir

281 , std_out = UseHandle outH

302 , std_out = UseHandle outH

282 , std_err = UseHandle outH

303 , std_err = UseHandle outH

@@ -302,8 +323,21 @@ singleBuild pb@PerformBuild {..} SingleBuild {..} =

302 testRunOut = pbLogDir </> fpFromText namever </> "test-run.out"

323 testRunOut = pbLogDir </> fpFromText namever </> "test-run.out"

303

324

304 wf fp inner' = do

325 wf fp inner' = do

326+ ref <- newIORef Nothing

327+ let cleanup = do

328+ mh <- readIORef ref

329+ forM_ mh hClose

330+ getH = do

331+ mh <- readIORef ref

332+ case mh of

333+ Just h -> return h

334+ Nothing -> mask_ $ do

305− createTree $ parent fp

335+ createTree $ parent fp

306− withBinaryFile (fpToString fp) WriteMode inner'

336+ h <- openBinaryFile (fpToString fp) WriteMode

337+ writeIORef ref $ Just h

338+ return h

339+

340+ inner' getH `finally` cleanup

307

341

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

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

309 when pbAllowNewer $ tell' "--allow-newer"

343 when pbAllowNewer $ tell' "--allow-newer"

@@ -317,6 +351,7 @@ singleBuild pb@PerformBuild {..} SingleBuild {..} =

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

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

318 when (pbEnableLibProfiling && pcEnableLibProfile) $

352 when (pbEnableLibProfiling && pcEnableLibProfile) $

319 tell' "--enable-library-profiling"

353 tell' "--enable-library-profiling"

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

320 where

355 where

321 tell' x = tell (x:)

356 tell' x = tell (x:)

322

357

@@ -330,22 +365,40 @@ singleBuild pb@PerformBuild {..} SingleBuild {..} =

330

365

331 PackageConstraints {..} = ppConstraints $ piPlan sbPackageInfo

366 PackageConstraints {..} = ppConstraints $ piPlan sbPackageInfo

332

367

333− buildLibrary = wf libOut $ \outH -> do

368+ buildLibrary = wf libOut $ \getOutH -> do

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

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

335− runChild outH a b

370+ runChild getOutH a b

371+

372+ isUnpacked <- newIORef False

373+ let withUnpacked inner = do

374+ unlessM (readIORef isUnpacked) $ do

336− log' $ "Unpacking " ++ namever

375+ log' $ "Unpacking " ++ namever

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

376+ runParent getOutH "cabal" ["unpack", namever]

338−

377+ writeIORef isUnpacked True

378+ inner

379+

380+ isConfiged <- newIORef False

381+ let withConfiged inner = withUnpacked $ do

382+ unlessM (readIORef isConfiged) $ do

339− log' $ "Configuring " ++ namever

383+ log' $ "Configuring " ++ namever

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

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

341−

385+ writeIORef isConfiged True

386+ inner

387+

388+ prevBuildResult <- getPreviousResult pb Build pident

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

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

391+ deletePreviousResults pb pident

392+

342− log' $ "Building " ++ namever

393+ log' $ "Building " ++ namever

343− run "cabal" ["build"]

394+ run "cabal" ["build"]

344−

395+

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

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

346− run "cabal" ["copy"]

397+ run "cabal" ["copy"]

347− withMVar sbRegisterMutex $ const $

398+ withMVar sbRegisterMutex $ const $

348− run "cabal" ["register"]

399+ run "cabal" ["register"]

400+

401+ savePreviousResult pb Build pident True

349

402

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

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

351 -- on top of our successful results

404 -- on top of our successful results

@@ -355,7 +408,11 @@ singleBuild pb@PerformBuild {..} SingleBuild {..} =

355 -- dependency's haddocks before this finishes

408 -- dependency's haddocks before this finishes

356 atomically $ putTMVar (piResult sbPackageInfo) True

409 atomically $ putTMVar (piResult sbPackageInfo) True

357

410

411+ prevHaddockResult <- getPreviousResult pb Haddock pident

412+ let needHaddock = pbEnableHaddock

413+ && checkPrevResult prevHaddockResult pcHaddocks

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

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

415+ when needHaddock $ withConfiged $ do

359 log' $ "Haddocks " ++ namever

416 log' $ "Haddocks " ++ namever

360 hfs <- readTVarIO sbHaddockFiles

417 hfs <- readTVarIO sbHaddockFiles

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

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

@@ -389,15 +446,21 @@ singleBuild pb@PerformBuild {..} SingleBuild {..} =

389 $ modifyTVar sbHaddockFiles

446 $ modifyTVar sbHaddockFiles

390 $ insertMap namever newPath

447 $ insertMap namever newPath

391

448

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

392 case (eres, pcHaddocks) of

450 case (eres, pcHaddocks) of

393 (Left e, ExpectSuccess) -> throwM e

451 (Left e, ExpectSuccess) -> throwM e

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

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

395 _ -> return ()

453 _ -> return ()

396

454

455+ return withUnpacked

456+

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

457+ runTests withUnpacked = wf testOut $ \getOutH -> do

398− let run = runChild outH

458+ let run = runChild getOutH

399

459

460+ prevTestResult <- getPreviousResult pb Test pident

400− when (pbEnableTests && pcTests /= Don'tBuild) $ do

461+ let needTest = pbEnableTests

462+ && checkPrevResult prevTestResult pcTests

463+ when needTest $ withUnpacked $ do

401 log' $ "Test configure " ++ namever

464 log' $ "Test configure " ++ namever

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

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

403

466

@@ -408,6 +471,7 @@ singleBuild pb@PerformBuild {..} SingleBuild {..} =

408 log' $ "Test run " ++ namever

471 log' $ "Test run " ++ namever

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

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

410

473

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

411 case (eres, pcTests) of

475 case (eres, pcTests) of

412 (Left e, ExpectSuccess) -> throwM e

476 (Left e, ExpectSuccess) -> throwM e

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

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

@@ -434,16 +498,6 @@ singleBuild pb@PerformBuild {..} SingleBuild {..} =

434renameOrCopy :: FilePath -> FilePath -> IO ()

498renameOrCopy :: FilePath -> FilePath -> IO ()

435renameOrCopy src dest = rename src dest `catchIO` \_ -> copyDir src dest

499renameOrCopy src dest = rename src dest `catchIO` \_ -> copyDir src dest

436

500

437−copyDir :: FilePath -> FilePath -> IO ()

438−copyDir src dest =

439− runResourceT $ sourceDirectoryDeep False src $$ mapM_C go

440− where

441− src' = src </> ""

442− go fp = forM_ (F.stripPrefix src' fp) $ \suffix -> do

443− let dest' = dest </> suffix

444− liftIO $ createTree $ parent dest'

445− sourceFile fp $$ (sinkFile dest' :: Sink ByteString (ResourceT IO) ())

446−

447copyBuiltInHaddocks :: FilePath -> IO ()

501copyBuiltInHaddocks :: FilePath -> IO ()

448copyBuiltInHaddocks docdir = do

502copyBuiltInHaddocks docdir = do

449 mghc <- findExecutable "ghc"

503 mghc <- findExecutable "ghc"

@@ -453,3 +507,52 @@ copyBuiltInHaddocks docdir = do

453 src <- canonicalizePath

507 src <- canonicalizePath

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

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

455 copyDir src docdir

509 copyDir src docdir

510+

511+------------- Previous results

512+

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

514+data ResultType = Build | Haddock | Test

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

516+

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

518+data PrevResult = PRNoResult | PRSuccess | PRFailure

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

520+

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

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

523+checkPrevResult _ Don'tBuild = False

524+checkPrevResult PRNoResult _ = True

525+checkPrevResult PRSuccess _ = False

526+checkPrevResult PRFailure ExpectSuccess = True

527+checkPrevResult PRFailure _ = False

528+

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

530+withPRPath pb rt ident inner = do

531+ createTree $ parent fp

532+ inner fp

533+ where

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

535+

536+successBS, failureBS :: ByteString

537+successBS = "success"

538+failureBS = "failure"

539+

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

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

542+ eres <- tryIO $ readFile fp

543+ return $ case eres of

544+ Right bs

545+ | bs == successBS -> PRSuccess

546+ | bs == failureBS -> PRFailure

547+ _ -> PRNoResult

548+

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

550+savePreviousResult pb rt ident res =

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

552+ if res then successBS else failureBS

553+

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

555+deletePreviousResults pb name =

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

557+ withPRPath pb rt name $ \fp ->

558+ void $ tryIO $ removeFile fp

Stackage/Prelude.hs+13

@@ -20,6 +20,9 @@ import Distribution.Version as X (Version (..),

20 VersionRange)

21import Distribution.Version as X (withinRange)

22import qualified Distribution.Version as C

23+import Filesystem (createTree)

24+import Filesystem.Path (parent)

25+import qualified Filesystem.Path as F

24unPackageName :: PackageName -> Text

27unPackageName :: PackageName -> Text

25unPackageName (PackageName str) = pack str

28unPackageName (PackageName str) = pack str

@@ -101,3 +104,13 @@ topologicalSort toFinal toDeps =

101data TopologicalSortException key = NoEmptyDeps (Map key (Set key))

104data TopologicalSortException key = NoEmptyDeps (Map key (Set key))

102 deriving (Show, Typeable)

105 deriving (Show, Typeable)

103instance (Show key, Typeable key) => Exception (TopologicalSortException key)

106instance (Show key, Typeable key) => Exception (TopologicalSortException key)

107+

108+copyDir :: FilePath -> FilePath -> IO ()

109+copyDir src dest =

110+ runResourceT $ sourceDirectoryDeep False src $$ mapM_C go

111+ where

112+ src' = src </> ""

113+ go fp = forM_ (F.stripPrefix src' fp) $ \suffix -> do

114+ let dest' = dest </> suffix

115+ liftIO $ createTree $ parent dest'

116+ sourceFile fp $$ (sinkFile dest' :: Sink ByteString (ResourceT IO) ())

Stackage/ServerBundle.hs+165−8

@@ -7,21 +7,31 @@ module Stackage.ServerBundle

7 , epochTime

8 , bpAllPackages

9 , docsListing

10+ , createBundleV2

11+ , CreateBundleV2 (..)

12+ , SnapshotType (..)

13+ , writeIndexStyle

14+ , DocMap

15+ , PackageDocs (..)

10 ) where

16 ) where

12import qualified Codec.Archive.Tar as Tar

18import qualified Codec.Archive.Tar as Tar

13import qualified Codec.Archive.Tar.Entry as Tar

19import qualified Codec.Archive.Tar.Entry as Tar

14import qualified Codec.Compression.GZip as GZip

20import qualified Codec.Compression.GZip as GZip

15import qualified Data.Map as M

21import qualified Data.Map as M

22+import Data.Aeson (ToJSON (..), (.=), object, FromJSON (..), (.:), withObject)

23+import System.IO.Temp (withTempDirectory)

16import qualified Data.Yaml as Y

24import qualified Data.Yaml as Y

17−import Filesystem (isFile)

25+import Filesystem (isFile, getWorkingDirectory, listDirectory, isDirectory, canonicalizePath)

18import Foreign.C.Types (CTime (CTime))

26import Foreign.C.Types (CTime (CTime))

19import Stackage.BuildConstraints

27import Stackage.BuildConstraints

20import Stackage.BuildPlan

28import Stackage.BuildPlan

21import Stackage.Prelude

29import Stackage.Prelude

30+import System.IO.Temp (withTempDirectory)

22import qualified System.PosixCompat.Time as PC

31import qualified System.PosixCompat.Time as PC

23import qualified Text.XML as X

32import qualified Text.XML as X

24import Text.XML.Cursor

33import Text.XML.Cursor

34+import System.PosixCompat.Files (createSymbolicLink)

26-- | Get current time

36-- | Get current time

27epochTime :: IO Tar.EpochTime

37epochTime :: IO Tar.EpochTime

@@ -73,13 +83,30 @@ serverBundle time title slug bp@BuildPlan {..} = GZip.compress $ Tar.write

73 map (\(PackageName name) -> name)

83 map (\(PackageName name) -> name)

74 (M.keys $ siCorePackages bpSystemInfo)

84 (M.keys $ siCorePackages bpSystemInfo)

86+-- | Package name is key

87+type DocMap = Map Text PackageDocs

88+data PackageDocs = PackageDocs

89+ { pdVersion :: Text

90+ , pdModules :: Map Text [Text]

91+ -- ^ module name, path

92+ }

93+instance ToJSON PackageDocs where

94+ toJSON PackageDocs {..} = object

95+ [ "version" .= pdVersion

96+ , "modules" .= pdModules

97+ ]

98+instance FromJSON PackageDocs where

99+ parseJSON = withObject "PackageDocs" $ \o -> PackageDocs

100+ <$> o .: "version"

101+ <*> o .: "modules"

102+

76docsListing :: BuildPlan

103docsListing :: BuildPlan

77 -> FilePath -- ^ docs directory

104 -> FilePath -- ^ docs directory

78− -> IO ByteString

105+ -> IO DocMap

79docsListing bp docsDir =

106docsListing bp docsDir =

80− fmap (Y.encode . fold) $ mapM go $ mapToList $ bpAllPackages bp

107+ fmap fold $ mapM go $ mapToList $ bpAllPackages bp

81 where

108 where

82− go :: (PackageName, Version) -> IO (Map Text Y.Value)

109+ go :: (PackageName, Version) -> IO DocMap

83 go (package, version) = do -- handleAny (const $ return mempty) $ do

110 go (package, version) = do -- handleAny (const $ return mempty) $ do

84 let dirname = fpFromText (concat

111 let dirname = fpFromText (concat

85 [ display package

112 [ display package

@@ -107,8 +134,138 @@ docsListing bp docsDir =

107 return $ if e

134 return $ if e

108 then asMap $ singletonMap name [fpToText dirname, href]

135 then asMap $ singletonMap name [fpToText dirname, href]

109 else mempty

136 else mempty

110− return $ singletonMap (display package) $ Y.object

137+ return $ singletonMap (display package) $ PackageDocs

111− [ "version" Y..= display version

138+ { pdVersion = display version

112− , "modules" Y..= m

139+ , pdModules = m

113− ]

140+ }

114 else return mempty

141 else return mempty

142+

143+data SnapshotType = STNightly

144+ | STLTS !Int !Int -- ^ major, minor

145+ deriving (Show, Read, Eq, Ord)

146+

147+instance ToJSON SnapshotType where

148+ toJSON STNightly = object

149+ [ "type" .= asText "nightly"

150+ ]

151+ toJSON (STLTS major minor) = object

152+ [ "type" .= asText "lts"

153+ , "major" .= major

154+ , "minor" .= minor

155+ ]

156+instance FromJSON SnapshotType where

157+ parseJSON = withObject "SnapshotType" $ \o -> do

158+ t <- o .: "type"

159+ case asText t of

160+ "nightly" -> return STNightly

161+ "lts" -> STLTS

162+ <$> o .: "major"

163+ <*> o .: "minor"

164+ _ -> fail $ "Unknown type for SnapshotType: " ++ unpack t

165+

166+data CreateBundleV2 = CreateBundleV2

167+ { cb2Plan :: BuildPlan

168+ , cb2Type :: SnapshotType

169+ , cb2DocsDir :: FilePath

170+ , cb2Dest :: FilePath

171+ }

172+

173+-- | Create a V2 bundle, which contains the build plan, metadata, docs, and doc

174+-- map.

175+createBundleV2 :: CreateBundleV2 -> IO ()

176+createBundleV2 CreateBundleV2 {..} = do

177+ docsDir <- canonicalizePath cb2DocsDir

178+ docMap <- docsListing cb2Plan cb2DocsDir

179+

180+ Y.encodeFile (fpToString $ docsDir </> "build-plan.yaml") cb2Plan

181+ Y.encodeFile (fpToString $ docsDir </> "build-type.yaml") cb2Type

182+ Y.encodeFile (fpToString $ docsDir </> "docs-map.yaml") docMap

183+ void $ writeIndexStyle Nothing cb2DocsDir

184+

185+ currentDir <- getWorkingDirectory

186+ files <- listDirectory docsDir

187+

188+ let args = "cfJ"

189+ : fpToString (currentDir </> cb2Dest)

190+ : "--dereference"

191+ : map (fpToString . filename) files

192+ cp = (proc "tar" args) { cwd = Just $ fpToString docsDir }

193+ withCheckedProcess cp $ \ClosedStream Inherited Inherited -> return ()

194+

195+writeIndexStyle :: Maybe Text -- ^ snapshot id

196+ -> FilePath -- ^ docs dir

197+ -> IO [String]

198+writeIndexStyle msnapid dir = do

199+ dirs <- fmap sort

200+ $ runResourceT

201+ $ sourceDirectory dir

202+ $$ filterMC (liftIO . isDirectory)

203+ =$ mapC (fpToString . filename)

204+ =$ sinkList

205+ writeFile (dir </> "index.html") $ mkIndex

206+ (unpack <$> msnapid)

207+ dirs

208+ writeFile (dir </> "style.css") styleCss

209+ return dirs

210+

211+mkIndex :: Maybe String -> [String] -> String

212+mkIndex msnapid dirs = concat

213+ [ "<!DOCTYPE html>\n<html lang='en'><head><title>Haddocks index</title>"

214+ , "<link rel='stylesheet' href='https://maxcdn.bootstrapcdn.com/bootstrap/3.2.0/css/bootstrap.min.css'>"

215+ , "<link rel='stylesheet' href='style.css'>"

216+ , "<link rel='shortcut icon' href='http://www.stackage.org/static/img/favicon.ico' />"

217+ , "</head>"

218+ , "<body><div class='container'>"

219+ , "<div class='row'><div class='span12 col-md-12'>"

220+ , "<h1>Haddock documentation index</h1>"

221+ , flip foldMap msnapid $ \snapid -> concat

222+ [ "<p class='return'><a href=\"http://www.stackage.org/stackage/"

223+ , snapid

224+ , "\">Return to snapshot</a></p>"

225+ ]

226+ , "<ul>"

227+ , concatMap toLI dirs

228+ , "</ul></div></div></div></body></html>"

229+ ]

230+ where

231+ toLI name = concat

232+ [ "<li><a href='"

233+ , name

234+ , "/index.html'>"

235+ , name

236+ , "</a></li>"

237+ ]

238+

239+styleCss :: String

240+styleCss = concat

241+ [ "@media (min-width: 530px) {"

242+ , "ul { -webkit-column-count: 2; -moz-column-count: 2; column-count: 2 }"

243+ , "}"

244+ , "@media (min-width: 760px) {"

245+ , "ul { -webkit-column-count: 3; -moz-column-count: 3; column-count: 3 }"

246+ , "}"

247+ , "ul {"

248+ , " margin-left: 0;"

249+ , " padding-left: 0;"

250+ , " list-style-type: none;"

251+ , "}"

252+ , "body {"

253+ , " background: #f0f0f0;"

254+ , " font-family: 'Lato', sans-serif;"

255+ , " text-shadow: 1px 1px 1px #ffffff;"

256+ , " font-size: 20px;"

257+ , " line-height: 30px;"

258+ , " padding-bottom: 5em;"

259+ , "}"

260+ , "h1 {"

261+ , " font-weight: normal;"

262+ , " color: #06537d;"

263+ , " font-size: 45px;"

264+ , "}"

265+ , ".return a {"

266+ , " color: #06537d;"

267+ , " font-style: italic;"

268+ , "}"

269+ , ".return {"

270+ , " margin-bottom: 1em;"

271+ , "}"]

Stackage/Upload.hs+63−70

@@ -14,17 +14,26 @@ module Stackage.Upload

14 , uploadHackageDistroNamed

15 , UploadDocMap (..)

16 , uploadDocMap

17+ , uploadBundleV2

18+ , UploadBundleV2 (..)

19+ , def

20+ , StackageServer

21+ , unStackageServer

17 ) where

22 ) where

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

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

20import Data.Default.Class (Default (..))

25import Data.Default.Class (Default (..))

26+import Data.Function (fix)

21import Filesystem (isDirectory, isFile)

27import Filesystem (isDirectory, isFile)

22import Network.HTTP.Client

28import Network.HTTP.Client

29+import qualified Network.HTTP.Client.Conduit as HCC

23import Network.HTTP.Client.MultipartFormData

30import Network.HTTP.Client.MultipartFormData

24import Stackage.BuildPlan (BuildPlan)

31import Stackage.BuildPlan (BuildPlan)

25import Stackage.Prelude

32import Stackage.Prelude

26−import Stackage.ServerBundle (bpAllPackages, docsListing)

33+import Stackage.ServerBundle (bpAllPackages, docsListing, writeIndexStyle)

27import System.IO.Temp (withSystemTempFile)

34import System.IO.Temp (withSystemTempFile)

35+import qualified System.IO as IO

36+import qualified Data.Yaml as Y

29newtype StackageServer = StackageServer { unStackageServer :: Text }

38newtype StackageServer = StackageServer { unStackageServer :: Text }

30 deriving (Show, Eq, Ord, Hashable, IsString)

39 deriving (Show, Eq, Ord, Hashable, IsString)

@@ -107,17 +116,7 @@ uploadDocs (UploadDocs (StackageServer host) fp0 token ident) man = do

107 where

116 where

108 uploadDocsDir = withSystemTempFile "haddocks.tar.xz" $ \fp h -> do

117 uploadDocsDir = withSystemTempFile "haddocks.tar.xz" $ \fp h -> do

109 hClose h

118 hClose h

110− dirs <- fmap sort

111− $ runResourceT

112− $ sourceDirectory fp0

113− $$ filterMC (liftIO . isDirectory)

114− =$ mapC (fpToString . filename)

115− =$ sinkList

116− writeFile (fp0 </> "index.html") $ mkIndex

117− (unpack $ unSnapshotIdent ident)

119+ dirs <- writeIndexStyle (Just $ unSnapshotIdent ident) fp0

118− dirs

119− writeFile (fp0 </> "style.css") styleCss

120− -- FIXME write index.html, style.css

121 let cp = (proc "tar" $ "cJf" : fp : "index.html" : "style.css" : dirs)

120 let cp = (proc "tar" $ "cJf" : fp : "index.html" : "style.css" : dirs)

122 { cwd = Just $ fpToString fp0

121 { cwd = Just $ fpToString fp0

123 }

122 }

@@ -201,7 +200,7 @@ uploadDocMap :: UploadDocMap -> Manager -> IO (Response LByteString)

201uploadDocMap UploadDocMap {..} man = do

200uploadDocMap UploadDocMap {..} man = do

202 docmap <- docsListing udmPlan udmDocDir

201 docmap <- docsListing udmPlan udmDocDir

203 req1 <- parseUrl $ unpack $ unStackageServer udmServer ++ "/upload-doc-map"

202 req1 <- parseUrl $ unpack $ unStackageServer udmServer ++ "/upload-doc-map"

204− req2 <- formDataBody (formData docmap) req1

203+ req2 <- formDataBody (formData $ Y.encode docmap) req1

205 let req3 = req2

204 let req3 = req2

206 { method = "PUT"

205 { method = "PUT"

207 , requestHeaders =

206 , requestHeaders =

@@ -219,61 +218,55 @@ uploadDocMap UploadDocMap {..} man = do

219 , partFileRequestBody "docmap" "docmap" $ RequestBodyBS docmap

218 , partFileRequestBody "docmap" "docmap" $ RequestBodyBS docmap

220 ]

219 ]

221

220

222−mkIndex :: String -> [String] -> String

221+data UploadBundleV2 = UploadBundleV2

223−mkIndex snapid dirs = concat

222+ { ub2Server :: StackageServer

224− [ "<!DOCTYPE html>\n<html lang='en'><head><title>Haddocks index</title>"

223+ , ub2AuthToken :: Text

225− , "<link rel='stylesheet' href='https://maxcdn.bootstrapcdn.com/bootstrap/3.2.0/css/bootstrap.min.css'>"

224+ , ub2Bundle :: FilePath

226− , "<link rel='stylesheet' href='style.css'>"

225+ }

227− , "<link rel='shortcut icon' href='http://www.stackage.org/static/img/favicon.ico' />"

228− , "</head>"

229− , "<body><div class='container'>"

230− , "<div class='row'><div class='span12 col-md-12'>"

231− , "<h1>Haddock documentation index</h1>"

232− , "<p class='return'><a href=\"http://www.stackage.org/stackage/"

233− , snapid

234− , "\">Return to snapshot</a></p><ul>"

235− , concatMap toLI dirs

236− , "</ul></div></div></div></body></html>"

237− ]

238− where

239− toLI name = concat

240− [ "<li><a href='"

241− , name

242− , "/index.html'>"

243− , name

244− , "</a></li>"

245− ]

246

226

247−styleCss :: String

227+uploadBundleV2 :: UploadBundleV2 -> Manager -> IO Text

248−styleCss = concat

228+uploadBundleV2 UploadBundleV2 {..} man = IO.withBinaryFile (fpToString ub2Bundle) IO.ReadMode $ \h -> do

249− [ "@media (min-width: 530px) {"

229+ size <- IO.hFileSize h

250− , "ul { -webkit-column-count: 2; -moz-column-count: 2; column-count: 2 }"

230+ putStrLn $ "Bundle size: " ++ tshow size

251− , "}"

231+ req1 <- parseUrl $ unpack $ unStackageServer ub2Server ++ "/upload2"

252− , "@media (min-width: 760px) {"

232+ let req2 = req1

253− , "ul { -webkit-column-count: 3; -moz-column-count: 3; column-count: 3 }"

233+ { method = "PUT"

254− , "}"

234+ , requestHeaders =

255− , "ul {"

235+ [ ("Authorization", encodeUtf8 ub2AuthToken)

256− , " margin-left: 0;"

236+ , ("Accept", "application/json")

257− , " padding-left: 0;"

237+ , ("Content-Type", "application/x-tar")

258− , " list-style-type: none;"

238+ ]

259− , "}"

239+ , requestBody = HCC.requestBodySource (fromIntegral size)

260− , "body {"

240+ $ sourceHandle h $= printProgress size

261− , " background: #f0f0f0;"

241+ }

262− , " font-family: 'Lato', sans-serif;"

242+ sink = decodeUtf8C =$ fix (\loop -> do

263− , " text-shadow: 1px 1px 1px #ffffff;"

243+ mx <- peekC

264− , " font-size: 20px;"

244+ case mx of

265− , " line-height: 30px;"

245+ Nothing -> error $ "uploadBundleV2: premature end of stream"

266− , " padding-bottom: 5em;"

246+ Just _ -> do

267− , "}"

247+ l <- lineC $ takeCE 4096 =$ foldC

268− , "h1 {"

248+ let (cmd, msg') = break (== ':') l

269− , " font-weight: normal;"

249+ msg = dropWhile (== ' ') $ dropWhile (== ':') msg'

270− , " color: #06537d;"

250+ case cmd of

271− , " font-size: 45px;"

251+ "CONT" -> do

272− , "}"

252+ putStrLn msg

273− , ".return a {"

253+ loop

274− , " color: #06537d;"

254+ "FAILURE" -> error $ "uploadBundleV2 failed: " ++ unpack msg

275− , " font-style: italic;"

255+ "SUCCESS" -> return msg

276− , "}"

256+ _ -> error $ "uploadBundleV2: unknown command " ++ unpack cmd

277− , ".return {"

257+ )

278− , " margin-bottom: 1em;"

258+ withResponse req2 man $ \res -> HCC.bodyReaderSource (responseBody res) $$ sink

279− , "}"]

259+ where

260+ printProgress total =

261+ loop 0 0

262+ where

263+ loop sent lastPercent =

264+ await >>= maybe (putStrLn "Upload complete") go

265+ where

266+ go bs = do

267+ yield bs

268+ let sent' = sent + fromIntegral (length bs)

269+ percent = sent' * 100 `div` total

270+ when (percent /= lastPercent)

271+ $ putStrLn $ "Upload progress: " ++ tshow percent ++ "%"

272+ loop sent' percent

app/stackage.hs+55−2

@@ -10,7 +10,11 @@ import Options.Applicative

10import Filesystem.Path.CurrentOS (decodeString)

11import Paths_stackage (version)

12import Stackage.CompleteBuild

13+import Stackage.Upload

13import Stackage.InstallBuild

14import Stackage.InstallBuild

15+import Network.HTTP.Client (withManager)

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

17+import qualified Data.Text as T

15main :: IO ()

19main :: IO ()

16main =

20main =

@@ -62,7 +66,13 @@ main =

62 installBuild

66 installBuild

63 installFlags

67 installFlags

64 "install"

68 "install"

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

69+ "Install a snapshot from an existing build plan"

70+ , cmnd

71+ uploadv2

72+ uploadv2Flags

73+ "upload2"

74+ "Upload a pre-existing v2 bundle"

75+ ]

67 cmnd exec parse name desc =

77 cmnd exec parse name desc =

68 command name $

78 command name $

@@ -77,6 +87,11 @@ main =

77 (switch

87 (switch

78 (long "skip-tests" <>

88 (long "skip-tests" <>

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

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

90+ fmap

91+ not

92+ (switch

93+ (long "skip-haddock" <>

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

80 fmap

95 fmap

81 not

96 not

82 (switch

97 (switch

@@ -85,12 +100,23 @@ main =

85 switch

100 switch

86 (long "enable-library-profiling" <>

101 (long "enable-library-profiling" <>

87 help "Enable profiling when building") <*>

102 help "Enable profiling when building") <*>

103+ switch

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

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

88 switch

106 switch

89 (long "verbose" <> short 'v' <>

107 (long "verbose" <> short 'v' <>

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

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

91 switch

109 switch

92 (long "skip-check" <>

110 (long "skip-check" <>

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

111+ help "Skip the check phase, and pass --allow-newer to cabal configure") <*>

112+ switch

113+ (long "upload-v1" <>

114+ help "Use the V1 upload code") <*>

115+ (fmap fromString (strOption

116+ (long "server-url" <>

117+ metavar "SERVER-URL" <>

118+ showDefault <> value (T.unpack $ unStackageServer def) <>

119+ help "Server to upload bundle to")))

120

95 nightlyUploadFlags = fromString <$> strArgument

121 nightlyUploadFlags = fromString <$> strArgument

96 (metavar "DATE" <>

122 (metavar "DATE" <>

@@ -136,12 +162,39 @@ main =

136 (switch

162 (switch

137 (long "skip-tests" <>

163 (long "skip-tests" <>

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

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

165+ fmap

166+ not

167+ (switch

168+ (long "skip-haddock" <>

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

139 switch

170 switch

140 (long "enable-library-profiling" <>

171 (long "enable-library-profiling" <>

141 help "Enable profiling when building") <*>

172 help "Enable profiling when building") <*>

173+ switch

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

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

142 switch

176 switch

143 (long "verbose" <> short 'v' <>

177 (long "verbose" <> short 'v' <>

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

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

145 switch

179 switch

146 (long "skip-check" <>

180 (long "skip-check" <>

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

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

182+

183+ uploadv2 (path, url) = withManager tlsManagerSettings $ \man -> do

184+ token <- getStackageAuthToken

185+ res <- flip uploadBundleV2 man UploadBundleV2

186+ { ub2AuthToken = token

187+ , ub2Server = fromString url

188+ , ub2Bundle = decodeString path

189+ }

190+ putStrLn $ "New URL: " ++ T.unpack res

191+

192+ uploadv2Flags = (,)

193+ <$> (strArgument

194+ (metavar "BUNDLE-PATH" <>

195+ help "Bundle path"))

196+ <*> strOption

197+ (long "server-url" <>

198+ metavar "SERVER-URL" <>

199+ showDefault <> value (T.unpack $ unStackageServer def) <>

200+ help "Server to upload bundle to")

build-constraints.yaml+95−23

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

379 - pipes

380 - pipes-parse

381 - pipes-concurrency

382+ - pipes-safe

382

383

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

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

384 - bloodhound

385 - bloodhound

@@ -390,9 +391,12 @@ packages:

390 - fay-jquery

391 - fay-jquery

391 - fay-text

392 - fay-text

392 - fay-uri

393 - fay-uri

393− - fclabels

394 - snaplet-fay

395

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

397+ - clay

398+ - fclabels

399+

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

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

397 - messagepack

401 - messagepack

398 - messagepack-rpc

402 - messagepack-rpc

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

473 - openpgp-asciiarmor

477 - openpgp-asciiarmor

474 - MusicBrainz

478 - MusicBrainz

475 - DAV

479 - DAV

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

476− - hopenpgp-tools

481+ #- hopenpgp-tools

477

482

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

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

479 "Ketil Malde":

484 "Ketil Malde":

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

503 - code-builder

508 - code-builder

504 - fay-builder

509 - fay-builder

505 - generic-aeson

510 - generic-aeson

511+ - generic-xmlpickler

506 - hxt-pickle-utils

512 - hxt-pickle-utils

507 - imagesize-conduit

513 - imagesize-conduit

508− - imagesize-conduit

509 - json-schema

514 - json-schema

510 - multipart

515 - multipart

511 - regular-xmlpickler

516 - regular-xmlpickler

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

518 - rest-types

523 - rest-types

519 - rest-wai

524 - rest-wai

520 - tostring

525 - tostring

521− - tostring

522− - uri-encode

523 - uri-encode

526 - uri-encode

524

527

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

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

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

529 - io-manager

532 - io-manager

530

533

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

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

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

536+ # - al

532 - monad-journal

537 - monad-journal

538+ - smoothie

533

539

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

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

535 - ghc-syb-utils

541 - ghc-syb-utils

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

574 - haddock-api

580 - haddock-api

575 - here

581 - here

576 - hlibgit2

582 - hlibgit2

583+ - gitlib-libgit2

577 - hostname-validate

584 - hostname-validate

578 - interpolatedstring-perl6

585 - interpolatedstring-perl6

579 - iproute

586 - iproute

@@ -612,6 +619,9 @@ packages:

612 - Spock

619 - Spock

613 - Spock-digestive

620 - Spock-digestive

614 - Spock-worker

621 - Spock-worker

622+ - users

623+ - users-test

624+ - users-postgresql-simple

615

625

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

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

617 - aeson-pretty

627 - aeson-pretty

@@ -641,6 +651,11 @@ packages:

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

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

642 - shake-language-c

652 - shake-language-c

643

653

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

655+ - diagrams-hsqml

656+ - type-list

657+ - vinyl-utils

658+

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

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

645 - type-list

660 - type-list

646

661

@@ -703,19 +718,37 @@ packages:

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

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

704 - sdl2

719 - sdl2

705

720

706− "Stackage upper bounds":

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

707

735

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

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

709− - random < 1.0.1.3

737+ - string-conversions

738+

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

740+ - waitra

741+

742+ "Adam C. Foltzer acfoltzer@galois.com @acfoltzer":

743+ - gitrev

744+

745+ "Stackage upper bounds":

710

746

711 # https://github.com/fpco/stackage/issues/390

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

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

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

713 # for language-ecmascript as well.

749 # for language-ecmascript as well.

714 - language-ecmascript < 0.17

750 - language-ecmascript < 0.17

715

751

716− # https://github.com/fpco/stackage/issues/402

717− - vector-space < 0.9

718−

719 # https://github.com/fpco/stackage/issues/407

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

720 - HStringTemplate < 0.8

753 - HStringTemplate < 0.8

721

754

@@ -731,22 +764,32 @@ packages:

731 # https://github.com/fpco/stackage/issues/426

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

732 - utf8-string < 1

765 - utf8-string < 1

733

766

734− # https://github.com/d12frosted/CanonicalPath/issues/3

735− - system-canonicalpath < 0.3

736−

737 # https://github.com/fpco/stackage/issues/440

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

738 - th-orphans < 0.9

768 - th-orphans < 0.9

739 - file-location < 0.4.7

769 - file-location < 0.4.7

770+ - th-desugar < 1.5.1

740

771

741 # https://github.com/fpco/stackage/issues/442

772 # https://github.com/fpco/stackage/issues/442

742 - blaze-builder < 0.4

773 - blaze-builder < 0.4

774+ - blaze-markup < 0.7

775+ - blaze-html < 0.8

743

776

744 # https://github.com/fpco/stackage/issues/443

777 # https://github.com/fpco/stackage/issues/443

745 - exceptions < 0.7

778 - exceptions < 0.7

746− - resourcet < 1.1.4

779+ - rest-client < 0.5

780+ - rest-types < 1.13

781+ - rest-core < 0.35

782+ - rest-gen < 0.17

783+ - rest-wai < 0.1.0.7

784+

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

786+ - lens < 4.8

747

787

748− # https://github.com/fpco/stackage/issues/445

788+ # https://github.com/fpco/stackage/issues/476

749− - semigroupoids < 4.3

789+ - vector-space < 0.10

790+

791+ # https://github.com/ekmett/linear/issues/70

792+ - linear < 1.18

750

793

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

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

752# global-flags

795# global-flags

@@ -918,9 +961,6 @@ expected-test-failures:

918 # https://github.com/BioHaskell/octree/issues/4

961 # https://github.com/BioHaskell/octree/issues/4

919 - Octree

962 - Octree

920

963

921− # https://github.com/goldfirere/th-desugar/issues/12

922− - th-desugar

923−

924 # https://github.com/jmillikin/haskell-filesystem/issues/3

964 # https://github.com/jmillikin/haskell-filesystem/issues/3

925 - system-filepath

965 - system-filepath

926

966

@@ -993,20 +1033,52 @@ expected-test-failures:

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

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

994 - distributed-process-execution

1034 - distributed-process-execution

995

1035

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

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

1038+ - happy

1039+

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

1041+ - directory-tree

1042+

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

1044+ - http-media

1045+

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

1047+ - semigroupoids

1048+

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

1050+ - hoogle

1051+

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

1053+ - gitson

1054+

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

1056+ - enclosed-exceptions

1057+

1058+ # Expects a running PostgreSQL server

1059+ - users-postgresql-simple

1060+

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

1062+ - nettle

1063+

1064+ # Requires locally running services

1065+ - network-anonymous-i2p

1066+

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

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

997expected-haddock-failures:

1068expected-haddock-failures:

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

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

999 - bytestring-progress

1070 - bytestring-progress

1000

1071

1001− # https://github.com/ekmett/gl/issues/4

1002− - gl

1003−

1004 # https://github.com/leventov/yarr/issues/5

1072 # https://github.com/leventov/yarr/issues/5

1005 - yarr

1073 - yarr

1006

1074

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

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

1008 - rethinkdb-client-driver

1076 - rethinkdb-client-driver

1009

1077

1078+ # Requires build before haddock, which doesn't always happen in incremental

1079+ # builds. Could consider special-casing this requirement.

1080+ - gtk

1081+

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

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

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

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

1012# benchmarks are included or not.

1084# benchmarks are included or not.

debian-bootstrap.sh+20−1

@@ -18,6 +18,9 @@ apt-get install -y \

18 build-essential \

19 libncurses-dev \

20 git \

21+ wget \

22+ m4 \

23+ texlive-full \

21 libgmp3c2 \

24 libgmp3c2 \

22 libgmp3-dev \

25 libgmp3-dev \

23 zlib1g-dev \

26 zlib1g-dev \

@@ -34,11 +37,11 @@ apt-get install -y \

34 llvm \

37 llvm \

35 libbz2-dev \

38 libbz2-dev \

36 libjudy-dev \

39 libjudy-dev \

40+ libsqlite3-dev \

37 libmysqlclient-dev \

41 libmysqlclient-dev \

38 libpq-dev \

42 libpq-dev \

39 libicu-dev \

43 libicu-dev \

40 libssl-dev \

44 libssl-dev \

41− nettle-dev \

42 libgsl0-dev \

45 libgsl0-dev \

43 libblas-dev \

46 libblas-dev \

44 liblapack-dev \

47 liblapack-dev \

@@ -49,4 +52,20 @@ apt-get install -y \

49 libyaml-dev \

52 libyaml-dev \

50 liblzma-dev \

53 liblzma-dev \

51 libsdl2-dev \

54 libsdl2-dev \

55+ libxss-dev \

52 libzmq3-dev

56 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 @@

1name: stackage

2−version: 0.5.2

2+version: 0.6.0.1

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

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

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

@@ -23,6 +23,7 @@ library

23 Stackage.BuildPlan

24 Stackage.CheckBuildPlan

25 Stackage.UpdateBuildPlan

26+ Stackage.GhcPkg

26 Stackage.GithubPings

27 Stackage.GithubPings

27 Stackage.InstallBuild

28 Stackage.InstallBuild

28 Stackage.PackageDescription

29 Stackage.PackageDescription

@@ -54,6 +55,7 @@ library

54 , yaml

55 , yaml

55 , unix-compat

56 , unix-compat

56 , http-client

57 , http-client

58+ , http-conduit

57 , http-client-tls

59 , http-client-tls

58 , temporary

60 , temporary

59 , data-default-class

61 , data-default-class

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

63 , streaming-commons >= 0.1.7.1

65 , streaming-commons >= 0.1.7.1

64 , semigroups

66 , semigroups

65 , xml-conduit

67 , xml-conduit

68+ , conduit

67executable stackage

70executable stackage

68 default-language: Haskell2010

71 default-language: Haskell2010

@@ -72,6 +75,9 @@ executable stackage

72 , stackage

75 , stackage

73 , optparse-applicative >= 0.11

76 , optparse-applicative >= 0.11

74 , system-filepath

77 , system-filepath

78+ , http-client

79+ , http-client-tls

80+ , text

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

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

77test-suite spec

83test-suite spec