mirror of
https://github.com/commercialhaskell/stackage.git
synced 2026-01-12 07:18:31 +01:00
Merge branch 'incremental' into new-upload
Conflicts: ChangeLog.md stackage.cabal
This commit is contained in:
commit
51f3aa1d10
3
.dir-locals.el
Normal file
3
.dir-locals.el
Normal file
@ -0,0 +1,3 @@
|
||||
((haskell-mode . ((haskell-process-type . cabal-repl)
|
||||
(haskell-indent-spaces . 4)
|
||||
(hindent-style . "johan-tibell"))))
|
||||
8
.dockerignore
Normal file
8
.dockerignore
Normal file
@ -0,0 +1,8 @@
|
||||
dist
|
||||
builds
|
||||
logs
|
||||
.cabal-sandbox
|
||||
cabal.sandbox.config
|
||||
tarballs
|
||||
*.yaml
|
||||
.git
|
||||
24
.travis.yml
Normal file
24
.travis.yml
Normal file
@ -0,0 +1,24 @@
|
||||
env:
|
||||
- CABALVER=1.20 GHCVER=7.8.4
|
||||
|
||||
cache:
|
||||
directories:
|
||||
- $HOME/.ghc
|
||||
- $HOME/.cabal
|
||||
|
||||
# Note: the distinction between `before_install` and `install` is not important.
|
||||
before_install:
|
||||
- travis_retry sudo add-apt-repository -y ppa:hvr/ghc
|
||||
- travis_retry sudo apt-get update
|
||||
- travis_retry sudo apt-get install cabal-install-$CABALVER ghc-$GHCVER # see note about happy/alex
|
||||
- export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH
|
||||
|
||||
install:
|
||||
- cabal --version
|
||||
- echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]"
|
||||
- travis_retry cabal update
|
||||
- cabal install -j
|
||||
|
||||
# Here starts the actual work to be performed for the package under test; any command which exits with a non-zero exit code causes the build to fail.
|
||||
script:
|
||||
- ./dist/build/stackage/stackage check
|
||||
23
ChangeLog.md
23
ChangeLog.md
@ -1,7 +1,28 @@
|
||||
## 0.4.0
|
||||
## Unreleased
|
||||
|
||||
* Upload bundle V2 stuff
|
||||
|
||||
## 0.5.2
|
||||
|
||||
* Upload LTS to Hackage with the name LTSHaskell
|
||||
|
||||
## 0.5.1
|
||||
|
||||
* `loadBuildConstraints`
|
||||
* More command line options
|
||||
|
||||
## 0.5.0
|
||||
|
||||
* Print "Still Alive" while checking, to avoid Travis timeouts
|
||||
* Include `stackage upload-nightly` command
|
||||
* Optional plan checking
|
||||
|
||||
## 0.4.0
|
||||
|
||||
* Command line uses optparse-applicative with additional options
|
||||
* Library profiling support during build
|
||||
* Remove cfGlobalFlags (just use package-specific flags)
|
||||
|
||||
## 0.3.1
|
||||
|
||||
* Added `justCheck` and `stackage check` command line.
|
||||
|
||||
25
Dockerfile
Normal file
25
Dockerfile
Normal file
@ -0,0 +1,25 @@
|
||||
FROM ubuntu:12.04
|
||||
|
||||
ENV HOME /home/stackage
|
||||
ENV LANG en_US.UTF-8
|
||||
|
||||
RUN mkdir /home/stackage -p
|
||||
RUN locale-gen en_US.UTF-8
|
||||
|
||||
RUN DEBIAN_FRONTEND=noninteractive apt-get update
|
||||
RUN DEBIAN_FRONTEND=noninteractive apt-get install -y software-properties-common python-software-properties
|
||||
RUN DEBIAN_FRONTEND=noninteractive add-apt-repository ppa:hvr/ghc -y
|
||||
|
||||
ADD debian-bootstrap.sh /tmp/debian-bootstrap.sh
|
||||
RUN DEBIAN_FRONTEND=noninteractive bash /tmp/debian-bootstrap.sh
|
||||
RUN rm /tmp/debian-bootstrap.sh
|
||||
|
||||
RUN DEBIAN_FRONTEND=noninteractive apt-get install -y cabal-install-1.20 ghc-7.8.4 alex-3.1.3 happy-1.19.4
|
||||
|
||||
ENV PATH /home/stackage/.cabal/bin:/usr/local/sbin:/usr/local/bin:/opt/ghc/7.8.4/bin:/opt/cabal/1.20/bin:/opt/alex/3.1.3/bin:/opt/happy/1.19.4/bin:/usr/sbin:/usr/bin:/sbin:/bin
|
||||
|
||||
RUN cabal update
|
||||
ADD . /tmp/stackage
|
||||
RUN cd /tmp/stackage && cabal install . hscolour cabal-install --constraint "Cabal < 1.22" && cp $HOME/.cabal/bin/* /usr/local/bin && rm -rf $HOME/.cabal $HOME/.ghc /tmp/stackage
|
||||
|
||||
RUN cd /home/stackage && cabal update && stackage check
|
||||
22
README.md
22
README.md
@ -49,6 +49,28 @@ build by running:
|
||||
cabal install stackage
|
||||
stackage nightly
|
||||
|
||||
### Docker
|
||||
|
||||
Note: This method is currently considered experimental.
|
||||
|
||||
If you'd like to check a build plan, or perform an entire build, without
|
||||
specially configuring your system, Docker may be a good approach. To check if
|
||||
some modifications to `build-constraints.yaml` are valid, try the following:
|
||||
|
||||
1. Create a local clone of the `stackage` repo
|
||||
2. Make modifications to your local `build-constraints.yaml`
|
||||
3. Inside the `stackage` working directory, run the following:
|
||||
|
||||
```
|
||||
$ docker run -it --rm -v $(pwd):/stackage -w /stackage snoyberg/stackage /bin/bash -c 'cabal update && stackage check'
|
||||
```
|
||||
|
||||
Similarly, if you'd like to perform an entire build, you can replace the last step with:
|
||||
|
||||
```
|
||||
$ docker run -it --rm -v $(pwd):/stackage -w /stackage snoyberg/stackage /bin/bash -c 'cabal update && stackage nightly --skip-upload'
|
||||
```
|
||||
|
||||
## Processing
|
||||
|
||||
The following describes at a high level the series of steps for processing
|
||||
|
||||
@ -10,6 +10,9 @@ module Stackage.BuildConstraints
|
||||
, SystemInfo (..)
|
||||
, getSystemInfo
|
||||
, defaultBuildConstraints
|
||||
, toBC
|
||||
, BuildConstraintsSource (..)
|
||||
, loadBuildConstraints
|
||||
) where
|
||||
|
||||
import Control.Monad.Writer.Strict (execWriter, tell)
|
||||
@ -21,7 +24,7 @@ import Distribution.System (Arch, OS)
|
||||
import qualified Distribution.System
|
||||
import Distribution.Version (anyVersion)
|
||||
import Filesystem (isFile)
|
||||
import Network.HTTP.Client (Manager, httpLbs, responseBody)
|
||||
import Network.HTTP.Client (Manager, httpLbs, responseBody, Request)
|
||||
import Stackage.CorePackages
|
||||
import Stackage.Prelude
|
||||
|
||||
@ -88,12 +91,13 @@ data BuildConstraints = BuildConstraints
|
||||
}
|
||||
|
||||
data PackageConstraints = PackageConstraints
|
||||
{ pcVersionRange :: VersionRange
|
||||
, pcMaintainer :: Maybe Maintainer
|
||||
, pcTests :: TestState
|
||||
, pcHaddocks :: TestState
|
||||
, pcBuildBenchmarks :: Bool
|
||||
, pcFlagOverrides :: Map FlagName Bool
|
||||
{ pcVersionRange :: VersionRange
|
||||
, pcMaintainer :: Maybe Maintainer
|
||||
, pcTests :: TestState
|
||||
, pcHaddocks :: TestState
|
||||
, pcBuildBenchmarks :: Bool
|
||||
, pcFlagOverrides :: Map FlagName Bool
|
||||
, pcEnableLibProfile :: Bool
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
instance ToJSON PackageConstraints where
|
||||
@ -103,6 +107,7 @@ instance ToJSON PackageConstraints where
|
||||
, "haddocks" .= pcHaddocks
|
||||
, "build-benchmarks" .= pcBuildBenchmarks
|
||||
, "flags" .= Map.mapKeysWith const unFlagName pcFlagOverrides
|
||||
, "library-profiling" .= pcEnableLibProfile
|
||||
]
|
||||
where
|
||||
addMaintainer = maybe id (\m -> (("maintainer" .= m):)) pcMaintainer
|
||||
@ -115,6 +120,7 @@ instance FromJSON PackageConstraints where
|
||||
pcBuildBenchmarks <- o .: "build-benchmarks"
|
||||
pcFlagOverrides <- Map.mapKeysWith const mkFlagName <$> o .: "flags"
|
||||
pcMaintainer <- o .:? "maintainer"
|
||||
pcEnableLibProfile <- fmap (fromMaybe True) (o .:? "library-profiling")
|
||||
return PackageConstraints {..}
|
||||
|
||||
-- | The proposed plan from the requirements provided by contributors.
|
||||
@ -122,15 +128,32 @@ instance FromJSON PackageConstraints where
|
||||
-- Checks the current directory for a build-constraints.yaml file and uses it
|
||||
-- if present. If not, downloads from Github.
|
||||
defaultBuildConstraints :: Manager -> IO BuildConstraints
|
||||
defaultBuildConstraints man = do
|
||||
e <- isFile fp
|
||||
if e
|
||||
then decodeFileEither (fpToString fp) >>= either throwIO toBC
|
||||
else httpLbs req man >>=
|
||||
either throwIO toBC . decodeEither' . toStrict . responseBody
|
||||
defaultBuildConstraints = loadBuildConstraints BCSDefault
|
||||
|
||||
data BuildConstraintsSource
|
||||
= BCSDefault
|
||||
| BCSFile FilePath
|
||||
| BCSWeb Request
|
||||
deriving (Show)
|
||||
|
||||
loadBuildConstraints :: BuildConstraintsSource -> Manager -> IO BuildConstraints
|
||||
loadBuildConstraints bcs man = do
|
||||
case bcs of
|
||||
BCSDefault -> do
|
||||
e <- isFile fp0
|
||||
if e
|
||||
then loadFile fp0
|
||||
else loadReq req0
|
||||
BCSFile fp -> loadFile fp
|
||||
BCSWeb req -> loadReq req
|
||||
where
|
||||
fp = "build-constraints.yaml"
|
||||
req = "https://raw.githubusercontent.com/fpco/stackage/master/build-constraints.yaml"
|
||||
fp0 = "build-constraints.yaml"
|
||||
req0 = "https://raw.githubusercontent.com/fpco/stackage/master/build-constraints.yaml"
|
||||
|
||||
loadFile fp = decodeFileEither (fpToString fp) >>= either throwIO toBC
|
||||
loadReq req = httpLbs req man >>=
|
||||
either throwIO toBC . decodeEither' . toStrict . responseBody
|
||||
|
||||
|
||||
getSystemInfo :: IO SystemInfo
|
||||
getSystemInfo = do
|
||||
@ -144,24 +167,24 @@ getSystemInfo = do
|
||||
siArch = Distribution.System.X86_64
|
||||
|
||||
data ConstraintFile = ConstraintFile
|
||||
{ cfGlobalFlags :: Map FlagName Bool
|
||||
, cfPackageFlags :: Map PackageName (Map FlagName Bool)
|
||||
{ cfPackageFlags :: Map PackageName (Map FlagName Bool)
|
||||
, cfSkippedTests :: Set PackageName
|
||||
, cfExpectedTestFailures :: Set PackageName
|
||||
, cfExpectedHaddockFailures :: Set PackageName
|
||||
, cfSkippedBenchmarks :: Set PackageName
|
||||
, cfPackages :: Map Maintainer (Vector Dependency)
|
||||
, cfGithubUsers :: Map Text (Set Text)
|
||||
, cfSkippedLibProfiling :: Set PackageName
|
||||
}
|
||||
|
||||
instance FromJSON ConstraintFile where
|
||||
parseJSON = withObject "ConstraintFile" $ \o -> do
|
||||
cfGlobalFlags <- goFlagMap <$> o .: "global-flags"
|
||||
cfPackageFlags <- (goPackageMap . fmap goFlagMap) <$> o .: "package-flags"
|
||||
cfSkippedTests <- getPackages o "skipped-tests"
|
||||
cfExpectedTestFailures <- getPackages o "expected-test-failures"
|
||||
cfExpectedHaddockFailures <- getPackages o "expected-haddock-failures"
|
||||
cfSkippedBenchmarks <- getPackages o "skipped-benchmarks"
|
||||
cfSkippedLibProfiling <- getPackages o "skipped-profiling"
|
||||
cfPackages <- o .: "packages"
|
||||
>>= mapM (mapM toDep)
|
||||
. Map.mapKeysWith const Maintainer
|
||||
@ -196,6 +219,7 @@ toBC ConstraintFile {..} = do
|
||||
mpair = lookup name revmap
|
||||
pcMaintainer = fmap fst mpair
|
||||
pcVersionRange = maybe anyVersion snd mpair
|
||||
pcEnableLibProfile = not (name `member` cfSkippedLibProfiling)
|
||||
pcTests
|
||||
| name `member` cfSkippedTests = Don'tBuild
|
||||
| name `member` cfExpectedTestFailures = ExpectFailure
|
||||
@ -205,7 +229,6 @@ toBC ConstraintFile {..} = do
|
||||
| name `member` cfExpectedHaddockFailures = ExpectFailure
|
||||
|
||||
| otherwise = ExpectSuccess
|
||||
pcFlagOverrides = fromMaybe mempty (lookup name cfPackageFlags) ++
|
||||
cfGlobalFlags
|
||||
pcFlagOverrides = fromMaybe mempty $ lookup name cfPackageFlags
|
||||
|
||||
bcGithubUsers = cfGithubUsers
|
||||
|
||||
@ -14,6 +14,7 @@ module Stackage.BuildPlan
|
||||
, PackagePlan (..)
|
||||
, newBuildPlan
|
||||
, makeToolMap
|
||||
, getLatestAllowedPlans
|
||||
) where
|
||||
|
||||
import Control.Monad.State.Strict (execState, get, put)
|
||||
@ -90,9 +91,9 @@ instance FromJSON PackagePlan where
|
||||
ppDesc <- o .: "description"
|
||||
return PackagePlan {..}
|
||||
|
||||
newBuildPlan :: MonadIO m => BuildConstraints -> m BuildPlan
|
||||
newBuildPlan bc@BuildConstraints {..} = liftIO $ do
|
||||
packagesOrig <- getLatestDescriptions (isAllowed bc) (mkPackagePlan bc)
|
||||
-- | Make a build plan given these package set and build constraints.
|
||||
newBuildPlan :: MonadIO m => Map PackageName PackagePlan -> BuildConstraints -> m BuildPlan
|
||||
newBuildPlan packagesOrig bc@BuildConstraints {..} = liftIO $ do
|
||||
let toolMap = makeToolMap packagesOrig
|
||||
packages = populateUsers $ removeUnincluded bc toolMap packagesOrig
|
||||
toolNames :: [ExeName]
|
||||
@ -205,3 +206,9 @@ mkPackagePlan bc gpd = do
|
||||
getFlag MkFlag {..} =
|
||||
(flagName, fromMaybe flagDefault $ lookup flagName overrides)
|
||||
flags = mapFromList $ map getFlag $ genPackageFlags gpd
|
||||
|
||||
getLatestAllowedPlans :: MonadIO m => BuildConstraints -> m (Map PackageName PackagePlan)
|
||||
getLatestAllowedPlans bc =
|
||||
getLatestDescriptions
|
||||
(isAllowed bc)
|
||||
(mkPackagePlan bc)
|
||||
|
||||
@ -1,3 +1,4 @@
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
@ -7,28 +8,38 @@
|
||||
-- | Confirm that a build plan has a consistent set of dependencies.
|
||||
module Stackage.CheckBuildPlan
|
||||
( checkBuildPlan
|
||||
, BadBuildPlan
|
||||
) where
|
||||
|
||||
import Control.Monad.Writer.Strict (Writer, execWriter, tell)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Map.Strict as M
|
||||
import qualified Data.Text as T
|
||||
import Stackage.BuildConstraints
|
||||
import Stackage.BuildPlan
|
||||
import Stackage.PackageDescription
|
||||
import Stackage.Prelude
|
||||
|
||||
-- FIXME check cycles in dependencies, only looking at libraries and
|
||||
-- executables
|
||||
|
||||
checkBuildPlan :: MonadThrow m => BuildPlan -> m ()
|
||||
-- | Check the build plan for missing deps, wrong versions, etc.
|
||||
checkBuildPlan :: (MonadThrow m) => BuildPlan -> m ()
|
||||
checkBuildPlan BuildPlan {..}
|
||||
| null errs' = return ()
|
||||
| otherwise = throwM errs
|
||||
where
|
||||
allPackages = siCorePackages bpSystemInfo ++ map ppVersion bpPackages
|
||||
allPackages = map (,mempty) (siCorePackages bpSystemInfo) ++
|
||||
map (ppVersion &&& M.keys . M.filter libAndExe . sdPackages . ppDesc) bpPackages
|
||||
errs@(BadBuildPlan errs') =
|
||||
execWriter $ mapM_ (checkDeps allPackages) $ mapToList bpPackages
|
||||
-- Only looking at libraries and executables, benchmarks and tests
|
||||
-- are allowed to create cycles (e.g. test-framework depends on
|
||||
-- text, which uses test-framework in its test-suite).
|
||||
libAndExe (DepInfo cs _) = any (flip elem [CompLibrary,CompExecutable]) cs
|
||||
|
||||
checkDeps :: Map PackageName Version
|
||||
-- | For a given package name and plan, check that its dependencies are:
|
||||
--
|
||||
-- 1. Existent (existing in the provided package map)
|
||||
-- 2. Within version range
|
||||
-- 3. Check for dependency cycles.
|
||||
checkDeps :: Map PackageName (Version,[PackageName])
|
||||
-> (PackageName, PackagePlan)
|
||||
-> Writer BadBuildPlan ()
|
||||
checkDeps allPackages (user, pb) =
|
||||
@ -37,8 +48,16 @@ checkDeps allPackages (user, pb) =
|
||||
go (dep, diRange -> range) =
|
||||
case lookup dep allPackages of
|
||||
Nothing -> tell $ BadBuildPlan $ singletonMap (dep, Nothing) errMap
|
||||
Just version
|
||||
| version `withinRange` range -> return ()
|
||||
Just (version,deps)
|
||||
| version `withinRange` range ->
|
||||
occursCheck allPackages
|
||||
(\d v ->
|
||||
tell $ BadBuildPlan $ singletonMap
|
||||
(d,v)
|
||||
errMap)
|
||||
dep
|
||||
deps
|
||||
[]
|
||||
| otherwise -> tell $ BadBuildPlan $ singletonMap
|
||||
(dep, Just version)
|
||||
errMap
|
||||
@ -51,6 +70,38 @@ checkDeps allPackages (user, pb) =
|
||||
, puGithubPings = ppGithubPings pb
|
||||
}
|
||||
|
||||
-- | Check whether the package(s) occurs within its own dependency
|
||||
-- tree.
|
||||
occursCheck
|
||||
:: Monad m
|
||||
=> Map PackageName (Version,[PackageName])
|
||||
-- ^ All packages.
|
||||
-> (PackageName -> Maybe Version -> m ())
|
||||
-- ^ Report an erroneous package.
|
||||
-> PackageName
|
||||
-- ^ Starting package to check for cycles in.
|
||||
-> [PackageName]
|
||||
-- ^ Dependencies of the package.
|
||||
-> [PackageName]
|
||||
-- ^ Previously seen packages up the dependency tree.
|
||||
-> m ()
|
||||
occursCheck allPackages reportError =
|
||||
go
|
||||
where
|
||||
go pkg deps seen =
|
||||
case find (flip elem seen) deps of
|
||||
Just cyclic ->
|
||||
reportError cyclic $
|
||||
fmap fst (lookup cyclic allPackages)
|
||||
Nothing ->
|
||||
forM_ deps $
|
||||
\pkg' ->
|
||||
case lookup pkg' allPackages of
|
||||
Just (_v,deps')
|
||||
| pkg' /= pkg -> go pkg' deps' seen'
|
||||
_ -> return ()
|
||||
where seen' = pkg : seen
|
||||
|
||||
data PkgUser = PkgUser
|
||||
{ puName :: PackageName
|
||||
, puVersion :: Version
|
||||
|
||||
@ -4,9 +4,14 @@
|
||||
module Stackage.CompleteBuild
|
||||
( BuildType (..)
|
||||
, BumpType (..)
|
||||
, BuildFlags (..)
|
||||
, completeBuild
|
||||
, justCheck
|
||||
, justUploadNightly
|
||||
) where
|
||||
|
||||
import Control.Concurrent (threadDelay)
|
||||
import Control.Concurrent.Async (withAsync)
|
||||
import Data.Default.Class (def)
|
||||
import Data.Semigroup (Max (..), Option (..))
|
||||
import Data.Text.Read (decimal)
|
||||
@ -22,8 +27,20 @@ import Stackage.Prelude
|
||||
import Stackage.ServerBundle
|
||||
import Stackage.UpdateBuildPlan
|
||||
import Stackage.Upload
|
||||
import System.Environment (lookupEnv)
|
||||
import System.IO (BufferMode (LineBuffering), hSetBuffering)
|
||||
|
||||
-- | Flags passed in from the command line.
|
||||
data BuildFlags = BuildFlags
|
||||
{ bfEnableTests :: !Bool
|
||||
, bfEnableHaddock :: !Bool
|
||||
, bfDoUpload :: !Bool
|
||||
, bfEnableLibProfile :: !Bool
|
||||
, bfEnableExecDyn :: !Bool
|
||||
, bfVerbose :: !Bool
|
||||
, bfSkipCheck :: !Bool
|
||||
} deriving (Show)
|
||||
|
||||
data BuildType = Nightly | LTS BumpType
|
||||
deriving (Show, Read, Eq, Ord)
|
||||
|
||||
@ -39,28 +56,42 @@ data Settings = Settings
|
||||
, slug :: Text
|
||||
, setArgs :: Text -> UploadBundle -> UploadBundle
|
||||
, postBuild :: IO ()
|
||||
, distroName :: Text -- ^ distro name on Hackage
|
||||
}
|
||||
|
||||
nightlyPlanFile :: Text -- ^ day
|
||||
-> FilePath
|
||||
nightlyPlanFile day = fpFromText ("nightly-" ++ day) <.> "yaml"
|
||||
|
||||
nightlySettings :: Text -- ^ day
|
||||
-> BuildPlan
|
||||
-> Settings
|
||||
nightlySettings day plan' = Settings
|
||||
{ planFile = nightlyPlanFile day
|
||||
, buildDir = fpFromText $ "builds/nightly"
|
||||
, logDir = fpFromText $ "logs/stackage-nightly-" ++ day
|
||||
, title = \ghcVer -> concat
|
||||
[ "Stackage Nightly "
|
||||
, day
|
||||
, ", GHC "
|
||||
, ghcVer
|
||||
]
|
||||
, slug = slug'
|
||||
, setArgs = \ghcVer ub -> ub { ubNightly = Just ghcVer }
|
||||
, plan = plan'
|
||||
, postBuild = return ()
|
||||
, distroName = "Stackage"
|
||||
}
|
||||
where
|
||||
slug' = "nightly-" ++ day
|
||||
|
||||
getSettings :: Manager -> BuildType -> IO Settings
|
||||
getSettings man Nightly = do
|
||||
day <- tshow . utctDay <$> getCurrentTime
|
||||
let slug' = "nightly-" ++ day
|
||||
plan' <- defaultBuildConstraints man >>= newBuildPlan
|
||||
return Settings
|
||||
{ planFile = fpFromText ("nightly-" ++ day) <.> "yaml"
|
||||
, buildDir = fpFromText $ "builds/stackage-nightly-" ++ day
|
||||
, logDir = fpFromText $ "logs/stackage-nightly-" ++ day
|
||||
, title = \ghcVer -> concat
|
||||
[ "Stackage Nightly "
|
||||
, day
|
||||
, ", GHC "
|
||||
, ghcVer
|
||||
]
|
||||
, slug = slug'
|
||||
, setArgs = \ghcVer ub -> ub { ubNightly = Just ghcVer }
|
||||
, plan = plan'
|
||||
, postBuild = return ()
|
||||
}
|
||||
bc <- defaultBuildConstraints man
|
||||
pkgs <- getLatestAllowedPlans bc
|
||||
plan' <- newBuildPlan pkgs bc
|
||||
return $ nightlySettings day plan'
|
||||
getSettings man (LTS bumpType) = do
|
||||
Option mlts <- fmap (fmap getMax) $ runResourceT
|
||||
$ sourceDirectory "."
|
||||
@ -72,21 +103,25 @@ getSettings man (LTS bumpType) = do
|
||||
case mlts of
|
||||
Nothing -> LTSVer 0 0
|
||||
Just (LTSVer x _) -> LTSVer (x + 1) 0
|
||||
plan' <- defaultBuildConstraints man >>= newBuildPlan
|
||||
bc <- defaultBuildConstraints man
|
||||
pkgs <- getLatestAllowedPlans bc
|
||||
plan' <- newBuildPlan pkgs bc
|
||||
return (new, plan')
|
||||
Minor -> do
|
||||
old <- maybe (error "No LTS plans found in current directory") return mlts
|
||||
oldplan <- decodeFileEither (fpToString $ renderLTSVer old)
|
||||
>>= either throwM return
|
||||
let new = incrLTSVer old
|
||||
plan' <- updateBuildPlan oldplan
|
||||
let bc = updateBuildConstraints oldplan
|
||||
pkgs <- getLatestAllowedPlans bc
|
||||
plan' <- newBuildPlan pkgs bc
|
||||
return (new, plan')
|
||||
|
||||
let newfile = renderLTSVer new
|
||||
|
||||
return Settings
|
||||
{ planFile = newfile
|
||||
, buildDir = fpFromText $ "builds/stackage-lts-" ++ tshow new
|
||||
, buildDir = fpFromText $ "builds/lts"
|
||||
, logDir = fpFromText $ "logs/stackage-lts-" ++ tshow new
|
||||
, title = \ghcVer -> concat
|
||||
[ "LTS Haskell "
|
||||
@ -106,6 +141,7 @@ getSettings man (LTS bumpType) = do
|
||||
git ["commit", "-m", "Added new LTS release: " ++ show new]
|
||||
putStrLn "Pushing to Git repository"
|
||||
git ["push"]
|
||||
, distroName = "LTSHaskell"
|
||||
}
|
||||
|
||||
data LTSVer = LTSVer !Int !Int
|
||||
@ -130,16 +166,27 @@ renderLTSVer lts = fpFromText $ concat
|
||||
, ".yaml"
|
||||
]
|
||||
|
||||
-- | Just print a message saying "still alive" every minute, to appease Travis.
|
||||
stillAlive :: IO () -> IO ()
|
||||
stillAlive inner =
|
||||
withAsync (printer 1) $ const inner
|
||||
where
|
||||
printer i = forever $ do
|
||||
threadDelay 60000000
|
||||
putStrLn $ "Still alive: " ++ tshow i
|
||||
printer $! i + 1
|
||||
|
||||
-- | Generate and check a new build plan, but do not execute it.
|
||||
--
|
||||
-- Since 0.3.1
|
||||
justCheck :: IO ()
|
||||
justCheck = withManager tlsManagerSettings $ \man -> do
|
||||
justCheck = stillAlive $ withManager tlsManagerSettings $ \man -> do
|
||||
putStrLn "Loading build constraints"
|
||||
bc <- defaultBuildConstraints man
|
||||
|
||||
putStrLn "Creating build plan"
|
||||
plan <- newBuildPlan bc
|
||||
plans <- getLatestAllowedPlans bc
|
||||
plan <- newBuildPlan plans bc
|
||||
|
||||
putStrLn $ "Writing build plan to check-plan.yaml"
|
||||
encodeFile "check-plan.yaml" plan
|
||||
@ -149,37 +196,71 @@ justCheck = withManager tlsManagerSettings $ \man -> do
|
||||
|
||||
putStrLn "Plan seems valid!"
|
||||
|
||||
completeBuild :: BuildType -> IO ()
|
||||
completeBuild buildType = withManager tlsManagerSettings $ \man -> do
|
||||
getPerformBuild :: BuildFlags -> Settings -> PerformBuild
|
||||
getPerformBuild buildFlags Settings {..} = PerformBuild
|
||||
{ pbPlan = plan
|
||||
, pbInstallDest = buildDir
|
||||
, pbLogDir = logDir
|
||||
, pbLog = hPut stdout
|
||||
, pbJobs = 8
|
||||
, pbGlobalInstall = False
|
||||
, pbEnableTests = bfEnableTests buildFlags
|
||||
, pbEnableHaddock = bfEnableHaddock buildFlags
|
||||
, pbEnableLibProfiling = bfEnableLibProfile buildFlags
|
||||
, pbEnableExecDyn = bfEnableExecDyn buildFlags
|
||||
, pbVerbose = bfVerbose buildFlags
|
||||
, pbAllowNewer = bfSkipCheck buildFlags
|
||||
}
|
||||
|
||||
-- | Make a complete plan, build, test and upload bundle, docs and
|
||||
-- distro.
|
||||
completeBuild :: BuildType -> BuildFlags -> IO ()
|
||||
completeBuild buildType buildFlags = withManager tlsManagerSettings $ \man -> do
|
||||
hSetBuffering stdout LineBuffering
|
||||
|
||||
putStrLn $ "Loading settings for: " ++ tshow buildType
|
||||
Settings {..} <- getSettings man buildType
|
||||
settings@Settings {..} <- getSettings man buildType
|
||||
|
||||
putStrLn $ "Writing build plan to: " ++ fpToText planFile
|
||||
encodeFile (fpToString planFile) plan
|
||||
|
||||
putStrLn "Checking build plan"
|
||||
checkBuildPlan plan
|
||||
if bfSkipCheck buildFlags
|
||||
then putStrLn "Skipping build plan check"
|
||||
else do
|
||||
putStrLn "Checking build plan"
|
||||
checkBuildPlan plan
|
||||
|
||||
putStrLn "Performing build"
|
||||
let pb = PerformBuild
|
||||
{ pbPlan = plan
|
||||
, pbInstallDest = buildDir
|
||||
, pbLogDir = logDir
|
||||
, pbLog = hPut stdout
|
||||
, pbJobs = 8
|
||||
, pbGlobalInstall = False
|
||||
}
|
||||
performBuild pb >>= mapM_ putStrLn
|
||||
performBuild (getPerformBuild buildFlags settings) >>= mapM_ putStrLn
|
||||
|
||||
when (bfDoUpload buildFlags) $
|
||||
finallyUpload settings man
|
||||
|
||||
justUploadNightly
|
||||
:: Text -- ^ nightly date
|
||||
-> IO ()
|
||||
justUploadNightly day = do
|
||||
plan <- decodeFileEither (fpToString $ nightlyPlanFile day)
|
||||
>>= either throwM return
|
||||
withManager tlsManagerSettings $ finallyUpload $ nightlySettings day plan
|
||||
|
||||
-- | The final part of the complete build process: uploading a bundle,
|
||||
-- docs and a distro to hackage.
|
||||
finallyUpload :: Settings -> Manager -> IO ()
|
||||
finallyUpload settings@Settings{..} man = do
|
||||
putStrLn "Uploading bundle to Stackage Server"
|
||||
token <- readFile "/auth-token"
|
||||
|
||||
mtoken <- lookupEnv "STACKAGE_AUTH_TOKEN"
|
||||
token <-
|
||||
case mtoken of
|
||||
Nothing -> decodeUtf8 <$> readFile "/auth-token"
|
||||
Just token -> return $ pack token
|
||||
|
||||
now <- epochTime
|
||||
let ghcVer = display $ siGhcVersion $ bpSystemInfo plan
|
||||
(ident, mloc) <- flip uploadBundle man $ setArgs ghcVer def
|
||||
{ ubContents = serverBundle now (title ghcVer) slug plan
|
||||
, ubAuthToken = decodeUtf8 token
|
||||
, ubAuthToken = token
|
||||
}
|
||||
putStrLn $ "New ident: " ++ unSnapshotIdent ident
|
||||
forM_ mloc $ \loc ->
|
||||
@ -190,7 +271,7 @@ completeBuild buildType = withManager tlsManagerSettings $ \man -> do
|
||||
putStrLn "Uploading docs to Stackage Server"
|
||||
res1 <- uploadDocs UploadDocs
|
||||
{ udServer = def
|
||||
, udAuthToken = decodeUtf8 token
|
||||
, udAuthToken = token
|
||||
, udDocs = pbDocDir pb
|
||||
, udSnapshot = ident
|
||||
} man
|
||||
@ -200,15 +281,17 @@ completeBuild buildType = withManager tlsManagerSettings $ \man -> do
|
||||
case map encodeUtf8 $ words $ decodeUtf8 $ either (const "") id ecreds of
|
||||
[username, password] -> do
|
||||
putStrLn "Uploading as Hackage distro"
|
||||
res2 <- uploadHackageDistro plan username password man
|
||||
res2 <- uploadHackageDistroNamed distroName plan username password man
|
||||
putStrLn $ "Distro upload response: " ++ tshow res2
|
||||
_ -> putStrLn "No creds found, skipping Hackage distro upload"
|
||||
|
||||
putStrLn "Uploading doc map"
|
||||
uploadDocMap UploadDocMap
|
||||
{ udmServer = def
|
||||
, udmAuthToken = decodeUtf8 token
|
||||
, udmAuthToken = token
|
||||
, udmSnapshot = ident
|
||||
, udmDocDir = pbDocDir pb
|
||||
, udmPlan = plan
|
||||
} man >>= print
|
||||
where
|
||||
pb = getPerformBuild (error "finallyUpload.buildFlags") settings
|
||||
|
||||
90
Stackage/GhcPkg.hs
Normal file
90
Stackage/GhcPkg.hs
Normal file
@ -0,0 +1,90 @@
|
||||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
-- | General commands related to ghc-pkg.
|
||||
|
||||
module Stackage.GhcPkg
|
||||
( setupPackageDatabase
|
||||
) where
|
||||
|
||||
import Data.Conduit
|
||||
import qualified Data.Conduit.List as CL
|
||||
import Data.Conduit.Process
|
||||
import qualified Data.Conduit.Text as CT
|
||||
import Data.Maybe
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Distribution.Compat.ReadP
|
||||
import Distribution.Package
|
||||
import Distribution.Text (parse)
|
||||
import Filesystem.Path.CurrentOS (FilePath)
|
||||
import qualified Filesystem.Path.CurrentOS as FP
|
||||
import Data.Map (Map)
|
||||
import Data.Version (Version)
|
||||
import Stackage.Prelude
|
||||
import Filesystem (removeTree)
|
||||
|
||||
setupPackageDatabase
|
||||
:: Maybe FilePath -- ^ database location, Nothing if using global DB
|
||||
-> FilePath -- ^ documentation root
|
||||
-> (ByteString -> IO ()) -- ^ logging
|
||||
-> Map PackageName Version -- ^ packages and versions to be installed
|
||||
-> IO (Set PackageName) -- ^ packages remaining in the database after cleanup
|
||||
setupPackageDatabase mdb docDir log' toInstall = do
|
||||
registered1 <- getRegisteredPackages flags
|
||||
forM_ registered1 $ \pi@(PackageIdentifier name version) ->
|
||||
case lookup name toInstall of
|
||||
Just version' | version /= version' -> unregisterPackage log' docDir flags pi
|
||||
_ -> return ()
|
||||
broken <- getBrokenPackages flags
|
||||
forM_ broken $ unregisterPackage log' docDir flags
|
||||
foldMap (\(PackageIdentifier name _) -> singletonSet name)
|
||||
<$> getRegisteredPackages flags
|
||||
where
|
||||
flags = ghcPkgFlags mdb
|
||||
|
||||
ghcPkgFlags :: Maybe FilePath -> [String]
|
||||
ghcPkgFlags mdb =
|
||||
"--no-user-package-db" :
|
||||
case mdb of
|
||||
Nothing -> ["--global"]
|
||||
Just fp -> ["--package-db=" ++ fpToString fp]
|
||||
|
||||
-- | Get broken packages.
|
||||
getBrokenPackages :: [String] -> IO [PackageIdentifier]
|
||||
getBrokenPackages flags = do
|
||||
(_,ps) <- sourceProcessWithConsumer
|
||||
(proc
|
||||
"ghc-pkg"
|
||||
("check" : "--simple-output" : flags))
|
||||
(CT.decodeUtf8 $= CT.lines $= CL.consume)
|
||||
return (mapMaybe parsePackageIdent (T.words (T.unlines ps)))
|
||||
|
||||
-- | Get available packages.
|
||||
getRegisteredPackages :: [String] -> IO [PackageIdentifier]
|
||||
getRegisteredPackages flags = do
|
||||
(_,ps) <- sourceProcessWithConsumer
|
||||
(proc
|
||||
"ghc-pkg"
|
||||
("list" : "--simple-output" : flags))
|
||||
(CT.decodeUtf8 $= CT.lines $= CL.consume)
|
||||
return (mapMaybe parsePackageIdent (T.words (T.unlines ps)))
|
||||
|
||||
-- | Parse a package identifier: foo-1.2.3
|
||||
parsePackageIdent :: Text -> Maybe PackageIdentifier
|
||||
parsePackageIdent = fmap fst .
|
||||
listToMaybe .
|
||||
filter (null . snd) .
|
||||
readP_to_S parse . T.unpack
|
||||
|
||||
-- | Unregister a package.
|
||||
unregisterPackage :: (ByteString -> IO ()) -- ^ log func
|
||||
-> FilePath -- ^ doc directory
|
||||
-> [String] -> PackageIdentifier -> IO ()
|
||||
unregisterPackage log' docDir flags ident@(PackageIdentifier name _) = do
|
||||
log' $ "Unregistering " ++ encodeUtf8 (display ident) ++ "\n"
|
||||
void (readProcessWithExitCode
|
||||
"ghc-pkg"
|
||||
("unregister": flags ++ ["--force", unpack $ display name])
|
||||
"")
|
||||
|
||||
void $ tryIO $ removeTree $ docDir </> fpFromText (display ident)
|
||||
100
Stackage/InstallBuild.hs
Normal file
100
Stackage/InstallBuild.hs
Normal file
@ -0,0 +1,100 @@
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
module Stackage.InstallBuild
|
||||
( InstallFlags (..)
|
||||
, BuildPlanSource (..)
|
||||
, installBuild
|
||||
) where
|
||||
|
||||
import qualified Codec.Archive.Tar as Tar
|
||||
import qualified Codec.Compression.GZip as GZip
|
||||
import qualified Data.Yaml as Yaml
|
||||
import Network.HTTP.Client
|
||||
import Network.HTTP.Client.TLS (tlsManagerSettings)
|
||||
import Stackage.BuildPlan
|
||||
import Stackage.CheckBuildPlan
|
||||
import Stackage.PerformBuild
|
||||
import Stackage.Prelude
|
||||
import System.IO (BufferMode (LineBuffering), hSetBuffering)
|
||||
|
||||
-- | Flags passed in from the command line.
|
||||
data InstallFlags = InstallFlags
|
||||
{ ifPlanSource :: !BuildPlanSource
|
||||
, ifInstallDest :: !FilePath
|
||||
, ifLogDir :: !(Maybe FilePath)
|
||||
, ifJobs :: !Int
|
||||
, ifGlobalInstall :: !Bool
|
||||
, ifEnableTests :: !Bool
|
||||
, ifEnableHaddock :: !Bool
|
||||
, ifEnableLibProfiling :: !Bool
|
||||
, ifEnableExecDyn :: !Bool
|
||||
, ifVerbose :: !Bool
|
||||
, ifSkipCheck :: !Bool
|
||||
} deriving (Show)
|
||||
|
||||
-- | Source for build plan.
|
||||
data BuildPlanSource = BPSBundleWeb String
|
||||
| BPSFile FilePath
|
||||
deriving (Show)
|
||||
|
||||
getPerformBuild :: BuildPlan -> InstallFlags -> PerformBuild
|
||||
getPerformBuild plan InstallFlags{..} =
|
||||
PerformBuild
|
||||
{ pbPlan = plan
|
||||
, pbInstallDest = ifInstallDest
|
||||
, pbLogDir = fromMaybe (ifInstallDest </> "logs") ifLogDir
|
||||
, pbLog = hPut stdout
|
||||
, pbJobs = ifJobs
|
||||
, pbGlobalInstall = ifGlobalInstall
|
||||
, pbEnableTests = ifEnableTests
|
||||
, pbEnableHaddock = ifEnableHaddock
|
||||
, pbEnableLibProfiling = ifEnableLibProfiling
|
||||
, pbEnableExecDyn = ifEnableExecDyn
|
||||
, pbVerbose = ifVerbose
|
||||
, pbAllowNewer = ifSkipCheck
|
||||
}
|
||||
|
||||
-- | Install stackage from an existing build plan.
|
||||
installBuild :: InstallFlags -> IO ()
|
||||
installBuild installFlags@InstallFlags{..} = do
|
||||
hSetBuffering stdout LineBuffering
|
||||
|
||||
putStrLn $ "Loading build plan"
|
||||
plan <- case ifPlanSource of
|
||||
BPSBundleWeb url -> withManager tlsManagerSettings $ \man -> do
|
||||
req <- parseUrl url
|
||||
res <- httpLbs req man
|
||||
planBSL <- getPlanEntry $ Tar.read $ GZip.decompress (responseBody res)
|
||||
decodeBuildPlan planBSL
|
||||
BPSFile path -> Yaml.decodeFileEither (fpToString path) >>= either throwM return
|
||||
|
||||
if ifSkipCheck
|
||||
then putStrLn "Skipping build plan check"
|
||||
else do
|
||||
putStrLn "Checking build plan"
|
||||
checkBuildPlan plan
|
||||
|
||||
putStrLn "Performing build"
|
||||
performBuild (getPerformBuild plan installFlags) >>= mapM_ putStrLn
|
||||
|
||||
where
|
||||
getPlanEntry Tar.Done = throwIO NoBuildPlanException
|
||||
getPlanEntry (Tar.Fail e) = throwIO e
|
||||
getPlanEntry (Tar.Next entry entries)
|
||||
| Tar.entryPath entry == "build-plan.yaml" =
|
||||
case Tar.entryContent entry of
|
||||
Tar.NormalFile bs _ -> return bs
|
||||
_ -> throwIO NoBuildPlanException
|
||||
| otherwise = getPlanEntry entries
|
||||
|
||||
decodeBuildPlan =
|
||||
either throwIO return . Yaml.decodeEither' . toStrict
|
||||
|
||||
data InstallBuildException = NoBuildPlanException
|
||||
deriving (Typeable)
|
||||
instance Exception InstallBuildException
|
||||
instance Show InstallBuildException where
|
||||
show NoBuildPlanException = "Bundle has missing or invalid build-plan.yaml"
|
||||
@ -19,11 +19,12 @@ import qualified Data.Map as Map
|
||||
import Data.NonNull (fromNullable)
|
||||
import Filesystem (canonicalizePath, createTree,
|
||||
getWorkingDirectory, isDirectory,
|
||||
removeTree, rename)
|
||||
removeTree, rename, isFile, removeFile)
|
||||
import Filesystem.Path (parent)
|
||||
import qualified Filesystem.Path as F
|
||||
import Stackage.BuildConstraints
|
||||
import Stackage.BuildPlan
|
||||
import Stackage.GhcPkg
|
||||
import Stackage.PackageDescription
|
||||
import Stackage.Prelude hiding (pi)
|
||||
import System.Directory (findExecutable)
|
||||
@ -61,6 +62,13 @@ data PerformBuild = PerformBuild
|
||||
, pbJobs :: Int
|
||||
, pbGlobalInstall :: Bool
|
||||
-- ^ Register packages in the global database
|
||||
, pbEnableTests :: Bool
|
||||
, pbEnableHaddock :: Bool
|
||||
, pbEnableLibProfiling :: Bool
|
||||
, pbEnableExecDyn :: Bool
|
||||
, pbVerbose :: Bool
|
||||
, pbAllowNewer :: Bool
|
||||
-- ^ Pass --allow-newer to cabal configure
|
||||
}
|
||||
|
||||
data PackageInfo = PackageInfo
|
||||
@ -83,7 +91,9 @@ waitForDeps toolMap packageMap activeComps bp pi action = do
|
||||
case lookup exe toolMap >>= fromNullable . map checkPackage . setToList of
|
||||
Nothing
|
||||
| isCoreExe exe -> return ()
|
||||
| otherwise -> throwSTM $ ToolMissing exe
|
||||
-- https://github.com/jgm/zip-archive/issues/23
|
||||
-- | otherwise -> throwSTM $ ToolMissing exe
|
||||
| otherwise -> return ()
|
||||
Just packages -> ofoldl1' (<|>) packages
|
||||
action
|
||||
where
|
||||
@ -126,6 +136,10 @@ pbLibDir pb = pbInstallDest pb </> "lib"
|
||||
pbDataDir pb = pbInstallDest pb </> "share"
|
||||
pbDocDir pb = pbInstallDest pb </> "doc"
|
||||
|
||||
-- | Directory keeping previous result info
|
||||
pbPrevResDir :: PerformBuild -> FilePath
|
||||
pbPrevResDir pb = pbInstallDest pb </> "prevres"
|
||||
|
||||
performBuild :: PerformBuild -> IO [Text]
|
||||
performBuild pb = do
|
||||
cwd <- getWorkingDirectory
|
||||
@ -153,12 +167,13 @@ performBuild' pb@PerformBuild {..} = withBuildDir $ \builddir -> do
|
||||
$ \ClosedStream Inherited Inherited -> return ()
|
||||
|
||||
let removeTree' fp = whenM (isDirectory fp) (removeTree fp)
|
||||
mapM_ removeTree' [pbInstallDest, pbLogDir]
|
||||
removeTree' pbLogDir
|
||||
|
||||
forM_ (pbDatabase pb) $ \db -> do
|
||||
createTree $ parent db
|
||||
withCheckedProcess (proc "ghc-pkg" ["init", fpToString db])
|
||||
$ \ClosedStream Inherited Inherited -> return ()
|
||||
forM_ (pbDatabase pb) $ \db ->
|
||||
unlessM (isFile $ db </> "package.cache") $ do
|
||||
createTree $ parent db
|
||||
withCheckedProcess (proc "ghc-pkg" ["init", fpToString db])
|
||||
$ \ClosedStream Inherited Inherited -> return ()
|
||||
pbLog $ encodeUtf8 "Copying built-in Haddocks\n"
|
||||
copyBuiltInHaddocks (pbDocDir pb)
|
||||
|
||||
@ -178,7 +193,14 @@ performBuild' pb@PerformBuild {..} = withBuildDir $ \builddir -> do
|
||||
env <- getEnvironment
|
||||
haddockFiles <- newTVarIO mempty
|
||||
|
||||
forM_ packageMap $ \pi -> void $ async $ singleBuild pb SingleBuild
|
||||
registeredPackages <- setupPackageDatabase
|
||||
(pbDatabase pb)
|
||||
(pbDocDir pb)
|
||||
pbLog
|
||||
(ppVersion <$> bpPackages pbPlan)
|
||||
|
||||
forM_ packageMap $ \pi -> void $ async $ singleBuild pb registeredPackages
|
||||
SingleBuild
|
||||
{ sbSem = sem
|
||||
, sbErrsVar = errsVar
|
||||
, sbWarningsVar = warningsVar
|
||||
@ -192,7 +214,7 @@ performBuild' pb@PerformBuild {..} = withBuildDir $ \builddir -> do
|
||||
id
|
||||
(\db -> (("HASKELL_PACKAGE_SANDBOX", fpToString db):))
|
||||
(pbDatabase pb)
|
||||
(map fixEnv env)
|
||||
(filter allowedEnv $ map fixEnv env)
|
||||
, sbHaddockFiles = haddockFiles
|
||||
}
|
||||
|
||||
@ -210,6 +232,8 @@ performBuild' pb@PerformBuild {..} = withBuildDir $ \builddir -> do
|
||||
| toUpper p == "PATH" = (p, fpToString (pbBinDir pb) ++ pathSep : x)
|
||||
| otherwise = (p, x)
|
||||
|
||||
allowedEnv (k, _) = k `notMember` bannedEnvs
|
||||
|
||||
-- | Separate for the PATH environment variable
|
||||
pathSep :: Char
|
||||
#ifdef mingw32_HOST_OS
|
||||
@ -218,6 +242,12 @@ performBuild' pb@PerformBuild {..} = withBuildDir $ \builddir -> do
|
||||
pathSep = ':'
|
||||
#endif
|
||||
|
||||
-- | Environment variables we don't allow to be passed on to child processes.
|
||||
bannedEnvs :: Set String
|
||||
bannedEnvs = setFromList
|
||||
[ "STACKAGE_AUTH_TOKEN"
|
||||
]
|
||||
|
||||
data SingleBuild = SingleBuild
|
||||
{ sbSem :: TSem
|
||||
, sbErrsVar :: TVar (Map PackageName BuildFailure)
|
||||
@ -232,8 +262,10 @@ data SingleBuild = SingleBuild
|
||||
, sbHaddockFiles :: TVar (Map Text FilePath) -- ^ package-version, .haddock file
|
||||
}
|
||||
|
||||
singleBuild :: PerformBuild -> SingleBuild -> IO ()
|
||||
singleBuild pb@PerformBuild {..} SingleBuild {..} =
|
||||
singleBuild :: PerformBuild
|
||||
-> Set PackageName -- ^ registered packages
|
||||
-> SingleBuild -> IO ()
|
||||
singleBuild pb@PerformBuild {..} registeredPackages SingleBuild {..} =
|
||||
withCounter sbActive
|
||||
$ handle updateErrs
|
||||
$ (`finally` void (atomically $ tryPutTMVar (piResult sbPackageInfo) False))
|
||||
@ -245,11 +277,13 @@ singleBuild pb@PerformBuild {..} SingleBuild {..} =
|
||||
let wfd comps =
|
||||
waitForDeps sbToolMap sbPackageMap comps pbPlan sbPackageInfo
|
||||
. withTSem sbSem
|
||||
wfd libComps buildLibrary
|
||||
withUnpacked <- wfd libComps buildLibrary
|
||||
|
||||
wfd testComps runTests
|
||||
wfd testComps (runTests withUnpacked)
|
||||
|
||||
name = display $ piName sbPackageInfo
|
||||
pname = piName sbPackageInfo
|
||||
pident = PackageIdentifier pname (ppVersion $ piPlan sbPackageInfo)
|
||||
name = display pname
|
||||
namever = concat
|
||||
[ name
|
||||
, "-"
|
||||
@ -290,6 +324,7 @@ singleBuild pb@PerformBuild {..} SingleBuild {..} =
|
||||
withBinaryFile (fpToString fp) WriteMode inner'
|
||||
|
||||
configArgs = ($ []) $ execWriter $ do
|
||||
when pbAllowNewer $ tell' "--allow-newer"
|
||||
tell' "--package-db=clear"
|
||||
tell' "--package-db=global"
|
||||
forM_ (pbDatabase pb) $ \db -> tell' $ "--package-db=" ++ fpToText db
|
||||
@ -298,6 +333,9 @@ singleBuild pb@PerformBuild {..} SingleBuild {..} =
|
||||
tell' $ "--datadir=" ++ fpToText (pbDataDir pb)
|
||||
tell' $ "--docdir=" ++ fpToText (pbDocDir pb)
|
||||
tell' $ "--flags=" ++ flags
|
||||
when (pbEnableLibProfiling && pcEnableLibProfile) $
|
||||
tell' "--enable-library-profiling"
|
||||
when pbEnableExecDyn $ tell' "--enable-executable-dynamic"
|
||||
where
|
||||
tell' x = tell (x:)
|
||||
|
||||
@ -312,20 +350,39 @@ singleBuild pb@PerformBuild {..} SingleBuild {..} =
|
||||
PackageConstraints {..} = ppConstraints $ piPlan sbPackageInfo
|
||||
|
||||
buildLibrary = wf libOut $ \outH -> do
|
||||
let run = runChild outH
|
||||
log' $ "Unpacking " ++ namever
|
||||
runParent outH "cabal" ["unpack", namever]
|
||||
let run a b = do when pbVerbose $ log' (unwords (a : b))
|
||||
runChild outH a b
|
||||
|
||||
log' $ "Configuring " ++ namever
|
||||
run "cabal" $ "configure" : configArgs
|
||||
isUnpacked <- newIORef False
|
||||
let withUnpacked inner = do
|
||||
unlessM (readIORef isUnpacked) $ do
|
||||
log' $ "Unpacking " ++ namever
|
||||
runParent outH "cabal" ["unpack", namever]
|
||||
writeIORef isUnpacked True
|
||||
inner
|
||||
|
||||
log' $ "Building " ++ namever
|
||||
run "cabal" ["build"]
|
||||
isConfiged <- newIORef False
|
||||
let withConfiged inner = withUnpacked $ do
|
||||
unlessM (readIORef isConfiged) $ do
|
||||
log' $ "Configuring " ++ namever
|
||||
run "cabal" $ "configure" : configArgs
|
||||
writeIORef isConfiged True
|
||||
inner
|
||||
|
||||
log' $ "Copying/registering " ++ namever
|
||||
run "cabal" ["copy"]
|
||||
withMVar sbRegisterMutex $ const $
|
||||
run "cabal" ["register"]
|
||||
prevBuildResult <- getPreviousResult pb Build pident
|
||||
unless (prevBuildResult == PRSuccess) $ withConfiged $ do
|
||||
assert (pname `notMember` registeredPackages) $ do
|
||||
deletePreviousResults pb pident
|
||||
|
||||
log' $ "Building " ++ namever
|
||||
run "cabal" ["build"]
|
||||
|
||||
log' $ "Copying/registering " ++ namever
|
||||
run "cabal" ["copy"]
|
||||
withMVar sbRegisterMutex $ const $
|
||||
run "cabal" ["register"]
|
||||
|
||||
savePreviousResult pb Build pident True
|
||||
|
||||
-- Even if the tests later fail, we can allow other libraries to build
|
||||
-- on top of our successful results
|
||||
@ -335,7 +392,11 @@ singleBuild pb@PerformBuild {..} SingleBuild {..} =
|
||||
-- dependency's haddocks before this finishes
|
||||
atomically $ putTMVar (piResult sbPackageInfo) True
|
||||
|
||||
when (pcHaddocks /= Don'tBuild && not (null $ sdModules $ ppDesc $ piPlan sbPackageInfo)) $ do
|
||||
prevHaddockResult <- getPreviousResult pb Haddock pident
|
||||
let needHaddock = pbEnableHaddock
|
||||
&& checkPrevResult prevHaddockResult pcHaddocks
|
||||
&& not (null $ sdModules $ ppDesc $ piPlan sbPackageInfo)
|
||||
when needHaddock $ withConfiged $ do
|
||||
log' $ "Haddocks " ++ namever
|
||||
hfs <- readTVarIO sbHaddockFiles
|
||||
let hfsOpts = flip map (mapToList hfs) $ \(pkgVer, hf) -> concat
|
||||
@ -370,15 +431,21 @@ singleBuild pb@PerformBuild {..} SingleBuild {..} =
|
||||
$ modifyTVar sbHaddockFiles
|
||||
$ insertMap namever newPath
|
||||
|
||||
savePreviousResult pb Haddock pident $ either (const False) (const True) eres
|
||||
case (eres, pcHaddocks) of
|
||||
(Left e, ExpectSuccess) -> throwM e
|
||||
(Right (), ExpectFailure) -> warn $ namever ++ ": unexpected Haddock success"
|
||||
_ -> return ()
|
||||
|
||||
runTests = wf testOut $ \outH -> do
|
||||
return withUnpacked
|
||||
|
||||
runTests withUnpacked = wf testOut $ \outH -> do
|
||||
let run = runChild outH
|
||||
|
||||
when (pcTests /= Don'tBuild) $ do
|
||||
prevTestResult <- getPreviousResult pb Test pident
|
||||
let needTest = pbEnableTests
|
||||
&& checkPrevResult prevTestResult pcTests
|
||||
when needTest $ withUnpacked $ do
|
||||
log' $ "Test configure " ++ namever
|
||||
run "cabal" $ "configure" : "--enable-tests" : configArgs
|
||||
|
||||
@ -389,6 +456,7 @@ singleBuild pb@PerformBuild {..} SingleBuild {..} =
|
||||
log' $ "Test run " ++ namever
|
||||
run "cabal" ["test", "--log=" ++ fpToText testRunOut]
|
||||
|
||||
savePreviousResult pb Test pident $ either (const False) (const True) eres
|
||||
case (eres, pcTests) of
|
||||
(Left e, ExpectSuccess) -> throwM e
|
||||
(Right (), ExpectFailure) -> warn $ namever ++ ": unexpected test success"
|
||||
@ -421,3 +489,52 @@ copyBuiltInHaddocks docdir = do
|
||||
src <- canonicalizePath
|
||||
(parent (fpFromString ghc) </> "../share/doc/ghc/html/libraries")
|
||||
copyDir src docdir
|
||||
|
||||
------------- Previous results
|
||||
|
||||
-- | The previous actions that can be run
|
||||
data ResultType = Build | Haddock | Test
|
||||
deriving (Show, Enum, Eq, Ord, Bounded, Read)
|
||||
|
||||
-- | The result generated on a previous run
|
||||
data PrevResult = PRNoResult | PRSuccess | PRFailure
|
||||
deriving (Show, Enum, Eq, Ord, Bounded, Read)
|
||||
|
||||
-- | Check if we should rerun based on a PrevResult and the expected status
|
||||
checkPrevResult :: PrevResult -> TestState -> Bool
|
||||
checkPrevResult _ Don'tBuild = False
|
||||
checkPrevResult PRNoResult _ = True
|
||||
checkPrevResult PRSuccess _ = False
|
||||
checkPrevResult PRFailure ExpectSuccess = True
|
||||
checkPrevResult PRFailure _ = False
|
||||
|
||||
withPRPath :: PerformBuild -> ResultType -> PackageIdentifier -> (FilePath -> IO a) -> IO a
|
||||
withPRPath pb rt ident inner = do
|
||||
createTree $ parent fp
|
||||
inner fp
|
||||
where
|
||||
fp = pbPrevResDir pb </> fpFromString (show rt) </> fpFromText (display ident)
|
||||
|
||||
successBS, failureBS :: ByteString
|
||||
successBS = "success"
|
||||
failureBS = "failure"
|
||||
|
||||
getPreviousResult :: PerformBuild -> ResultType -> PackageIdentifier -> IO PrevResult
|
||||
getPreviousResult w x y = withPRPath w x y $ \fp -> do
|
||||
eres <- tryIO $ readFile fp
|
||||
return $ case eres of
|
||||
Right bs
|
||||
| bs == successBS -> PRSuccess
|
||||
| bs == failureBS -> PRFailure
|
||||
_ -> PRNoResult
|
||||
|
||||
savePreviousResult :: PerformBuild -> ResultType -> PackageIdentifier -> Bool -> IO ()
|
||||
savePreviousResult pb rt ident res =
|
||||
withPRPath pb rt ident $ \fp -> writeFile fp $
|
||||
if res then successBS else failureBS
|
||||
|
||||
deletePreviousResults :: PerformBuild -> PackageIdentifier -> IO ()
|
||||
deletePreviousResults pb name =
|
||||
forM_ [minBound..maxBound] $ \rt ->
|
||||
withPRPath pb rt name $ \fp ->
|
||||
void $ tryIO $ removeFile fp
|
||||
|
||||
@ -15,8 +15,9 @@ import Stackage.BuildConstraints
|
||||
import Stackage.BuildPlan
|
||||
import Stackage.Prelude
|
||||
|
||||
updateBuildPlan :: BuildPlan -> IO BuildPlan
|
||||
updateBuildPlan = newBuildPlan . updateBuildConstraints
|
||||
updateBuildPlan :: Map PackageName PackagePlan -> BuildPlan -> IO BuildPlan
|
||||
updateBuildPlan packagesOrig
|
||||
= newBuildPlan packagesOrig . updateBuildConstraints
|
||||
|
||||
updateBuildConstraints :: BuildPlan -> BuildConstraints
|
||||
updateBuildConstraints BuildPlan {..} =
|
||||
@ -33,6 +34,7 @@ updateBuildConstraints BuildPlan {..} =
|
||||
, pcHaddocks = maybe ExpectSuccess pcHaddocks moldPC
|
||||
, pcBuildBenchmarks = maybe True pcBuildBenchmarks moldPC
|
||||
, pcFlagOverrides = maybe mempty pcFlagOverrides moldPC
|
||||
, pcEnableLibProfile = maybe False pcEnableLibProfile moldPC
|
||||
}
|
||||
where
|
||||
moldBP = lookup name bpPackages
|
||||
|
||||
@ -11,6 +11,7 @@ module Stackage.Upload
|
||||
, UploadDocs (..)
|
||||
, uploadDocs
|
||||
, uploadHackageDistro
|
||||
, uploadHackageDistroNamed
|
||||
, UploadDocMap (..)
|
||||
, uploadDocMap
|
||||
, uploadBundleV2
|
||||
@ -145,8 +146,28 @@ uploadHackageDistro :: BuildPlan
|
||||
-> ByteString -- ^ Hackage password
|
||||
-> Manager
|
||||
-> IO (Response LByteString)
|
||||
uploadHackageDistro bp username password =
|
||||
httpLbs (applyBasicAuth username password req)
|
||||
uploadHackageDistro = uploadHackageDistroNamed "Stackage"
|
||||
|
||||
uploadHackageDistroNamed
|
||||
:: Text -- ^ distro name
|
||||
-> BuildPlan
|
||||
-> ByteString -- ^ Hackage username
|
||||
-> ByteString -- ^ Hackage password
|
||||
-> Manager
|
||||
-> IO (Response LByteString)
|
||||
uploadHackageDistroNamed name bp username password manager = do
|
||||
req1 <- parseUrl $ concat
|
||||
[ "http://hackage.haskell.org/distro/"
|
||||
, unpack name
|
||||
, "/packages.csv"
|
||||
]
|
||||
let req2 = req1
|
||||
{ requestHeaders = [("Content-Type", "text/csv")]
|
||||
, requestBody = RequestBodyLBS csv
|
||||
, checkStatus = \_ _ _ -> Nothing
|
||||
, method = "PUT"
|
||||
}
|
||||
httpLbs (applyBasicAuth username password req2) manager
|
||||
where
|
||||
csv = encodeUtf8
|
||||
$ builderToLazy
|
||||
@ -164,13 +185,6 @@ uploadHackageDistro bp username password =
|
||||
(toBuilder $ display name) ++
|
||||
"\""
|
||||
|
||||
req = "http://hackage.haskell.org/distro/Stackage/packages.csv"
|
||||
{ requestHeaders = [("Content-Type", "text/csv")]
|
||||
, requestBody = RequestBodyLBS csv
|
||||
, checkStatus = \_ _ _ -> Nothing
|
||||
, method = "PUT"
|
||||
}
|
||||
|
||||
data UploadDocMap = UploadDocMap
|
||||
{ udmServer :: StackageServer
|
||||
, udmAuthToken :: Text
|
||||
|
||||
171
app/stackage.hs
171
app/stackage.hs
@ -1,16 +1,163 @@
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
|
||||
module Main where
|
||||
|
||||
import Control.Monad
|
||||
import Data.Monoid
|
||||
import Data.String (fromString)
|
||||
import Data.Version
|
||||
import Options.Applicative
|
||||
import Filesystem.Path.CurrentOS (decodeString)
|
||||
import Paths_stackage (version)
|
||||
import Stackage.CompleteBuild
|
||||
import System.Environment (getArgs)
|
||||
import Stackage.InstallBuild
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
args <- getArgs
|
||||
case args of
|
||||
[x] | Just y <- lookup x m -> y
|
||||
_ -> error $ "Expected one argument, one of: " ++ unwords (map fst m)
|
||||
main =
|
||||
join $
|
||||
execParser $
|
||||
info
|
||||
(helpOption <*> versionOption <*> config)
|
||||
(header "Stackage" <>
|
||||
fullDesc)
|
||||
where
|
||||
m =
|
||||
[ ("nightly", completeBuild Nightly)
|
||||
, ("lts-major", completeBuild $ LTS Major)
|
||||
, ("lts-minor", completeBuild $ LTS Minor)
|
||||
, ("check", justCheck)
|
||||
]
|
||||
helpOption =
|
||||
abortOption ShowHelpText $
|
||||
long "help" <>
|
||||
help "Show this help text"
|
||||
versionOption =
|
||||
infoOption
|
||||
("stackage version " ++ showVersion version)
|
||||
(long "version" <>
|
||||
help "Show stackage version")
|
||||
config =
|
||||
subparser $
|
||||
mconcat
|
||||
[ cmnd
|
||||
(uncurry completeBuild)
|
||||
(fmap (Nightly, ) buildFlags)
|
||||
"nightly"
|
||||
"Build, test and upload the Nightly snapshot"
|
||||
, cmnd
|
||||
(uncurry completeBuild)
|
||||
(fmap (LTS Major, ) buildFlags)
|
||||
"lts-major"
|
||||
"Build, test and upload the LTS (major) snapshot"
|
||||
, cmnd
|
||||
(uncurry completeBuild)
|
||||
(fmap (LTS Minor, ) buildFlags)
|
||||
"lts-minor"
|
||||
"Build, test and upload the LTS (minor) snapshot"
|
||||
, cmnd
|
||||
justUploadNightly
|
||||
nightlyUploadFlags
|
||||
"upload-nightly"
|
||||
"Upload an already-built nightly snapshot"
|
||||
, cmnd
|
||||
(const justCheck)
|
||||
(pure ())
|
||||
"check"
|
||||
"Just check that the build plan is ok"
|
||||
, cmnd
|
||||
installBuild
|
||||
installFlags
|
||||
"install"
|
||||
"Install a snapshot from an existing build plan"]
|
||||
|
||||
cmnd exec parse name desc =
|
||||
command name $
|
||||
info
|
||||
(fmap exec (parse <**> helpOption))
|
||||
(progDesc desc)
|
||||
|
||||
buildFlags =
|
||||
BuildFlags <$>
|
||||
fmap
|
||||
not
|
||||
(switch
|
||||
(long "skip-tests" <>
|
||||
help "Skip build and running the test suites")) <*>
|
||||
fmap
|
||||
not
|
||||
(switch
|
||||
(long "skip-haddock" <>
|
||||
help "Skip generating haddock documentation")) <*>
|
||||
fmap
|
||||
not
|
||||
(switch
|
||||
(long "skip-upload" <>
|
||||
help "Skip uploading bundle, docs, etc.")) <*>
|
||||
switch
|
||||
(long "enable-library-profiling" <>
|
||||
help "Enable profiling when building") <*>
|
||||
switch
|
||||
(long "enable-executable-dynamic" <>
|
||||
help "Enable dynamic executables when building") <*>
|
||||
switch
|
||||
(long "verbose" <> short 'v' <>
|
||||
help "Output verbose detail about the build steps") <*>
|
||||
switch
|
||||
(long "skip-check" <>
|
||||
help "Skip the check phase, and pass --allow-newer to cabal configure")
|
||||
|
||||
nightlyUploadFlags = fromString <$> strArgument
|
||||
(metavar "DATE" <>
|
||||
help "Date, in YYYY-MM-DD format")
|
||||
|
||||
installFlags =
|
||||
InstallFlags <$>
|
||||
(fmap
|
||||
BPSBundleWeb
|
||||
(strOption
|
||||
(long "bundle" <>
|
||||
metavar "URL" <>
|
||||
help "Stackage bundle containing build plan")) <|>
|
||||
fmap
|
||||
(BPSFile . decodeString)
|
||||
(strOption
|
||||
(long "build-plan" <>
|
||||
metavar "PATH" <>
|
||||
help "Build-plan YAML file"))) <*>
|
||||
fmap
|
||||
decodeString
|
||||
(strArgument
|
||||
(metavar "DESTINATION-PATH" <>
|
||||
help "Destination directory path")) <*>
|
||||
(fmap
|
||||
(Just . decodeString)
|
||||
(strOption
|
||||
(long "log-dir" <>
|
||||
metavar "PATH" <>
|
||||
help "Location of log files (default DESTINATION-PATH/logs)")) <|>
|
||||
pure Nothing) <*>
|
||||
option
|
||||
auto
|
||||
(long "jobs" <>
|
||||
metavar "NUMBER" <>
|
||||
showDefault <> value 8 <>
|
||||
help "Number of threads") <*>
|
||||
switch
|
||||
(long "global" <>
|
||||
help "Install in global package database") <*>
|
||||
fmap
|
||||
not
|
||||
(switch
|
||||
(long "skip-tests" <>
|
||||
help "Skip build and running the test suites")) <*>
|
||||
fmap
|
||||
not
|
||||
(switch
|
||||
(long "skip-haddock" <>
|
||||
help "Skip generating haddock documentation")) <*>
|
||||
switch
|
||||
(long "enable-library-profiling" <>
|
||||
help "Enable profiling when building") <*>
|
||||
switch
|
||||
(long "enable-executable-dynamic" <>
|
||||
help "Enable dynamic executables when building") <*>
|
||||
switch
|
||||
(long "verbose" <> short 'v' <>
|
||||
help "Output verbose detail about the build steps") <*>
|
||||
switch
|
||||
(long "skip-check" <>
|
||||
help "Skip the check phase, and pass --allow-newer to cabal configure")
|
||||
|
||||
@ -2,7 +2,7 @@
|
||||
packages:
|
||||
"Michael Snoyman michael@snoyman.com @snoyberg":
|
||||
- bzlib-conduit
|
||||
- cabal-install < 1.19
|
||||
- cabal-install < 1.19 # GHC 7.10 bumpd to 1.22
|
||||
- cabal-src
|
||||
- case-insensitive
|
||||
- classy-prelude-yesod
|
||||
@ -27,7 +27,10 @@ packages:
|
||||
- warp-tls
|
||||
- yackage
|
||||
- yesod
|
||||
- yesod-auth
|
||||
- yesod-auth-oauth
|
||||
- yesod-auth-deskcom
|
||||
- authenticate-oauth
|
||||
- yesod-bin
|
||||
- yesod-eventsource
|
||||
- yesod-fay
|
||||
@ -42,6 +45,11 @@ packages:
|
||||
- repa-algorithms
|
||||
- repa-devil
|
||||
- JuicyPixels-repa
|
||||
- cereal-conduit
|
||||
- binary-conduit
|
||||
- lzma-conduit
|
||||
- mutable-containers
|
||||
- hpc-coveralls
|
||||
|
||||
"FP Complete michael@fpcomplete.com @snoyberg":
|
||||
- alex
|
||||
@ -64,7 +72,7 @@ packages:
|
||||
- fixed-list
|
||||
- foreign-store
|
||||
- formatting
|
||||
- fpco-api
|
||||
#- fpco-api
|
||||
- gtk2hs-buildtools
|
||||
- happy
|
||||
- histogram-fill
|
||||
@ -105,18 +113,18 @@ packages:
|
||||
- distributed-process-async
|
||||
- distributed-process-client-server
|
||||
- distributed-process-supervisor
|
||||
|
||||
# https://github.com/fpco/stackage/issues/381
|
||||
#- distributed-process-task
|
||||
#- distributed-process-execution
|
||||
- distributed-process-task
|
||||
- distributed-process-execution
|
||||
|
||||
- kure
|
||||
|
||||
"Omari Norman <omari@smileystation.com>":
|
||||
- barecheck
|
||||
- rainbow
|
||||
- rainbow-tests
|
||||
- quickpull
|
||||
- multiarg
|
||||
- prednote
|
||||
- cartel
|
||||
|
||||
"Neil Mitchell":
|
||||
- hlint
|
||||
@ -144,6 +152,7 @@ packages:
|
||||
"Jasper Van der Jeugt":
|
||||
- blaze-html
|
||||
- blaze-markup
|
||||
- hakyll
|
||||
- stylish-haskell
|
||||
|
||||
"Antoine Latter":
|
||||
@ -175,7 +184,6 @@ packages:
|
||||
- crypto-random-api
|
||||
- hit
|
||||
- language-java
|
||||
- language-java
|
||||
- libgit
|
||||
- pem
|
||||
- siphash
|
||||
@ -202,8 +210,11 @@ packages:
|
||||
- scrobble
|
||||
- shell-conduit
|
||||
- sourcemap
|
||||
- hindent
|
||||
- descriptive
|
||||
- wrap
|
||||
# requires old haddock currently - haskell-docs
|
||||
# TODO: Add hindent and structured-haskell-mode once they've been ported to HSE 1.16.
|
||||
# TODO: Add structured-haskell-mode once they've been ported to HSE 1.16.
|
||||
|
||||
# GHC 7.6
|
||||
# "Alberto G. Corona <agocorona@gmail.com>":
|
||||
@ -253,7 +264,7 @@ packages:
|
||||
- monad-products
|
||||
- monad-st
|
||||
- monad-st
|
||||
- mtl < 2.2
|
||||
- mtl < 2.2 # GHC 7.10 bump
|
||||
- nats
|
||||
- numeric-extras
|
||||
- parsers
|
||||
@ -304,8 +315,9 @@ packages:
|
||||
|
||||
"Brent Yorgey <byorgey@gmail.com>":
|
||||
- active
|
||||
- BlogLiterately
|
||||
- BlogLiterately-diagrams
|
||||
# Temporarily disabled due to restrictive lens upper bound
|
||||
#- BlogLiterately
|
||||
#- BlogLiterately-diagrams
|
||||
- diagrams
|
||||
- diagrams-builder
|
||||
- diagrams-contrib
|
||||
@ -325,6 +337,8 @@ packages:
|
||||
- JuicyPixels
|
||||
- FontyFruity
|
||||
- Rasterific
|
||||
- svg-tree
|
||||
- rasterific-svg
|
||||
|
||||
"Patrick Brisbin":
|
||||
- gravatar
|
||||
@ -365,6 +379,7 @@ packages:
|
||||
- pipes
|
||||
- pipes-parse
|
||||
- pipes-concurrency
|
||||
- pipes-safe
|
||||
|
||||
"Chris Allen <cma@bitemyapp.com>":
|
||||
- bloodhound
|
||||
@ -378,6 +393,10 @@ packages:
|
||||
- fay-uri
|
||||
- snaplet-fay
|
||||
|
||||
"Sebastiaan Visser <haskell@fvisser.nl>":
|
||||
- clay
|
||||
- fclabels
|
||||
|
||||
"Rodrigo Setti <rodrigosetti@gmail.com>":
|
||||
- messagepack
|
||||
- messagepack-rpc
|
||||
@ -399,9 +418,11 @@ packages:
|
||||
- hPDB
|
||||
- hPDB-examples
|
||||
|
||||
# https://github.com/fpco/stackage/pull/382#issuecomment-68182467
|
||||
# - wordpass
|
||||
# - json-autotype
|
||||
- wordpass
|
||||
- json-autotype
|
||||
|
||||
"Dominic Steinitz <dominic@steinitz.org>":
|
||||
- yarr
|
||||
|
||||
"Roman Cheplyaka <roma@ro-che.info>":
|
||||
- action-permutations
|
||||
@ -431,6 +452,7 @@ packages:
|
||||
"George Giorgidze <giorgidze@gmail.com>":
|
||||
- HCodecs
|
||||
- YampaSynth
|
||||
- set-monad
|
||||
|
||||
"Phil Hargett <phil@haphazardhouse.net>":
|
||||
- courier
|
||||
@ -444,6 +466,8 @@ packages:
|
||||
- circle-packing
|
||||
- arbtt
|
||||
- ghc-heap-view
|
||||
- tttool
|
||||
- gipeda
|
||||
|
||||
"Aditya Bhargava <adit@adit.io":
|
||||
- HandsomeSoup
|
||||
@ -453,7 +477,8 @@ packages:
|
||||
- openpgp-asciiarmor
|
||||
- MusicBrainz
|
||||
- DAV
|
||||
- hopenpgp-tools
|
||||
# https://github.com/fpco/stackage/issues/463
|
||||
#- hopenpgp-tools
|
||||
|
||||
# https://github.com/fpco/stackage/issues/160
|
||||
"Ketil Malde":
|
||||
@ -483,9 +508,9 @@ packages:
|
||||
- code-builder
|
||||
- fay-builder
|
||||
- generic-aeson
|
||||
- generic-xmlpickler
|
||||
- hxt-pickle-utils
|
||||
- imagesize-conduit
|
||||
- imagesize-conduit
|
||||
- json-schema
|
||||
- multipart
|
||||
- regular-xmlpickler
|
||||
@ -498,8 +523,6 @@ packages:
|
||||
- rest-types
|
||||
- rest-wai
|
||||
- tostring
|
||||
- tostring
|
||||
- uri-encode
|
||||
- uri-encode
|
||||
|
||||
"Simon Michael <simon@joyful.com>":
|
||||
@ -509,7 +532,10 @@ packages:
|
||||
- io-manager
|
||||
|
||||
"Dimitri Sabadie <dimitri.sabadie@gmail.com":
|
||||
# https://github.com/fpco/stackage/pull/461#issuecomment-76914158
|
||||
# - al
|
||||
- monad-journal
|
||||
- smoothie
|
||||
|
||||
"Thomas Schilling <nominolo@googlemail.com>":
|
||||
- ghc-syb-utils
|
||||
@ -543,6 +569,7 @@ packages:
|
||||
|
||||
"Emanuel Borsobom <manny@fpcomplete.com>":
|
||||
- BoundedChan
|
||||
- broadcast-chan
|
||||
- bytestring-lexing
|
||||
- bytestring-trie
|
||||
- data-accessor
|
||||
@ -553,6 +580,7 @@ packages:
|
||||
- haddock-api
|
||||
- here
|
||||
- hlibgit2
|
||||
- gitlib-libgit2
|
||||
- hostname-validate
|
||||
- interpolatedstring-perl6
|
||||
- iproute
|
||||
@ -561,6 +589,7 @@ packages:
|
||||
- multimap
|
||||
- parallel-io
|
||||
- text-binary
|
||||
- wl-pprint-text
|
||||
|
||||
"Michael Sloan <mgsloan@gmail.com":
|
||||
- th-orphans
|
||||
@ -574,7 +603,7 @@ packages:
|
||||
- hasql-backend
|
||||
- hasql-postgres
|
||||
- list-t
|
||||
- mtl-prelude < 2
|
||||
- mtl-prelude < 2 # GHC 7.10 bump
|
||||
- neat-interpolation
|
||||
- partial-handler
|
||||
- postgresql-binary
|
||||
@ -588,6 +617,11 @@ packages:
|
||||
- graph-core
|
||||
- reroute
|
||||
- Spock
|
||||
- Spock-digestive
|
||||
- Spock-worker
|
||||
- users
|
||||
- users-test
|
||||
- users-postgresql-simple
|
||||
|
||||
"Joey Eremondi <joey@eremondi.com>":
|
||||
- aeson-pretty
|
||||
@ -618,42 +652,137 @@ packages:
|
||||
- shake-language-c
|
||||
|
||||
"Marcin Mrotek <marcin.jan.mrotek@gmail.com>":
|
||||
- diagrams-hsqml
|
||||
- type-list
|
||||
|
||||
- vinyl-utils
|
||||
|
||||
"Marcin Mrotek <marcin.jan.mrotek@gmail.com>":
|
||||
- type-list
|
||||
|
||||
"David Turner <dave.c.turner@gmail.com>":
|
||||
- alarmclock
|
||||
- bank-holidays-england
|
||||
|
||||
"Haskell Servant jkarni@gmail.com @jkarni":
|
||||
- servant
|
||||
- servant-client
|
||||
- servant-docs
|
||||
- servant-jquery
|
||||
- servant-server
|
||||
|
||||
"Alexandr Ruchkin voidex@live.com @mvoidex":
|
||||
- hdocs
|
||||
- hsdev
|
||||
|
||||
"Aleksey Kliger aleksey@lambdageek.org @lambdageek":
|
||||
- unbound-generics
|
||||
|
||||
"Alois Cochard alois.cochard@gmail.com @aloiscochard":
|
||||
- codex
|
||||
- machines-directory
|
||||
- machines-io
|
||||
- machines-process
|
||||
# on behalf of Bryan O'Sullivan @bos
|
||||
- wreq
|
||||
|
||||
"Andraz Bajt andraz@bajt.me @edofic":
|
||||
- effect-handlers
|
||||
- koofr-client
|
||||
- snowflake
|
||||
|
||||
"Leza M. Lutonda lemol-c@hotmail.com @lemol":
|
||||
- HaskellNet
|
||||
|
||||
"Jens Petersen juhpetersen@gmail.com @juhp":
|
||||
- cabal-rpm
|
||||
|
||||
"Renzo Carbonara renzocarbonara@gmail.com @k0001":
|
||||
- network-simple
|
||||
- pipes-aeson
|
||||
- pipes-attoparsec
|
||||
- pipes-binary
|
||||
- pipes-network
|
||||
|
||||
"Tomas Carnecky":
|
||||
- rethinkdb-client-driver
|
||||
|
||||
"Alexandr Kurilin alex@kurilin.net @alex_kurilin":
|
||||
- bcrypt
|
||||
|
||||
"Jeffrey Rosenbluth jeffrey.rosenbluth@gmail.com":
|
||||
- palette
|
||||
- diagrams-canvas
|
||||
- diagrams-rasterific
|
||||
- lucid-svg
|
||||
|
||||
"Gabríel Arthúr Pétursson gabriel@system.is":
|
||||
- sdl2
|
||||
|
||||
"Leon Mergen leon@solatis.com @solatis":
|
||||
- network-attoparsec
|
||||
- network-anonymous-i2p
|
||||
|
||||
"Timothy Jones git@zmthy.io @zmthy":
|
||||
- cabal-test-quickcheck
|
||||
- http-media
|
||||
|
||||
"Greg V greg@unrelenting.technology @myfreeweb":
|
||||
- gitson
|
||||
- pcre-heavy
|
||||
|
||||
"Francesco Mazzoli f@mazzo.li @bitonic":
|
||||
- language-c-quote
|
||||
|
||||
"Sönke Hahn soenkehahn@gmail.com @soenkehahn":
|
||||
- string-conversions
|
||||
|
||||
"Oleg Grenrus oleg.grenrus@iki.fi @phadej":
|
||||
- waitra
|
||||
|
||||
"Stackage upper bounds":
|
||||
|
||||
# Force a specific version that's compatible with transformers 0.3
|
||||
- transformers-compat == 0.3.3.3
|
||||
- transformers-compat == 0.4.0.3
|
||||
|
||||
# https://github.com/fpco/stackage/issues/291
|
||||
- random < 1.0.1.3
|
||||
# https://github.com/fpco/stackage/issues/390
|
||||
# NOTE: When this issue is resolved, remove the expected test failure
|
||||
# for language-ecmascript as well.
|
||||
- language-ecmascript < 0.17
|
||||
|
||||
# https://github.com/fpco/stackage/issues/318
|
||||
- HaXml < 1.25
|
||||
# https://github.com/fpco/stackage/issues/407
|
||||
- HStringTemplate < 0.8
|
||||
|
||||
# https://github.com/fpco/stackage/issues/319
|
||||
- polyparse < 1.10
|
||||
# https://github.com/fpco/stackage/issues/410
|
||||
- elm-package < 0.4
|
||||
|
||||
# https://github.com/fpco/stackage/issues/370
|
||||
- monad-control < 1
|
||||
- hasql < 0.5
|
||||
- list-t < 0.4
|
||||
# https://github.com/fpco/stackage/issues/415
|
||||
- hackage-db < 1.12
|
||||
|
||||
# Global flags are applied to all packages
|
||||
global-flags:
|
||||
blaze_html_0_5: true
|
||||
small_base: true
|
||||
https: true
|
||||
splitbase: true
|
||||
old-locale: true
|
||||
new-base: true
|
||||
bytestring-in-base: false
|
||||
test-hlint: false
|
||||
network-uri: true
|
||||
# https://github.com/fpco/stackage/issues/424
|
||||
- control-monad-free < 0.6
|
||||
|
||||
# https://github.com/fpco/stackage/issues/426
|
||||
- utf8-string < 1
|
||||
|
||||
# https://github.com/fpco/stackage/issues/440
|
||||
- th-orphans < 0.9
|
||||
- file-location < 0.4.7
|
||||
|
||||
# https://github.com/fpco/stackage/issues/442
|
||||
- blaze-builder < 0.4
|
||||
- blaze-markup < 0.7
|
||||
- blaze-html < 0.8
|
||||
|
||||
# https://github.com/fpco/stackage/issues/443
|
||||
- exceptions < 0.7
|
||||
- rest-client < 0.5
|
||||
- rest-types < 1.13
|
||||
- rest-core < 0.35
|
||||
- rest-gen < 0.17
|
||||
- rest-wai < 0.1.0.7
|
||||
|
||||
# https://github.com/fpco/stackage/issues/467
|
||||
- lens < 4.8
|
||||
|
||||
# Package flags are applied to individual packages, and override the values of
|
||||
# global-flags
|
||||
@ -672,6 +801,44 @@ package-flags:
|
||||
simplelocalnet: true
|
||||
p2p: true
|
||||
|
||||
# GHC 7.10: Remove this
|
||||
# Note that the flag is lower-cased, because that's what Cabal does
|
||||
# Perhaps the codebase should automatically lower case flag names?
|
||||
storable-complex:
|
||||
instanceinbase: false
|
||||
|
||||
logfloat:
|
||||
splitbase: true
|
||||
|
||||
curl:
|
||||
new-base: true
|
||||
|
||||
# GHC 7.10 remove
|
||||
aeson:
|
||||
old-locale: true
|
||||
tttool:
|
||||
old-locale: true
|
||||
|
||||
hxt:
|
||||
network-uri: true
|
||||
hxt-http:
|
||||
network-uri: true
|
||||
hxt-relaxng:
|
||||
network-uri: true
|
||||
|
||||
pandoc:
|
||||
https: true
|
||||
|
||||
text:
|
||||
integer-simple: false
|
||||
|
||||
tar:
|
||||
old-time: false
|
||||
|
||||
mtl-compat:
|
||||
two-point-one: true
|
||||
two-point-two: false
|
||||
|
||||
# By skipping a test suite, we do not pull in the build dependencies
|
||||
skipped-tests:
|
||||
- ReadArgs # old version of hspec
|
||||
@ -718,17 +885,15 @@ skipped-tests:
|
||||
# https://github.com/fpco/stackage/pull/380#issuecomment-68060871
|
||||
- Rasterific
|
||||
|
||||
# https://github.com/Soostone/retry/issues/18
|
||||
- retry
|
||||
|
||||
# Tests which we should build and run, but which are expected to fail. We
|
||||
# should not fail a build based on a test failure for one of these packages.
|
||||
expected-test-failures:
|
||||
# Requires an old version of WAI and Warp for tests
|
||||
- HTTP
|
||||
|
||||
# text and setenv have recursive dependencies in their tests, which
|
||||
# cabal can't (yet) handle
|
||||
- text
|
||||
- setenv
|
||||
|
||||
# https://github.com/bos/statistics/issues/42
|
||||
- statistics
|
||||
|
||||
@ -852,6 +1017,61 @@ expected-test-failures:
|
||||
- crypto-numbers
|
||||
- distributed-process-task
|
||||
|
||||
# https://github.com/vincenthz/hs-crypto-pubkey/issues/17
|
||||
- crypto-pubkey
|
||||
|
||||
# https://github.com/jswebtools/language-ecmascript/issues/60
|
||||
- language-ecmascript
|
||||
|
||||
# https://github.com/kazu-yamamoto/unix-time/issues/29
|
||||
- unix-time
|
||||
|
||||
# Tests can fail when the build plan fails, which happens arbitrarily.
|
||||
- stackage
|
||||
|
||||
# https://github.com/TomMD/DRBG/issues/7
|
||||
- DRBG
|
||||
|
||||
# https://github.com/bos/wreq/issues/53
|
||||
- wreq
|
||||
|
||||
# Requires local database running
|
||||
- rethinkdb-client-driver
|
||||
|
||||
# https://github.com/haskell-distributed/distributed-process-execution/issues/2
|
||||
- distributed-process-execution
|
||||
|
||||
# Seems to depend on mtl being installed in user package database, which
|
||||
# isn't always the case (e.g., build server)
|
||||
- happy
|
||||
|
||||
# https://github.com/jberryman/directory-tree/issues/4
|
||||
- directory-tree
|
||||
|
||||
# https://github.com/zmthy/http-media/issues/11
|
||||
- http-media
|
||||
|
||||
# https://github.com/ekmett/semigroupoids/issues/18
|
||||
- semigroupoids
|
||||
|
||||
# https://github.com/ndmitchell/hoogle/issues/101
|
||||
- hoogle
|
||||
|
||||
# https://github.com/myfreeweb/gitson/issues/1
|
||||
- gitson
|
||||
|
||||
# https://github.com/jcristovao/enclosed-exceptions/issues/6
|
||||
- enclosed-exceptions
|
||||
|
||||
# Expects a running PostgreSQL server
|
||||
- users-postgresql-simple
|
||||
|
||||
# Problems with linking with system libraries on Ubuntu 12.04
|
||||
- nettle
|
||||
|
||||
# Requires locally running services
|
||||
- network-anonymous-i2p
|
||||
|
||||
# Haddocks which are expected to fail. Same concept as expected test failures.
|
||||
expected-haddock-failures:
|
||||
# https://github.com/acw/bytestring-progress/issues/4
|
||||
@ -860,6 +1080,12 @@ expected-haddock-failures:
|
||||
# https://github.com/ekmett/gl/issues/4
|
||||
- gl
|
||||
|
||||
# https://github.com/leventov/yarr/issues/5
|
||||
- yarr
|
||||
|
||||
# https://github.com/wereHamster/rethinkdb-client-driver/issues/1
|
||||
- rethinkdb-client-driver
|
||||
|
||||
# Benchmarks which should not be built. Note that Stackage does *not* generally
|
||||
# build benchmarks. The difference here will be whether dependencies for these
|
||||
# benchmarks are included or not.
|
||||
@ -886,6 +1112,10 @@ skipped-benchmarks:
|
||||
# sometimes falls out-of-sync on hasql-postgres
|
||||
- hasql
|
||||
|
||||
skipped-profiling:
|
||||
# https://github.com/nomeata/ghc-heap-view/commit/8d198eb8fbbad2ce0c4527c781659f35b8909c04#diff-8288955e209cfbead5b318a8598be9c0R10
|
||||
- ghc-heap-view
|
||||
|
||||
# Mapping from Github account holding a package to the Github users who should
|
||||
# be pinged on failure. If no value is specified here, then the owning account
|
||||
# will be pinged.
|
||||
@ -908,3 +1138,5 @@ github-users:
|
||||
- mightybyte
|
||||
haskell-ro:
|
||||
- mihaimaruseac
|
||||
elm-lang:
|
||||
- JoeyEremondi
|
||||
|
||||
@ -647,7 +647,7 @@ constraints: abstract-deque ==0.3,
|
||||
semigroups ==0.16.0.1,
|
||||
sendfile ==0.7.9,
|
||||
seqloc ==0.6,
|
||||
setenv ==0.1.1.1,
|
||||
setenv ==0.1.1.2,
|
||||
SHA ==1.6.4.1,
|
||||
shake ==0.14.2,
|
||||
shake-language-c ==0.6.3,
|
||||
|
||||
@ -10,13 +10,17 @@
|
||||
# instructions, see:
|
||||
# http://www.stackage.org/install
|
||||
|
||||
sudo add-apt-repository -y ppa:chris-lea/zeromq
|
||||
sudo add-apt-repository -y ppa:floe/libtisch
|
||||
sudo apt-get update
|
||||
sudo apt-get install -y \
|
||||
add-apt-repository -y ppa:chris-lea/zeromq
|
||||
add-apt-repository -y ppa:floe/libtisch
|
||||
add-apt-repository -y ppa:zoogie/sdl2-snapshots
|
||||
apt-get update
|
||||
apt-get install -y \
|
||||
build-essential \
|
||||
libncurses-dev \
|
||||
git \
|
||||
wget \
|
||||
m4 \
|
||||
texlive-full \
|
||||
libgmp3c2 \
|
||||
libgmp3-dev \
|
||||
zlib1g-dev \
|
||||
@ -33,11 +37,11 @@ sudo apt-get install -y \
|
||||
llvm \
|
||||
libbz2-dev \
|
||||
libjudy-dev \
|
||||
libsqlite3-dev \
|
||||
libmysqlclient-dev \
|
||||
libpq-dev \
|
||||
libicu-dev \
|
||||
libssl-dev \
|
||||
nettle-dev \
|
||||
libgsl0-dev \
|
||||
libblas-dev \
|
||||
liblapack-dev \
|
||||
@ -46,4 +50,22 @@ sudo apt-get install -y \
|
||||
libnotify-dev \
|
||||
libgd2-xpm-dev \
|
||||
libyaml-dev \
|
||||
liblzma-dev \
|
||||
libsdl2-dev \
|
||||
libxss-dev \
|
||||
libzmq3-dev
|
||||
|
||||
mkdir /tmp/nettle-build
|
||||
(
|
||||
cd /tmp/nettle-build
|
||||
wget https://ftp.gnu.org/gnu/nettle/nettle-2.7.1.tar.gz
|
||||
tar zxf nettle-2.7.1.tar.gz
|
||||
cd nettle-2.7.1
|
||||
./configure --prefix=/usr
|
||||
make
|
||||
make install
|
||||
|
||||
mkdir -p /usr/lib/x86_64-linux-gnu/
|
||||
ln -sfv /usr/lib/libnettle.so.4.7 /usr/lib/x86_64-linux-gnu/libnettle.so.4
|
||||
)
|
||||
rm -rf /tmp/nettle-build
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
name: stackage
|
||||
version: 0.4.0
|
||||
version: 0.5.2
|
||||
synopsis: "Stable Hackage," tools for creating a vetted set of packages from Hackage.
|
||||
description: Please see <http://www.stackage.org/package/stackage> for a description and documentation.
|
||||
homepage: https://github.com/fpco/stackage
|
||||
@ -12,6 +12,7 @@ build-type: Simple
|
||||
cabal-version: >=1.10
|
||||
extra-source-files: README.md
|
||||
ChangeLog.md
|
||||
test/test-build-constraints.yaml
|
||||
|
||||
library
|
||||
default-language: Haskell2010
|
||||
@ -22,7 +23,9 @@ library
|
||||
Stackage.BuildPlan
|
||||
Stackage.CheckBuildPlan
|
||||
Stackage.UpdateBuildPlan
|
||||
Stackage.GhcPkg
|
||||
Stackage.GithubPings
|
||||
Stackage.InstallBuild
|
||||
Stackage.PackageDescription
|
||||
Stackage.ServerBundle
|
||||
Stackage.Upload
|
||||
@ -62,6 +65,7 @@ library
|
||||
, streaming-commons >= 0.1.7.1
|
||||
, semigroups
|
||||
, xml-conduit
|
||||
, conduit
|
||||
|
||||
executable stackage
|
||||
default-language: Haskell2010
|
||||
@ -69,6 +73,8 @@ executable stackage
|
||||
main-is: stackage.hs
|
||||
build-depends: base
|
||||
, stackage
|
||||
, optparse-applicative >= 0.11
|
||||
, system-filepath
|
||||
ghc-options: -rtsopts -threaded -with-rtsopts=-N
|
||||
|
||||
test-suite spec
|
||||
|
||||
@ -1,21 +1,66 @@
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE OverloadedStrings, NoImplicitPrelude #-}
|
||||
module Stackage.BuildPlanSpec (spec) where
|
||||
|
||||
import Stackage.BuildPlan
|
||||
import Stackage.Prelude
|
||||
import Stackage.BuildConstraints
|
||||
import Stackage.UpdateBuildPlan
|
||||
import Test.Hspec
|
||||
import qualified Data.Yaml as Y
|
||||
import Distribution.Version (anyVersion)
|
||||
import qualified Data.Map as Map
|
||||
import Network.HTTP.Client (withManager)
|
||||
import Network.HTTP.Client.TLS (tlsManagerSettings)
|
||||
import qualified Data.Map.Strict as M
|
||||
import qualified Data.Set as S
|
||||
import Data.Yaml
|
||||
import qualified Data.Yaml as Y
|
||||
import Distribution.Version
|
||||
import Network.HTTP.Client
|
||||
import Network.HTTP.Client.TLS (tlsManagerSettings)
|
||||
import Stackage.BuildConstraints
|
||||
import Stackage.BuildPlan
|
||||
import Stackage.CheckBuildPlan
|
||||
import Stackage.PackageDescription
|
||||
import Stackage.Prelude
|
||||
import Stackage.UpdateBuildPlan
|
||||
import Test.Hspec
|
||||
|
||||
spec :: Spec
|
||||
spec = it "works" $ withManager tlsManagerSettings $ \man -> do
|
||||
bc <- defaultBuildConstraints man
|
||||
bp <- newBuildPlan bc
|
||||
spec = do
|
||||
it "simple package set" $ check testBuildConstraints $ makePackageSet
|
||||
[("foo", [0, 0, 0], [("bar", thisV [0, 0, 0])])
|
||||
,("bar", [0, 0, 0], [])]
|
||||
it "bad version range on depdendency fails" $ badBuildPlan $ makePackageSet
|
||||
[("foo", [0, 0, 0], [("bar", thisV [1, 1, 0])])
|
||||
,("bar", [0, 0, 0], [])]
|
||||
it "nonexistent package fails to check" $ badBuildPlan $ makePackageSet
|
||||
[("foo", [0, 0, 0], [("nonexistent", thisV [0, 0, 0])])
|
||||
,("bar", [0, 0, 0], [])]
|
||||
it "mutual cycles fail to check" $ badBuildPlan $ makePackageSet
|
||||
[("foo", [0, 0, 0], [("bar", thisV [0, 0, 0])])
|
||||
,("bar", [0, 0, 0], [("foo", thisV [0, 0, 0])])]
|
||||
it "nested cycles fail to check" $ badBuildPlan $ makePackageSet
|
||||
[("foo", [0, 0, 0], [("bar", thisV [0, 0, 0])])
|
||||
,("bar", [0, 0, 0], [("mu", thisV [0, 0, 0])])
|
||||
,("mu", [0, 0, 0], [("foo", thisV [0, 0, 0])])]
|
||||
{- Shouldn't be testing this actually
|
||||
it "default package set checks ok" $
|
||||
check defaultBuildConstraints getLatestAllowedPlans
|
||||
-}
|
||||
|
||||
-- | Checking should be considered a bad build plan.
|
||||
badBuildPlan :: (BuildConstraints -> IO (Map PackageName PackagePlan))
|
||||
-> void
|
||||
-> IO ()
|
||||
badBuildPlan m _ = do
|
||||
mu <- try (check testBuildConstraints m)
|
||||
case mu of
|
||||
Left (_ :: BadBuildPlan) ->
|
||||
return ()
|
||||
Right () ->
|
||||
error "Expected bad build plan."
|
||||
|
||||
-- | Check build plan with the given package set getter.
|
||||
check :: (Manager -> IO BuildConstraints)
|
||||
-> (BuildConstraints -> IO (Map PackageName PackagePlan))
|
||||
-> IO ()
|
||||
check readPlanFile getPlans = withManager tlsManagerSettings $ \man -> do
|
||||
bc <- readPlanFile man
|
||||
plans <- getPlans bc
|
||||
bp <- newBuildPlan plans bc
|
||||
let bs = Y.encode bp
|
||||
ebp' = Y.decodeEither bs
|
||||
|
||||
@ -25,14 +70,74 @@ spec = it "works" $ withManager tlsManagerSettings $ \man -> do
|
||||
forM_ allPackages $ \name ->
|
||||
(name, lookup name (bpPackages bp')) `shouldBe`
|
||||
(name, lookup name (bpPackages bp))
|
||||
|
||||
bpGithubUsers bp' `shouldBe` bpGithubUsers bp
|
||||
|
||||
when (bp' /= bp) $ error "bp' /= bp"
|
||||
bp2 <- updateBuildPlan bp
|
||||
bp2 <- updateBuildPlan plans bp
|
||||
when (dropVersionRanges bp2 /= dropVersionRanges bp) $ error "bp2 /= bp"
|
||||
checkBuildPlan bp
|
||||
where
|
||||
dropVersionRanges bp =
|
||||
bp { bpPackages = map go $ bpPackages bp }
|
||||
where
|
||||
go pb = pb { ppConstraints = go' $ ppConstraints pb }
|
||||
go' pc = pc { pcVersionRange = anyVersion }
|
||||
|
||||
-- | Make a package set from a convenient data structure.
|
||||
makePackageSet
|
||||
:: [(String,[Int],[(String,VersionRange)])]
|
||||
-> BuildConstraints
|
||||
-> IO (Map PackageName PackagePlan)
|
||||
makePackageSet ps _ =
|
||||
return $
|
||||
M.fromList $
|
||||
map
|
||||
(\(name,ver,deps) ->
|
||||
( PackageName name
|
||||
, dummyPackage ver $
|
||||
M.fromList $
|
||||
map
|
||||
(\(dname,dver) ->
|
||||
( PackageName dname
|
||||
, DepInfo {diComponents = S.fromList
|
||||
[CompLibrary]
|
||||
,diRange = dver}))
|
||||
deps))
|
||||
ps
|
||||
where
|
||||
dummyPackage v deps =
|
||||
PackagePlan
|
||||
{ppVersion = Version v []
|
||||
,ppGithubPings = mempty
|
||||
,ppUsers = mempty
|
||||
,ppConstraints =
|
||||
PackageConstraints
|
||||
{pcVersionRange = anyV
|
||||
,pcMaintainer = Nothing
|
||||
,pcTests = Don'tBuild
|
||||
,pcHaddocks = Don'tBuild
|
||||
,pcBuildBenchmarks = False
|
||||
,pcFlagOverrides = mempty
|
||||
,pcEnableLibProfile = False}
|
||||
,ppDesc =
|
||||
SimpleDesc
|
||||
{sdPackages = deps
|
||||
,sdTools = mempty
|
||||
,sdProvidedExes = mempty
|
||||
,sdModules = mempty}}
|
||||
|
||||
-- | This exact version is required.
|
||||
thisV :: [Int] -> VersionRange
|
||||
thisV ver = thisVersion (Version ver [])
|
||||
|
||||
-- | Accept any version.
|
||||
anyV :: VersionRange
|
||||
anyV = anyVersion
|
||||
|
||||
-- | Test plan.
|
||||
testBuildConstraints :: void -> IO BuildConstraints
|
||||
testBuildConstraints _ =
|
||||
decodeFileEither
|
||||
(fpToString fp) >>=
|
||||
either throwIO toBC
|
||||
where fp = "test/test-build-constraints.yaml"
|
||||
|
||||
20
test/test-build-constraints.yaml
Normal file
20
test/test-build-constraints.yaml
Normal file
@ -0,0 +1,20 @@
|
||||
packages:
|
||||
"Test":
|
||||
- foo
|
||||
- bar
|
||||
|
||||
global-flags: []
|
||||
|
||||
skipped-tests: []
|
||||
expected-test-failures: []
|
||||
expected-haddock-failures: []
|
||||
skipped-benchmarks: []
|
||||
skipped-profiling: []
|
||||
|
||||
github-users:
|
||||
bar:
|
||||
- demo
|
||||
|
||||
package-flags:
|
||||
foo:
|
||||
demo: true
|
||||
Loading…
Reference in New Issue
Block a user