git.iko.soy/stackage
on master help sign in
Separate out stackage-curator
1891c1bMichael Snoyman
.gitignore−9
compare with master
unifiedsplit
@@ -1,13 +1,4 @@
1−dist
2−*.o
3−*.hi
4−*.chi
5−*.chs.h
6−*.swp
7/builds/
1/builds/
8/logs/
2/logs/
9−/.cabal-sandbox/
10−cabal.sandbox.config
11nightly-*.yaml
3nightly-*.yaml
12lts-*.yaml
4lts-*.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
7Stackage. If you simply want to use Stackage as an end user, please follow the
7Stackage. If you simply want to use Stackage as an end user, please follow the
8instructions on [http://www.stackage.org/](http://www.stackage.org).
8instructions on [http://www.stackage.org/](http://www.stackage.org).
9
9
10−A note about the codebase: the goal is to minimize dependencies and have
10+The Stackage project consists of multiple repositories. This repository
11−the maximum range of supported compiler versions. Therefore, we avoid
11+contains the metadata on packages to be included in future builds and some
12−anything "complicated." For example, instead of using the text package,
12+project information. In addition, we have the following repositories:
13−we use Strings everywhere.
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)
14
18
15Get your package included
19Get your package included
16-------------------------
20-------------------------
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:
93 - shelly
93 - shelly
94 - smtLib
94 - smtLib
95 - stackage
95 - stackage
96+ - stackage-curator
96 - statistics-linreg
97 - statistics-linreg
97 - th-expand-syns
98 - th-expand-syns
98 - thyme
99 - 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