git.iko.soy/stackage
on master help sign in
Separate out stackage-curator
commit1891c1bfa79910555aeed6f105672acf8296d642 authorMichael Snoyman <michael@snoyman.com> dateSun 22 Mar 2015, 13:25 (12 years ago) parent8f95d18
30 files changed+9−4383
compare with master
unifiedsplit
.gitignore−9 ChangeLog.md−64 Dockerfile−25 README.md+8−4 Setup.hs−2 Stackage/BuildConstraints.hs−234 Stackage/BuildPlan.hs−214 Stackage/CheckBuildPlan.hs−162 Stackage/CompleteBuild.hs−337 Stackage/CorePackages.hs−53 Stackage/GhcPkg.hs−104 Stackage/GithubPings.hs−36 Stackage/InstallBuild.hs−102 Stackage/PackageDescription.hs−200 Stackage/PackageIndex.hs−127 Stackage/PerformBuild.hs−560 Stackage/Prelude.hs−116 Stackage/ServerBundle.hs−271 Stackage/UpdateBuildPlan.hs−54 Stackage/Upload.hs−272 app/stackage.hs−210 build-constraints.yaml+1 cabal.config−847 debian-bootstrap.sh−71 stackage.cabal−105 test/Spec.hs−1 test/Stackage/BuildPlanSpec.hs−143 test/Stackage/CorePackagesSpec.hs−19 test/Stackage/PackageIndexSpec.hs−21 test/test-build-constraints.yaml−20
.gitignore−9
@@ -1,13 +1,4 @@
1−dist
2−*.o
3−*.hi
4−*.chi
5−*.chs.h
6−*.swp
71/builds/
82/logs/
9−/.cabal-sandbox/
10−cabal.sandbox.config
113nightly-*.yaml
124lts-*.yaml
13−/tarballs/
ChangeLog.mddeleted−64
@@ -1,64 +0,0 @@
1−## 0.6.1
2−
3−* Switch to V2 upload by default
4−* --skip-hoogle option
5−
6−## 0.6.0
7−
8−* Upload bundle V2 stuff
9−
10−## 0.5.2
11−
12−* Upload LTS to Hackage with the name LTSHaskell
13−
14−## 0.5.1
15−
16−* `loadBuildConstraints`
17−* More command line options
18−
19−## 0.5.0
20−
21−* Print "Still Alive" while checking, to avoid Travis timeouts
22−* Include `stackage upload-nightly` command
23−* Optional plan checking
24−
25−## 0.4.0
26−
27−* Command line uses optparse-applicative with additional options
28−* Library profiling support during build
29−* Remove cfGlobalFlags (just use package-specific flags)
30−
31−## 0.3.1
32−
33−* Added `justCheck` and `stackage check` command line.
34−
35−## 0.3.0.1
36−
37−Pre-fetch all packages from Hackage to catch Hackage downtime early.
38−
39−## 0.3.0.0
40−
41−* Return progress URL from uploadBundle
42−
43−## 0.2.1.4
44−
45−Generate a `core` file in bundles.
46−
47−## 0.2.1.1
48−
49−Run postBuild earlier to avoid problems from broken doc uploads.
50−
51−## 0.2.1.0
52−
53−* Use TLS manager (to download from Github)
54−
55−## 0.2.0.0
56−
57−* Minor fixes
58−* `pbGlobalInstall`
59−
60−## 0.1.0.0
61−
62−First version of Stackage which is made available as its own package. The
63−codebase has been completely rewritten at this point, to be ready for generated
64−both Stackage Nightly and LTS Haskell distributions.
Dockerfiledeleted−25
@@ -1,25 +0,0 @@
1−FROM ubuntu:12.04
2−
3−ENV HOME /home/stackage
4−ENV LANG en_US.UTF-8
5−
6−RUN mkdir /home/stackage -p
7−RUN locale-gen en_US.UTF-8
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+8−4
@@ -7,10 +7,14 @@ __NOTE__ This repository is for package authors to get their code into
77Stackage. If you simply want to use Stackage as an end user, please follow the
88instructions on [http://www.stackage.org/](http://www.stackage.org).
99
10−A note about the codebase: the goal is to minimize dependencies and have
11−the maximum range of supported compiler versions. Therefore, we avoid
12−anything "complicated." For example, instead of using the text package,
13−we use Strings everywhere.
10+The Stackage project consists of multiple repositories. This repository
11+contains the metadata on packages to be included in future builds and some
12+project information. In addition, we have the following repositories:
13+
14+* [stackage-server](https://github.com/fpco/stackage-server)
15+* [stackage-curator](https://github.com/fpco/stackage-curator)
16+* [stackage-types](https://github.com/fpco/stackage-types)
17+* [lts-haskell](https://github.com/fpco/lts-haskell)
1418
1519Get your package included
1620-------------------------
Setup.hsdeleted−2
@@ -1,2 +0,0 @@
1−import Distribution.Simple
2−main = defaultMain
Stackage/BuildConstraints.hsdeleted−234
@@ -1,234 +0,0 @@
1−{-# LANGUAGE NoImplicitPrelude #-}
2−{-# LANGUAGE OverloadedStrings #-}
3−{-# LANGUAGE RecordWildCards #-}
4−{-# LANGUAGE TupleSections #-}
5−-- | The constraints on package selection for a new build plan.
6−module Stackage.BuildConstraints
7− ( BuildConstraints (..)
8− , PackageConstraints (..)
9− , TestState (..)
10− , SystemInfo (..)
11− , getSystemInfo
12− , defaultBuildConstraints
13− , toBC
14− , BuildConstraintsSource (..)
15− , loadBuildConstraints
16− ) where
17−
18−import Control.Monad.Writer.Strict (execWriter, tell)
19−import Data.Aeson
20−import qualified Data.Map as Map
21−import Data.Yaml (decodeEither', decodeFileEither)
22−import Distribution.Package (Dependency (..))
23−import Distribution.System (Arch, OS)
24−import qualified Distribution.System
25−import Distribution.Version (anyVersion)
26−import Filesystem (isFile)
27−import Network.HTTP.Client (Manager, httpLbs, responseBody, Request)
28−import Stackage.CorePackages
29−import Stackage.Prelude
30−
31−data TestState = ExpectSuccess
32− | ExpectFailure
33− | Don'tBuild -- ^ when the test suite will pull in things we don't want
34− deriving (Show, Eq, Ord, Bounded, Enum)
35−
36−testStateToText :: TestState -> Text
37−testStateToText ExpectSuccess = "expect-success"
38−testStateToText ExpectFailure = "expect-failure"
39−testStateToText Don'tBuild = "do-not-build"
40−
41−instance ToJSON TestState where
42− toJSON = toJSON . testStateToText
43−instance FromJSON TestState where
44− parseJSON = withText "TestState" $ \t ->
45− case lookup t states of
46− Nothing -> fail $ "Invalid state: " ++ unpack t
47− Just v -> return v
48− where
49− states = asHashMap $ mapFromList
50− $ map (\x -> (testStateToText x, x)) [minBound..maxBound]
51−
52−data SystemInfo = SystemInfo
53− { siGhcVersion :: Version
54− , siOS :: OS
55− , siArch :: Arch
56− , siCorePackages :: Map PackageName Version
57− , siCoreExecutables :: Set ExeName
58− }
59− deriving (Show, Eq, Ord)
60−instance ToJSON SystemInfo where
61− toJSON SystemInfo {..} = object
62− [ "ghc-version" .= display siGhcVersion
63− , "os" .= display siOS
64− , "arch" .= display siArch
65− , "core-packages" .= Map.mapKeysWith const unPackageName (map display siCorePackages)
66− , "core-executables" .= siCoreExecutables
67− ]
68−instance FromJSON SystemInfo where
69− parseJSON = withObject "SystemInfo" $ \o -> do
70− let helper name = (o .: name) >>= either (fail . show) return . simpleParse
71− siGhcVersion <- helper "ghc-version"
72− siOS <- helper "os"
73− siArch <- helper "arch"
74− siCorePackages <- (o .: "core-packages") >>= goPackages
75− siCoreExecutables <- o .: "core-executables"
76− return SystemInfo {..}
77− where
78− goPackages = either (fail . show) return
79− . mapM simpleParse
80− . Map.mapKeysWith const mkPackageName
81−
82−data BuildConstraints = BuildConstraints
83− { bcPackages :: Set PackageName
84− -- ^ This does not include core packages.
85− , bcPackageConstraints :: PackageName -> PackageConstraints
86−
87− , bcSystemInfo :: SystemInfo
88−
89− , bcGithubUsers :: Map Text (Set Text)
90− -- ^ map an account to set of pingees
91− }
92−
93−data PackageConstraints = PackageConstraints
94− { pcVersionRange :: VersionRange
95− , pcMaintainer :: Maybe Maintainer
96− , pcTests :: TestState
97− , pcHaddocks :: TestState
98− , pcBuildBenchmarks :: Bool
99− , pcFlagOverrides :: Map FlagName Bool
100− , pcEnableLibProfile :: Bool
101− }
102− deriving (Show, Eq)
103−instance ToJSON PackageConstraints where
104− toJSON PackageConstraints {..} = object $ addMaintainer
105− [ "version-range" .= display pcVersionRange
106− , "tests" .= pcTests
107− , "haddocks" .= pcHaddocks
108− , "build-benchmarks" .= pcBuildBenchmarks
109− , "flags" .= Map.mapKeysWith const unFlagName pcFlagOverrides
110− , "library-profiling" .= pcEnableLibProfile
111− ]
112− where
113− addMaintainer = maybe id (\m -> (("maintainer" .= m):)) pcMaintainer
114−instance FromJSON PackageConstraints where
115− parseJSON = withObject "PackageConstraints" $ \o -> do
116− pcVersionRange <- (o .: "version-range")
117− >>= either (fail . show) return . simpleParse
118− pcTests <- o .: "tests"
119− pcHaddocks <- o .: "haddocks"
120− pcBuildBenchmarks <- o .: "build-benchmarks"
121− pcFlagOverrides <- Map.mapKeysWith const mkFlagName <$> o .: "flags"
122− pcMaintainer <- o .:? "maintainer"
123− pcEnableLibProfile <- fmap (fromMaybe True) (o .:? "library-profiling")
124− return PackageConstraints {..}
125−
126−-- | The proposed plan from the requirements provided by contributors.
127−--
128−-- Checks the current directory for a build-constraints.yaml file and uses it
129−-- if present. If not, downloads from Github.
130−defaultBuildConstraints :: Manager -> IO BuildConstraints
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
149− where
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−
157−
158−getSystemInfo :: IO SystemInfo
159−getSystemInfo = do
160− siCorePackages <- getCorePackages
161− siCoreExecutables <- getCoreExecutables
162− siGhcVersion <- getGhcVersion
163− return SystemInfo {..}
164− where
165− -- FIXME consider not hard-coding the next two values
166− siOS = Distribution.System.Linux
167− siArch = Distribution.System.X86_64
168−
169−data ConstraintFile = ConstraintFile
170− { cfPackageFlags :: Map PackageName (Map FlagName Bool)
171− , cfSkippedTests :: Set PackageName
172− , cfExpectedTestFailures :: Set PackageName
173− , cfExpectedHaddockFailures :: Set PackageName
174− , cfSkippedBenchmarks :: Set PackageName
175− , cfPackages :: Map Maintainer (Vector Dependency)
176− , cfGithubUsers :: Map Text (Set Text)
177− , cfSkippedLibProfiling :: Set PackageName
178− }
179−
180−instance FromJSON ConstraintFile where
181− parseJSON = withObject "ConstraintFile" $ \o -> do
182− cfPackageFlags <- (goPackageMap . fmap goFlagMap) <$> o .: "package-flags"
183− cfSkippedTests <- getPackages o "skipped-tests"
184− cfExpectedTestFailures <- getPackages o "expected-test-failures"
185− cfExpectedHaddockFailures <- getPackages o "expected-haddock-failures"
186− cfSkippedBenchmarks <- getPackages o "skipped-benchmarks"
187− cfSkippedLibProfiling <- getPackages o "skipped-profiling"
188− cfPackages <- o .: "packages"
189− >>= mapM (mapM toDep)
190− . Map.mapKeysWith const Maintainer
191− cfGithubUsers <- o .: "github-users"
192− return ConstraintFile {..}
193− where
194− goFlagMap = Map.mapKeysWith const FlagName
195− goPackageMap = Map.mapKeysWith const PackageName
196− getPackages o name = (setFromList . map PackageName) <$> o .: name
197−
198− toDep :: Monad m => Text -> m Dependency
199− toDep = either (fail . show) return . simpleParse
200−
201−toBC :: ConstraintFile -> IO BuildConstraints
202−toBC ConstraintFile {..} = do
203− bcSystemInfo <- getSystemInfo
204− return BuildConstraints {..}
205− where
206− combine (maintainer, range1) (_, range2) =
207− (maintainer, intersectVersionRanges range1 range2)
208− revmap = unionsWith combine $ ($ []) $ execWriter
209− $ forM_ (mapToList cfPackages)
210− $ \(maintainer, deps) -> forM_ deps
211− $ \(Dependency name range) ->
212− tell (singletonMap name (maintainer, range):)
213−
214− bcPackages = Map.keysSet revmap
215−
216− bcPackageConstraints name =
217− PackageConstraints {..}
218− where
219− mpair = lookup name revmap
220− pcMaintainer = fmap fst mpair
221− pcVersionRange = maybe anyVersion snd mpair
222− pcEnableLibProfile = not (name `member` cfSkippedLibProfiling)
223− pcTests
224− | name `member` cfSkippedTests = Don'tBuild
225− | name `member` cfExpectedTestFailures = ExpectFailure
226− | otherwise = ExpectSuccess
227− pcBuildBenchmarks = name `notMember` cfSkippedBenchmarks
228− pcHaddocks
229− | name `member` cfExpectedHaddockFailures = ExpectFailure
230−
231− | otherwise = ExpectSuccess
232− pcFlagOverrides = fromMaybe mempty $ lookup name cfPackageFlags
233−
234− bcGithubUsers = cfGithubUsers
Stackage/BuildPlan.hsdeleted−214
@@ -1,214 +0,0 @@
1−{-# LANGUAGE DeriveDataTypeable #-}
2−{-# LANGUAGE DeriveFoldable #-}
3−{-# LANGUAGE DeriveFunctor #-}
4−{-# LANGUAGE DeriveTraversable #-}
5−{-# LANGUAGE NoImplicitPrelude #-}
6−{-# LANGUAGE OverloadedStrings #-}
7−{-# LANGUAGE RecordWildCards #-}
8−{-# LANGUAGE TupleSections #-}
9−{-# LANGUAGE TypeFamilies #-}
10−-- | Representation of a concrete build plan, and how to generate a new one
11−-- based on constraints.
12−module Stackage.BuildPlan
13− ( BuildPlan (..)
14− , PackagePlan (..)
15− , newBuildPlan
16− , makeToolMap
17− , getLatestAllowedPlans
18− ) where
19−
20−import Control.Monad.State.Strict (execState, get, put)
21−import Data.Aeson
22−import qualified Data.Map as Map
23−import qualified Data.Set as Set
24−import qualified Distribution.Compiler
25−import Distribution.PackageDescription
26−import Stackage.BuildConstraints
27−import Stackage.GithubPings
28−import Stackage.PackageDescription
29−import Stackage.PackageIndex
30−import Stackage.Prelude
31−
32−data BuildPlan = BuildPlan
33− { bpSystemInfo :: SystemInfo
34− , bpTools :: Vector (PackageName, Version)
35− , bpPackages :: Map PackageName PackagePlan
36− , bpGithubUsers :: Map Text (Set Text)
37− }
38− deriving (Show, Eq)
39−
40−instance ToJSON BuildPlan where
41− toJSON BuildPlan {..} = object
42− [ "system-info" .= bpSystemInfo
43− , "tools" .= map goTool bpTools
44− , "packages" .= Map.mapKeysWith const unPackageName bpPackages
45− , "github-users" .= bpGithubUsers
46− ]
47− where
48− goTool (k, v) = object
49− [ "name" .= display k
50− , "version" .= display v
51− ]
52−instance FromJSON BuildPlan where
53− parseJSON = withObject "BuildPlan" $ \o -> do
54− bpSystemInfo <- o .: "system-info"
55− bpTools <- (o .: "tools") >>= mapM goTool
56− bpPackages <- Map.mapKeysWith const mkPackageName <$> (o .: "packages")
57− bpGithubUsers <- o .:? "github-users" .!= mempty
58− return BuildPlan {..}
59− where
60− goTool = withObject "Tool" $ \o -> (,)
61− <$> ((o .: "name") >>=
62− either (fail . show) return . simpleParse . asText)
63− <*> ((o .: "version") >>=
64− either (fail . show) return . simpleParse . asText)
65−
66−data PackagePlan = PackagePlan
67− { ppVersion :: Version
68− , ppGithubPings :: Set Text
69− , ppUsers :: Set PackageName
70− , ppConstraints :: PackageConstraints
71− , ppDesc :: SimpleDesc
72− }
73− deriving (Show, Eq)
74−
75−instance ToJSON PackagePlan where
76− toJSON PackagePlan {..} = object
77− [ "version" .= asText (display ppVersion)
78− , "github-pings" .= ppGithubPings
79− , "users" .= map unPackageName (unpack ppUsers)
80− , "constraints" .= ppConstraints
81− , "description" .= ppDesc
82− ]
83−instance FromJSON PackagePlan where
84− parseJSON = withObject "PackageBuild" $ \o -> do
85− ppVersion <- o .: "version"
86− >>= either (fail . show) return
87− . simpleParse . asText
88− ppGithubPings <- o .:? "github-pings" .!= mempty
89− ppUsers <- Set.map PackageName <$> (o .:? "users" .!= mempty)
90− ppConstraints <- o .: "constraints"
91− ppDesc <- o .: "description"
92− return PackagePlan {..}
93−
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
97− let toolMap = makeToolMap packagesOrig
98− packages = populateUsers $ removeUnincluded bc toolMap packagesOrig
99− toolNames :: [ExeName]
100− toolNames = concatMap (Map.keys . sdTools . ppDesc) packages
101− tools <- topologicalSortTools toolMap $ mapFromList $ do
102− exeName <- toolNames
103− guard $ exeName `notMember` siCoreExecutables
104− packageName <- maybe mempty setToList $ lookup exeName toolMap
105− packagePlan <- maybeToList $ lookup packageName packagesOrig
106− return (packageName, packagePlan)
107− -- FIXME topologically sort packages? maybe just leave that to the build phase
108− return BuildPlan
109− { bpSystemInfo = bcSystemInfo
110− , bpTools = tools
111− , bpPackages = packages
112− , bpGithubUsers = bcGithubUsers
113− }
114− where
115− SystemInfo {..} = bcSystemInfo
116−
117−makeToolMap :: Map PackageName PackagePlan
118− -> Map ExeName (Set PackageName)
119−makeToolMap =
120− unionsWith (++) . map go . mapToList
121− where
122− go (packageName, pp) =
123− foldMap go' $ sdProvidedExes $ ppDesc pp
124− where
125− go' exeName = singletonMap exeName (singletonSet packageName)
126−
127−topologicalSortTools :: MonadThrow m
128− => Map ExeName (Set PackageName)
129− -> Map PackageName PackagePlan
130− -> m (Vector (PackageName, Version))
131−topologicalSortTools toolMap = topologicalSort
132− ppVersion
133− (concatMap (fromMaybe mempty . flip lookup toolMap) . Map.keys . sdTools . ppDesc)
134−
135−-- | Include only packages which are dependencies of the required packages and
136−-- their build tools.
137−removeUnincluded :: BuildConstraints
138− -> Map ExeName (Set PackageName)
139− -> Map PackageName PackagePlan
140− -> Map PackageName PackagePlan
141−removeUnincluded BuildConstraints {..} toolMap orig =
142− mapFromList $ filter (\(x, _) -> x `member` included) $ mapToList orig
143− where
144− SystemInfo {..} = bcSystemInfo
145−
146− included :: Set PackageName
147− included = flip execState mempty $ mapM_ add bcPackages
148−
149− add name = do
150− inc <- get
151− when (name `notMember` inc) $ do
152− put $ insertSet name inc
153− case lookup name orig of
154− Nothing -> return ()
155− Just pb -> do
156− mapM_ add $ Map.keys $ sdPackages $ ppDesc pb
157− forM_ (Map.keys $ sdTools $ ppDesc pb) $
158− \exeName -> when (exeName `notMember` siCoreExecutables)
159− $ mapM_ add $ fromMaybe mempty $ lookup exeName toolMap
160−
161−populateUsers :: Map PackageName PackagePlan
162− -> Map PackageName PackagePlan
163−populateUsers orig =
164− mapWithKey go orig
165− where
166− go name pb = pb { ppUsers = foldMap (go2 name) (mapToList orig) }
167−
168− go2 dep (user, pb)
169− | dep `member` sdPackages (ppDesc pb) = singletonSet user
170− | otherwise = mempty
171−
172−-- | Check whether the given package/version combo meets the constraints
173−-- currently in place.
174−isAllowed :: BuildConstraints
175− -> PackageName -> Version -> Bool
176−isAllowed bc = \name version ->
177− case lookup name $ siCorePackages $ bcSystemInfo bc of
178− Just _ -> False -- never reinstall a core package
179− Nothing -> withinRange version $ pcVersionRange $ bcPackageConstraints bc name
180−
181−mkPackagePlan :: MonadThrow m
182− => BuildConstraints
183− -> GenericPackageDescription
184− -> m PackagePlan
185−mkPackagePlan bc gpd = do
186− ppDesc <- toSimpleDesc CheckCond {..} gpd
187− return PackagePlan {..}
188− where
189− PackageIdentifier name ppVersion = package $ packageDescription gpd
190− ppGithubPings = getGithubPings bc gpd
191− ppConstraints = bcPackageConstraints bc name
192− ppUsers = mempty -- must be filled in later
193−
194− ccPackageName = name
195− ccOS = siOS
196− ccArch = siArch
197− ccCompilerFlavor = Distribution.Compiler.GHC
198− ccCompilerVersion = siGhcVersion
199− ccFlags = flags
200− ccIncludeTests = pcTests ppConstraints /= Don'tBuild
201− ccIncludeBenchmarks = pcBuildBenchmarks ppConstraints
202−
203− SystemInfo {..} = bcSystemInfo bc
204−
205− overrides = pcFlagOverrides ppConstraints
206− getFlag MkFlag {..} =
207− (flagName, fromMaybe flagDefault $ lookup flagName overrides)
208− 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.hsdeleted−162
@@ -1,162 +0,0 @@
1−{-# LANGUAGE TupleSections #-}
2−{-# LANGUAGE DeriveDataTypeable #-}
3−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
4−{-# LANGUAGE NoImplicitPrelude #-}
5−{-# LANGUAGE OverloadedStrings #-}
6−{-# LANGUAGE RecordWildCards #-}
7−{-# LANGUAGE ViewPatterns #-}
8−-- | Confirm that a build plan has a consistent set of dependencies.
9−module Stackage.CheckBuildPlan
10− ( checkBuildPlan
11− , BadBuildPlan
12− ) where
13−
14−import Control.Monad.Writer.Strict (Writer, execWriter, tell)
15−import qualified Data.Map.Strict as M
16−import qualified Data.Text as T
17−import Stackage.BuildConstraints
18−import Stackage.BuildPlan
19−import Stackage.PackageDescription
20−import Stackage.Prelude
21−
22−-- | Check the build plan for missing deps, wrong versions, etc.
23−checkBuildPlan :: (MonadThrow m) => BuildPlan -> m ()
24−checkBuildPlan BuildPlan {..}
25− | null errs' = return ()
26− | otherwise = throwM errs
27− where
28− allPackages = map (,mempty) (siCorePackages bpSystemInfo) ++
29− map (ppVersion &&& M.keys . M.filter libAndExe . sdPackages . ppDesc) bpPackages
30− errs@(BadBuildPlan errs') =
31− 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
36−
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])
43− -> (PackageName, PackagePlan)
44− -> Writer BadBuildPlan ()
45−checkDeps allPackages (user, pb) =
46− mapM_ go $ mapToList $ sdPackages $ ppDesc pb
47− where
48− go (dep, diRange -> range) =
49− case lookup dep allPackages of
50− Nothing -> tell $ BadBuildPlan $ singletonMap (dep, Nothing) errMap
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− []
61− | otherwise -> tell $ BadBuildPlan $ singletonMap
62− (dep, Just version)
63− errMap
64− where
65− errMap = singletonMap pu range
66− pu = PkgUser
67− { puName = user
68− , puVersion = ppVersion pb
69− , puMaintainer = pcMaintainer $ ppConstraints pb
70− , puGithubPings = ppGithubPings pb
71− }
72−
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−
105−data PkgUser = PkgUser
106− { puName :: PackageName
107− , puVersion :: Version
108− , puMaintainer :: Maybe Maintainer
109− , puGithubPings :: Set Text
110− }
111− deriving (Eq, Ord)
112−
113−pkgUserShow1 :: PkgUser -> Text
114−pkgUserShow1 PkgUser {..} = concat
115− [ display puName
116− , "-"
117− , display puVersion
118− ]
119−
120−pkgUserShow2 :: PkgUser -> Text
121−pkgUserShow2 PkgUser {..} = unwords
122− $ (maybe "No maintainer" unMaintainer puMaintainer ++ ".")
123− : map (cons '@') (setToList puGithubPings)
124−
125−newtype BadBuildPlan =
126− BadBuildPlan (Map (PackageName, Maybe Version) (Map PkgUser VersionRange))
127− deriving Typeable
128−instance Exception BadBuildPlan
129−instance Show BadBuildPlan where
130− show (BadBuildPlan errs) =
131− unpack $ concatMap go $ mapToList errs
132− where
133− go ((dep, mdepVer), users) = unlines
134− $ ""
135− : showDepVer dep mdepVer
136− : map showUser (mapToList users)
137−
138− showDepVer :: PackageName -> Maybe Version -> Text
139− showDepVer dep Nothing = display dep ++ " (not present) depended on by:"
140− showDepVer dep (Just version) = concat
141− [ display dep
142− , "-"
143− , display version
144− , " depended on by:"
145− ]
146−
147− showUser :: (PkgUser, VersionRange) -> Text
148− showUser (pu, range) = concat
149− [ "- "
150− , pkgUserShow1 pu
151− , " ("
152− -- add a space after < to avoid confusing Markdown processors (like
153− -- Github's issue tracker)
154− , T.replace "<" "< " $ display range
155− , "). "
156− , pkgUserShow2 pu
157− ]
158−
159−instance Monoid BadBuildPlan where
160− mempty = BadBuildPlan mempty
161− mappend (BadBuildPlan x) (BadBuildPlan y) =
162− BadBuildPlan $ unionWith (unionWith intersectVersionRanges) x y
Stackage/CompleteBuild.hsdeleted−337
@@ -1,337 +0,0 @@
1−{-# LANGUAGE NoImplicitPrelude #-}
2−{-# LANGUAGE OverloadedStrings #-}
3−{-# LANGUAGE RecordWildCards #-}
4−module Stackage.CompleteBuild
5− ( BuildType (..)
6− , BumpType (..)
7− , BuildFlags (..)
8− , completeBuild
9− , justCheck
10− , justUploadNightly
11− , getStackageAuthToken
12− ) where
13−
14−import Control.Concurrent (threadDelay)
15−import Control.Concurrent.Async (withAsync)
16−import Data.Default.Class (def)
17−import Data.Semigroup (Max (..), Option (..))
18−import Data.Text.Read (decimal)
19−import Data.Time
20−import Data.Yaml (decodeFileEither, encodeFile)
21−import Network.HTTP.Client
22−import Network.HTTP.Client.TLS (tlsManagerSettings)
23−import Stackage.BuildConstraints
24−import Stackage.BuildPlan
25−import Stackage.CheckBuildPlan
26−import Stackage.PerformBuild
27−import Stackage.Prelude
28−import Stackage.ServerBundle
29−import Stackage.UpdateBuildPlan
30−import Stackage.Upload
31−import System.Environment (lookupEnv)
32−import System.IO (BufferMode (LineBuffering), hSetBuffering)
33−
34−-- | Flags passed in from the command line.
35−data BuildFlags = BuildFlags
36− { bfEnableTests :: !Bool
37− , bfEnableHaddock :: !Bool
38− , bfDoUpload :: !Bool
39− , bfEnableLibProfile :: !Bool
40− , bfEnableExecDyn :: !Bool
41− , bfVerbose :: !Bool
42− , bfSkipCheck :: !Bool
43− , bfUploadV1 :: !Bool
44− , bfServer :: !StackageServer
45− , bfBuildHoogle :: !Bool
46− } deriving (Show)
47−
48−data BuildType = Nightly | LTS BumpType
49− deriving (Show, Read, Eq, Ord)
50−
51−data BumpType = Major | Minor
52− deriving (Show, Read, Eq, Ord)
53−
54−data Settings = Settings
55− { plan :: BuildPlan
56− , planFile :: FilePath
57− , buildDir :: FilePath
58− , logDir :: FilePath
59− , title :: Text -> Text -- ^ GHC version -> title
60− , slug :: Text
61− , setArgs :: Text -> UploadBundle -> UploadBundle
62− , postBuild :: IO ()
63− , distroName :: Text -- ^ distro name on Hackage
64− , snapshotType :: SnapshotType
65− , bundleDest :: FilePath
66− }
67−
68−nightlyPlanFile :: Text -- ^ day
69− -> FilePath
70−nightlyPlanFile day = fpFromText ("nightly-" ++ day) <.> "yaml"
71−
72−nightlySettings :: Text -- ^ day
73− -> BuildPlan
74− -> Settings
75−nightlySettings day plan' = Settings
76− { planFile = nightlyPlanFile day
77− , buildDir = fpFromText $ "builds/nightly"
78− , logDir = fpFromText $ "logs/stackage-nightly-" ++ day
79− , title = \ghcVer -> concat
80− [ "Stackage Nightly "
81− , day
82− , ", GHC "
83− , ghcVer
84− ]
85− , slug = slug'
86− , setArgs = \ghcVer ub -> ub { ubNightly = Just ghcVer }
87− , plan = plan'
88− , postBuild = return ()
89− , distroName = "Stackage"
90− , snapshotType = STNightly
91− , bundleDest = fpFromText $ "stackage-nightly-" ++ day ++ ".bundle"
92− }
93− where
94− slug' = "nightly-" ++ day
95−
96−getSettings :: Manager -> BuildType -> IO Settings
97−getSettings man Nightly = do
98− day <- tshow . utctDay <$> getCurrentTime
99− bc <- defaultBuildConstraints man
100− pkgs <- getLatestAllowedPlans bc
101− plan' <- newBuildPlan pkgs bc
102− return $ nightlySettings day plan'
103−getSettings man (LTS bumpType) = do
104− Option mlts <- fmap (fmap getMax) $ runResourceT
105− $ sourceDirectory "."
106− $$ foldMapC (Option . fmap Max . parseLTSVer . filename)
107−
108− (new, plan') <- case bumpType of
109− Major -> do
110− let new =
111− case mlts of
112− Nothing -> LTSVer 0 0
113− Just (LTSVer x _) -> LTSVer (x + 1) 0
114− bc <- defaultBuildConstraints man
115− pkgs <- getLatestAllowedPlans bc
116− plan' <- newBuildPlan pkgs bc
117− return (new, plan')
118− Minor -> do
119− old <- maybe (error "No LTS plans found in current directory") return mlts
120− oldplan <- decodeFileEither (fpToString $ renderLTSVer old)
121− >>= either throwM return
122− let new = incrLTSVer old
123− let bc = updateBuildConstraints oldplan
124− pkgs <- getLatestAllowedPlans bc
125− plan' <- newBuildPlan pkgs bc
126− return (new, plan')
127−
128− let newfile = renderLTSVer new
129−
130− return Settings
131− { planFile = newfile
132− , buildDir = fpFromText $ "builds/lts"
133− , logDir = fpFromText $ "logs/stackage-lts-" ++ tshow new
134− , title = \ghcVer -> concat
135− [ "LTS Haskell "
136− , tshow new
137− , ", GHC "
138− , ghcVer
139− ]
140− , slug = "lts-" ++ tshow new
141− , setArgs = \_ ub -> ub { ubLTS = Just $ tshow new }
142− , plan = plan'
143− , postBuild = do
144− let git args = withCheckedProcess
145− (proc "git" args) $ \ClosedStream Inherited Inherited ->
146− return ()
147− putStrLn "Committing new LTS file to Git"
148− git ["add", fpToString newfile]
149− git ["commit", "-m", "Added new LTS release: " ++ show new]
150− putStrLn "Pushing to Git repository"
151− git ["push"]
152− , distroName = "LTSHaskell"
153− , snapshotType =
154− case new of
155− LTSVer x y -> STLTS x y
156− , bundleDest = fpFromText $ "stackage-lts-" ++ tshow new ++ ".bundle"
157− }
158−
159−data LTSVer = LTSVer !Int !Int
160− deriving (Eq, Ord)
161−instance Show LTSVer where
162− show (LTSVer x y) = concat [show x, ".", show y]
163−incrLTSVer :: LTSVer -> LTSVer
164−incrLTSVer (LTSVer x y) = LTSVer x (y + 1)
165−
166−parseLTSVer :: FilePath -> Maybe LTSVer
167−parseLTSVer fp = do
168− w <- stripPrefix "lts-" $ fpToText fp
169− x <- stripSuffix ".yaml" w
170− Right (major, y) <- Just $ decimal x
171− z <- stripPrefix "." y
172− Right (minor, "") <- Just $ decimal z
173− return $ LTSVer major minor
174−renderLTSVer :: LTSVer -> FilePath
175−renderLTSVer lts = fpFromText $ concat
176− [ "lts-"
177− , tshow lts
178− , ".yaml"
179− ]
180−
181−-- | Just print a message saying "still alive" every minute, to appease Travis.
182−stillAlive :: IO () -> IO ()
183−stillAlive inner =
184− withAsync (printer 1) $ const inner
185− where
186− printer i = forever $ do
187− threadDelay 60000000
188− putStrLn $ "Still alive: " ++ tshow i
189− printer $! i + 1
190−
191−-- | Generate and check a new build plan, but do not execute it.
192−--
193−-- Since 0.3.1
194−justCheck :: IO ()
195−justCheck = stillAlive $ withManager tlsManagerSettings $ \man -> do
196− putStrLn "Loading build constraints"
197− bc <- defaultBuildConstraints man
198−
199− putStrLn "Creating build plan"
200− plans <- getLatestAllowedPlans bc
201− plan <- newBuildPlan plans bc
202−
203− putStrLn $ "Writing build plan to check-plan.yaml"
204− encodeFile "check-plan.yaml" plan
205−
206− putStrLn "Checking plan"
207− checkBuildPlan plan
208−
209− putStrLn "Plan seems valid!"
210−
211−getPerformBuild :: BuildFlags -> Settings -> PerformBuild
212−getPerformBuild buildFlags Settings {..} = PerformBuild
213− { pbPlan = plan
214− , pbInstallDest = buildDir
215− , pbLogDir = logDir
216− , pbLog = hPut stdout
217− , pbJobs = 8
218− , pbGlobalInstall = False
219− , pbEnableTests = bfEnableTests buildFlags
220− , pbEnableHaddock = bfEnableHaddock buildFlags
221− , pbEnableLibProfiling = bfEnableLibProfile buildFlags
222− , pbEnableExecDyn = bfEnableExecDyn buildFlags
223− , pbVerbose = bfVerbose buildFlags
224− , pbAllowNewer = bfSkipCheck buildFlags
225− , pbBuildHoogle = bfBuildHoogle buildFlags
226− }
227−
228−-- | Make a complete plan, build, test and upload bundle, docs and
229−-- distro.
230−completeBuild :: BuildType -> BuildFlags -> IO ()
231−completeBuild buildType buildFlags = withManager tlsManagerSettings $ \man -> do
232− hSetBuffering stdout LineBuffering
233−
234− putStrLn $ "Loading settings for: " ++ tshow buildType
235− settings@Settings {..} <- getSettings man buildType
236−
237− putStrLn $ "Writing build plan to: " ++ fpToText planFile
238− encodeFile (fpToString planFile) plan
239−
240− if bfSkipCheck buildFlags
241− then putStrLn "Skipping build plan check"
242− else do
243− putStrLn "Checking build plan"
244− checkBuildPlan plan
245−
246− putStrLn "Performing build"
247− let pb = getPerformBuild buildFlags settings
248− performBuild pb >>= mapM_ putStrLn
249−
250− putStrLn $ "Creating bundle (v2) at: " ++ fpToText bundleDest
251− createBundleV2 CreateBundleV2
252− { cb2Plan = plan
253− , cb2Type = snapshotType
254− , cb2DocsDir = pbDocDir pb
255− , cb2Dest = bundleDest
256− }
257−
258− when (bfDoUpload buildFlags) $
259− finallyUpload
260− (not $ bfUploadV1 buildFlags)
261− (bfServer buildFlags)
262− settings
263− man
264−
265−justUploadNightly
266− :: Text -- ^ nightly date
267− -> IO ()
268−justUploadNightly day = do
269− plan <- decodeFileEither (fpToString $ nightlyPlanFile day)
270− >>= either throwM return
271− withManager tlsManagerSettings $ finallyUpload False def $ nightlySettings day plan
272−
273−getStackageAuthToken :: IO Text
274−getStackageAuthToken = do
275− mtoken <- lookupEnv "STACKAGE_AUTH_TOKEN"
276− case mtoken of
277− Nothing -> decodeUtf8 <$> readFile "/auth-token"
278− Just token -> return $ pack token
279−
280−-- | The final part of the complete build process: uploading a bundle,
281−-- docs and a distro to hackage.
282−finallyUpload :: Bool -- ^ use v2 upload
283− -> StackageServer
284− -> Settings -> Manager -> IO ()
285−finallyUpload useV2 server settings@Settings{..} man = do
286− putStrLn "Uploading bundle to Stackage Server"
287−
288− token <- getStackageAuthToken
289−
290− if useV2
291− then do
292− res <- flip uploadBundleV2 man UploadBundleV2
293− { ub2Server = server
294− , ub2AuthToken = token
295− , ub2Bundle = bundleDest
296− }
297− putStrLn $ "New snapshot available at: " ++ res
298− else do
299− now <- epochTime
300− let ghcVer = display $ siGhcVersion $ bpSystemInfo plan
301− (ident, mloc) <- flip uploadBundle man $ setArgs ghcVer def
302− { ubContents = serverBundle now (title ghcVer) slug plan
303− , ubAuthToken = token
304− }
305− putStrLn $ "New ident: " ++ unSnapshotIdent ident
306− forM_ mloc $ \loc ->
307− putStrLn $ "Track progress at: " ++ loc
308−
309− putStrLn "Uploading docs to Stackage Server"
310− res1 <- tryAny $ uploadDocs UploadDocs
311− { udServer = def
312− , udAuthToken = token
313− , udDocs = pbDocDir pb
314− , udSnapshot = ident
315− } man
316− putStrLn $ "Doc upload response: " ++ tshow res1
317−
318− putStrLn "Uploading doc map"
319− tryAny (uploadDocMap UploadDocMap
320− { udmServer = def
321− , udmAuthToken = token
322− , udmSnapshot = ident
323− , udmDocDir = pbDocDir pb
324− , udmPlan = plan
325− } man) >>= print
326−
327− postBuild `catchAny` print
328−
329− ecreds <- tryIO $ readFile "/hackage-creds"
330− case map encodeUtf8 $ words $ decodeUtf8 $ either (const "") id ecreds of
331− [username, password] -> do
332− putStrLn "Uploading as Hackage distro"
333− res2 <- uploadHackageDistroNamed distroName plan username password man
334− putStrLn $ "Distro upload response: " ++ tshow res2
335− _ -> putStrLn "No creds found, skipping Hackage distro upload"
336− where
337− pb = getPerformBuild (error "finallyUpload.buildFlags") settings
Stackage/CorePackages.hsdeleted−53
@@ -1,53 +0,0 @@
1−{-# LANGUAGE NoImplicitPrelude #-}
2−{-# LANGUAGE OverloadedStrings #-}
3−module Stackage.CorePackages
4− ( getCorePackages
5− , getCoreExecutables
6− , getGhcVersion
7− ) where
8−
9−import qualified Data.Text as T
10−import Filesystem (listDirectory)
11−import Stackage.Prelude
12−import System.Directory (findExecutable)
13−
14−-- | Get a @Map@ of all of the core packages. Core packages are defined as
15−-- packages which ship with GHC itself.
16−--
17−-- Precondition: GHC global package database has only core packages, and GHC
18−-- ships with just a single version of each packages.
19−getCorePackages :: IO (Map PackageName Version)
20−getCorePackages =
21− withCheckedProcess cp $ \ClosedStream src Inherited ->
22− src $$ decodeUtf8C =$ linesUnboundedC =$ foldMapMC parsePackage
23− where
24− cp = proc "ghc-pkg" ["--no-user-package-conf", "list"]
25− parsePackage t
26− | ":" `isInfixOf` t = return mempty
27− | Just p <- stripSuffix "-" p' = singletonMap
28− <$> simpleParse p
29− <*> simpleParse v
30− | otherwise = return mempty
31− where
32− (p', v) = T.breakOnEnd "-" $ dropParens $ T.strip t
33−
34− dropParens s
35− | length s > 2 && headEx s == '(' && lastEx s == ')' =
36− initEx $ tailEx s
37− | otherwise = s
38−
39−-- | A list of executables that are shipped with GHC.
40−getCoreExecutables :: IO (Set ExeName)
41−getCoreExecutables = do
42− mfp <- findExecutable "ghc"
43− dir <-
44− case mfp of
45− Nothing -> error "No ghc executable found on PATH"
46− Just fp -> return $ directory $ fpFromString fp
47− (setFromList . map (ExeName . fpToText . filename)) <$> listDirectory dir
48−
49−getGhcVersion :: IO Version
50−getGhcVersion = do
51− withCheckedProcess (proc "ghc" ["--numeric-version"]) $
52− \ClosedStream src Inherited ->
53− (src $$ decodeUtf8C =$ foldC) >>= simpleParse
Stackage/GhcPkg.hsdeleted−104
@@ -1,104 +0,0 @@
1−{-# LANGUAGE NoImplicitPrelude #-}
2−{-# LANGUAGE OverloadedStrings #-}
3−-- | General commands related to ghc-pkg.
4−
5−module Stackage.GhcPkg
6− ( setupPackageDatabase
7− ) where
8−
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/GithubPings.hsdeleted−36
@@ -1,36 +0,0 @@
1−{-# LANGUAGE NoImplicitPrelude #-}
2−{-# LANGUAGE OverloadedStrings #-}
3−{-# LANGUAGE ViewPatterns #-}
4−module Stackage.GithubPings
5− ( getGithubPings
6− ) where
7−
8−import Distribution.PackageDescription
9−import Stackage.BuildConstraints
10−import Stackage.Prelude
11−
12−-- | Determine accounts to be pinged on Github based on various metadata in the
13−-- package description.
14−getGithubPings :: BuildConstraints -- ^ for mapping to pingees
15− -> GenericPackageDescription -> Set Text
16−getGithubPings bc gpd =
17− foldMap (\(pack -> name) -> fromMaybe (singletonSet name) (lookup name (bcGithubUsers bc))) $
18− goHomepage (homepage $ packageDescription gpd) ++
19− concatMap goRepo (sourceRepos $ packageDescription gpd)
20− where
21− goHomepage t = do
22− prefix <-
23− [ "http://github.com/"
24− , "https://github.com/"
25− , "git://github.com/"
26− , "git@github.com:"
27− ]
28− t' <- maybeToList $ stripPrefix prefix t
29− let t'' = takeWhile (/= '/') t'
30− guard $ not $ null t''
31− return t''
32−
33− goRepo sr =
34− case (repoType sr, repoLocation sr) of
35− (Just Git, Just s) -> goHomepage s
36− _ -> []
Stackage/InstallBuild.hsdeleted−102
@@ -1,102 +0,0 @@
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− , ifBuildHoogle :: !Bool
37− } deriving (Show)
38−
39−-- | Source for build plan.
40−data BuildPlanSource = BPSBundleWeb String
41− | BPSFile FilePath
42− deriving (Show)
43−
44−getPerformBuild :: BuildPlan -> InstallFlags -> PerformBuild
45−getPerformBuild plan InstallFlags{..} =
46− PerformBuild
47− { pbPlan = plan
48− , pbInstallDest = ifInstallDest
49− , pbLogDir = fromMaybe (ifInstallDest </> "logs") ifLogDir
50− , pbLog = hPut stdout
51− , pbJobs = ifJobs
52− , pbGlobalInstall = ifGlobalInstall
53− , pbEnableTests = ifEnableTests
54− , pbEnableHaddock = ifEnableHaddock
55− , pbEnableLibProfiling = ifEnableLibProfiling
56− , pbEnableExecDyn = ifEnableExecDyn
57− , pbVerbose = ifVerbose
58− , pbAllowNewer = ifSkipCheck
59− , pbBuildHoogle = ifBuildHoogle
60− }
61−
62−-- | Install stackage from an existing build plan.
63−installBuild :: InstallFlags -> IO ()
64−installBuild installFlags@InstallFlags{..} = do
65− hSetBuffering stdout LineBuffering
66−
67− putStrLn $ "Loading build plan"
68− plan <- case ifPlanSource of
69− BPSBundleWeb url -> withManager tlsManagerSettings $ \man -> do
70− req <- parseUrl url
71− res <- httpLbs req man
72− planBSL <- getPlanEntry $ Tar.read $ GZip.decompress (responseBody res)
73− decodeBuildPlan planBSL
74− BPSFile path -> Yaml.decodeFileEither (fpToString path) >>= either throwM return
75−
76− if ifSkipCheck
77− then putStrLn "Skipping build plan check"
78− else do
79− putStrLn "Checking build plan"
80− checkBuildPlan plan
81−
82− putStrLn "Performing build"
83− performBuild (getPerformBuild plan installFlags) >>= mapM_ putStrLn
84−
85− where
86− getPlanEntry Tar.Done = throwIO NoBuildPlanException
87− getPlanEntry (Tar.Fail e) = throwIO e
88− getPlanEntry (Tar.Next entry entries)
89− | Tar.entryPath entry == "build-plan.yaml" =
90− case Tar.entryContent entry of
91− Tar.NormalFile bs _ -> return bs
92− _ -> throwIO NoBuildPlanException
93− | otherwise = getPlanEntry entries
94−
95− decodeBuildPlan =
96− either throwIO return . Yaml.decodeEither' . toStrict
97−
98−data InstallBuildException = NoBuildPlanException
99− deriving (Typeable)
100−instance Exception InstallBuildException
101−instance Show InstallBuildException where
102− show NoBuildPlanException = "Bundle has missing or invalid build-plan.yaml"
Stackage/PackageDescription.hsdeleted−200
@@ -1,200 +0,0 @@
1−{-# LANGUAGE DeriveDataTypeable #-}
2−{-# LANGUAGE DeriveFoldable #-}
3−{-# LANGUAGE DeriveFunctor #-}
4−{-# LANGUAGE DeriveTraversable #-}
5−{-# LANGUAGE FlexibleContexts #-}
6−{-# LANGUAGE NoImplicitPrelude #-}
7−{-# LANGUAGE OverloadedStrings #-}
8−{-# LANGUAGE RecordWildCards #-}
9−{-# LANGUAGE TypeFamilies #-}
10−-- | Manipulate @GenericPackageDescription@ from Cabal into something more
11−-- useful for us.
12−module Stackage.PackageDescription
13− ( SimpleDesc (..)
14− , toSimpleDesc
15− , CheckCond (..)
16− , Component (..)
17− , DepInfo (..)
18− ) where
19−
20−import Control.Monad.Writer.Strict (MonadWriter, execWriterT,
21− tell)
22−import Data.Aeson
23−import qualified Data.Map as Map
24−import Distribution.Compiler (CompilerFlavor)
25−import Distribution.Package (Dependency (..))
26−import Distribution.PackageDescription
27−import Distribution.System (Arch, OS)
28−import Stackage.Prelude
29−
30−data Component = CompLibrary
31− | CompExecutable
32− | CompTestSuite
33− | CompBenchmark
34− deriving (Show, Read, Eq, Ord, Enum, Bounded)
35−
36−compToText :: Component -> Text
37−compToText CompLibrary = "library"
38−compToText CompExecutable = "executable"
39−compToText CompTestSuite = "test-suite"
40−compToText CompBenchmark = "benchmark"
41−
42−instance ToJSON Component where
43− toJSON = toJSON . compToText
44−instance FromJSON Component where
45− parseJSON = withText "Component" $ \t -> maybe
46− (fail $ "Invalid component: " ++ unpack t)
47− return
48− (lookup t comps)
49− where
50− comps = asHashMap $ mapFromList $ map (compToText &&& id) [minBound..maxBound]
51−
52−data DepInfo = DepInfo
53− { diComponents :: Set Component
54− , diRange :: VersionRange
55− }
56− deriving (Show, Eq)
57−
58−instance Semigroup DepInfo where
59− DepInfo a x <> DepInfo b y = DepInfo
60− (a <> b)
61− (intersectVersionRanges x y)
62−instance ToJSON DepInfo where
63− toJSON DepInfo {..} = object
64− [ "components" .= diComponents
65− , "range" .= display diRange
66− ]
67−instance FromJSON DepInfo where
68− parseJSON = withObject "DepInfo" $ \o -> do
69− diComponents <- o .: "components"
70− diRange <- o .: "range" >>= either (fail . show) return . simpleParse
71− return DepInfo {..}
72−
73−-- | A simplified package description that tracks:
74−--
75−-- * Package dependencies
76−--
77−-- * Build tool dependencies
78−--
79−-- * Provided executables
80−--
81−-- It has fully resolved all conditionals
82−data SimpleDesc = SimpleDesc
83− { sdPackages :: Map PackageName DepInfo
84− , sdTools :: Map ExeName DepInfo
85− , sdProvidedExes :: Set ExeName
86− , sdModules :: Set Text
87− -- ^ modules exported by the library
88− }
89− deriving (Show, Eq)
90−instance Monoid SimpleDesc where
91− mempty = SimpleDesc mempty mempty mempty mempty
92− mappend (SimpleDesc a b c d) (SimpleDesc w x y z) = SimpleDesc
93− (unionWith (<>) a w)
94− (unionWith (<>) b x)
95− (c ++ y)
96− (d ++ z)
97−instance ToJSON SimpleDesc where
98− toJSON SimpleDesc {..} = object
99− [ "packages" .= Map.mapKeysWith const unPackageName sdPackages
100− , "tools" .= Map.mapKeysWith const unExeName sdTools
101− , "provided-exes" .= sdProvidedExes
102− , "modules" .= sdModules
103− ]
104−instance FromJSON SimpleDesc where
105− parseJSON = withObject "SimpleDesc" $ \o -> do
106− sdPackages <- Map.mapKeysWith const mkPackageName <$> (o .: "packages")
107− sdTools <- Map.mapKeysWith const ExeName <$> (o .: "tools")
108− sdProvidedExes <- o .: "provided-exes"
109− sdModules <- o .: "modules"
110− return SimpleDesc {..}
111−
112−-- | Convert a 'GenericPackageDescription' into a 'SimpleDesc' by following the
113−-- constraints in the provided 'CheckCond'.
114−toSimpleDesc :: MonadThrow m
115− => CheckCond
116− -> GenericPackageDescription
117− -> m SimpleDesc
118−toSimpleDesc cc gpd = execWriterT $ do
119− forM_ (condLibrary gpd) $ tellTree cc CompLibrary libBuildInfo getModules
120− forM_ (condExecutables gpd) $ tellTree cc CompExecutable buildInfo noModules . snd
121− tell mempty { sdProvidedExes = setFromList
122− $ map (fromString . fst)
123− $ condExecutables gpd
124− }
125− when (ccIncludeTests cc) $ forM_ (condTestSuites gpd)
126− $ tellTree cc CompTestSuite testBuildInfo noModules . snd
127− when (ccIncludeBenchmarks cc) $ forM_ (condBenchmarks gpd)
128− $ tellTree cc CompBenchmark benchmarkBuildInfo noModules . snd
129− where
130− noModules = const mempty
131− getModules = setFromList . map display . exposedModules
132−
133−-- | Convert a single CondTree to a 'SimpleDesc'.
134−tellTree :: (MonadWriter SimpleDesc m, MonadThrow m)
135− => CheckCond
136− -> Component
137− -> (a -> BuildInfo)
138− -> (a -> Set Text) -- ^ get module names
139− -> CondTree ConfVar [Dependency] a
140− -> m ()
141−tellTree cc component getBI getModules =
142− loop
143− where
144− loop (CondNode dat deps comps) = do
145− tell mempty
146− { sdPackages = unionsWith (<>) $ flip map deps
147− $ \(Dependency x y) -> singletonMap x DepInfo
148− { diComponents = singletonSet component
149− , diRange = simplifyVersionRange y
150− }
151− , sdTools = unionsWith (<>) $ flip map (buildTools $ getBI dat)
152− $ \(Dependency name range) -> singletonMap
153− -- In practice, cabal files refer to the exe name, not the
154− -- package name.
155− (ExeName $ unPackageName name)
156− DepInfo
157− { diComponents = singletonSet component
158− , diRange = simplifyVersionRange range
159− }
160− , sdModules = getModules dat
161− }
162− forM_ comps $ \(cond, ontrue, onfalse) -> do
163− b <- checkCond cc cond
164− if b
165− then loop ontrue
166− else maybe (return ()) loop onfalse
167−
168−-- | Resolve a condition to a boolean based on the provided 'CheckCond'.
169−checkCond :: MonadThrow m => CheckCond -> Condition ConfVar -> m Bool
170−checkCond CheckCond {..} cond0 =
171− go cond0
172− where
173− go (Var (OS os)) = return $ os == ccOS
174− go (Var (Arch arch)) = return $ arch == ccArch
175− go (Var (Flag flag)) =
176− case lookup flag ccFlags of
177− Nothing -> throwM $ FlagNotDefined ccPackageName flag cond0
178− Just b -> return b
179− go (Var (Impl flavor range)) = return
180− $ flavor == ccCompilerFlavor
181− && ccCompilerVersion `withinRange` range
182− go (Lit b) = return b
183− go (CNot c) = not `liftM` go c
184− go (CAnd x y) = (&&) `liftM` go x `ap` go y
185− go (COr x y) = (||) `liftM` go x `ap` go y
186−
187−data CheckCondException = FlagNotDefined PackageName FlagName (Condition ConfVar)
188− deriving (Show, Typeable)
189−instance Exception CheckCondException
190−
191−data CheckCond = CheckCond
192− { ccPackageName :: PackageName -- for debugging only
193− , ccOS :: OS
194− , ccArch :: Arch
195− , ccFlags :: Map FlagName Bool
196− , ccCompilerFlavor :: CompilerFlavor
197− , ccCompilerVersion :: Version
198− , ccIncludeTests :: Bool
199− , ccIncludeBenchmarks :: Bool
200− }
Stackage/PackageIndex.hsdeleted−127
@@ -1,127 +0,0 @@
1−{-# LANGUAGE DeriveDataTypeable #-}
2−{-# LANGUAGE FlexibleContexts #-}
3−{-# LANGUAGE NoImplicitPrelude #-}
4−{-# LANGUAGE OverloadedStrings #-}
5−{-# LANGUAGE RankNTypes #-}
6−{-# LANGUAGE ViewPatterns #-}
7−-- | Dealing with the 00-index file and all its cabal files.
8−module Stackage.PackageIndex
9− ( sourcePackageIndex
10− , UnparsedCabalFile (..)
11− , getLatestDescriptions
12− ) where
13−
14−import qualified Codec.Archive.Tar as Tar
15−import Data.Conduit.Lazy (MonadActive,
16− lazyConsume)
17−import qualified Data.Text as T
18−import Distribution.PackageDescription (package,
19− packageDescription)
20−import Distribution.PackageDescription.Parse (ParseResult (..),
21− parsePackageDescription)
22−import Distribution.ParseUtils (PError)
23−import Stackage.Prelude
24−import System.Directory (getAppUserDataDirectory)
25−
26−-- | Name of the 00-index.tar downloaded from Hackage.
27−getPackageIndexPath :: MonadIO m => m FilePath
28−getPackageIndexPath = liftIO $ do
29− c <- getCabalRoot
30− configLines <- runResourceT $ sourceFile (c </> "config")
31− $$ decodeUtf8C
32− =$ linesUnboundedC
33− =$ concatMapC getRemoteCache
34− =$ sinkList
35− case configLines of
36− [x] -> return $ x </> "hackage.haskell.org" </> "00-index.tar"
37− [] -> error $ "No remote-repo-cache found in Cabal config file"
38− _ -> error $ "Multiple remote-repo-cache entries found in Cabal config file"
39− where
40− getCabalRoot :: IO FilePath
41− getCabalRoot = fpFromString <$> getAppUserDataDirectory "cabal"
42−
43− getRemoteCache s = do
44− ("remote-repo-cache", stripPrefix ":" -> Just v) <- Just $ break (== ':') s
45− Just $ fpFromText $ T.strip v
46−
47−-- | A cabal file with name and version parsed from the filepath, and the
48−-- package description itself ready to be parsed. It's left in unparsed form
49−-- for efficiency.
50−data UnparsedCabalFile = UnparsedCabalFile
51− { ucfName :: PackageName
52− , ucfVersion :: Version
53− , ucfParse :: forall m. MonadThrow m => m GenericPackageDescription
54− }
55−
56−-- | Stream all of the cabal files from the 00-index tar file.
57−sourcePackageIndex :: (MonadThrow m, MonadResource m, MonadActive m, MonadBaseControl IO m)
58− => Producer m UnparsedCabalFile
59−sourcePackageIndex = do
60− fp <- getPackageIndexPath
61− -- yay for the tar package. Use lazyConsume instead of readFile to get some
62− -- kind of resource protection
63− lbs <- lift $ fromChunks <$> lazyConsume (sourceFile fp)
64− loop (Tar.read lbs)
65− where
66− loop (Tar.Next e es) = goE e >> loop es
67− loop Tar.Done = return ()
68− loop (Tar.Fail e) = throwM e
69−
70− goE e
71− | Just front <- stripSuffix ".cabal" $ pack $ Tar.entryPath e
72− , Tar.NormalFile lbs _size <- Tar.entryContent e = do
73− (name, version) <- parseNameVersion front
74− yield UnparsedCabalFile
75− { ucfName = name
76− , ucfVersion = version
77− , ucfParse = goContent (Tar.entryPath e) name version lbs
78− }
79− | otherwise = return ()
80−
81− goContent fp name version lbs =
82− case parsePackageDescription $ unpack $ decodeUtf8 lbs of
83− ParseFailed e -> throwM $ CabalParseException (fpFromString fp) e
84− ParseOk _warnings gpd -> do
85− let pd = packageDescription gpd
86− PackageIdentifier name' version' = package pd
87− when (name /= name' || version /= version') $
88− throwM $ MismatchedNameVersion (fpFromString fp)
89− name name' version version'
90− return gpd
91−
92− parseNameVersion t1 = do
93− let (p', t2) = break (== '/') $ T.replace "\\" "/" t1
94− p <- simpleParse p'
95− t3 <- maybe (throwM $ InvalidCabalPath t1 "no slash") return
96− $ stripPrefix "/" t2
97− let (v', t4) = break (== '/') t3
98− v <- simpleParse v'
99− when (t4 /= cons '/' p') $ throwM $ InvalidCabalPath t1 $ "Expected at end: " ++ p'
100− return (p, v)
101−
102−data InvalidCabalPath = InvalidCabalPath Text Text
103− deriving (Show, Typeable)
104−instance Exception InvalidCabalPath
105−
106−data CabalParseException = CabalParseException FilePath PError
107− | MismatchedNameVersion FilePath PackageName PackageName Version Version
108− deriving (Show, Typeable)
109−instance Exception CabalParseException
110−
111−-- | Get all of the latest descriptions for name/version pairs matching the
112−-- given criterion.
113−getLatestDescriptions :: MonadIO m
114− => (PackageName -> Version -> Bool)
115− -> (GenericPackageDescription -> IO desc)
116− -> m (Map PackageName desc)
117−getLatestDescriptions f parseDesc = liftIO $ do
118− m <- runResourceT $ sourcePackageIndex $$ filterC f' =$ foldlC add mempty
119− forM m $ \ucf -> liftIO $ ucfParse ucf >>= parseDesc
120− where
121− f' ucf = f (ucfName ucf) (ucfVersion ucf)
122− add m ucf =
123− case lookup name m of
124− Just ucf' | ucfVersion ucf < ucfVersion ucf' -> m
125− _ -> insertMap name ucf m
126− where
127− name = ucfName ucf
Stackage/PerformBuild.hsdeleted−560
@@ -1,560 +0,0 @@
1−-- | Perform an actual build, generate a binary package database and a
2−-- documentation directory in the process.
3−{-# LANGUAGE CPP #-}
4−{-# LANGUAGE DeriveDataTypeable #-}
5−{-# LANGUAGE NoImplicitPrelude #-}
6−{-# LANGUAGE OverloadedStrings #-}
7−{-# LANGUAGE RecordWildCards #-}
8−module Stackage.PerformBuild
9− ( performBuild
10− , PerformBuild (..)
11− , BuildException (..)
12− , pbDocDir
13− ) where
14−
15−import Control.Concurrent.Async (async)
16−import Control.Concurrent.STM.TSem
17−import Control.Monad.Writer.Strict (execWriter, tell)
18−import qualified Data.Map as Map
19−import Data.NonNull (fromNullable)
20−import Filesystem (canonicalizePath, createTree,
21− getWorkingDirectory, isDirectory,
22− removeTree, rename, isFile, removeFile)
23−import Filesystem.Path (parent)
24−import qualified Filesystem.Path as F
25−import Stackage.BuildConstraints
26−import Stackage.BuildPlan
27−import Stackage.GhcPkg
28−import Stackage.PackageDescription
29−import Stackage.Prelude hiding (pi)
30−import System.Directory (findExecutable)
31−import System.Environment (getEnvironment)
32−import System.IO (IOMode (WriteMode),
33− openBinaryFile)
34−import System.IO.Temp (withSystemTempDirectory)
35−
36−data BuildException = BuildException (Map PackageName BuildFailure) [Text]
37− deriving Typeable
38−instance Exception BuildException
39−instance Show BuildException where
40− show (BuildException m warnings) =
41− unlines $ map go (mapToList m) ++ map unpack warnings
42− where
43− go (PackageName name, bf) = concat
44− [ name
45− , ": "
46− , show bf
47− ]
48−
49−data BuildFailure = DependencyFailed PackageName
50− | DependencyMissing PackageName
51− | ToolMissing ExeName
52− | NotImplemented
53− | BuildFailureException SomeException
54− deriving (Show, Typeable)
55−instance Exception BuildFailure
56−
57−data PerformBuild = PerformBuild
58− { pbPlan :: BuildPlan
59− , pbInstallDest :: FilePath
60− , pbLog :: ByteString -> IO ()
61− , pbLogDir :: FilePath
62− , pbJobs :: Int
63− , pbGlobalInstall :: Bool
64− -- ^ 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
72− , pbBuildHoogle :: Bool
73− -- ^ Should we build Hoogle database?
74− --
75− -- May be disabled due to: https://ghc.haskell.org/trac/ghc/ticket/9921
76− }
77−
78−data PackageInfo = PackageInfo
79− { piPlan :: PackagePlan
80− , piName :: PackageName
81− , piResult :: TMVar Bool
82− }
83−
84−waitForDeps :: Map ExeName (Set PackageName)
85− -> Map PackageName PackageInfo
86− -> Set Component
87− -> BuildPlan
88− -> PackageInfo
89− -> IO a
90− -> IO a
91−waitForDeps toolMap packageMap activeComps bp pi action = do
92− atomically $ do
93− mapM_ checkPackage $ Map.keys $ filterUnused $ sdPackages $ ppDesc $ piPlan pi
94− forM_ (Map.keys $ filterUnused $ sdTools $ ppDesc $ piPlan pi) $ \exe -> do
95− case lookup exe toolMap >>= fromNullable . map checkPackage . setToList of
96− Nothing
97− | isCoreExe exe -> return ()
98− -- https://github.com/jgm/zip-archive/issues/23
99− -- - | otherwise -> throwSTM $ ToolMissing exe
100− | otherwise -> return ()
101− Just packages -> ofoldl1' (<|>) packages
102− action
103− where
104− filterUnused :: Ord key => Map key DepInfo -> Map key DepInfo
105− filterUnused =
106− mapFromList . filter (go . snd) . mapToList
107− where
108− go = not . null . intersection activeComps . diComponents
109−
110− checkPackage package | package == piName pi = return ()
111− checkPackage package =
112− case lookup package packageMap of
113− Nothing
114− | isCore package -> return ()
115− | otherwise -> throwSTM $ DependencyMissing package
116− Just dep -> do
117− res <- readTMVar $ piResult dep
118− unless res $ throwSTM $ DependencyFailed package
119−
120− isCore = (`member` siCorePackages (bpSystemInfo bp))
121− isCoreExe = (`member` siCoreExecutables (bpSystemInfo bp))
122−
123−withCounter :: TVar Int -> IO a -> IO a
124−withCounter counter = bracket_
125− (atomically $ modifyTVar counter (+ 1))
126− (atomically $ modifyTVar counter (subtract 1))
127−
128−withTSem :: TSem -> IO a -> IO a
129−withTSem sem = bracket_ (atomically $ waitTSem sem) (atomically $ signalTSem sem)
130−
131−-- | Returns @Nothing@ if installing to a global database
132−pbDatabase :: PerformBuild -> Maybe FilePath
133−pbDatabase pb
134− | pbGlobalInstall pb = Nothing
135− | otherwise = Just $ pbInstallDest pb </> "pkgdb"
136−
137−pbBinDir, pbLibDir, pbDataDir, pbDocDir :: PerformBuild -> FilePath
138−pbBinDir pb = pbInstallDest pb </> "bin"
139−pbLibDir pb = pbInstallDest pb </> "lib"
140−pbDataDir pb = pbInstallDest pb </> "share"
141−pbDocDir pb = pbInstallDest pb </> "doc"
142−
143−-- | Directory keeping previous result info
144−pbPrevResDir :: PerformBuild -> FilePath
145−pbPrevResDir pb = pbInstallDest pb </> "prevres"
146−
147−performBuild :: PerformBuild -> IO [Text]
148−performBuild pb = do
149− cwd <- getWorkingDirectory
150− performBuild' pb
151− { pbInstallDest = cwd </> pbInstallDest pb
152− , pbLogDir = cwd </> pbLogDir pb
153− }
154−
155−performBuild' :: PerformBuild -> IO [Text]
156−performBuild' pb@PerformBuild {..} = withBuildDir $ \builddir -> do
157− -- First make sure to fetch all of the dependencies... just in case Hackage
158− -- has an outage. Don't feel like wasting hours of CPU time.
159− pbLog $ encodeUtf8 "Pre-fetching all packages\n"
160− let toDownload = flip map (mapToList $ bpPackages pbPlan)
161− $ \(name, plan) -> unpack $ concat
162− [ display name
163− , "-"
164− , display $ ppVersion plan
165− ]
166− withCheckedProcess
167− (proc "cabal"
168− $ "fetch"
169− : "--no-dependencies"
170− : toDownload)
171− $ \ClosedStream Inherited Inherited -> return ()
172−
173− let removeTree' fp = whenM (isDirectory fp) (removeTree fp)
174− removeTree' pbLogDir
175−
176− forM_ (pbDatabase pb) $ \db ->
177− unlessM (isFile $ db </> "package.cache") $ do
178− createTree $ parent db
179− withCheckedProcess (proc "ghc-pkg" ["init", fpToString db])
180− $ \ClosedStream Inherited Inherited -> return ()
181− pbLog $ encodeUtf8 "Copying built-in Haddocks\n"
182− copyBuiltInHaddocks (pbDocDir pb)
183−
184− sem <- atomically $ newTSem pbJobs
185− active <- newTVarIO (0 :: Int)
186− let toolMap = makeToolMap $ bpPackages pbPlan
187− packageMap <- fmap fold $ forM (mapToList $ bpPackages pbPlan)
188− $ \(name, plan) -> do
189− let piPlan = plan
190− piName = name
191− piResult <- newEmptyTMVarIO
192− return $ singletonMap name PackageInfo {..}
193−
194− errsVar <- newTVarIO mempty
195− warningsVar <- newTVarIO id
196− mutex <- newMVar ()
197− env <- getEnvironment
198− haddockFiles <- newTVarIO mempty
199−
200− registeredPackages <- setupPackageDatabase
201− (pbDatabase pb)
202− (pbDocDir pb)
203− pbLog
204− (ppVersion <$> bpPackages pbPlan)
205− (deletePreviousResults pb)
206−
207− forM_ packageMap $ \pi -> void $ async $ singleBuild pb registeredPackages
208− SingleBuild
209− { sbSem = sem
210− , sbErrsVar = errsVar
211− , sbWarningsVar = warningsVar
212− , sbActive = active
213− , sbToolMap = toolMap
214− , sbPackageMap = packageMap
215− , sbBuildDir = builddir
216− , sbPackageInfo = pi
217− , sbRegisterMutex = mutex
218− , sbModifiedEnv = maybe
219− id
220− (\db -> (("HASKELL_PACKAGE_SANDBOX", fpToString db):))
221− (pbDatabase pb)
222− (filter allowedEnv $ map fixEnv env)
223− , sbHaddockFiles = haddockFiles
224− }
225−
226− void $ tryAny $ atomically $ readTVar active >>= checkSTM . (== 0)
227−
228− warnings <- ($ []) <$> readTVarIO warningsVar
229− errs <- readTVarIO errsVar
230− when (not $ null errs) $ throwM $ BuildException errs warnings
231− return warnings
232− where
233− withBuildDir f = withSystemTempDirectory "stackage-build" (f . fpFromString)
234−
235− fixEnv (p, x)
236− -- Thank you Windows having case-insensitive environment variables...
237− | toUpper p == "PATH" = (p, fpToString (pbBinDir pb) ++ pathSep : x)
238− | otherwise = (p, x)
239−
240− allowedEnv (k, _) = k `notMember` bannedEnvs
241−
242− -- | Separate for the PATH environment variable
243− pathSep :: Char
244−#ifdef mingw32_HOST_OS
245− pathSep = ';'
246−#else
247− pathSep = ':'
248−#endif
249−
250−-- | Environment variables we don't allow to be passed on to child processes.
251−bannedEnvs :: Set String
252−bannedEnvs = setFromList
253− [ "STACKAGE_AUTH_TOKEN"
254− ]
255−
256−data SingleBuild = SingleBuild
257− { sbSem :: TSem
258− , sbErrsVar :: TVar (Map PackageName BuildFailure)
259− , sbWarningsVar :: TVar ([Text] -> [Text])
260− , sbActive :: TVar Int
261− , sbToolMap :: Map ExeName (Set PackageName)
262− , sbPackageMap :: Map PackageName PackageInfo
263− , sbBuildDir :: FilePath
264− , sbPackageInfo :: PackageInfo
265− , sbRegisterMutex :: MVar ()
266− , sbModifiedEnv :: [(String, String)]
267− , sbHaddockFiles :: TVar (Map Text FilePath) -- ^ package-version, .haddock file
268− }
269−
270−singleBuild :: PerformBuild
271− -> Set PackageName -- ^ registered packages
272− -> SingleBuild -> IO ()
273−singleBuild pb@PerformBuild {..} registeredPackages SingleBuild {..} =
274− withCounter sbActive
275− $ handle updateErrs
276− $ (`finally` void (atomically $ tryPutTMVar (piResult sbPackageInfo) False))
277− $ inner
278− where
279− libComps = setFromList [CompLibrary, CompExecutable]
280− testComps = insertSet CompTestSuite libComps
281− inner = do
282− let wfd comps =
283− waitForDeps sbToolMap sbPackageMap comps pbPlan sbPackageInfo
284− . withTSem sbSem
285− withUnpacked <- wfd libComps buildLibrary
286−
287− wfd testComps (runTests withUnpacked)
288−
289− pname = piName sbPackageInfo
290− pident = PackageIdentifier pname (ppVersion $ piPlan sbPackageInfo)
291− name = display pname
292− namever = concat
293− [ name
294− , "-"
295− , display $ ppVersion $ piPlan sbPackageInfo
296− ]
297−
298− runIn wdir getOutH cmd args = do
299− outH <- getOutH
300− withCheckedProcess (cp outH) $ \ClosedStream UseProvidedHandle UseProvidedHandle ->
301− (return () :: IO ())
302− where
303− cp outH = (proc (unpack $ asText cmd) (map (unpack . asText) args))
304− { cwd = Just $ fpToString wdir
305− , std_out = UseHandle outH
306− , std_err = UseHandle outH
307− , env = Just sbModifiedEnv
308− }
309− runParent = runIn sbBuildDir
310− runChild = runIn childDir
311− childDir = sbBuildDir </> fpFromText namever
312−
313− log' t = do
314− i <- readTVarIO sbActive
315− errs <- readTVarIO sbErrsVar
316− pbLog $ encodeUtf8 $ concat
317− [ t
318− , " (pending: "
319− , tshow i
320− , ", failures: "
321− , tshow $ length errs
322− , ")\n"
323− ]
324− libOut = pbLogDir </> fpFromText namever </> "build.out"
325− testOut = pbLogDir </> fpFromText namever </> "test.out"
326− testRunOut = pbLogDir </> fpFromText namever </> "test-run.out"
327−
328− wf fp inner' = do
329− ref <- newIORef Nothing
330− let cleanup = do
331− mh <- readIORef ref
332− forM_ mh hClose
333− getH = do
334− mh <- readIORef ref
335− case mh of
336− Just h -> return h
337− Nothing -> mask_ $ do
338− createTree $ parent fp
339− h <- openBinaryFile (fpToString fp) WriteMode
340− writeIORef ref $ Just h
341− return h
342−
343− inner' getH `finally` cleanup
344−
345− configArgs = ($ []) $ execWriter $ do
346− when pbAllowNewer $ tell' "--allow-newer"
347− tell' "--package-db=clear"
348− tell' "--package-db=global"
349− forM_ (pbDatabase pb) $ \db -> tell' $ "--package-db=" ++ fpToText db
350− tell' $ "--libdir=" ++ fpToText (pbLibDir pb)
351− tell' $ "--bindir=" ++ fpToText (pbBinDir pb)
352− tell' $ "--datadir=" ++ fpToText (pbDataDir pb)
353− tell' $ "--docdir=" ++ fpToText (pbDocDir pb)
354− tell' $ "--flags=" ++ flags
355− when (pbEnableLibProfiling && pcEnableLibProfile) $
356− tell' "--enable-library-profiling"
357− when pbEnableExecDyn $ tell' "--enable-executable-dynamic"
358− where
359− tell' x = tell (x:)
360−
361− flags :: Text
362− flags = unwords $ map go $ mapToList pcFlagOverrides
363− where
364− go (name', isOn) = concat
365− [ if isOn then "" else "-"
366− , unFlagName name'
367− ]
368−
369− PackageConstraints {..} = ppConstraints $ piPlan sbPackageInfo
370−
371− buildLibrary = wf libOut $ \getOutH -> do
372− let run a b = do when pbVerbose $ log' (unwords (a : b))
373− runChild getOutH a b
374−
375− isUnpacked <- newIORef False
376− let withUnpacked inner = do
377− unlessM (readIORef isUnpacked) $ do
378− log' $ "Unpacking " ++ namever
379− runParent getOutH "cabal" ["unpack", namever]
380− writeIORef isUnpacked True
381− inner
382−
383− isConfiged <- newIORef False
384− let withConfiged inner = withUnpacked $ do
385− unlessM (readIORef isConfiged) $ do
386− log' $ "Configuring " ++ namever
387− run "cabal" $ "configure" : configArgs
388− writeIORef isConfiged True
389− inner
390−
391− prevBuildResult <- getPreviousResult pb Build pident
392− unless (prevBuildResult == PRSuccess) $ withConfiged $ do
393− assert (pname `notMember` registeredPackages) $ do
394− deletePreviousResults pb pident
395−
396− log' $ "Building " ++ namever
397− run "cabal" ["build"]
398−
399− log' $ "Copying/registering " ++ namever
400− run "cabal" ["copy"]
401− withMVar sbRegisterMutex $ const $
402− run "cabal" ["register"]
403−
404− savePreviousResult pb Build pident True
405−
406− -- Even if the tests later fail, we can allow other libraries to build
407− -- on top of our successful results
408− --
409− -- FIXME do we need to wait to do this until after Haddocks build?
410− -- otherwise, we could have a race condition and try to build a
411− -- dependency's haddocks before this finishes
412− atomically $ putTMVar (piResult sbPackageInfo) True
413−
414− prevHaddockResult <- getPreviousResult pb Haddock pident
415− let needHaddock = pbEnableHaddock
416− && checkPrevResult prevHaddockResult pcHaddocks
417− && not (null $ sdModules $ ppDesc $ piPlan sbPackageInfo)
418− when needHaddock $ withConfiged $ do
419− log' $ "Haddocks " ++ namever
420− hfs <- readTVarIO sbHaddockFiles
421− let hfsOpts = flip map (mapToList hfs) $ \(pkgVer, hf) -> concat
422− [ "--haddock-options=--read-interface="
423− , "../"
424− , pkgVer
425− , "/,"
426− , fpToText hf
427− ]
428− args = ($ hfsOpts) $ execWriter $ do
429− let tell' x = tell (x:)
430− tell' "haddock"
431− tell' "--hyperlink-source"
432− tell' "--html"
433− when pbBuildHoogle $ tell' "--hoogle"
434− tell' "--html-location=../$pkg-$version/"
435−
436− eres <- tryAny $ run "cabal" args
437−
438− forM_ eres $ \() -> do
439− renameOrCopy
440− (childDir </> "dist" </> "doc" </> "html" </> fpFromText name)
441− (pbDocDir pb </> fpFromText namever)
442−
443− enewPath <- tryIO
444− $ canonicalizePath
445− $ pbDocDir pb
446− </> fpFromText namever
447− </> fpFromText name <.> "haddock"
448− case enewPath of
449− Left e -> warn $ tshow e
450− Right newPath -> atomically
451− $ modifyTVar sbHaddockFiles
452− $ insertMap namever newPath
453−
454− savePreviousResult pb Haddock pident $ either (const False) (const True) eres
455− case (eres, pcHaddocks) of
456− (Left e, ExpectSuccess) -> throwM e
457− (Right (), ExpectFailure) -> warn $ namever ++ ": unexpected Haddock success"
458− _ -> return ()
459−
460− return withUnpacked
461−
462− runTests withUnpacked = wf testOut $ \getOutH -> do
463− let run = runChild getOutH
464−
465− prevTestResult <- getPreviousResult pb Test pident
466− let needTest = pbEnableTests
467− && checkPrevResult prevTestResult pcTests
468− when needTest $ withUnpacked $ do
469− log' $ "Test configure " ++ namever
470− run "cabal" $ "configure" : "--enable-tests" : configArgs
471−
472− eres <- tryAny $ do
473− log' $ "Test build " ++ namever
474− run "cabal" ["build"]
475−
476− log' $ "Test run " ++ namever
477− run "cabal" ["test", "--log=" ++ fpToText testRunOut]
478−
479− savePreviousResult pb Test pident $ either (const False) (const True) eres
480− case (eres, pcTests) of
481− (Left e, ExpectSuccess) -> throwM e
482− (Right (), ExpectFailure) -> warn $ namever ++ ": unexpected test success"
483− _ -> return ()
484−
485− warn t = atomically $ modifyTVar sbWarningsVar (. (t:))
486−
487− updateErrs exc = do
488− log' $ concat
489− [ display (piName sbPackageInfo)
490− , ": "
491− , tshow exc
492− ]
493− atomically $ modifyTVar sbErrsVar $ insertMap (piName sbPackageInfo) exc'
494− where
495− exc' =
496− case fromException exc of
497− Just bf -> bf
498− Nothing -> BuildFailureException exc
499−
500−renameOrCopy :: FilePath -> FilePath -> IO ()
501−renameOrCopy src dest = rename src dest `catchIO` \_ -> copyDir src dest
502−
503−copyBuiltInHaddocks :: FilePath -> IO ()
504−copyBuiltInHaddocks docdir = do
505− mghc <- findExecutable "ghc"
506− case mghc of
507− Nothing -> error "GHC not found on PATH"
508− Just ghc -> do
509− src <- canonicalizePath
510− (parent (fpFromString ghc) </> "../share/doc/ghc/html/libraries")
511− copyDir src docdir
512−
513−------------- Previous results
514−
515−-- | The previous actions that can be run
516−data ResultType = Build | Haddock | Test
517− deriving (Show, Enum, Eq, Ord, Bounded, Read)
518−
519−-- | The result generated on a previous run
520−data PrevResult = PRNoResult | PRSuccess | PRFailure
521− deriving (Show, Enum, Eq, Ord, Bounded, Read)
522−
523−-- | Check if we should rerun based on a PrevResult and the expected status
524−checkPrevResult :: PrevResult -> TestState -> Bool
525−checkPrevResult _ Don'tBuild = False
526−checkPrevResult PRNoResult _ = True
527−checkPrevResult PRSuccess _ = False
528−checkPrevResult PRFailure ExpectSuccess = True
529−checkPrevResult PRFailure _ = False
530−
531−withPRPath :: PerformBuild -> ResultType -> PackageIdentifier -> (FilePath -> IO a) -> IO a
532−withPRPath pb rt ident inner = do
533− createTree $ parent fp
534− inner fp
535− where
536− fp = pbPrevResDir pb </> fpFromString (show rt) </> fpFromText (display ident)
537−
538−successBS, failureBS :: ByteString
539−successBS = "success"
540−failureBS = "failure"
541−
542−getPreviousResult :: PerformBuild -> ResultType -> PackageIdentifier -> IO PrevResult
543−getPreviousResult w x y = withPRPath w x y $ \fp -> do
544− eres <- tryIO $ readFile fp
545− return $ case eres of
546− Right bs
547− | bs == successBS -> PRSuccess
548− | bs == failureBS -> PRFailure
549− _ -> PRNoResult
550−
551−savePreviousResult :: PerformBuild -> ResultType -> PackageIdentifier -> Bool -> IO ()
552−savePreviousResult pb rt ident res =
553− withPRPath pb rt ident $ \fp -> writeFile fp $
554− if res then successBS else failureBS
555−
556−deletePreviousResults :: PerformBuild -> PackageIdentifier -> IO ()
557−deletePreviousResults pb name =
558− forM_ [minBound..maxBound] $ \rt ->
559− withPRPath pb rt name $ \fp ->
560− void $ tryIO $ removeFile fp
Stackage/Prelude.hsdeleted−116
@@ -1,116 +0,0 @@
1−{-# LANGUAGE DeriveDataTypeable #-}
2−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
3−{-# LANGUAGE NoImplicitPrelude #-}
4−{-# LANGUAGE OverloadedStrings #-}
5−{-# LANGUAGE TypeFamilies #-}
6−module Stackage.Prelude
7− ( module X
8− , module Stackage.Prelude
9− ) where
10−
11−import ClassyPrelude.Conduit as X
12−import Data.Aeson (FromJSON, ToJSON)
13−import Data.Conduit.Process as X
14−import qualified Data.Map as Map
15−import Data.Typeable (TypeRep, typeOf)
16−import Distribution.Package as X (PackageIdentifier (..), PackageName (PackageName))
17−import Distribution.PackageDescription as X (FlagName (..), GenericPackageDescription)
18−import qualified Distribution.Text as DT
19−import Distribution.Version as X (Version (..),
20− VersionRange)
21−import Distribution.Version as X (withinRange)
22−import qualified Distribution.Version as C
23−import Filesystem (createTree)
24−import Filesystem.Path (parent)
25−import qualified Filesystem.Path as F
26−
27−unPackageName :: PackageName -> Text
28−unPackageName (PackageName str) = pack str
29−
30−unFlagName :: FlagName -> Text
31−unFlagName (FlagName str) = pack str
32−
33−mkPackageName :: Text -> PackageName
34−mkPackageName = PackageName . unpack
35−
36−mkFlagName :: Text -> FlagName
37−mkFlagName = FlagName . unpack
38−
39−display :: DT.Text a => a -> Text
40−display = fromString . DT.display
41−
42−simpleParse :: (MonadThrow m, DT.Text a, Typeable a) => Text -> m a
43−simpleParse orig = withTypeRep $ \rep ->
44− case DT.simpleParse str of
45− Nothing -> throwM (ParseFailedException rep (pack str))
46− Just v -> return v
47− where
48− str = unpack orig
49−
50− withTypeRep :: Typeable a => (TypeRep -> m a) -> m a
51− withTypeRep f =
52− res
53− where
54− res = f (typeOf (unwrap res))
55−
56− unwrap :: m a -> a
57− unwrap _ = error "unwrap"
58−
59−data ParseFailedException = ParseFailedException TypeRep Text
60− deriving (Show, Typeable)
61−instance Exception ParseFailedException
62−
63−newtype Maintainer = Maintainer { unMaintainer :: Text }
64− deriving (Show, Eq, Ord, Hashable, ToJSON, FromJSON, IsString)
65−
66−-- | Name of an executable.
67−newtype ExeName = ExeName { unExeName :: Text }
68− deriving (Show, Eq, Ord, Hashable, ToJSON, FromJSON, IsString)
69−
70−intersectVersionRanges :: VersionRange -> VersionRange -> VersionRange
71−intersectVersionRanges x y = C.simplifyVersionRange $ C.intersectVersionRanges x y
72−
73−-- | There seems to be a bug in Cabal where serializing and deserializing
74−-- version ranges winds up with different representations. So we have a
75−-- super-simplifier to deal with that.
76−simplifyVersionRange :: VersionRange -> VersionRange
77−simplifyVersionRange vr =
78− fromMaybe (assert False vr') $ simpleParse $ display vr'
79− where
80− vr' = C.simplifyVersionRange vr
81−
82−-- | Topologically sort so that items with dependencies occur after those
83−-- dependencies.
84−topologicalSort :: (Ord key, Show key, MonadThrow m, Typeable key)
85− => (value -> finalValue)
86− -> (value -> Set key) -- ^ deps
87− -> Map key value
88− -> m (Vector (key, finalValue))
89−topologicalSort toFinal toDeps =
90− loop id . mapWithKey removeSelfDeps . fmap (toDeps &&& toFinal)
91− where
92− removeSelfDeps k (deps, final) = (deleteSet k deps, final)
93− loop front toProcess | null toProcess = return $ pack $ front []
94− loop front toProcess
95− | null noDeps = throwM $ NoEmptyDeps (map fst toProcess')
96− | otherwise = loop (front . noDeps') (mapFromList hasDeps)
97− where
98− toProcess' = fmap (first removeUnavailable) toProcess
99− allKeys = Map.keysSet toProcess
100− removeUnavailable = asSet . setFromList . filter (`member` allKeys) . setToList
101− (noDeps, hasDeps) = partition (null . fst . snd) $ mapToList toProcess'
102− noDeps' = (map (second snd) noDeps ++)
103−
104−data TopologicalSortException key = NoEmptyDeps (Map key (Set key))
105− deriving (Show, Typeable)
106−instance (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.hsdeleted−271
@@ -1,271 +0,0 @@
1−-- | Create a bundle to be uploaded to Stackage Server.
2−{-# LANGUAGE NoImplicitPrelude #-}
3−{-# LANGUAGE OverloadedStrings #-}
4−{-# LANGUAGE RecordWildCards #-}
5−module Stackage.ServerBundle
6− ( serverBundle
7− , epochTime
8− , bpAllPackages
9− , docsListing
10− , createBundleV2
11− , CreateBundleV2 (..)
12− , SnapshotType (..)
13− , writeIndexStyle
14− , DocMap
15− , PackageDocs (..)
16− ) where
17−
18−import qualified Codec.Archive.Tar as Tar
19−import qualified Codec.Archive.Tar.Entry as Tar
20−import qualified Codec.Compression.GZip as GZip
21−import qualified Data.Map as M
22−import Data.Aeson (ToJSON (..), (.=), object, FromJSON (..), (.:), withObject)
23−import System.IO.Temp (withTempDirectory)
24−import qualified Data.Yaml as Y
25−import Filesystem (isFile, getWorkingDirectory, listDirectory, isDirectory, canonicalizePath)
26−import Foreign.C.Types (CTime (CTime))
27−import Stackage.BuildConstraints
28−import Stackage.BuildPlan
29−import Stackage.Prelude
30−import System.IO.Temp (withTempDirectory)
31−import qualified System.PosixCompat.Time as PC
32−import qualified Text.XML as X
33−import Text.XML.Cursor
34−import System.PosixCompat.Files (createSymbolicLink)
35−
36−-- | Get current time
37−epochTime :: IO Tar.EpochTime
38−epochTime = (\(CTime t) -> fromIntegral t) <$> PC.epochTime
39−
40−-- | All package/versions in a build plan, including core packages.
41−--
42−-- Note that this may include packages not available on Hackage.
43−bpAllPackages :: BuildPlan -> Map PackageName Version
44−bpAllPackages BuildPlan {..} =
45− siCorePackages bpSystemInfo ++ map ppVersion bpPackages
46−
47−serverBundle :: Tar.EpochTime
48− -> Text -- ^ title
49− -> Text -- ^ slug
50− -> BuildPlan
51− -> LByteString
52−serverBundle time title slug bp@BuildPlan {..} = GZip.compress $ Tar.write
53− [ fe "build-plan.yaml" (fromStrict $ Y.encode bp)
54− , fe "hackage" hackage
55− , fe "slug" (fromStrict $ encodeUtf8 slug)
56− , fe "desc" (fromStrict $ encodeUtf8 title)
57− , fe "core" corePackagesList
58− ]
59− where
60− fe name contents =
61− case Tar.toTarPath False name of
62− Left s -> error s
63− Right name' -> (Tar.fileEntry name' contents)
64− { Tar.entryTime = time
65− }
66− hackage = builderToLazy $ foldMap goPair $ mapToList packageMap
67−
68− -- need to remove some packages that don't exist on Hackage
69− packageMap = foldr deleteMap (bpAllPackages bp) $ map PackageName
70− [ "bin-package-db"
71− , "ghc"
72− , "rts"
73− ]
74−
75− goPair (name, version) =
76− toBuilder (display name) ++
77− toBuilder (asText "-") ++
78− toBuilder (display version) ++
79− toBuilder (asText "\n")
80−
81− corePackagesList =
82− builderToLazy $ toBuilder $ unlines $
83− map (\(PackageName name) -> name)
84− (M.keys $ siCorePackages bpSystemInfo)
85−
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−
103−docsListing :: BuildPlan
104− -> FilePath -- ^ docs directory
105− -> IO DocMap
106−docsListing bp docsDir =
107− fmap fold $ mapM go $ mapToList $ bpAllPackages bp
108− where
109− go :: (PackageName, Version) -> IO DocMap
110− go (package, version) = do -- handleAny (const $ return mempty) $ do
111− let dirname = fpFromText (concat
112− [ display package
113− , "-"
114− , display version
115− ])
116− indexFP = (docsDir </> dirname </> "index.html")
117− ie <- isFile indexFP
118− if ie
119− then do
120− doc <- flip X.readFile indexFP X.def
121− { X.psDecodeEntities = X.decodeHtmlEntities
122− }
123− let cursor = fromDocument doc
124− getPair x = take 1 $ do
125− href <- attribute "href" x
126− let name = concat $ x $// content
127− guard $ not $ null name
128− return (href, name)
129− pairs = cursor $// attributeIs "class" "module"
130− &/ laxElement "a" >=> getPair
131− m <- fmap fold $ forM pairs $ \(href, name) -> do
132− let suffix = dirname </> fpFromText href
133− e <- isFile $ docsDir </> suffix
134− return $ if e
135− then asMap $ singletonMap name [fpToText dirname, href]
136− else mempty
137− return $ singletonMap (display package) $ PackageDocs
138− { pdVersion = display version
139− , pdModules = m
140− }
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/UpdateBuildPlan.hsdeleted−54
@@ -1,54 +0,0 @@
1−{-# LANGUAGE NoImplicitPrelude #-}
2−{-# LANGUAGE OverloadedStrings #-}
3−{-# LANGUAGE RecordWildCards #-}
4−-- | Take an existing build plan and bump all packages to the newest version in
5−-- the same major version number.
6−module Stackage.UpdateBuildPlan
7− ( updateBuildConstraints
8− , updateBuildPlan
9− ) where
10−
11−import qualified Data.Map as Map
12−import Distribution.Version (anyVersion, earlierVersion,
13− orLaterVersion)
14−import Stackage.BuildConstraints
15−import Stackage.BuildPlan
16−import Stackage.Prelude
17−
18−updateBuildPlan :: Map PackageName PackagePlan -> BuildPlan -> IO BuildPlan
19−updateBuildPlan packagesOrig
20− = newBuildPlan packagesOrig . updateBuildConstraints
21−
22−updateBuildConstraints :: BuildPlan -> BuildConstraints
23−updateBuildConstraints BuildPlan {..} =
24− BuildConstraints {..}
25− where
26− bcSystemInfo = bpSystemInfo
27− bcPackages = Map.keysSet bpPackages
28− bcGithubUsers = bpGithubUsers
29−
30− bcPackageConstraints name = PackageConstraints
31− { pcVersionRange = addBumpRange (maybe anyVersion pcVersionRange moldPC)
32− , pcMaintainer = moldPC >>= pcMaintainer
33− , pcTests = maybe ExpectSuccess pcTests moldPC
34− , pcHaddocks = maybe ExpectSuccess pcHaddocks moldPC
35− , pcBuildBenchmarks = maybe True pcBuildBenchmarks moldPC
36− , pcFlagOverrides = maybe mempty pcFlagOverrides moldPC
37− , pcEnableLibProfile = maybe False pcEnableLibProfile moldPC
38− }
39− where
40− moldBP = lookup name bpPackages
41− moldPC = ppConstraints <$> moldBP
42−
43− addBumpRange oldRange =
44− case moldBP of
45− Nothing -> oldRange
46− Just bp -> intersectVersionRanges oldRange
47− $ bumpRange $ ppVersion bp
48−
49− bumpRange version = intersectVersionRanges
50− (orLaterVersion version)
51− (earlierVersion $ bumpVersion version)
52− bumpVersion (Version (x:y:_) _) = Version [x, y + 1] []
53− bumpVersion (Version [x] _) = Version [x, 1] []
54− bumpVersion (Version [] _) = assert False $ Version [1, 0] []
Stackage/Upload.hsdeleted−272
@@ -1,272 +0,0 @@
1−-- | Upload to Stackage and Hackage
2−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
3−{-# LANGUAGE NoImplicitPrelude #-}
4−{-# LANGUAGE OverloadedStrings #-}
5−{-# LANGUAGE RecordWildCards #-}
6−{-# LANGUAGE TupleSections #-}
7−module Stackage.Upload
8− ( UploadBundle (..)
9− , SnapshotIdent (..)
10− , uploadBundle
11− , UploadDocs (..)
12− , uploadDocs
13− , uploadHackageDistro
14− , uploadHackageDistroNamed
15− , UploadDocMap (..)
16− , uploadDocMap
17− , uploadBundleV2
18− , UploadBundleV2 (..)
19− , def
20− , StackageServer
21− , unStackageServer
22− ) where
23−
24−import Control.Monad.Writer.Strict (execWriter, tell)
25−import Data.Default.Class (Default (..))
26−import Data.Function (fix)
27−import Filesystem (isDirectory, isFile)
28−import Network.HTTP.Client
29−import qualified Network.HTTP.Client.Conduit as HCC
30−import Network.HTTP.Client.MultipartFormData
31−import Stackage.BuildPlan (BuildPlan)
32−import Stackage.Prelude
33−import Stackage.ServerBundle (bpAllPackages, docsListing, writeIndexStyle)
34−import System.IO.Temp (withSystemTempFile)
35−import qualified System.IO as IO
36−import qualified Data.Yaml as Y
37−
38−newtype StackageServer = StackageServer { unStackageServer :: Text }
39− deriving (Show, Eq, Ord, Hashable, IsString)
40−instance Default StackageServer where
41− def = "http://www.stackage.org"
42−
43−data UploadBundle = UploadBundle
44− { ubServer :: StackageServer
45− , ubContents :: LByteString
46− , ubAlias :: Maybe Text
47− , ubNightly :: Maybe Text -- ^ should be GHC version
48− , ubLTS :: Maybe Text -- ^ e.g. 2.3
49− , ubAuthToken :: Text
50− }
51−instance Default UploadBundle where
52− def = UploadBundle
53− { ubServer = def
54− , ubContents = mempty
55− , ubAlias = Nothing
56− , ubNightly = Nothing
57− , ubLTS = Nothing
58− , ubAuthToken = "no-auth-token-provided"
59− }
60−
61−newtype SnapshotIdent = SnapshotIdent { unSnapshotIdent :: Text }
62− deriving (Show, Eq, Ord, Hashable, IsString)
63−
64−uploadBundle :: UploadBundle -> Manager -> IO (SnapshotIdent, Maybe Text)
65−uploadBundle UploadBundle {..} man = do
66− req1 <- parseUrl $ unpack $ unStackageServer ubServer ++ "/upload"
67− req2 <- formDataBody formData req1
68− let req3 = req2
69− { method = "PUT"
70− , requestHeaders =
71− [ ("Authorization", encodeUtf8 ubAuthToken)
72− , ("Accept", "application/json")
73− ] ++ requestHeaders req2
74− , redirectCount = 0
75− , checkStatus = \_ _ _ -> Nothing
76− , responseTimeout = Just 300000000
77− }
78− res <- httpLbs req3 man
79− case lookup "x-stackage-ident" $ responseHeaders res of
80− Just snapid -> return
81− ( SnapshotIdent $ decodeUtf8 snapid
82− , decodeUtf8 <$> lookup "location" (responseHeaders res)
83− )
84− Nothing -> error $ "An error occurred: " ++ show res
85− where
86− params = mapMaybe (\(x, y) -> (x, ) <$> y)
87− [ ("alias", ubAlias)
88− , ("nightly", ubNightly)
89− , ("lts", ubLTS)
90− ]
91− formData = ($ []) $ execWriter $ do
92− forM_ params $ \(key, value) ->
93− tell' $ partBS key $ encodeUtf8 value
94− tell' $ partFileRequestBody "stackage" "stackage"
95− $ RequestBodyLBS ubContents
96−
97− tell' x = tell (x:)
98−
99−data UploadDocs = UploadDocs
100− { udServer :: StackageServer
101− , udDocs :: FilePath -- ^ may be a directory or a tarball
102− , udAuthToken :: Text
103− , udSnapshot :: SnapshotIdent
104− }
105−
106−uploadDocs :: UploadDocs -> Manager -> IO (Response LByteString)
107−uploadDocs (UploadDocs (StackageServer host) fp0 token ident) man = do
108− fe <- isFile fp0
109− if fe
110− then uploadDocsFile $ fpToString fp0
111− else do
112− de <- isDirectory fp0
113− if de
114− then uploadDocsDir
115− else error $ "Path not found: " ++ fpToString fp0
116− where
117− uploadDocsDir = withSystemTempFile "haddocks.tar.xz" $ \fp h -> do
118− hClose h
119− dirs <- writeIndexStyle (Just $ unSnapshotIdent ident) fp0
120− let cp = (proc "tar" $ "cJf" : fp : "index.html" : "style.css" : dirs)
121− { cwd = Just $ fpToString fp0
122− }
123− withCheckedProcess cp $ \Inherited Inherited Inherited -> return ()
124− uploadDocsFile fp
125− uploadDocsFile fp = do
126− req1 <- parseUrl $ unpack $ concat
127− [ host
128− , "/upload-haddock/"
129− , unSnapshotIdent ident
130− ]
131− let formData =
132− [ partFileSource "tarball" fp
133− ]
134− req2 <- formDataBody formData req1
135− let req3 = req2
136− { method = "PUT"
137− , requestHeaders =
138− [ ("Authorization", encodeUtf8 token)
139− , ("Accept", "application/json")
140− ] ++ requestHeaders req2
141− , redirectCount = 0
142− , checkStatus = \_ _ _ -> Nothing
143− , responseTimeout = Just 300000000
144− }
145− httpLbs req3 man
146−
147−uploadHackageDistro :: BuildPlan
148− -> ByteString -- ^ Hackage username
149− -> ByteString -- ^ Hackage password
150− -> Manager
151− -> IO (Response LByteString)
152−uploadHackageDistro = uploadHackageDistroNamed "Stackage"
153−
154−uploadHackageDistroNamed
155− :: Text -- ^ distro name
156− -> BuildPlan
157− -> ByteString -- ^ Hackage username
158− -> ByteString -- ^ Hackage password
159− -> Manager
160− -> IO (Response LByteString)
161−uploadHackageDistroNamed name bp username password manager = do
162− req1 <- parseUrl $ concat
163− [ "http://hackage.haskell.org/distro/"
164− , unpack name
165− , "/packages.csv"
166− ]
167− let req2 = req1
168− { requestHeaders = [("Content-Type", "text/csv")]
169− , requestBody = RequestBodyLBS csv
170− , checkStatus = \_ _ _ -> Nothing
171− , method = "PUT"
172− }
173− httpLbs (applyBasicAuth username password req2) manager
174− where
175− csv = encodeUtf8
176− $ builderToLazy
177− $ mconcat
178− $ intersperse "\n"
179− $ map go
180− $ mapToList
181− $ bpAllPackages bp
182− go (name, version) =
183− "\"" ++
184− (toBuilder $ display name) ++
185− "\",\"" ++
186− (toBuilder $ display version) ++
187− "\",\"http://www.stackage.org/package/" ++
188− (toBuilder $ display name) ++
189− "\""
190−
191−data UploadDocMap = UploadDocMap
192− { udmServer :: StackageServer
193− , udmAuthToken :: Text
194− , udmSnapshot :: SnapshotIdent
195− , udmDocDir :: FilePath
196− , udmPlan :: BuildPlan
197− }
198−
199−uploadDocMap :: UploadDocMap -> Manager -> IO (Response LByteString)
200−uploadDocMap UploadDocMap {..} man = do
201− docmap <- docsListing udmPlan udmDocDir
202− req1 <- parseUrl $ unpack $ unStackageServer udmServer ++ "/upload-doc-map"
203− req2 <- formDataBody (formData $ Y.encode docmap) req1
204− let req3 = req2
205− { method = "PUT"
206− , requestHeaders =
207− [ ("Authorization", encodeUtf8 udmAuthToken)
208− , ("Accept", "application/json")
209− ] ++ requestHeaders req2
210− , redirectCount = 0
211− , checkStatus = \_ _ _ -> Nothing
212− , responseTimeout = Just 300000000
213− }
214− httpLbs req3 man
215− where
216− formData docmap =
217− [ partBS "snapshot" (encodeUtf8 $ unSnapshotIdent udmSnapshot)
218− , partFileRequestBody "docmap" "docmap" $ RequestBodyBS docmap
219− ]
220−
221−data UploadBundleV2 = UploadBundleV2
222− { ub2Server :: StackageServer
223− , ub2AuthToken :: Text
224− , ub2Bundle :: FilePath
225− }
226−
227−uploadBundleV2 :: UploadBundleV2 -> Manager -> IO Text
228−uploadBundleV2 UploadBundleV2 {..} man = IO.withBinaryFile (fpToString ub2Bundle) IO.ReadMode $ \h -> do
229− size <- IO.hFileSize h
230− putStrLn $ "Bundle size: " ++ tshow size
231− req1 <- parseUrl $ unpack $ unStackageServer ub2Server ++ "/upload2"
232− let req2 = req1
233− { method = "PUT"
234− , requestHeaders =
235− [ ("Authorization", encodeUtf8 ub2AuthToken)
236− , ("Accept", "application/json")
237− , ("Content-Type", "application/x-tar")
238− ]
239− , requestBody = HCC.requestBodySource (fromIntegral size)
240− $ sourceHandle h $= printProgress size
241− }
242− sink = decodeUtf8C =$ fix (\loop -> do
243− mx <- peekC
244− case mx of
245− Nothing -> error $ "uploadBundleV2: premature end of stream"
246− Just _ -> do
247− l <- lineC $ takeCE 4096 =$ foldC
248− let (cmd, msg') = break (== ':') l
249− msg = dropWhile (== ' ') $ dropWhile (== ':') msg'
250− case cmd of
251− "CONT" -> do
252− putStrLn msg
253− loop
254− "FAILURE" -> error $ "uploadBundleV2 failed: " ++ unpack msg
255− "SUCCESS" -> return msg
256− _ -> error $ "uploadBundleV2: unknown command " ++ unpack cmd
257− )
258− withResponse req2 man $ \res -> HCC.bodyReaderSource (responseBody res) $$ sink
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.hsdeleted−210
@@ -1,210 +0,0 @@
1−{-# LANGUAGE TupleSections #-}
2−
3−module Main where
4−
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)
12−import Stackage.CompleteBuild
13−import Stackage.Upload
14−import Stackage.InstallBuild
15−import Network.HTTP.Client (withManager)
16−import Network.HTTP.Client.TLS (tlsManagerSettings)
17−import qualified Data.Text as T
18−
19−main :: IO ()
20−main =
21− join $
22− execParser $
23− info
24− (helpOption <*> versionOption <*> config)
25− (header "Stackage" <>
26− fullDesc)
27− where
28− helpOption =
29− abortOption ShowHelpText $
30− long "help" <>
31− help "Show this help text"
32− versionOption =
33− infoOption
34− ("stackage version " ++ showVersion version)
35− (long "version" <>
36− help "Show stackage version")
37− config =
38− subparser $
39− mconcat
40− [ cmnd
41− (uncurry completeBuild)
42− (fmap (Nightly, ) buildFlags)
43− "nightly"
44− "Build, test and upload the Nightly snapshot"
45− , cmnd
46− (uncurry completeBuild)
47− (fmap (LTS Major, ) buildFlags)
48− "lts-major"
49− "Build, test and upload the LTS (major) snapshot"
50− , cmnd
51− (uncurry completeBuild)
52− (fmap (LTS Minor, ) buildFlags)
53− "lts-minor"
54− "Build, test and upload the LTS (minor) snapshot"
55− , cmnd
56− justUploadNightly
57− nightlyUploadFlags
58− "upload-nightly"
59− "Upload an already-built nightly snapshot"
60− , cmnd
61− (const justCheck)
62− (pure ())
63− "check"
64− "Just check that the build plan is ok"
65− , cmnd
66− installBuild
67− installFlags
68− "install"
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− ]
76−
77− cmnd exec parse name desc =
78− command name $
79− info
80− (fmap exec (parse <**> helpOption))
81− (progDesc desc)
82−
83− buildFlags =
84− BuildFlags <$>
85− fmap
86− not
87− (switch
88− (long "skip-tests" <>
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")) <*>
95− fmap
96− not
97− (switch
98− (long "skip-upload" <>
99− help "Skip uploading bundle, docs, etc.")) <*>
100− switch
101− (long "enable-library-profiling" <>
102− help "Enable profiling when building") <*>
103− switch
104− (long "enable-executable-dynamic" <>
105− help "Enable dynamic executables when building") <*>
106− switch
107− (long "verbose" <> short 'v' <>
108− help "Output verbose detail about the build steps") <*>
109− switch
110− (long "skip-check" <>
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− fmap
121− not
122− (switch
123− (long "skip-hoogle" <>
124− help "Skip generating Hoogle input files"))
125−
126− nightlyUploadFlags = fromString <$> strArgument
127− (metavar "DATE" <>
128− help "Date, in YYYY-MM-DD format")
129−
130− installFlags =
131− InstallFlags <$>
132− (fmap
133− BPSBundleWeb
134− (strOption
135− (long "bundle" <>
136− metavar "URL" <>
137− help "Stackage bundle containing build plan")) <|>
138− fmap
139− (BPSFile . decodeString)
140− (strOption
141− (long "build-plan" <>
142− metavar "PATH" <>
143− help "Build-plan YAML file"))) <*>
144− fmap
145− decodeString
146− (strArgument
147− (metavar "DESTINATION-PATH" <>
148− help "Destination directory path")) <*>
149− (fmap
150− (Just . decodeString)
151− (strOption
152− (long "log-dir" <>
153− metavar "PATH" <>
154− help "Location of log files (default DESTINATION-PATH/logs)")) <|>
155− pure Nothing) <*>
156− option
157− auto
158− (long "jobs" <>
159− metavar "NUMBER" <>
160− showDefault <> value 8 <>
161− help "Number of threads") <*>
162− switch
163− (long "global" <>
164− help "Install in global package database") <*>
165− fmap
166− not
167− (switch
168− (long "skip-tests" <>
169− help "Skip build and running the test suites")) <*>
170− fmap
171− not
172− (switch
173− (long "skip-haddock" <>
174− help "Skip generating haddock documentation")) <*>
175− switch
176− (long "enable-library-profiling" <>
177− help "Enable profiling when building") <*>
178− switch
179− (long "enable-executable-dynamic" <>
180− help "Enable dynamic executables when building") <*>
181− switch
182− (long "verbose" <> short 'v' <>
183− help "Output verbose detail about the build steps") <*>
184− switch
185− (long "skip-check" <>
186− help "Skip the check phase, and pass --allow-newer to cabal configure") <*>
187− fmap
188− not
189− (switch
190− (long "skip-hoogle" <>
191− help "Skip generating Hoogle input files"))
192−
193− uploadv2 (path, url) = withManager tlsManagerSettings $ \man -> do
194− token <- getStackageAuthToken
195− res <- flip uploadBundleV2 man UploadBundleV2
196− { ub2AuthToken = token
197− , ub2Server = fromString url
198− , ub2Bundle = decodeString path
199− }
200− putStrLn $ "New URL: " ++ T.unpack res
201−
202− uploadv2Flags = (,)
203− <$> (strArgument
204− (metavar "BUNDLE-PATH" <>
205− help "Bundle path"))
206− <*> strOption
207− (long "server-url" <>
208− metavar "SERVER-URL" <>
209− showDefault <> value (T.unpack $ unStackageServer def) <>
210− help "Server to upload bundle to")
build-constraints.yaml+1
@@ -93,6 +93,7 @@ packages:
9393 - shelly
9494 - smtLib
9595 - stackage
96+ - stackage-curator
9697 - statistics-linreg
9798 - th-expand-syns
9899 - thyme
cabal.configdeleted−847
@@ -1,847 +0,0 @@
1−-- Stackage snapshot from: http://www.stackage.org/snapshot/nightly-2014-12-24
2−-- Please place this file next to your .cabal file as cabal.config
3−-- To only use tested packages, uncomment the following line:
4−-- remote-repo: stackage-nightly-2014-12-24:http://www.stackage.org/snapshot/nightly-2014-12-24
5−constraints: abstract-deque ==0.3,
6− abstract-par ==0.3.3,
7− accelerate ==0.15.0.0,
8− ace ==0.6,
9− action-permutations ==0.0.0.1,
10− active ==0.1.0.17,
11− AC-Vector ==2.3.2,
12− ad ==4.2.1.1,
13− adjunctions ==4.2,
14− aeson ==0.8.0.2,
15− aeson-pretty ==0.7.2,
16− aeson-qq ==0.7.4,
17− aeson-utils ==0.2.2.1,
18− alarmclock ==0.2.0.5,
19− alex ==3.1.3,
20− amqp ==0.10.1,
21− ansi-terminal ==0.6.2.1,
22− ansi-wl-pprint ==0.6.7.1,
23− appar ==0.1.4,
24− approximate ==0.2.1.1,
25− arbtt ==0.8.1.4,
26− arithmoi ==0.4.1.1,
27− array installed,
28− arrow-list ==0.6.1.5,
29− asn1-data ==0.7.1,
30− asn1-encoding ==0.9.0,
31− asn1-parse ==0.9.0,
32− asn1-types ==0.3.0,
33− async ==2.0.2,
34− atto-lisp ==0.2.2,
35− attoparsec ==0.12.1.2,
36− attoparsec-conduit ==1.1.0,
37− attoparsec-enumerator ==0.3.3,
38− attoparsec-expr ==0.1.1.1,
39− authenticate ==1.3.2.11,
40− auto-update ==0.1.2.1,
41− aws ==0.11,
42− bake ==0.2,
43− bank-holidays-england ==0.1.0.1,
44− barecheck ==0.2.0.6,
45− base16-bytestring ==0.1.1.6,
46− base64-bytestring ==1.0.0.1,
47− base-compat ==0.5.0,
48− base-prelude ==0.1.8,
49− base-unicode-symbols ==0.2.2.4,
50− basic-prelude ==0.3.10,
51− bifunctors ==4.2,
52− binary installed,
53− binary-list ==1.0.1.0,
54− bindings-DSL ==1.0.21,
55− bioace ==0.0.1,
56− bioalign ==0.0.5,
57− biocore ==0.3.1,
58− biofasta ==0.0.3,
59− biofastq ==0.1,
60− biophd ==0.0.5,
61− biopsl ==0.4,
62− biosff ==0.3.7.1,
63− bits ==0.4,
64− BlastHTTP ==1.0.1,
65− blastxml ==0.3.2,
66− blaze-builder ==0.3.3.4,
67− blaze-builder-enumerator ==0.2.0.6,
68− blaze-html ==0.7.0.3,
69− blaze-markup ==0.6.1.1,
70− blaze-svg ==0.3.4,
71− blaze-textual ==0.2.0.9,
72− BlogLiterately ==0.7.1.7,
73− BlogLiterately-diagrams ==0.1.4.3,
74− bloodhound ==0.5.0.1,
75− bmp ==1.2.5.2,
76− Boolean ==0.2.3,
77− bool-extras ==0.4.0,
78− bound ==1.0.4,
79− BoundedChan ==1.0.3.0,
80− bson ==0.3.1,
81− bumper ==0.6.0.2,
82− byteable ==0.1.1,
83− bytedump ==1.0,
84− byteorder ==1.0.4,
85− bytes ==0.14.1.2,
86− bytestring installed,
87− bytestring-builder ==0.10.4.0.1,
88− bytestring-lexing ==0.4.3.2,
89− bytestring-mmap ==0.2.2,
90− bytestring-progress ==1.0.3,
91− bytestring-trie ==0.2.4,
92− bzlib ==0.5.0.4,
93− bzlib-conduit ==0.2.1.3,
94− c2hs ==0.20.1,
95− Cabal installed,
96− cabal-install ==1.18.0.6,
97− cabal-src ==0.2.5,
98− cairo ==0.13.0.5,
99− case-insensitive ==1.2.0.3,
100− cases ==0.1.2,
101− cassava ==0.4.2.1,
102− cautious-file ==1.0.2,
103− cereal ==0.4.1.0,
104− cereal-conduit ==0.7.2.3,
105− certificate ==1.3.9,
106− charset ==0.3.7,
107− Chart ==1.3.2,
108− Chart-diagrams ==1.3.2,
109− ChasingBottoms ==1.3.0.8,
110− check-email ==1.0,
111− checkers ==0.4.1,
112− chell ==0.4,
113− chell-quickcheck ==0.2.4,
114− chunked-data ==0.1.0.1,
115− cipher-aes ==0.2.9,
116− cipher-blowfish ==0.0.3,
117− cipher-camellia ==0.0.2,
118− cipher-des ==0.0.6,
119− cipher-rc4 ==0.1.4,
120− circle-packing ==0.1.0.3,
121− classy-prelude ==0.10.2,
122− classy-prelude-conduit ==0.10.2,
123− classy-prelude-yesod ==0.10.2,
124− clientsession ==0.9.1.1,
125− clock ==0.4.1.3,
126− cmdargs ==0.10.12,
127− code-builder ==0.1.3,
128− colour ==2.3.3,
129− comonad ==4.2.2,
130− comonads-fd ==4.0,
131− comonad-transformers ==4.0,
132− compdata ==0.9,
133− compensated ==0.6.1,
134− composition ==1.0.1.0,
135− compressed ==3.10,
136− concatenative ==1.0.1,
137− concurrent-extra ==0.7.0.9,
138− concurrent-supply ==0.1.7,
139− cond ==0.4.1.1,
140− conduit ==1.2.3.1,
141− conduit-combinators ==0.3.0.5,
142− conduit-extra ==1.1.5.1,
143− configurator ==0.3.0.0,
144− connection ==0.2.3,
145− constraints ==0.4.1.1,
146− containers installed,
147− containers-unicode-symbols ==0.3.1.1,
148− contravariant ==1.2,
149− control-monad-free ==0.5.3,
150− control-monad-loop ==0.1,
151− convertible ==1.1.0.0,
152− cookie ==0.4.1.4,
153− courier ==0.1.0.15,
154− cpphs ==1.18.6,
155− cprng-aes ==0.6.1,
156− cpu ==0.1.2,
157− criterion ==1.0.2.0,
158− crypto-api ==0.13.2,
159− cryptocipher ==0.6.2,
160− crypto-cipher-tests ==0.0.11,
161− crypto-cipher-types ==0.0.9,
162− cryptohash ==0.11.6,
163− cryptohash-conduit ==0.1.1,
164− cryptohash-cryptoapi ==0.1.3,
165− crypto-numbers ==0.2.3,
166− crypto-pubkey ==0.2.6,
167− crypto-pubkey-types ==0.4.2.3,
168− crypto-random ==0.0.8,
169− crypto-random-api ==0.2.0,
170− css-text ==0.1.2.1,
171− csv ==0.1.2,
172− csv-conduit ==0.6.3,
173− curl ==1.3.8,
174− data-accessor ==0.2.2.6,
175− data-accessor-mtl ==0.2.0.4,
176− data-binary-ieee754 ==0.4.4,
177− data-default ==0.5.3,
178− data-default-class ==0.0.1,
179− data-default-instances-base ==0.0.1,
180− data-default-instances-containers ==0.0.1,
181− data-default-instances-dlist ==0.0.1,
182− data-default-instances-old-locale ==0.0.1,
183− data-inttrie ==0.1.0,
184− data-lens-light ==0.1.2.1,
185− data-memocombinators ==0.5.1,
186− data-reify ==0.6,
187− DAV ==1.0.3,
188− deepseq installed,
189− deepseq-generics ==0.1.1.2,
190− derive ==2.5.18,
191− diagrams ==1.2,
192− diagrams-builder ==0.6.0.2,
193− diagrams-cairo ==1.2.0.4,
194− diagrams-contrib ==1.1.2.4,
195− diagrams-core ==1.2.0.4,
196− diagrams-haddock ==0.2.2.12,
197− diagrams-lib ==1.2.0.7,
198− diagrams-postscript ==1.1.0.3,
199− diagrams-svg ==1.1.0.3,
200− Diff ==0.3.0,
201− digest ==0.0.1.2,
202− digestive-functors ==0.7.1.3,
203− dimensional ==0.13.0.1,
204− directory installed,
205− directory-tree ==0.12.0,
206− direct-sqlite ==2.3.14,
207− distributed-process ==0.5.3,
208− distributed-process-async ==0.2.0,
209− distributed-process-client-server ==0.1.1,
210− distributed-process-execution ==0.1.0,
211− distributed-process-extras ==0.1.1,
212− distributed-process-simplelocalnet ==0.2.2.0,
213− distributed-process-supervisor ==0.1.1,
214− distributed-process-task ==0.1.0,
215− distributed-static ==0.3.1.0,
216− distributive ==0.4.4,
217− djinn-ghc ==0.0.2.2,
218− djinn-lib ==0.0.1.2,
219− dlist ==0.7.1,
220− dlist-instances ==0.1,
221− doctest ==0.9.11.1,
222− double-conversion ==2.0.1.0,
223− dual-tree ==0.2.0.5,
224− easy-file ==0.2.0,
225− either ==4.3.2.1,
226− elm-build-lib ==0.14.0.0,
227− elm-compiler ==0.14,
228− elm-core-sources ==1.0.0,
229− elm-package ==0.2.2,
230− email-validate ==2.0.1,
231− enclosed-exceptions ==1.0.1,
232− entropy ==0.3.4.1,
233− enumerator ==0.4.20,
234− eq ==4.0.3,
235− erf ==2.0.0.0,
236− errorcall-eq-instance ==0.1.0,
237− errors ==1.4.7,
238− ersatz ==0.2.6.1,
239− esqueleto ==2.1.2.1,
240− exceptions ==0.6.1,
241− exception-transformers ==0.3.0.4,
242− executable-path ==0.0.3,
243− ex-pool ==0.2,
244− extensible-exceptions ==0.1.1.4,
245− extra ==1.0,
246− failure ==0.2.0.3,
247− fast-logger ==2.2.3,
248− fay ==0.21.2.1,
249− fay-base ==0.19.4.1,
250− fay-builder ==0.2.0.1,
251− fay-dom ==0.5,
252− fay-jquery ==0.6.0.2,
253− fay-text ==0.3.2,
254− fay-uri ==0.2.0.0,
255− fb ==1.0.7,
256− fb-persistent ==0.3.4,
257− fclabels ==2.0.2,
258− FenwickTree ==0.1.1,
259− fgl ==5.5.0.1,
260− file-embed ==0.0.7,
261− file-location ==0.4.5.3,
262− filemanip ==0.3.6.2,
263− filepath installed,
264− fingertree ==0.1.0.0,
265− fixed ==0.2.1,
266− fixed-list ==0.1.5,
267− flexible-defaults ==0.0.1.1,
268− focus ==0.1.3,
269− foldl ==1.0.7,
270− force-layout ==0.3.0.8,
271− foreign-store ==0.1,
272− formatting ==6.0.0,
273− fpco-api ==1.2.0.4,
274− free ==4.10.0.1,
275− freenect ==1.2,
276− frisby ==0.2,
277− fsnotify ==0.1.0.3,
278− fuzzcheck ==0.1.1,
279− gd ==3000.7.3,
280− generic-aeson ==0.2.0.2,
281− generic-deriving ==1.6.3,
282− generics-sop ==0.1.0.4,
283− ghc-heap-view ==0.5.3,
284− ghcid ==0.3.3,
285− ghc-mod ==5.2.1.1,
286− ghc-mtl ==1.2.1.0,
287− ghc-paths ==0.1.0.9,
288− ghc-prim installed,
289− ghc-syb-utils ==0.2.2,
290− gio ==0.13.0.3,
291− git-embed ==0.1.0,
292− gl ==0.6.2,
293− glib ==0.13.0.6,
294− Glob ==0.7.5,
295− GLURaw ==1.4.0.1,
296− GLUT ==2.5.1.1,
297− graph-core ==0.2.1.0,
298− graphs ==0.5.0.1,
299− graphviz ==2999.17.0.1,
300− gravatar ==0.6,
301− groundhog ==0.7.0.1,
302− groundhog-mysql ==0.7.0.1,
303− groundhog-postgresql ==0.7.0.1,
304− groundhog-sqlite ==0.7.0.1,
305− groundhog-th ==0.7.0,
306− groupoids ==4.0,
307− groups ==0.4.0.0,
308− gtk ==0.13.3,
309− gtk2hs-buildtools ==0.13.0.3,
310− haddock-api ==2.15.0.1,
311− haddock-library ==1.1.1,
312− half ==0.2.0.1,
313− HandsomeSoup ==0.3.5,
314− happstack-server ==7.3.9,
315− happy ==1.19.4,
316− hashable ==1.2.3.1,
317− hashable-extras ==0.2.0.1,
318− hashmap ==1.3.0.1,
319− hashtables ==1.2.0.1,
320− haskeline installed,
321− haskell2010 installed,
322− haskell98 installed,
323− haskell-lexer ==1.0,
324− haskell-names ==0.4.1,
325− haskell-packages ==0.2.4.3,
326− haskell-src ==1.0.1.6,
327− haskell-src-exts ==1.16.0.1,
328− haskell-src-meta ==0.6.0.8,
329− hasql ==0.4.1,
330− hasql-backend ==0.2.2,
331− hasql-postgres ==0.9.1,
332− hastache ==0.6.1,
333− HaTeX ==3.16.0.0,
334− HaXml ==1.24.1,
335− haxr ==3000.10.3.1,
336− HCodecs ==0.5,
337− hdaemonize ==0.5.0.0,
338− hdevtools ==0.1.0.6,
339− heaps ==0.3.1,
340− hebrew-time ==0.1.1,
341− heist ==0.14.0.1,
342− here ==1.2.6,
343− heredoc ==0.2.0.0,
344− highlighting-kate ==0.5.11.1,
345− hinotify ==0.3.7,
346− hint ==0.4.2.1,
347− histogram-fill ==0.8.3.0,
348− hit ==0.6.2,
349− hjsmin ==0.1.4.7,
350− hledger ==0.23.3,
351− hledger-lib ==0.23.3,
352− hlibgit2 ==0.18.0.13,
353− hlint ==1.9.13,
354− hmatrix ==0.16.1.2,
355− hmatrix-gsl ==0.16.0.2,
356− holy-project ==0.1.1.1,
357− hoogle ==4.2.36,
358− hoopl installed,
359− hOpenPGP ==1.11,
360− hopenpgp-tools ==0.13,
361− hostname ==1.0,
362− hostname-validate ==1.0.0,
363− hourglass ==0.2.6,
364− hpc installed,
365− hPDB ==1.2.0,
366− hPDB-examples ==1.1.2,
367− hs-bibutils ==5.5,
368− hscolour ==1.20.3,
369− hse-cpp ==0.1,
370− hslogger ==1.2.6,
371− hslua ==0.3.13,
372− hspec ==2.1.2,
373− hspec2 ==0.6.1,
374− hspec-core ==2.1.2,
375− hspec-discover ==2.1.2,
376− hspec-expectations ==0.6.1,
377− hspec-meta ==2.0.0,
378− hspec-wai ==0.6.2,
379− hspec-wai-json ==0.6.0,
380− HStringTemplate ==0.7.3,
381− hsyslog ==2.0,
382− HTF ==0.12.2.3,
383− html ==1.0.1.2,
384− html-conduit ==1.1.1.1,
385− HTTP ==4000.2.19,
386− http-client ==0.4.6.1,
387− http-client-tls ==0.2.2,
388− http-conduit ==2.1.5,
389− http-date ==0.0.4,
390− http-reverse-proxy ==0.4.1.2,
391− http-types ==0.8.5,
392− HUnit ==1.2.5.2,
393− hweblib ==0.6.3,
394− hxt ==9.3.1.10,
395− hxt-charproperties ==9.2.0.0,
396− hxt-http ==9.1.5,
397− hxt-pickle-utils ==0.1.0.2,
398− hxt-regex-xmlschema ==9.2.0,
399− hxt-relaxng ==9.1.5.1,
400− hxt-unicode ==9.0.2.2,
401− hybrid-vectors ==0.1.2,
402− hyphenation ==0.4,
403− idna ==0.3.0,
404− ieee754 ==0.7.4,
405− imagesize-conduit ==1.0.0.4,
406− immortal ==0.2,
407− incremental-parser ==0.2.3.3,
408− indents ==0.3.3,
409− ini ==0.2.2,
410− integer-gmp installed,
411− integration ==0.2.0.1,
412− interpolate ==0.1.0,
413− interpolatedstring-perl6 ==0.9.0,
414− intervals ==0.7.0.1,
415− io-choice ==0.0.5,
416− io-manager ==0.1.0.2,
417− io-memoize ==1.1.1.0,
418− iproute ==1.3.1,
419− iterable ==3.0,
420− ixset ==1.0.6,
421− js-flot ==0.8.3,
422− js-jquery ==1.11.1,
423− json-schema ==0.7.3.0,
424− JuicyPixels ==3.1.7.1,
425− JuicyPixels-repa ==0.7,
426− kan-extensions ==4.1.1,
427− kdt ==0.2.2,
428− keter ==1.3.7.1,
429− keys ==3.10.1,
430− kure ==2.4.10,
431− language-c ==0.4.7,
432− language-ecmascript ==0.16.2,
433− language-glsl ==0.1.1,
434− language-haskell-extract ==0.2.4,
435− language-java ==0.2.7,
436− language-javascript ==0.5.13,
437− lazy-csv ==0.5,
438− lca ==0.2.4,
439− lens ==4.6.0.1,
440− lens-aeson ==1.0.0.3,
441− lens-family-th ==0.4.0.0,
442− lhs2tex ==1.18.1,
443− libgit ==0.3.0,
444− libnotify ==0.1.1.0,
445− lifted-async ==0.2.0.2,
446− lifted-base ==0.2.3.3,
447− linear ==1.15.5,
448− linear-accelerate ==0.2,
449− list-t ==0.3.1,
450− loch-th ==0.2.1,
451− log-domain ==0.9.3,
452− logfloat ==0.12.1,
453− logict ==0.6.0.2,
454− loop ==0.2.0,
455− lucid ==2.5,
456− machines ==0.4.1,
457− mandrill ==0.1.1.0,
458− map-syntax ==0.2,
459− markdown ==0.1.13,
460− markdown-unlit ==0.2.0.1,
461− math-functions ==0.1.5.2,
462− matrix ==0.3.4.0,
463− MaybeT ==0.1.2,
464− MemoTrie ==0.6.2,
465− mersenne-random-pure64 ==0.2.0.4,
466− messagepack ==0.3.0,
467− messagepack-rpc ==0.1.0.3,
468− mime-mail ==0.4.6.2,
469− mime-mail-ses ==0.3.2.1,
470− mime-types ==0.1.0.5,
471− missing-foreign ==0.1.1,
472− MissingH ==1.3.0.1,
473− mmap ==0.5.9,
474− mmorph ==1.0.4,
475− MonadCatchIO-transformers ==0.3.1.3,
476− monad-control ==0.3.3.0,
477− monad-coroutine ==0.8.0.1,
478− monadcryptorandom ==0.6.1,
479− monad-extras ==0.5.9,
480− monadic-arrays ==0.2.1.3,
481− monad-journal ==0.6.0.2,
482− monad-logger ==0.3.11.1,
483− monad-loops ==0.4.2.1,
484− monad-par ==0.3.4.7,
485− monad-parallel ==0.7.1.3,
486− monad-par-extras ==0.3.3,
487− monad-primitive ==0.1,
488− monad-products ==4.0.0.1,
489− MonadPrompt ==1.0.0.5,
490− MonadRandom ==0.3.0.1,
491− monad-st ==0.2.4,
492− monads-tf ==0.1.0.2,
493− mongoDB ==2.0.3,
494− monoid-extras ==0.3.3.5,
495− monoid-subclasses ==0.3.6.2,
496− mono-traversable ==0.7.0,
497− mtl ==2.1.3.1,
498− mtlparse ==0.1.2,
499− mtl-prelude ==1.0.1,
500− multimap ==1.2.1,
501− multipart ==0.1.2,
502− MusicBrainz ==0.2.2,
503− mwc-random ==0.13.2.2,
504− mysql ==0.1.1.7,
505− mysql-simple ==0.2.2.4,
506− nanospec ==0.2.0,
507− nats ==1,
508− neat-interpolation ==0.2.2,
509− nettle ==0.1.0,
510− network ==2.6.0.2,
511− network-conduit-tls ==1.1.0.2,
512− network-info ==0.2.0.5,
513− network-multicast ==0.0.11,
514− network-simple ==0.4.0.2,
515− network-transport ==0.4.1.0,
516− network-transport-tcp ==0.4.1,
517− network-transport-tests ==0.2.1.0,
518− network-uri ==2.6.0.1,
519− newtype ==0.2,
520− nsis ==0.2.4,
521− numbers ==3000.2.0.1,
522− numeric-extras ==0.0.3,
523− NumInstances ==1.4,
524− numtype ==1.1,
525− Octree ==0.5.3,
526− old-locale installed,
527− old-time installed,
528− OneTuple ==0.2.1,
529− opaleye ==0.3,
530− OpenGL ==2.9.2.0,
531− OpenGLRaw ==1.5.0.0,
532− openpgp-asciiarmor ==0.1,
533− operational ==0.2.3.2,
534− options ==1.2.1,
535− optparse-applicative ==0.11.0.1,
536− osdkeys ==0.0,
537− pandoc ==1.13.2,
538− pandoc-citeproc ==0.6,
539− pandoc-types ==1.12.4.1,
540− pango ==0.13.0.4,
541− parallel ==3.2.0.5,
542− parallel-io ==0.3.3,
543− parseargs ==0.1.5.2,
544− parsec ==3.1.7,
545− parsers ==0.12.1.1,
546− partial-handler ==0.1.0,
547− path-pieces ==0.1.5,
548− patience ==0.1.1,
549− pcre-light ==0.4.0.3,
550− pdfinfo ==1.5.1,
551− pem ==0.2.2,
552− persistent ==2.1.1.3,
553− persistent-mongoDB ==2.1.2,
554− persistent-mysql ==2.1.2,
555− persistent-postgresql ==2.1.2,
556− persistent-sqlite ==2.1.1.2,
557− persistent-template ==2.1.0.1,
558− phantom-state ==0.2.0.2,
559− pipes ==4.1.4,
560− pipes-concurrency ==2.0.2,
561− pipes-parse ==3.0.2,
562− placeholders ==0.1,
563− pointed ==4.1.1,
564− polyparse ==1.9,
565− pool-conduit ==0.1.2.3,
566− postgresql-binary ==0.5.0,
567− postgresql-libpq ==0.9.0.1,
568− postgresql-simple ==0.4.8.0,
569− pqueue ==1.2.1,
570− prefix-units ==0.1.0.2,
571− prelude-extras ==0.4,
572− present ==2.2,
573− pretty installed,
574− prettyclass ==1.0.0.0,
575− pretty-class ==1.0.1.1,
576− pretty-show ==1.6.8,
577− primes ==0.2.1.0,
578− primitive ==0.5.4.0,
579− process installed,
580− process-conduit ==1.2.0.1,
581− process-extras ==0.2.0,
582− product-profunctors ==0.6,
583− profunctor-extras ==4.0,
584− profunctors ==4.3.2,
585− project-template ==0.1.4.2,
586− publicsuffixlist ==0.1,
587− punycode ==2.0,
588− pure-io ==0.2.1,
589− pureMD5 ==2.1.2.1,
590− pwstore-fast ==2.4.4,
591− quandl-api ==0.2.0.0,
592− QuasiText ==0.1.2.5,
593− QuickCheck ==2.7.6,
594− quickcheck-assertions ==0.1.1,
595− quickcheck-instances ==0.3.9,
596− quickcheck-io ==0.1.1,
597− quickpull ==0.4.0.0,
598− rainbow ==0.20.0.4,
599− rainbow-tests ==0.20.0.4,
600− random ==1.0.1.1,
601− random-fu ==0.2.6.1,
602− random-shuffle ==0.0.4,
603− random-source ==0.3.0.6,
604− rank1dynamic ==0.2.0.1,
605− raw-strings-qq ==1.0.2,
606− ReadArgs ==1.2.2,
607− reducers ==3.10.3,
608− reflection ==1.5.1,
609− regex-applicative ==0.3.0.3,
610− regex-base ==0.93.2,
611− regex-compat ==0.95.1,
612− regex-pcre-builtin ==0.94.4.8.8.35,
613− regex-posix ==0.95.2,
614− regexpr ==0.5.4,
615− regex-tdfa ==1.2.0,
616− regex-tdfa-rc ==1.1.8.3,
617− regular ==0.3.4.3,
618− regular-xmlpickler ==0.2,
619− rematch ==0.2.0.0,
620− repa ==3.3.1.2,
621− repa-algorithms ==3.3.1.2,
622− repa-devil ==0.3.2.2,
623− repa-io ==3.3.1.2,
624− reroute ==0.2.2.1,
625− resource-pool ==0.2.3.2,
626− resourcet ==1.1.3.3,
627− rest-client ==0.4.0.2,
628− rest-core ==0.33.1.2,
629− rest-gen ==0.16.1.3,
630− rest-happstack ==0.2.10.3,
631− rest-snap ==0.1.17.14,
632− rest-stringmap ==0.2.0.2,
633− rest-types ==1.11.1.1,
634− rest-wai ==0.1.0.4,
635− rev-state ==0.1,
636− rfc5051 ==0.1.0.3,
637− runmemo ==1.0.0.1,
638− rvar ==0.2.0.2,
639− safe ==0.3.8,
640− safecopy ==0.8.3,
641− scientific ==0.3.3.3,
642− scotty ==0.9.0,
643− scrobble ==0.2.1.1,
644− securemem ==0.1.4,
645− semigroupoid-extras ==4.0,
646− semigroupoids ==4.2,
647− semigroups ==0.16.0.1,
648− sendfile ==0.7.9,
649− seqloc ==0.6,
650− setenv ==0.1.1.2,
651− SHA ==1.6.4.1,
652− shake ==0.14.2,
653− shake-language-c ==0.6.3,
654− shakespeare ==2.0.2.1,
655− shakespeare-i18n ==1.1.0,
656− shakespeare-text ==1.1.0,
657− shell-conduit ==4.5,
658− shelly ==1.5.6,
659− silently ==1.2.4.1,
660− simple-reflect ==0.3.2,
661− simple-sendfile ==0.2.18,
662− singletons ==1.0,
663− siphash ==1.0.3,
664− skein ==1.0.9.2,
665− slave-thread ==0.1.5,
666− smallcheck ==1.1.1,
667− smtLib ==1.0.7,
668− snap ==0.13.3.2,
669− snap-core ==0.9.6.4,
670− snaplet-fay ==0.3.3.8,
671− snap-server ==0.9.4.6,
672− socks ==0.5.4,
673− sodium ==0.11.0.2,
674− sourcemap ==0.1.3.0,
675− speculation ==1.5.0.1,
676− sphinx ==0.6.0.1,
677− split ==0.2.2,
678− Spock ==0.7.5.1,
679− spoon ==0.3.1,
680− sqlite-simple ==0.4.8.0,
681− stateref ==0.3,
682− statestack ==0.2.0.3,
683− statistics ==0.13.2.1,
684− statistics-linreg ==0.3,
685− stm ==2.4.4,
686− stm-chans ==3.0.0.2,
687− stm-conduit ==2.5.2,
688− stm-containers ==0.2.7,
689− stm-stats ==0.2.0.0,
690− storable-complex ==0.2.1,
691− storable-endian ==0.2.5,
692− streaming-commons ==0.1.8,
693− streams ==3.2,
694− strict ==0.3.2,
695− stringable ==0.1.3,
696− stringbuilder ==0.5.0,
697− stringprep ==1.0.0,
698− stringsearch ==0.3.6.5,
699− stylish-haskell ==0.5.11.0,
700− SVGFonts ==1.4.0.3,
701− syb ==0.4.2,
702− syb-with-class ==0.6.1.5,
703− system-canonicalpath ==0.2.0.0,
704− system-fileio ==0.3.16,
705− system-filepath ==0.4.13,
706− system-posix-redirect ==1.1.0.1,
707− tabular ==0.2.2.5,
708− tagged ==0.7.3,
709− tagshare ==0.0,
710− tagsoup ==0.13.3,
711− tagstream-conduit ==0.5.5.3,
712− tar ==0.4.0.1,
713− tardis ==0.3.0.0,
714− tasty ==0.10.1,
715− tasty-ant-xml ==1.0.1,
716− tasty-golden ==2.2.2.4,
717− tasty-hunit ==0.9.0.1,
718− tasty-quickcheck ==0.8.3.2,
719− tasty-smallcheck ==0.8.0.1,
720− tasty-th ==0.1.3,
721− template-haskell installed,
722− temporary ==1.2.0.3,
723− temporary-rc ==1.2.0.3,
724− terminal-progress-bar ==0.0.1.4,
725− terminal-size ==0.3.0,
726− terminfo installed,
727− test-framework ==0.8.1.0,
728− test-framework-hunit ==0.3.0.1,
729− test-framework-quickcheck2 ==0.3.0.3,
730− test-framework-th ==0.2.4,
731− testing-feat ==0.4.0.2,
732− testpack ==2.1.3.0,
733− texmath ==0.8.0.1,
734− text ==1.1.1.3,
735− text-binary ==0.1.0,
736− text-format ==0.3.1.1,
737− text-icu ==0.7.0.0,
738− tf-random ==0.5,
739− th-desugar ==1.4.2,
740− th-expand-syns ==0.3.0.4,
741− th-extras ==0.0.0.2,
742− th-lift ==0.7,
743− th-orphans ==0.8.2,
744− threads ==0.5.1.2,
745− th-reify-many ==0.1.2,
746− thyme ==0.3.5.5,
747− time installed,
748− time-compat ==0.1.0.3,
749− time-lens ==0.4.0.1,
750− timezone-olson ==0.1.6,
751− timezone-series ==0.1.4,
752− tls ==1.2.13,
753− tls-debug ==0.3.4,
754− tostring ==0.2.1,
755− transformers installed,
756− transformers-base ==0.4.3,
757− transformers-compat ==0.3.3.3,
758− traverse-with-class ==0.2.0.3,
759− tree-view ==0.4,
760− tuple ==0.3.0.2,
761− type-eq ==0.4.2,
762− type-list ==0.0.0.0,
763− udbus ==0.2.1,
764− unbounded-delays ==0.1.0.8,
765− union-find ==0.2,
766− uniplate ==1.6.12,
767− unix installed,
768− unix-compat ==0.4.1.3,
769− unix-time ==0.3.4,
770− unordered-containers ==0.2.5.1,
771− uri-encode ==1.5.0.3,
772− url ==2.1.3,
773− utf8-light ==0.4.2,
774− utf8-string ==0.3.8,
775− uuid ==1.3.7,
776− vault ==0.3.0.4,
777− vector ==0.10.12.2,
778− vector-algorithms ==0.6.0.3,
779− vector-binary-instances ==0.2.1.0,
780− vector-instances ==3.3,
781− vector-space ==0.8.7,
782− vector-space-points ==0.2,
783− vector-th-unbox ==0.2.1.0,
784− vhd ==0.2.2,
785− void ==0.7,
786− wai ==3.0.2.1,
787− wai-app-static ==3.0.0.5,
788− wai-conduit ==3.0.0.2,
789− wai-eventsource ==3.0.0,
790− wai-extra ==3.0.3.1,
791− wai-logger ==2.2.3,
792− wai-middleware-static ==0.6.0.1,
793− wai-websockets ==3.0.0.3,
794− warp ==3.0.4.1,
795− warp-tls ==3.0.1.1,
796− webdriver ==0.6.0.3,
797− web-fpco ==0.1.1.0,
798− websockets ==0.9.2.1,
799− wizards ==1.0.1,
800− wl-pprint ==1.1,
801− wl-pprint-extras ==3.5.0.3,
802− wl-pprint-terminfo ==3.7.1.3,
803− wl-pprint-text ==1.1.0.2,
804− word8 ==0.1.1,
805− X11 ==1.6.1.2,
806− x509 ==1.5.0.1,
807− x509-store ==1.5.0,
808− x509-system ==1.5.0,
809− x509-validation ==1.5.1,
810− xenstore ==0.1.1,
811− xhtml installed,
812− xml ==1.3.13,
813− xml-conduit ==1.2.3.1,
814− xmlgen ==0.6.2.1,
815− xml-hamlet ==0.4.0.9,
816− xmlhtml ==0.2.3.3,
817− xml-types ==0.3.4,
818− xss-sanitize ==0.3.5.4,
819− yackage ==0.7.0.6,
820− yaml ==0.8.10.1,
821− Yampa ==0.9.6,
822− YampaSynth ==0.2,
823− yesod ==1.4.1.3,
824− yesod-auth ==1.4.1.1,
825− yesod-auth-deskcom ==1.4.0,
826− yesod-auth-fb ==1.6.6,
827− yesod-auth-hashdb ==1.4.1.1,
828− yesod-bin ==1.4.3.1,
829− yesod-core ==1.4.7.1,
830− yesod-eventsource ==1.4.0.1,
831− yesod-fay ==0.7.0,
832− yesod-fb ==0.3.4,
833− yesod-form ==1.4.3.1,
834− yesod-gitrepo ==0.1.1.0,
835− yesod-newsfeed ==1.4.0.1,
836− yesod-persistent ==1.4.0.2,
837− yesod-sitemap ==1.4.0.1,
838− yesod-static ==1.4.0.4,
839− yesod-test ==1.4.2.1,
840− yesod-text-markdown ==0.1.7,
841− yesod-websockets ==0.2.1.1,
842− zeromq4-haskell ==0.6.2,
843− zip-archive ==0.2.3.5,
844− zlib ==0.5.4.2,
845− zlib-bindings ==0.1.1.5,
846− zlib-enum ==0.2.3.1,
847− zlib-lens ==0.1
debian-bootstrap.shdeleted−71
@@ -1,71 +0,0 @@
1−#!/bin/bash -ex
2−
3−# Work in progress: create a list of commands necessary to get Stackage
4−# up-and-running on a freshly installed Debian-based system (includin Ubuntu).
5−
6−# Quick start:
7−# wget -O - https://raw.github.com/fpco/stackage/master/debian-bootstrap.sh | bash -ex
8−
9−# NOTE: Requires that GHC and Cabal are installed and on your PATH. For
10−# instructions, see:
11−# http://www.stackage.org/install
12−
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 \
18− build-essential \
19− libncurses-dev \
20− git \
21− wget \
22− m4 \
23− texlive-full \
24− libgmp3c2 \
25− libgmp3-dev \
26− zlib1g-dev \
27− libedit2 \
28− libedit-dev \
29− freeglut3-dev \
30− libglu1-mesa-dev \
31− libglib2.0-dev \
32− libcairo2-dev \
33− libpango1.0-dev \
34− libgtk2.0-dev \
35− zip \
36− libdevil-dev \
37− llvm \
38− libbz2-dev \
39− libjudy-dev \
40− libsqlite3-dev \
41− libmysqlclient-dev \
42− libpq-dev \
43− libicu-dev \
44− libssl-dev \
45− libgsl0-dev \
46− libblas-dev \
47− liblapack-dev \
48− libcurl4-openssl-dev \
49− libfreenect-dev \
50− libnotify-dev \
51− libgd2-xpm-dev \
52− libyaml-dev \
53− liblzma-dev \
54− libsdl2-dev \
55− libxss-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.cabaldeleted−105
@@ -1,105 +0,0 @@
1−name: stackage
2−version: 0.6.0.1
3−synopsis: "Stable Hackage," tools for creating a vetted set of packages from Hackage.
4−description: Please see <http://www.stackage.org/package/stackage> for a description and documentation.
5−homepage: https://github.com/fpco/stackage
6−license: MIT
7−license-file: LICENSE
8−author: Michael Snoyman
9−maintainer: michael@fpcomplete.com
10−category: Distribution
11−build-type: Simple
12−cabal-version: >=1.10
13−extra-source-files: README.md
14− ChangeLog.md
15− test/test-build-constraints.yaml
16−
17−library
18− default-language: Haskell2010
19− exposed-modules: Stackage.Prelude
20− Stackage.BuildConstraints
21− Stackage.CorePackages
22− Stackage.PackageIndex
23− Stackage.BuildPlan
24− Stackage.CheckBuildPlan
25− Stackage.UpdateBuildPlan
26− Stackage.GhcPkg
27− Stackage.GithubPings
28− Stackage.InstallBuild
29− Stackage.PackageDescription
30− Stackage.ServerBundle
31− Stackage.Upload
32− Stackage.PerformBuild
33− Stackage.CompleteBuild
34− build-depends: base >= 4 && < 5
35− , containers
36− , Cabal >= 1.14
37− , tar >= 0.3
38− , zlib
39− , bytestring
40− , directory
41− , filepath
42− , transformers
43− , process
44− , old-locale
45− , time
46− , utf8-string
47−
48− , conduit-extra
49− , classy-prelude-conduit
50− , text
51− , system-fileio
52− , system-filepath
53− , mtl
54− , aeson
55− , yaml
56− , unix-compat
57− , http-client
58− , http-conduit
59− , http-client-tls
60− , temporary
61− , data-default-class
62− , stm
63− , mono-traversable
64− , async
65− , streaming-commons >= 0.1.7.1
66− , semigroups
67− , xml-conduit
68− , conduit
69−
70−executable stackage
71− default-language: Haskell2010
72− hs-source-dirs: app
73− main-is: stackage.hs
74− build-depends: base
75− , stackage
76− , optparse-applicative >= 0.11
77− , system-filepath
78− , http-client
79− , http-client-tls
80− , text
81− ghc-options: -rtsopts -threaded -with-rtsopts=-N
82−
83−test-suite spec
84− type: exitcode-stdio-1.0
85− default-language: Haskell2010
86− hs-source-dirs: test
87− main-is: Spec.hs
88− other-modules: Stackage.CorePackagesSpec
89− Stackage.PackageIndexSpec
90− Stackage.BuildPlanSpec
91− build-depends: base
92− , stackage
93− , hspec
94− , QuickCheck
95− , text
96− , classy-prelude-conduit
97− , Cabal
98− , yaml
99− , containers
100− , http-client
101− , http-client-tls
102−
103−source-repository head
104− type: git
105− location: https://github.com/fpco/stackage
test/Spec.hsdeleted−1
@@ -1 +0,0 @@
1−{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
test/Stackage/BuildPlanSpec.hsdeleted−143
@@ -1,143 +0,0 @@
1−{-# LANGUAGE ScopedTypeVariables #-}
2−{-# LANGUAGE OverloadedStrings, NoImplicitPrelude #-}
3−module Stackage.BuildPlanSpec (spec) where
4−
5−import qualified Data.Map as Map
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
20−
21−spec :: Spec
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
64− let bs = Y.encode bp
65− ebp' = Y.decodeEither bs
66−
67− bp' <- either error return ebp'
68−
69− let allPackages = Map.keysSet (bpPackages bp) ++ Map.keysSet (bpPackages bp')
70− forM_ allPackages $ \name ->
71− (name, lookup name (bpPackages bp')) `shouldBe`
72− (name, lookup name (bpPackages bp))
73− bpGithubUsers bp' `shouldBe` bpGithubUsers bp
74−
75− when (bp' /= bp) $ error "bp' /= bp"
76− bp2 <- updateBuildPlan plans bp
77− when (dropVersionRanges bp2 /= dropVersionRanges bp) $ error "bp2 /= bp"
78− checkBuildPlan bp
79− where
80− dropVersionRanges bp =
81− bp { bpPackages = map go $ bpPackages bp }
82− where
83− go pb = pb { ppConstraints = go' $ ppConstraints pb }
84− 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/Stackage/CorePackagesSpec.hsdeleted−19
@@ -1,19 +0,0 @@
1−{-# LANGUAGE OverloadedStrings, NoImplicitPrelude #-}
2−module Stackage.CorePackagesSpec (spec) where
3−
4−import Stackage.CorePackages
5−import Stackage.Prelude
6−import Test.Hspec
7−
8−spec :: Spec
9−spec = do
10− it "works" $ void getCorePackages
11− it "contains known core packages" $ do
12− m <- getCorePackages
13− forM_ (words "ghc containers base") $ \p ->
14− m `shouldSatisfy` (member (PackageName p))
15− it "getCoreExecutables includes known executables" $ do
16− s <- getCoreExecutables
17− s `shouldSatisfy` member "ghc"
18− s `shouldSatisfy` member "hsc2hs"
19− s `shouldSatisfy` member "runghc"
test/Stackage/PackageIndexSpec.hsdeleted−21
@@ -1,21 +0,0 @@
1−{-# LANGUAGE OverloadedStrings, NoImplicitPrelude #-}
2−module Stackage.PackageIndexSpec (spec) where
3−
4−import Stackage.PackageIndex
5−import Stackage.Prelude
6−import Test.Hspec
7−import Distribution.Package (packageId)
8−
9−spec :: Spec
10−spec = do
11− it "works" $ (runResourceT $ sourcePackageIndex $$ sinkNull :: IO ())
12− it "getLatestDescriptions gives reasonable results" $ do
13− let f x y = (display x, display y) `member` asSet (setFromList
14− [ (asText "base", asText "4.5.0.0")
15− , ("does-not-exist", "9999999999999999999")
16− ])
17− m <- getLatestDescriptions f return
18− length m `shouldBe` 1
19− p <- simpleParse $ asText "base"
20− v <- simpleParse $ asText "4.5.0.0"
21− (pkgVersion . packageId <$> m) `shouldBe` singletonMap p v
test/test-build-constraints.yamldeleted−20
@@ -1,20 +0,0 @@
1−packages:
2− "Test":
3− - foo
4− - bar
5−
6−global-flags: []
7−
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