mirror of
https://github.com/commercialhaskell/stackage.git
synced 2026-01-11 23:08:30 +01:00
Separate out stackage-curator
This commit is contained in:
Michael Snoyman
parent
8f95d1879c
commit
1891c1bfa7
9
.gitignore
vendored
9
.gitignore
vendored
@ -1,13 +1,4 @@
|
||||
dist
|
||||
*.o
|
||||
*.hi
|
||||
*.chi
|
||||
*.chs.h
|
||||
*.swp
|
||||
/builds/
|
||||
/logs/
|
||||
/.cabal-sandbox/
|
||||
cabal.sandbox.config
|
||||
nightly-*.yaml
|
||||
lts-*.yaml
|
||||
/tarballs/
|
||||
|
||||
64
ChangeLog.md
64
ChangeLog.md
@ -1,64 +0,0 @@
|
||||
## 0.6.1
|
||||
|
||||
* Switch to V2 upload by default
|
||||
* --skip-hoogle option
|
||||
|
||||
## 0.6.0
|
||||
|
||||
* 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.
|
||||
|
||||
## 0.3.0.1
|
||||
|
||||
Pre-fetch all packages from Hackage to catch Hackage downtime early.
|
||||
|
||||
## 0.3.0.0
|
||||
|
||||
* Return progress URL from uploadBundle
|
||||
|
||||
## 0.2.1.4
|
||||
|
||||
Generate a `core` file in bundles.
|
||||
|
||||
## 0.2.1.1
|
||||
|
||||
Run postBuild earlier to avoid problems from broken doc uploads.
|
||||
|
||||
## 0.2.1.0
|
||||
|
||||
* Use TLS manager (to download from Github)
|
||||
|
||||
## 0.2.0.0
|
||||
|
||||
* Minor fixes
|
||||
* `pbGlobalInstall`
|
||||
|
||||
## 0.1.0.0
|
||||
|
||||
First version of Stackage which is made available as its own package. The
|
||||
codebase has been completely rewritten at this point, to be ready for generated
|
||||
both Stackage Nightly and LTS Haskell distributions.
|
||||
25
Dockerfile
25
Dockerfile
@ -1,25 +0,0 @@
|
||||
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
|
||||
12
README.md
12
README.md
@ -7,10 +7,14 @@ __NOTE__ This repository is for package authors to get their code into
|
||||
Stackage. If you simply want to use Stackage as an end user, please follow the
|
||||
instructions on [http://www.stackage.org/](http://www.stackage.org).
|
||||
|
||||
A note about the codebase: the goal is to minimize dependencies and have
|
||||
the maximum range of supported compiler versions. Therefore, we avoid
|
||||
anything "complicated." For example, instead of using the text package,
|
||||
we use Strings everywhere.
|
||||
The Stackage project consists of multiple repositories. This repository
|
||||
contains the metadata on packages to be included in future builds and some
|
||||
project information. In addition, we have the following repositories:
|
||||
|
||||
* [stackage-server](https://github.com/fpco/stackage-server)
|
||||
* [stackage-curator](https://github.com/fpco/stackage-curator)
|
||||
* [stackage-types](https://github.com/fpco/stackage-types)
|
||||
* [lts-haskell](https://github.com/fpco/lts-haskell)
|
||||
|
||||
Get your package included
|
||||
-------------------------
|
||||
|
||||
@ -1,234 +0,0 @@
|
||||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
-- | The constraints on package selection for a new build plan.
|
||||
module Stackage.BuildConstraints
|
||||
( BuildConstraints (..)
|
||||
, PackageConstraints (..)
|
||||
, TestState (..)
|
||||
, SystemInfo (..)
|
||||
, getSystemInfo
|
||||
, defaultBuildConstraints
|
||||
, toBC
|
||||
, BuildConstraintsSource (..)
|
||||
, loadBuildConstraints
|
||||
) where
|
||||
|
||||
import Control.Monad.Writer.Strict (execWriter, tell)
|
||||
import Data.Aeson
|
||||
import qualified Data.Map as Map
|
||||
import Data.Yaml (decodeEither', decodeFileEither)
|
||||
import Distribution.Package (Dependency (..))
|
||||
import Distribution.System (Arch, OS)
|
||||
import qualified Distribution.System
|
||||
import Distribution.Version (anyVersion)
|
||||
import Filesystem (isFile)
|
||||
import Network.HTTP.Client (Manager, httpLbs, responseBody, Request)
|
||||
import Stackage.CorePackages
|
||||
import Stackage.Prelude
|
||||
|
||||
data TestState = ExpectSuccess
|
||||
| ExpectFailure
|
||||
| Don'tBuild -- ^ when the test suite will pull in things we don't want
|
||||
deriving (Show, Eq, Ord, Bounded, Enum)
|
||||
|
||||
testStateToText :: TestState -> Text
|
||||
testStateToText ExpectSuccess = "expect-success"
|
||||
testStateToText ExpectFailure = "expect-failure"
|
||||
testStateToText Don'tBuild = "do-not-build"
|
||||
|
||||
instance ToJSON TestState where
|
||||
toJSON = toJSON . testStateToText
|
||||
instance FromJSON TestState where
|
||||
parseJSON = withText "TestState" $ \t ->
|
||||
case lookup t states of
|
||||
Nothing -> fail $ "Invalid state: " ++ unpack t
|
||||
Just v -> return v
|
||||
where
|
||||
states = asHashMap $ mapFromList
|
||||
$ map (\x -> (testStateToText x, x)) [minBound..maxBound]
|
||||
|
||||
data SystemInfo = SystemInfo
|
||||
{ siGhcVersion :: Version
|
||||
, siOS :: OS
|
||||
, siArch :: Arch
|
||||
, siCorePackages :: Map PackageName Version
|
||||
, siCoreExecutables :: Set ExeName
|
||||
}
|
||||
deriving (Show, Eq, Ord)
|
||||
instance ToJSON SystemInfo where
|
||||
toJSON SystemInfo {..} = object
|
||||
[ "ghc-version" .= display siGhcVersion
|
||||
, "os" .= display siOS
|
||||
, "arch" .= display siArch
|
||||
, "core-packages" .= Map.mapKeysWith const unPackageName (map display siCorePackages)
|
||||
, "core-executables" .= siCoreExecutables
|
||||
]
|
||||
instance FromJSON SystemInfo where
|
||||
parseJSON = withObject "SystemInfo" $ \o -> do
|
||||
let helper name = (o .: name) >>= either (fail . show) return . simpleParse
|
||||
siGhcVersion <- helper "ghc-version"
|
||||
siOS <- helper "os"
|
||||
siArch <- helper "arch"
|
||||
siCorePackages <- (o .: "core-packages") >>= goPackages
|
||||
siCoreExecutables <- o .: "core-executables"
|
||||
return SystemInfo {..}
|
||||
where
|
||||
goPackages = either (fail . show) return
|
||||
. mapM simpleParse
|
||||
. Map.mapKeysWith const mkPackageName
|
||||
|
||||
data BuildConstraints = BuildConstraints
|
||||
{ bcPackages :: Set PackageName
|
||||
-- ^ This does not include core packages.
|
||||
, bcPackageConstraints :: PackageName -> PackageConstraints
|
||||
|
||||
, bcSystemInfo :: SystemInfo
|
||||
|
||||
, bcGithubUsers :: Map Text (Set Text)
|
||||
-- ^ map an account to set of pingees
|
||||
}
|
||||
|
||||
data PackageConstraints = PackageConstraints
|
||||
{ pcVersionRange :: VersionRange
|
||||
, pcMaintainer :: Maybe Maintainer
|
||||
, pcTests :: TestState
|
||||
, pcHaddocks :: TestState
|
||||
, pcBuildBenchmarks :: Bool
|
||||
, pcFlagOverrides :: Map FlagName Bool
|
||||
, pcEnableLibProfile :: Bool
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
instance ToJSON PackageConstraints where
|
||||
toJSON PackageConstraints {..} = object $ addMaintainer
|
||||
[ "version-range" .= display pcVersionRange
|
||||
, "tests" .= pcTests
|
||||
, "haddocks" .= pcHaddocks
|
||||
, "build-benchmarks" .= pcBuildBenchmarks
|
||||
, "flags" .= Map.mapKeysWith const unFlagName pcFlagOverrides
|
||||
, "library-profiling" .= pcEnableLibProfile
|
||||
]
|
||||
where
|
||||
addMaintainer = maybe id (\m -> (("maintainer" .= m):)) pcMaintainer
|
||||
instance FromJSON PackageConstraints where
|
||||
parseJSON = withObject "PackageConstraints" $ \o -> do
|
||||
pcVersionRange <- (o .: "version-range")
|
||||
>>= either (fail . show) return . simpleParse
|
||||
pcTests <- o .: "tests"
|
||||
pcHaddocks <- o .: "haddocks"
|
||||
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.
|
||||
--
|
||||
-- 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 = 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
|
||||
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
|
||||
siCorePackages <- getCorePackages
|
||||
siCoreExecutables <- getCoreExecutables
|
||||
siGhcVersion <- getGhcVersion
|
||||
return SystemInfo {..}
|
||||
where
|
||||
-- FIXME consider not hard-coding the next two values
|
||||
siOS = Distribution.System.Linux
|
||||
siArch = Distribution.System.X86_64
|
||||
|
||||
data ConstraintFile = ConstraintFile
|
||||
{ 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
|
||||
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
|
||||
cfGithubUsers <- o .: "github-users"
|
||||
return ConstraintFile {..}
|
||||
where
|
||||
goFlagMap = Map.mapKeysWith const FlagName
|
||||
goPackageMap = Map.mapKeysWith const PackageName
|
||||
getPackages o name = (setFromList . map PackageName) <$> o .: name
|
||||
|
||||
toDep :: Monad m => Text -> m Dependency
|
||||
toDep = either (fail . show) return . simpleParse
|
||||
|
||||
toBC :: ConstraintFile -> IO BuildConstraints
|
||||
toBC ConstraintFile {..} = do
|
||||
bcSystemInfo <- getSystemInfo
|
||||
return BuildConstraints {..}
|
||||
where
|
||||
combine (maintainer, range1) (_, range2) =
|
||||
(maintainer, intersectVersionRanges range1 range2)
|
||||
revmap = unionsWith combine $ ($ []) $ execWriter
|
||||
$ forM_ (mapToList cfPackages)
|
||||
$ \(maintainer, deps) -> forM_ deps
|
||||
$ \(Dependency name range) ->
|
||||
tell (singletonMap name (maintainer, range):)
|
||||
|
||||
bcPackages = Map.keysSet revmap
|
||||
|
||||
bcPackageConstraints name =
|
||||
PackageConstraints {..}
|
||||
where
|
||||
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
|
||||
| otherwise = ExpectSuccess
|
||||
pcBuildBenchmarks = name `notMember` cfSkippedBenchmarks
|
||||
pcHaddocks
|
||||
| name `member` cfExpectedHaddockFailures = ExpectFailure
|
||||
|
||||
| otherwise = ExpectSuccess
|
||||
pcFlagOverrides = fromMaybe mempty $ lookup name cfPackageFlags
|
||||
|
||||
bcGithubUsers = cfGithubUsers
|
||||
@ -1,214 +0,0 @@
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
{-# LANGUAGE DeriveFoldable #-}
|
||||
{-# LANGUAGE DeriveFunctor #-}
|
||||
{-# LANGUAGE DeriveTraversable #-}
|
||||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
-- | Representation of a concrete build plan, and how to generate a new one
|
||||
-- based on constraints.
|
||||
module Stackage.BuildPlan
|
||||
( BuildPlan (..)
|
||||
, PackagePlan (..)
|
||||
, newBuildPlan
|
||||
, makeToolMap
|
||||
, getLatestAllowedPlans
|
||||
) where
|
||||
|
||||
import Control.Monad.State.Strict (execState, get, put)
|
||||
import Data.Aeson
|
||||
import qualified Data.Map as Map
|
||||
import qualified Data.Set as Set
|
||||
import qualified Distribution.Compiler
|
||||
import Distribution.PackageDescription
|
||||
import Stackage.BuildConstraints
|
||||
import Stackage.GithubPings
|
||||
import Stackage.PackageDescription
|
||||
import Stackage.PackageIndex
|
||||
import Stackage.Prelude
|
||||
|
||||
data BuildPlan = BuildPlan
|
||||
{ bpSystemInfo :: SystemInfo
|
||||
, bpTools :: Vector (PackageName, Version)
|
||||
, bpPackages :: Map PackageName PackagePlan
|
||||
, bpGithubUsers :: Map Text (Set Text)
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
|
||||
instance ToJSON BuildPlan where
|
||||
toJSON BuildPlan {..} = object
|
||||
[ "system-info" .= bpSystemInfo
|
||||
, "tools" .= map goTool bpTools
|
||||
, "packages" .= Map.mapKeysWith const unPackageName bpPackages
|
||||
, "github-users" .= bpGithubUsers
|
||||
]
|
||||
where
|
||||
goTool (k, v) = object
|
||||
[ "name" .= display k
|
||||
, "version" .= display v
|
||||
]
|
||||
instance FromJSON BuildPlan where
|
||||
parseJSON = withObject "BuildPlan" $ \o -> do
|
||||
bpSystemInfo <- o .: "system-info"
|
||||
bpTools <- (o .: "tools") >>= mapM goTool
|
||||
bpPackages <- Map.mapKeysWith const mkPackageName <$> (o .: "packages")
|
||||
bpGithubUsers <- o .:? "github-users" .!= mempty
|
||||
return BuildPlan {..}
|
||||
where
|
||||
goTool = withObject "Tool" $ \o -> (,)
|
||||
<$> ((o .: "name") >>=
|
||||
either (fail . show) return . simpleParse . asText)
|
||||
<*> ((o .: "version") >>=
|
||||
either (fail . show) return . simpleParse . asText)
|
||||
|
||||
data PackagePlan = PackagePlan
|
||||
{ ppVersion :: Version
|
||||
, ppGithubPings :: Set Text
|
||||
, ppUsers :: Set PackageName
|
||||
, ppConstraints :: PackageConstraints
|
||||
, ppDesc :: SimpleDesc
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
|
||||
instance ToJSON PackagePlan where
|
||||
toJSON PackagePlan {..} = object
|
||||
[ "version" .= asText (display ppVersion)
|
||||
, "github-pings" .= ppGithubPings
|
||||
, "users" .= map unPackageName (unpack ppUsers)
|
||||
, "constraints" .= ppConstraints
|
||||
, "description" .= ppDesc
|
||||
]
|
||||
instance FromJSON PackagePlan where
|
||||
parseJSON = withObject "PackageBuild" $ \o -> do
|
||||
ppVersion <- o .: "version"
|
||||
>>= either (fail . show) return
|
||||
. simpleParse . asText
|
||||
ppGithubPings <- o .:? "github-pings" .!= mempty
|
||||
ppUsers <- Set.map PackageName <$> (o .:? "users" .!= mempty)
|
||||
ppConstraints <- o .: "constraints"
|
||||
ppDesc <- o .: "description"
|
||||
return PackagePlan {..}
|
||||
|
||||
-- | 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]
|
||||
toolNames = concatMap (Map.keys . sdTools . ppDesc) packages
|
||||
tools <- topologicalSortTools toolMap $ mapFromList $ do
|
||||
exeName <- toolNames
|
||||
guard $ exeName `notMember` siCoreExecutables
|
||||
packageName <- maybe mempty setToList $ lookup exeName toolMap
|
||||
packagePlan <- maybeToList $ lookup packageName packagesOrig
|
||||
return (packageName, packagePlan)
|
||||
-- FIXME topologically sort packages? maybe just leave that to the build phase
|
||||
return BuildPlan
|
||||
{ bpSystemInfo = bcSystemInfo
|
||||
, bpTools = tools
|
||||
, bpPackages = packages
|
||||
, bpGithubUsers = bcGithubUsers
|
||||
}
|
||||
where
|
||||
SystemInfo {..} = bcSystemInfo
|
||||
|
||||
makeToolMap :: Map PackageName PackagePlan
|
||||
-> Map ExeName (Set PackageName)
|
||||
makeToolMap =
|
||||
unionsWith (++) . map go . mapToList
|
||||
where
|
||||
go (packageName, pp) =
|
||||
foldMap go' $ sdProvidedExes $ ppDesc pp
|
||||
where
|
||||
go' exeName = singletonMap exeName (singletonSet packageName)
|
||||
|
||||
topologicalSortTools :: MonadThrow m
|
||||
=> Map ExeName (Set PackageName)
|
||||
-> Map PackageName PackagePlan
|
||||
-> m (Vector (PackageName, Version))
|
||||
topologicalSortTools toolMap = topologicalSort
|
||||
ppVersion
|
||||
(concatMap (fromMaybe mempty . flip lookup toolMap) . Map.keys . sdTools . ppDesc)
|
||||
|
||||
-- | Include only packages which are dependencies of the required packages and
|
||||
-- their build tools.
|
||||
removeUnincluded :: BuildConstraints
|
||||
-> Map ExeName (Set PackageName)
|
||||
-> Map PackageName PackagePlan
|
||||
-> Map PackageName PackagePlan
|
||||
removeUnincluded BuildConstraints {..} toolMap orig =
|
||||
mapFromList $ filter (\(x, _) -> x `member` included) $ mapToList orig
|
||||
where
|
||||
SystemInfo {..} = bcSystemInfo
|
||||
|
||||
included :: Set PackageName
|
||||
included = flip execState mempty $ mapM_ add bcPackages
|
||||
|
||||
add name = do
|
||||
inc <- get
|
||||
when (name `notMember` inc) $ do
|
||||
put $ insertSet name inc
|
||||
case lookup name orig of
|
||||
Nothing -> return ()
|
||||
Just pb -> do
|
||||
mapM_ add $ Map.keys $ sdPackages $ ppDesc pb
|
||||
forM_ (Map.keys $ sdTools $ ppDesc pb) $
|
||||
\exeName -> when (exeName `notMember` siCoreExecutables)
|
||||
$ mapM_ add $ fromMaybe mempty $ lookup exeName toolMap
|
||||
|
||||
populateUsers :: Map PackageName PackagePlan
|
||||
-> Map PackageName PackagePlan
|
||||
populateUsers orig =
|
||||
mapWithKey go orig
|
||||
where
|
||||
go name pb = pb { ppUsers = foldMap (go2 name) (mapToList orig) }
|
||||
|
||||
go2 dep (user, pb)
|
||||
| dep `member` sdPackages (ppDesc pb) = singletonSet user
|
||||
| otherwise = mempty
|
||||
|
||||
-- | Check whether the given package/version combo meets the constraints
|
||||
-- currently in place.
|
||||
isAllowed :: BuildConstraints
|
||||
-> PackageName -> Version -> Bool
|
||||
isAllowed bc = \name version ->
|
||||
case lookup name $ siCorePackages $ bcSystemInfo bc of
|
||||
Just _ -> False -- never reinstall a core package
|
||||
Nothing -> withinRange version $ pcVersionRange $ bcPackageConstraints bc name
|
||||
|
||||
mkPackagePlan :: MonadThrow m
|
||||
=> BuildConstraints
|
||||
-> GenericPackageDescription
|
||||
-> m PackagePlan
|
||||
mkPackagePlan bc gpd = do
|
||||
ppDesc <- toSimpleDesc CheckCond {..} gpd
|
||||
return PackagePlan {..}
|
||||
where
|
||||
PackageIdentifier name ppVersion = package $ packageDescription gpd
|
||||
ppGithubPings = getGithubPings bc gpd
|
||||
ppConstraints = bcPackageConstraints bc name
|
||||
ppUsers = mempty -- must be filled in later
|
||||
|
||||
ccPackageName = name
|
||||
ccOS = siOS
|
||||
ccArch = siArch
|
||||
ccCompilerFlavor = Distribution.Compiler.GHC
|
||||
ccCompilerVersion = siGhcVersion
|
||||
ccFlags = flags
|
||||
ccIncludeTests = pcTests ppConstraints /= Don'tBuild
|
||||
ccIncludeBenchmarks = pcBuildBenchmarks ppConstraints
|
||||
|
||||
SystemInfo {..} = bcSystemInfo bc
|
||||
|
||||
overrides = pcFlagOverrides ppConstraints
|
||||
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,162 +0,0 @@
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
-- | 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.Map.Strict as M
|
||||
import qualified Data.Text as T
|
||||
import Stackage.BuildConstraints
|
||||
import Stackage.BuildPlan
|
||||
import Stackage.PackageDescription
|
||||
import Stackage.Prelude
|
||||
|
||||
-- | 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 = 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
|
||||
|
||||
-- | 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) =
|
||||
mapM_ go $ mapToList $ sdPackages $ ppDesc pb
|
||||
where
|
||||
go (dep, diRange -> range) =
|
||||
case lookup dep allPackages of
|
||||
Nothing -> tell $ BadBuildPlan $ singletonMap (dep, Nothing) errMap
|
||||
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
|
||||
where
|
||||
errMap = singletonMap pu range
|
||||
pu = PkgUser
|
||||
{ puName = user
|
||||
, puVersion = ppVersion pb
|
||||
, puMaintainer = pcMaintainer $ ppConstraints 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
|
||||
, puMaintainer :: Maybe Maintainer
|
||||
, puGithubPings :: Set Text
|
||||
}
|
||||
deriving (Eq, Ord)
|
||||
|
||||
pkgUserShow1 :: PkgUser -> Text
|
||||
pkgUserShow1 PkgUser {..} = concat
|
||||
[ display puName
|
||||
, "-"
|
||||
, display puVersion
|
||||
]
|
||||
|
||||
pkgUserShow2 :: PkgUser -> Text
|
||||
pkgUserShow2 PkgUser {..} = unwords
|
||||
$ (maybe "No maintainer" unMaintainer puMaintainer ++ ".")
|
||||
: map (cons '@') (setToList puGithubPings)
|
||||
|
||||
newtype BadBuildPlan =
|
||||
BadBuildPlan (Map (PackageName, Maybe Version) (Map PkgUser VersionRange))
|
||||
deriving Typeable
|
||||
instance Exception BadBuildPlan
|
||||
instance Show BadBuildPlan where
|
||||
show (BadBuildPlan errs) =
|
||||
unpack $ concatMap go $ mapToList errs
|
||||
where
|
||||
go ((dep, mdepVer), users) = unlines
|
||||
$ ""
|
||||
: showDepVer dep mdepVer
|
||||
: map showUser (mapToList users)
|
||||
|
||||
showDepVer :: PackageName -> Maybe Version -> Text
|
||||
showDepVer dep Nothing = display dep ++ " (not present) depended on by:"
|
||||
showDepVer dep (Just version) = concat
|
||||
[ display dep
|
||||
, "-"
|
||||
, display version
|
||||
, " depended on by:"
|
||||
]
|
||||
|
||||
showUser :: (PkgUser, VersionRange) -> Text
|
||||
showUser (pu, range) = concat
|
||||
[ "- "
|
||||
, pkgUserShow1 pu
|
||||
, " ("
|
||||
-- add a space after < to avoid confusing Markdown processors (like
|
||||
-- Github's issue tracker)
|
||||
, T.replace "<" "< " $ display range
|
||||
, "). "
|
||||
, pkgUserShow2 pu
|
||||
]
|
||||
|
||||
instance Monoid BadBuildPlan where
|
||||
mempty = BadBuildPlan mempty
|
||||
mappend (BadBuildPlan x) (BadBuildPlan y) =
|
||||
BadBuildPlan $ unionWith (unionWith intersectVersionRanges) x y
|
||||
@ -1,337 +0,0 @@
|
||||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
module Stackage.CompleteBuild
|
||||
( BuildType (..)
|
||||
, BumpType (..)
|
||||
, BuildFlags (..)
|
||||
, completeBuild
|
||||
, justCheck
|
||||
, justUploadNightly
|
||||
, getStackageAuthToken
|
||||
) 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)
|
||||
import Data.Time
|
||||
import Data.Yaml (decodeFileEither, encodeFile)
|
||||
import Network.HTTP.Client
|
||||
import Network.HTTP.Client.TLS (tlsManagerSettings)
|
||||
import Stackage.BuildConstraints
|
||||
import Stackage.BuildPlan
|
||||
import Stackage.CheckBuildPlan
|
||||
import Stackage.PerformBuild
|
||||
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
|
||||
, bfUploadV1 :: !Bool
|
||||
, bfServer :: !StackageServer
|
||||
, bfBuildHoogle :: !Bool
|
||||
} deriving (Show)
|
||||
|
||||
data BuildType = Nightly | LTS BumpType
|
||||
deriving (Show, Read, Eq, Ord)
|
||||
|
||||
data BumpType = Major | Minor
|
||||
deriving (Show, Read, Eq, Ord)
|
||||
|
||||
data Settings = Settings
|
||||
{ plan :: BuildPlan
|
||||
, planFile :: FilePath
|
||||
, buildDir :: FilePath
|
||||
, logDir :: FilePath
|
||||
, title :: Text -> Text -- ^ GHC version -> title
|
||||
, slug :: Text
|
||||
, setArgs :: Text -> UploadBundle -> UploadBundle
|
||||
, postBuild :: IO ()
|
||||
, distroName :: Text -- ^ distro name on Hackage
|
||||
, snapshotType :: SnapshotType
|
||||
, bundleDest :: FilePath
|
||||
}
|
||||
|
||||
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"
|
||||
, snapshotType = STNightly
|
||||
, bundleDest = fpFromText $ "stackage-nightly-" ++ day ++ ".bundle"
|
||||
}
|
||||
where
|
||||
slug' = "nightly-" ++ day
|
||||
|
||||
getSettings :: Manager -> BuildType -> IO Settings
|
||||
getSettings man Nightly = do
|
||||
day <- tshow . utctDay <$> getCurrentTime
|
||||
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 "."
|
||||
$$ foldMapC (Option . fmap Max . parseLTSVer . filename)
|
||||
|
||||
(new, plan') <- case bumpType of
|
||||
Major -> do
|
||||
let new =
|
||||
case mlts of
|
||||
Nothing -> LTSVer 0 0
|
||||
Just (LTSVer x _) -> LTSVer (x + 1) 0
|
||||
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
|
||||
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/lts"
|
||||
, logDir = fpFromText $ "logs/stackage-lts-" ++ tshow new
|
||||
, title = \ghcVer -> concat
|
||||
[ "LTS Haskell "
|
||||
, tshow new
|
||||
, ", GHC "
|
||||
, ghcVer
|
||||
]
|
||||
, slug = "lts-" ++ tshow new
|
||||
, setArgs = \_ ub -> ub { ubLTS = Just $ tshow new }
|
||||
, plan = plan'
|
||||
, postBuild = do
|
||||
let git args = withCheckedProcess
|
||||
(proc "git" args) $ \ClosedStream Inherited Inherited ->
|
||||
return ()
|
||||
putStrLn "Committing new LTS file to Git"
|
||||
git ["add", fpToString newfile]
|
||||
git ["commit", "-m", "Added new LTS release: " ++ show new]
|
||||
putStrLn "Pushing to Git repository"
|
||||
git ["push"]
|
||||
, distroName = "LTSHaskell"
|
||||
, snapshotType =
|
||||
case new of
|
||||
LTSVer x y -> STLTS x y
|
||||
, bundleDest = fpFromText $ "stackage-lts-" ++ tshow new ++ ".bundle"
|
||||
}
|
||||
|
||||
data LTSVer = LTSVer !Int !Int
|
||||
deriving (Eq, Ord)
|
||||
instance Show LTSVer where
|
||||
show (LTSVer x y) = concat [show x, ".", show y]
|
||||
incrLTSVer :: LTSVer -> LTSVer
|
||||
incrLTSVer (LTSVer x y) = LTSVer x (y + 1)
|
||||
|
||||
parseLTSVer :: FilePath -> Maybe LTSVer
|
||||
parseLTSVer fp = do
|
||||
w <- stripPrefix "lts-" $ fpToText fp
|
||||
x <- stripSuffix ".yaml" w
|
||||
Right (major, y) <- Just $ decimal x
|
||||
z <- stripPrefix "." y
|
||||
Right (minor, "") <- Just $ decimal z
|
||||
return $ LTSVer major minor
|
||||
renderLTSVer :: LTSVer -> FilePath
|
||||
renderLTSVer lts = fpFromText $ concat
|
||||
[ "lts-"
|
||||
, tshow lts
|
||||
, ".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 = stillAlive $ withManager tlsManagerSettings $ \man -> do
|
||||
putStrLn "Loading build constraints"
|
||||
bc <- defaultBuildConstraints man
|
||||
|
||||
putStrLn "Creating build plan"
|
||||
plans <- getLatestAllowedPlans bc
|
||||
plan <- newBuildPlan plans bc
|
||||
|
||||
putStrLn $ "Writing build plan to check-plan.yaml"
|
||||
encodeFile "check-plan.yaml" plan
|
||||
|
||||
putStrLn "Checking plan"
|
||||
checkBuildPlan plan
|
||||
|
||||
putStrLn "Plan seems valid!"
|
||||
|
||||
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
|
||||
, pbBuildHoogle = bfBuildHoogle 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@Settings {..} <- getSettings man buildType
|
||||
|
||||
putStrLn $ "Writing build plan to: " ++ fpToText planFile
|
||||
encodeFile (fpToString planFile) plan
|
||||
|
||||
if bfSkipCheck buildFlags
|
||||
then putStrLn "Skipping build plan check"
|
||||
else do
|
||||
putStrLn "Checking build plan"
|
||||
checkBuildPlan plan
|
||||
|
||||
putStrLn "Performing build"
|
||||
let pb = getPerformBuild buildFlags settings
|
||||
performBuild pb >>= mapM_ putStrLn
|
||||
|
||||
putStrLn $ "Creating bundle (v2) at: " ++ fpToText bundleDest
|
||||
createBundleV2 CreateBundleV2
|
||||
{ cb2Plan = plan
|
||||
, cb2Type = snapshotType
|
||||
, cb2DocsDir = pbDocDir pb
|
||||
, cb2Dest = bundleDest
|
||||
}
|
||||
|
||||
when (bfDoUpload buildFlags) $
|
||||
finallyUpload
|
||||
(not $ bfUploadV1 buildFlags)
|
||||
(bfServer buildFlags)
|
||||
settings
|
||||
man
|
||||
|
||||
justUploadNightly
|
||||
:: Text -- ^ nightly date
|
||||
-> IO ()
|
||||
justUploadNightly day = do
|
||||
plan <- decodeFileEither (fpToString $ nightlyPlanFile day)
|
||||
>>= either throwM return
|
||||
withManager tlsManagerSettings $ finallyUpload False def $ nightlySettings day plan
|
||||
|
||||
getStackageAuthToken :: IO Text
|
||||
getStackageAuthToken = do
|
||||
mtoken <- lookupEnv "STACKAGE_AUTH_TOKEN"
|
||||
case mtoken of
|
||||
Nothing -> decodeUtf8 <$> readFile "/auth-token"
|
||||
Just token -> return $ pack token
|
||||
|
||||
-- | The final part of the complete build process: uploading a bundle,
|
||||
-- docs and a distro to hackage.
|
||||
finallyUpload :: Bool -- ^ use v2 upload
|
||||
-> StackageServer
|
||||
-> Settings -> Manager -> IO ()
|
||||
finallyUpload useV2 server settings@Settings{..} man = do
|
||||
putStrLn "Uploading bundle to Stackage Server"
|
||||
|
||||
token <- getStackageAuthToken
|
||||
|
||||
if useV2
|
||||
then do
|
||||
res <- flip uploadBundleV2 man UploadBundleV2
|
||||
{ ub2Server = server
|
||||
, ub2AuthToken = token
|
||||
, ub2Bundle = bundleDest
|
||||
}
|
||||
putStrLn $ "New snapshot available at: " ++ res
|
||||
else do
|
||||
now <- epochTime
|
||||
let ghcVer = display $ siGhcVersion $ bpSystemInfo plan
|
||||
(ident, mloc) <- flip uploadBundle man $ setArgs ghcVer def
|
||||
{ ubContents = serverBundle now (title ghcVer) slug plan
|
||||
, ubAuthToken = token
|
||||
}
|
||||
putStrLn $ "New ident: " ++ unSnapshotIdent ident
|
||||
forM_ mloc $ \loc ->
|
||||
putStrLn $ "Track progress at: " ++ loc
|
||||
|
||||
putStrLn "Uploading docs to Stackage Server"
|
||||
res1 <- tryAny $ uploadDocs UploadDocs
|
||||
{ udServer = def
|
||||
, udAuthToken = token
|
||||
, udDocs = pbDocDir pb
|
||||
, udSnapshot = ident
|
||||
} man
|
||||
putStrLn $ "Doc upload response: " ++ tshow res1
|
||||
|
||||
putStrLn "Uploading doc map"
|
||||
tryAny (uploadDocMap UploadDocMap
|
||||
{ udmServer = def
|
||||
, udmAuthToken = token
|
||||
, udmSnapshot = ident
|
||||
, udmDocDir = pbDocDir pb
|
||||
, udmPlan = plan
|
||||
} man) >>= print
|
||||
|
||||
postBuild `catchAny` print
|
||||
|
||||
ecreds <- tryIO $ readFile "/hackage-creds"
|
||||
case map encodeUtf8 $ words $ decodeUtf8 $ either (const "") id ecreds of
|
||||
[username, password] -> do
|
||||
putStrLn "Uploading as Hackage distro"
|
||||
res2 <- uploadHackageDistroNamed distroName plan username password man
|
||||
putStrLn $ "Distro upload response: " ++ tshow res2
|
||||
_ -> putStrLn "No creds found, skipping Hackage distro upload"
|
||||
where
|
||||
pb = getPerformBuild (error "finallyUpload.buildFlags") settings
|
||||
@ -1,53 +0,0 @@
|
||||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module Stackage.CorePackages
|
||||
( getCorePackages
|
||||
, getCoreExecutables
|
||||
, getGhcVersion
|
||||
) where
|
||||
|
||||
import qualified Data.Text as T
|
||||
import Filesystem (listDirectory)
|
||||
import Stackage.Prelude
|
||||
import System.Directory (findExecutable)
|
||||
|
||||
-- | Get a @Map@ of all of the core packages. Core packages are defined as
|
||||
-- packages which ship with GHC itself.
|
||||
--
|
||||
-- Precondition: GHC global package database has only core packages, and GHC
|
||||
-- ships with just a single version of each packages.
|
||||
getCorePackages :: IO (Map PackageName Version)
|
||||
getCorePackages =
|
||||
withCheckedProcess cp $ \ClosedStream src Inherited ->
|
||||
src $$ decodeUtf8C =$ linesUnboundedC =$ foldMapMC parsePackage
|
||||
where
|
||||
cp = proc "ghc-pkg" ["--no-user-package-conf", "list"]
|
||||
parsePackage t
|
||||
| ":" `isInfixOf` t = return mempty
|
||||
| Just p <- stripSuffix "-" p' = singletonMap
|
||||
<$> simpleParse p
|
||||
<*> simpleParse v
|
||||
| otherwise = return mempty
|
||||
where
|
||||
(p', v) = T.breakOnEnd "-" $ dropParens $ T.strip t
|
||||
|
||||
dropParens s
|
||||
| length s > 2 && headEx s == '(' && lastEx s == ')' =
|
||||
initEx $ tailEx s
|
||||
| otherwise = s
|
||||
|
||||
-- | A list of executables that are shipped with GHC.
|
||||
getCoreExecutables :: IO (Set ExeName)
|
||||
getCoreExecutables = do
|
||||
mfp <- findExecutable "ghc"
|
||||
dir <-
|
||||
case mfp of
|
||||
Nothing -> error "No ghc executable found on PATH"
|
||||
Just fp -> return $ directory $ fpFromString fp
|
||||
(setFromList . map (ExeName . fpToText . filename)) <$> listDirectory dir
|
||||
|
||||
getGhcVersion :: IO Version
|
||||
getGhcVersion = do
|
||||
withCheckedProcess (proc "ghc" ["--numeric-version"]) $
|
||||
\ClosedStream src Inherited ->
|
||||
(src $$ decodeUtf8C =$ foldC) >>= simpleParse
|
||||
@ -1,104 +0,0 @@
|
||||
{-# 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
|
||||
-> (PackageIdentifier -> IO ()) -- ^ callback to be used when unregistering a package
|
||||
-> IO (Set PackageName) -- ^ packages remaining in the database after cleanup
|
||||
setupPackageDatabase mdb docDir log' toInstall onUnregister = do
|
||||
registered1 <- getRegisteredPackages flags
|
||||
forM_ registered1 $ \pi@(PackageIdentifier name version) ->
|
||||
case lookup name toInstall of
|
||||
Just version' | version /= version' -> unregisterPackage log' onUnregister docDir flags pi
|
||||
_ -> return ()
|
||||
broken <- getBrokenPackages flags
|
||||
forM_ broken $ unregisterPackage log' onUnregister 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
|
||||
-> (PackageIdentifier -> IO ()) -- ^ callback to be used when unregistering a package
|
||||
-> FilePath -- ^ doc directory
|
||||
-> [String] -> PackageIdentifier -> IO ()
|
||||
unregisterPackage log' onUnregister docDir flags ident@(PackageIdentifier name _) = do
|
||||
log' $ "Unregistering " ++ encodeUtf8 (display ident) ++ "\n"
|
||||
onUnregister ident
|
||||
|
||||
-- Delete libraries
|
||||
sourceProcessWithConsumer
|
||||
(proc "ghc-pkg" ("describe" : flags ++ [unpack $ display ident]))
|
||||
(CT.decodeUtf8
|
||||
$= CT.lines
|
||||
$= CL.mapMaybe parseLibraryDir
|
||||
$= CL.mapM_ (void . tryIO . removeTree))
|
||||
|
||||
void (readProcessWithExitCode
|
||||
"ghc-pkg"
|
||||
("unregister": flags ++ ["--force", unpack $ display name])
|
||||
"")
|
||||
|
||||
void $ tryIO $ removeTree $ docDir </> fpFromText (display ident)
|
||||
where
|
||||
parseLibraryDir = fmap fpFromText . stripPrefix "library-dirs: "
|
||||
@ -1,36 +0,0 @@
|
||||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
module Stackage.GithubPings
|
||||
( getGithubPings
|
||||
) where
|
||||
|
||||
import Distribution.PackageDescription
|
||||
import Stackage.BuildConstraints
|
||||
import Stackage.Prelude
|
||||
|
||||
-- | Determine accounts to be pinged on Github based on various metadata in the
|
||||
-- package description.
|
||||
getGithubPings :: BuildConstraints -- ^ for mapping to pingees
|
||||
-> GenericPackageDescription -> Set Text
|
||||
getGithubPings bc gpd =
|
||||
foldMap (\(pack -> name) -> fromMaybe (singletonSet name) (lookup name (bcGithubUsers bc))) $
|
||||
goHomepage (homepage $ packageDescription gpd) ++
|
||||
concatMap goRepo (sourceRepos $ packageDescription gpd)
|
||||
where
|
||||
goHomepage t = do
|
||||
prefix <-
|
||||
[ "http://github.com/"
|
||||
, "https://github.com/"
|
||||
, "git://github.com/"
|
||||
, "git@github.com:"
|
||||
]
|
||||
t' <- maybeToList $ stripPrefix prefix t
|
||||
let t'' = takeWhile (/= '/') t'
|
||||
guard $ not $ null t''
|
||||
return t''
|
||||
|
||||
goRepo sr =
|
||||
case (repoType sr, repoLocation sr) of
|
||||
(Just Git, Just s) -> goHomepage s
|
||||
_ -> []
|
||||
@ -1,102 +0,0 @@
|
||||
{-# 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
|
||||
, ifBuildHoogle :: !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
|
||||
, pbBuildHoogle = ifBuildHoogle
|
||||
}
|
||||
|
||||
-- | 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"
|
||||
@ -1,200 +0,0 @@
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
{-# LANGUAGE DeriveFoldable #-}
|
||||
{-# LANGUAGE DeriveFunctor #-}
|
||||
{-# LANGUAGE DeriveTraversable #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
-- | Manipulate @GenericPackageDescription@ from Cabal into something more
|
||||
-- useful for us.
|
||||
module Stackage.PackageDescription
|
||||
( SimpleDesc (..)
|
||||
, toSimpleDesc
|
||||
, CheckCond (..)
|
||||
, Component (..)
|
||||
, DepInfo (..)
|
||||
) where
|
||||
|
||||
import Control.Monad.Writer.Strict (MonadWriter, execWriterT,
|
||||
tell)
|
||||
import Data.Aeson
|
||||
import qualified Data.Map as Map
|
||||
import Distribution.Compiler (CompilerFlavor)
|
||||
import Distribution.Package (Dependency (..))
|
||||
import Distribution.PackageDescription
|
||||
import Distribution.System (Arch, OS)
|
||||
import Stackage.Prelude
|
||||
|
||||
data Component = CompLibrary
|
||||
| CompExecutable
|
||||
| CompTestSuite
|
||||
| CompBenchmark
|
||||
deriving (Show, Read, Eq, Ord, Enum, Bounded)
|
||||
|
||||
compToText :: Component -> Text
|
||||
compToText CompLibrary = "library"
|
||||
compToText CompExecutable = "executable"
|
||||
compToText CompTestSuite = "test-suite"
|
||||
compToText CompBenchmark = "benchmark"
|
||||
|
||||
instance ToJSON Component where
|
||||
toJSON = toJSON . compToText
|
||||
instance FromJSON Component where
|
||||
parseJSON = withText "Component" $ \t -> maybe
|
||||
(fail $ "Invalid component: " ++ unpack t)
|
||||
return
|
||||
(lookup t comps)
|
||||
where
|
||||
comps = asHashMap $ mapFromList $ map (compToText &&& id) [minBound..maxBound]
|
||||
|
||||
data DepInfo = DepInfo
|
||||
{ diComponents :: Set Component
|
||||
, diRange :: VersionRange
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
|
||||
instance Semigroup DepInfo where
|
||||
DepInfo a x <> DepInfo b y = DepInfo
|
||||
(a <> b)
|
||||
(intersectVersionRanges x y)
|
||||
instance ToJSON DepInfo where
|
||||
toJSON DepInfo {..} = object
|
||||
[ "components" .= diComponents
|
||||
, "range" .= display diRange
|
||||
]
|
||||
instance FromJSON DepInfo where
|
||||
parseJSON = withObject "DepInfo" $ \o -> do
|
||||
diComponents <- o .: "components"
|
||||
diRange <- o .: "range" >>= either (fail . show) return . simpleParse
|
||||
return DepInfo {..}
|
||||
|
||||
-- | A simplified package description that tracks:
|
||||
--
|
||||
-- * Package dependencies
|
||||
--
|
||||
-- * Build tool dependencies
|
||||
--
|
||||
-- * Provided executables
|
||||
--
|
||||
-- It has fully resolved all conditionals
|
||||
data SimpleDesc = SimpleDesc
|
||||
{ sdPackages :: Map PackageName DepInfo
|
||||
, sdTools :: Map ExeName DepInfo
|
||||
, sdProvidedExes :: Set ExeName
|
||||
, sdModules :: Set Text
|
||||
-- ^ modules exported by the library
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
instance Monoid SimpleDesc where
|
||||
mempty = SimpleDesc mempty mempty mempty mempty
|
||||
mappend (SimpleDesc a b c d) (SimpleDesc w x y z) = SimpleDesc
|
||||
(unionWith (<>) a w)
|
||||
(unionWith (<>) b x)
|
||||
(c ++ y)
|
||||
(d ++ z)
|
||||
instance ToJSON SimpleDesc where
|
||||
toJSON SimpleDesc {..} = object
|
||||
[ "packages" .= Map.mapKeysWith const unPackageName sdPackages
|
||||
, "tools" .= Map.mapKeysWith const unExeName sdTools
|
||||
, "provided-exes" .= sdProvidedExes
|
||||
, "modules" .= sdModules
|
||||
]
|
||||
instance FromJSON SimpleDesc where
|
||||
parseJSON = withObject "SimpleDesc" $ \o -> do
|
||||
sdPackages <- Map.mapKeysWith const mkPackageName <$> (o .: "packages")
|
||||
sdTools <- Map.mapKeysWith const ExeName <$> (o .: "tools")
|
||||
sdProvidedExes <- o .: "provided-exes"
|
||||
sdModules <- o .: "modules"
|
||||
return SimpleDesc {..}
|
||||
|
||||
-- | Convert a 'GenericPackageDescription' into a 'SimpleDesc' by following the
|
||||
-- constraints in the provided 'CheckCond'.
|
||||
toSimpleDesc :: MonadThrow m
|
||||
=> CheckCond
|
||||
-> GenericPackageDescription
|
||||
-> m SimpleDesc
|
||||
toSimpleDesc cc gpd = execWriterT $ do
|
||||
forM_ (condLibrary gpd) $ tellTree cc CompLibrary libBuildInfo getModules
|
||||
forM_ (condExecutables gpd) $ tellTree cc CompExecutable buildInfo noModules . snd
|
||||
tell mempty { sdProvidedExes = setFromList
|
||||
$ map (fromString . fst)
|
||||
$ condExecutables gpd
|
||||
}
|
||||
when (ccIncludeTests cc) $ forM_ (condTestSuites gpd)
|
||||
$ tellTree cc CompTestSuite testBuildInfo noModules . snd
|
||||
when (ccIncludeBenchmarks cc) $ forM_ (condBenchmarks gpd)
|
||||
$ tellTree cc CompBenchmark benchmarkBuildInfo noModules . snd
|
||||
where
|
||||
noModules = const mempty
|
||||
getModules = setFromList . map display . exposedModules
|
||||
|
||||
-- | Convert a single CondTree to a 'SimpleDesc'.
|
||||
tellTree :: (MonadWriter SimpleDesc m, MonadThrow m)
|
||||
=> CheckCond
|
||||
-> Component
|
||||
-> (a -> BuildInfo)
|
||||
-> (a -> Set Text) -- ^ get module names
|
||||
-> CondTree ConfVar [Dependency] a
|
||||
-> m ()
|
||||
tellTree cc component getBI getModules =
|
||||
loop
|
||||
where
|
||||
loop (CondNode dat deps comps) = do
|
||||
tell mempty
|
||||
{ sdPackages = unionsWith (<>) $ flip map deps
|
||||
$ \(Dependency x y) -> singletonMap x DepInfo
|
||||
{ diComponents = singletonSet component
|
||||
, diRange = simplifyVersionRange y
|
||||
}
|
||||
, sdTools = unionsWith (<>) $ flip map (buildTools $ getBI dat)
|
||||
$ \(Dependency name range) -> singletonMap
|
||||
-- In practice, cabal files refer to the exe name, not the
|
||||
-- package name.
|
||||
(ExeName $ unPackageName name)
|
||||
DepInfo
|
||||
{ diComponents = singletonSet component
|
||||
, diRange = simplifyVersionRange range
|
||||
}
|
||||
, sdModules = getModules dat
|
||||
}
|
||||
forM_ comps $ \(cond, ontrue, onfalse) -> do
|
||||
b <- checkCond cc cond
|
||||
if b
|
||||
then loop ontrue
|
||||
else maybe (return ()) loop onfalse
|
||||
|
||||
-- | Resolve a condition to a boolean based on the provided 'CheckCond'.
|
||||
checkCond :: MonadThrow m => CheckCond -> Condition ConfVar -> m Bool
|
||||
checkCond CheckCond {..} cond0 =
|
||||
go cond0
|
||||
where
|
||||
go (Var (OS os)) = return $ os == ccOS
|
||||
go (Var (Arch arch)) = return $ arch == ccArch
|
||||
go (Var (Flag flag)) =
|
||||
case lookup flag ccFlags of
|
||||
Nothing -> throwM $ FlagNotDefined ccPackageName flag cond0
|
||||
Just b -> return b
|
||||
go (Var (Impl flavor range)) = return
|
||||
$ flavor == ccCompilerFlavor
|
||||
&& ccCompilerVersion `withinRange` range
|
||||
go (Lit b) = return b
|
||||
go (CNot c) = not `liftM` go c
|
||||
go (CAnd x y) = (&&) `liftM` go x `ap` go y
|
||||
go (COr x y) = (||) `liftM` go x `ap` go y
|
||||
|
||||
data CheckCondException = FlagNotDefined PackageName FlagName (Condition ConfVar)
|
||||
deriving (Show, Typeable)
|
||||
instance Exception CheckCondException
|
||||
|
||||
data CheckCond = CheckCond
|
||||
{ ccPackageName :: PackageName -- for debugging only
|
||||
, ccOS :: OS
|
||||
, ccArch :: Arch
|
||||
, ccFlags :: Map FlagName Bool
|
||||
, ccCompilerFlavor :: CompilerFlavor
|
||||
, ccCompilerVersion :: Version
|
||||
, ccIncludeTests :: Bool
|
||||
, ccIncludeBenchmarks :: Bool
|
||||
}
|
||||
@ -1,127 +0,0 @@
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
-- | Dealing with the 00-index file and all its cabal files.
|
||||
module Stackage.PackageIndex
|
||||
( sourcePackageIndex
|
||||
, UnparsedCabalFile (..)
|
||||
, getLatestDescriptions
|
||||
) where
|
||||
|
||||
import qualified Codec.Archive.Tar as Tar
|
||||
import Data.Conduit.Lazy (MonadActive,
|
||||
lazyConsume)
|
||||
import qualified Data.Text as T
|
||||
import Distribution.PackageDescription (package,
|
||||
packageDescription)
|
||||
import Distribution.PackageDescription.Parse (ParseResult (..),
|
||||
parsePackageDescription)
|
||||
import Distribution.ParseUtils (PError)
|
||||
import Stackage.Prelude
|
||||
import System.Directory (getAppUserDataDirectory)
|
||||
|
||||
-- | Name of the 00-index.tar downloaded from Hackage.
|
||||
getPackageIndexPath :: MonadIO m => m FilePath
|
||||
getPackageIndexPath = liftIO $ do
|
||||
c <- getCabalRoot
|
||||
configLines <- runResourceT $ sourceFile (c </> "config")
|
||||
$$ decodeUtf8C
|
||||
=$ linesUnboundedC
|
||||
=$ concatMapC getRemoteCache
|
||||
=$ sinkList
|
||||
case configLines of
|
||||
[x] -> return $ x </> "hackage.haskell.org" </> "00-index.tar"
|
||||
[] -> error $ "No remote-repo-cache found in Cabal config file"
|
||||
_ -> error $ "Multiple remote-repo-cache entries found in Cabal config file"
|
||||
where
|
||||
getCabalRoot :: IO FilePath
|
||||
getCabalRoot = fpFromString <$> getAppUserDataDirectory "cabal"
|
||||
|
||||
getRemoteCache s = do
|
||||
("remote-repo-cache", stripPrefix ":" -> Just v) <- Just $ break (== ':') s
|
||||
Just $ fpFromText $ T.strip v
|
||||
|
||||
-- | A cabal file with name and version parsed from the filepath, and the
|
||||
-- package description itself ready to be parsed. It's left in unparsed form
|
||||
-- for efficiency.
|
||||
data UnparsedCabalFile = UnparsedCabalFile
|
||||
{ ucfName :: PackageName
|
||||
, ucfVersion :: Version
|
||||
, ucfParse :: forall m. MonadThrow m => m GenericPackageDescription
|
||||
}
|
||||
|
||||
-- | Stream all of the cabal files from the 00-index tar file.
|
||||
sourcePackageIndex :: (MonadThrow m, MonadResource m, MonadActive m, MonadBaseControl IO m)
|
||||
=> Producer m UnparsedCabalFile
|
||||
sourcePackageIndex = do
|
||||
fp <- getPackageIndexPath
|
||||
-- yay for the tar package. Use lazyConsume instead of readFile to get some
|
||||
-- kind of resource protection
|
||||
lbs <- lift $ fromChunks <$> lazyConsume (sourceFile fp)
|
||||
loop (Tar.read lbs)
|
||||
where
|
||||
loop (Tar.Next e es) = goE e >> loop es
|
||||
loop Tar.Done = return ()
|
||||
loop (Tar.Fail e) = throwM e
|
||||
|
||||
goE e
|
||||
| Just front <- stripSuffix ".cabal" $ pack $ Tar.entryPath e
|
||||
, Tar.NormalFile lbs _size <- Tar.entryContent e = do
|
||||
(name, version) <- parseNameVersion front
|
||||
yield UnparsedCabalFile
|
||||
{ ucfName = name
|
||||
, ucfVersion = version
|
||||
, ucfParse = goContent (Tar.entryPath e) name version lbs
|
||||
}
|
||||
| otherwise = return ()
|
||||
|
||||
goContent fp name version lbs =
|
||||
case parsePackageDescription $ unpack $ decodeUtf8 lbs of
|
||||
ParseFailed e -> throwM $ CabalParseException (fpFromString fp) e
|
||||
ParseOk _warnings gpd -> do
|
||||
let pd = packageDescription gpd
|
||||
PackageIdentifier name' version' = package pd
|
||||
when (name /= name' || version /= version') $
|
||||
throwM $ MismatchedNameVersion (fpFromString fp)
|
||||
name name' version version'
|
||||
return gpd
|
||||
|
||||
parseNameVersion t1 = do
|
||||
let (p', t2) = break (== '/') $ T.replace "\\" "/" t1
|
||||
p <- simpleParse p'
|
||||
t3 <- maybe (throwM $ InvalidCabalPath t1 "no slash") return
|
||||
$ stripPrefix "/" t2
|
||||
let (v', t4) = break (== '/') t3
|
||||
v <- simpleParse v'
|
||||
when (t4 /= cons '/' p') $ throwM $ InvalidCabalPath t1 $ "Expected at end: " ++ p'
|
||||
return (p, v)
|
||||
|
||||
data InvalidCabalPath = InvalidCabalPath Text Text
|
||||
deriving (Show, Typeable)
|
||||
instance Exception InvalidCabalPath
|
||||
|
||||
data CabalParseException = CabalParseException FilePath PError
|
||||
| MismatchedNameVersion FilePath PackageName PackageName Version Version
|
||||
deriving (Show, Typeable)
|
||||
instance Exception CabalParseException
|
||||
|
||||
-- | Get all of the latest descriptions for name/version pairs matching the
|
||||
-- given criterion.
|
||||
getLatestDescriptions :: MonadIO m
|
||||
=> (PackageName -> Version -> Bool)
|
||||
-> (GenericPackageDescription -> IO desc)
|
||||
-> m (Map PackageName desc)
|
||||
getLatestDescriptions f parseDesc = liftIO $ do
|
||||
m <- runResourceT $ sourcePackageIndex $$ filterC f' =$ foldlC add mempty
|
||||
forM m $ \ucf -> liftIO $ ucfParse ucf >>= parseDesc
|
||||
where
|
||||
f' ucf = f (ucfName ucf) (ucfVersion ucf)
|
||||
add m ucf =
|
||||
case lookup name m of
|
||||
Just ucf' | ucfVersion ucf < ucfVersion ucf' -> m
|
||||
_ -> insertMap name ucf m
|
||||
where
|
||||
name = ucfName ucf
|
||||
@ -1,560 +0,0 @@
|
||||
-- | Perform an actual build, generate a binary package database and a
|
||||
-- documentation directory in the process.
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
module Stackage.PerformBuild
|
||||
( performBuild
|
||||
, PerformBuild (..)
|
||||
, BuildException (..)
|
||||
, pbDocDir
|
||||
) where
|
||||
|
||||
import Control.Concurrent.Async (async)
|
||||
import Control.Concurrent.STM.TSem
|
||||
import Control.Monad.Writer.Strict (execWriter, tell)
|
||||
import qualified Data.Map as Map
|
||||
import Data.NonNull (fromNullable)
|
||||
import Filesystem (canonicalizePath, createTree,
|
||||
getWorkingDirectory, isDirectory,
|
||||
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)
|
||||
import System.Environment (getEnvironment)
|
||||
import System.IO (IOMode (WriteMode),
|
||||
openBinaryFile)
|
||||
import System.IO.Temp (withSystemTempDirectory)
|
||||
|
||||
data BuildException = BuildException (Map PackageName BuildFailure) [Text]
|
||||
deriving Typeable
|
||||
instance Exception BuildException
|
||||
instance Show BuildException where
|
||||
show (BuildException m warnings) =
|
||||
unlines $ map go (mapToList m) ++ map unpack warnings
|
||||
where
|
||||
go (PackageName name, bf) = concat
|
||||
[ name
|
||||
, ": "
|
||||
, show bf
|
||||
]
|
||||
|
||||
data BuildFailure = DependencyFailed PackageName
|
||||
| DependencyMissing PackageName
|
||||
| ToolMissing ExeName
|
||||
| NotImplemented
|
||||
| BuildFailureException SomeException
|
||||
deriving (Show, Typeable)
|
||||
instance Exception BuildFailure
|
||||
|
||||
data PerformBuild = PerformBuild
|
||||
{ pbPlan :: BuildPlan
|
||||
, pbInstallDest :: FilePath
|
||||
, pbLog :: ByteString -> IO ()
|
||||
, pbLogDir :: FilePath
|
||||
, 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
|
||||
, pbBuildHoogle :: Bool
|
||||
-- ^ Should we build Hoogle database?
|
||||
--
|
||||
-- May be disabled due to: https://ghc.haskell.org/trac/ghc/ticket/9921
|
||||
}
|
||||
|
||||
data PackageInfo = PackageInfo
|
||||
{ piPlan :: PackagePlan
|
||||
, piName :: PackageName
|
||||
, piResult :: TMVar Bool
|
||||
}
|
||||
|
||||
waitForDeps :: Map ExeName (Set PackageName)
|
||||
-> Map PackageName PackageInfo
|
||||
-> Set Component
|
||||
-> BuildPlan
|
||||
-> PackageInfo
|
||||
-> IO a
|
||||
-> IO a
|
||||
waitForDeps toolMap packageMap activeComps bp pi action = do
|
||||
atomically $ do
|
||||
mapM_ checkPackage $ Map.keys $ filterUnused $ sdPackages $ ppDesc $ piPlan pi
|
||||
forM_ (Map.keys $ filterUnused $ sdTools $ ppDesc $ piPlan pi) $ \exe -> do
|
||||
case lookup exe toolMap >>= fromNullable . map checkPackage . setToList of
|
||||
Nothing
|
||||
| isCoreExe exe -> return ()
|
||||
-- https://github.com/jgm/zip-archive/issues/23
|
||||
-- - | otherwise -> throwSTM $ ToolMissing exe
|
||||
| otherwise -> return ()
|
||||
Just packages -> ofoldl1' (<|>) packages
|
||||
action
|
||||
where
|
||||
filterUnused :: Ord key => Map key DepInfo -> Map key DepInfo
|
||||
filterUnused =
|
||||
mapFromList . filter (go . snd) . mapToList
|
||||
where
|
||||
go = not . null . intersection activeComps . diComponents
|
||||
|
||||
checkPackage package | package == piName pi = return ()
|
||||
checkPackage package =
|
||||
case lookup package packageMap of
|
||||
Nothing
|
||||
| isCore package -> return ()
|
||||
| otherwise -> throwSTM $ DependencyMissing package
|
||||
Just dep -> do
|
||||
res <- readTMVar $ piResult dep
|
||||
unless res $ throwSTM $ DependencyFailed package
|
||||
|
||||
isCore = (`member` siCorePackages (bpSystemInfo bp))
|
||||
isCoreExe = (`member` siCoreExecutables (bpSystemInfo bp))
|
||||
|
||||
withCounter :: TVar Int -> IO a -> IO a
|
||||
withCounter counter = bracket_
|
||||
(atomically $ modifyTVar counter (+ 1))
|
||||
(atomically $ modifyTVar counter (subtract 1))
|
||||
|
||||
withTSem :: TSem -> IO a -> IO a
|
||||
withTSem sem = bracket_ (atomically $ waitTSem sem) (atomically $ signalTSem sem)
|
||||
|
||||
-- | Returns @Nothing@ if installing to a global database
|
||||
pbDatabase :: PerformBuild -> Maybe FilePath
|
||||
pbDatabase pb
|
||||
| pbGlobalInstall pb = Nothing
|
||||
| otherwise = Just $ pbInstallDest pb </> "pkgdb"
|
||||
|
||||
pbBinDir, pbLibDir, pbDataDir, pbDocDir :: PerformBuild -> FilePath
|
||||
pbBinDir pb = pbInstallDest pb </> "bin"
|
||||
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
|
||||
performBuild' pb
|
||||
{ pbInstallDest = cwd </> pbInstallDest pb
|
||||
, pbLogDir = cwd </> pbLogDir pb
|
||||
}
|
||||
|
||||
performBuild' :: PerformBuild -> IO [Text]
|
||||
performBuild' pb@PerformBuild {..} = withBuildDir $ \builddir -> do
|
||||
-- First make sure to fetch all of the dependencies... just in case Hackage
|
||||
-- has an outage. Don't feel like wasting hours of CPU time.
|
||||
pbLog $ encodeUtf8 "Pre-fetching all packages\n"
|
||||
let toDownload = flip map (mapToList $ bpPackages pbPlan)
|
||||
$ \(name, plan) -> unpack $ concat
|
||||
[ display name
|
||||
, "-"
|
||||
, display $ ppVersion plan
|
||||
]
|
||||
withCheckedProcess
|
||||
(proc "cabal"
|
||||
$ "fetch"
|
||||
: "--no-dependencies"
|
||||
: toDownload)
|
||||
$ \ClosedStream Inherited Inherited -> return ()
|
||||
|
||||
let removeTree' fp = whenM (isDirectory fp) (removeTree fp)
|
||||
removeTree' pbLogDir
|
||||
|
||||
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)
|
||||
|
||||
sem <- atomically $ newTSem pbJobs
|
||||
active <- newTVarIO (0 :: Int)
|
||||
let toolMap = makeToolMap $ bpPackages pbPlan
|
||||
packageMap <- fmap fold $ forM (mapToList $ bpPackages pbPlan)
|
||||
$ \(name, plan) -> do
|
||||
let piPlan = plan
|
||||
piName = name
|
||||
piResult <- newEmptyTMVarIO
|
||||
return $ singletonMap name PackageInfo {..}
|
||||
|
||||
errsVar <- newTVarIO mempty
|
||||
warningsVar <- newTVarIO id
|
||||
mutex <- newMVar ()
|
||||
env <- getEnvironment
|
||||
haddockFiles <- newTVarIO mempty
|
||||
|
||||
registeredPackages <- setupPackageDatabase
|
||||
(pbDatabase pb)
|
||||
(pbDocDir pb)
|
||||
pbLog
|
||||
(ppVersion <$> bpPackages pbPlan)
|
||||
(deletePreviousResults pb)
|
||||
|
||||
forM_ packageMap $ \pi -> void $ async $ singleBuild pb registeredPackages
|
||||
SingleBuild
|
||||
{ sbSem = sem
|
||||
, sbErrsVar = errsVar
|
||||
, sbWarningsVar = warningsVar
|
||||
, sbActive = active
|
||||
, sbToolMap = toolMap
|
||||
, sbPackageMap = packageMap
|
||||
, sbBuildDir = builddir
|
||||
, sbPackageInfo = pi
|
||||
, sbRegisterMutex = mutex
|
||||
, sbModifiedEnv = maybe
|
||||
id
|
||||
(\db -> (("HASKELL_PACKAGE_SANDBOX", fpToString db):))
|
||||
(pbDatabase pb)
|
||||
(filter allowedEnv $ map fixEnv env)
|
||||
, sbHaddockFiles = haddockFiles
|
||||
}
|
||||
|
||||
void $ tryAny $ atomically $ readTVar active >>= checkSTM . (== 0)
|
||||
|
||||
warnings <- ($ []) <$> readTVarIO warningsVar
|
||||
errs <- readTVarIO errsVar
|
||||
when (not $ null errs) $ throwM $ BuildException errs warnings
|
||||
return warnings
|
||||
where
|
||||
withBuildDir f = withSystemTempDirectory "stackage-build" (f . fpFromString)
|
||||
|
||||
fixEnv (p, x)
|
||||
-- Thank you Windows having case-insensitive environment variables...
|
||||
| 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
|
||||
pathSep = ';'
|
||||
#else
|
||||
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)
|
||||
, sbWarningsVar :: TVar ([Text] -> [Text])
|
||||
, sbActive :: TVar Int
|
||||
, sbToolMap :: Map ExeName (Set PackageName)
|
||||
, sbPackageMap :: Map PackageName PackageInfo
|
||||
, sbBuildDir :: FilePath
|
||||
, sbPackageInfo :: PackageInfo
|
||||
, sbRegisterMutex :: MVar ()
|
||||
, sbModifiedEnv :: [(String, String)]
|
||||
, sbHaddockFiles :: TVar (Map Text FilePath) -- ^ package-version, .haddock file
|
||||
}
|
||||
|
||||
singleBuild :: PerformBuild
|
||||
-> Set PackageName -- ^ registered packages
|
||||
-> SingleBuild -> IO ()
|
||||
singleBuild pb@PerformBuild {..} registeredPackages SingleBuild {..} =
|
||||
withCounter sbActive
|
||||
$ handle updateErrs
|
||||
$ (`finally` void (atomically $ tryPutTMVar (piResult sbPackageInfo) False))
|
||||
$ inner
|
||||
where
|
||||
libComps = setFromList [CompLibrary, CompExecutable]
|
||||
testComps = insertSet CompTestSuite libComps
|
||||
inner = do
|
||||
let wfd comps =
|
||||
waitForDeps sbToolMap sbPackageMap comps pbPlan sbPackageInfo
|
||||
. withTSem sbSem
|
||||
withUnpacked <- wfd libComps buildLibrary
|
||||
|
||||
wfd testComps (runTests withUnpacked)
|
||||
|
||||
pname = piName sbPackageInfo
|
||||
pident = PackageIdentifier pname (ppVersion $ piPlan sbPackageInfo)
|
||||
name = display pname
|
||||
namever = concat
|
||||
[ name
|
||||
, "-"
|
||||
, display $ ppVersion $ piPlan sbPackageInfo
|
||||
]
|
||||
|
||||
runIn wdir getOutH cmd args = do
|
||||
outH <- getOutH
|
||||
withCheckedProcess (cp outH) $ \ClosedStream UseProvidedHandle UseProvidedHandle ->
|
||||
(return () :: IO ())
|
||||
where
|
||||
cp outH = (proc (unpack $ asText cmd) (map (unpack . asText) args))
|
||||
{ cwd = Just $ fpToString wdir
|
||||
, std_out = UseHandle outH
|
||||
, std_err = UseHandle outH
|
||||
, env = Just sbModifiedEnv
|
||||
}
|
||||
runParent = runIn sbBuildDir
|
||||
runChild = runIn childDir
|
||||
childDir = sbBuildDir </> fpFromText namever
|
||||
|
||||
log' t = do
|
||||
i <- readTVarIO sbActive
|
||||
errs <- readTVarIO sbErrsVar
|
||||
pbLog $ encodeUtf8 $ concat
|
||||
[ t
|
||||
, " (pending: "
|
||||
, tshow i
|
||||
, ", failures: "
|
||||
, tshow $ length errs
|
||||
, ")\n"
|
||||
]
|
||||
libOut = pbLogDir </> fpFromText namever </> "build.out"
|
||||
testOut = pbLogDir </> fpFromText namever </> "test.out"
|
||||
testRunOut = pbLogDir </> fpFromText namever </> "test-run.out"
|
||||
|
||||
wf fp inner' = do
|
||||
ref <- newIORef Nothing
|
||||
let cleanup = do
|
||||
mh <- readIORef ref
|
||||
forM_ mh hClose
|
||||
getH = do
|
||||
mh <- readIORef ref
|
||||
case mh of
|
||||
Just h -> return h
|
||||
Nothing -> mask_ $ do
|
||||
createTree $ parent fp
|
||||
h <- openBinaryFile (fpToString fp) WriteMode
|
||||
writeIORef ref $ Just h
|
||||
return h
|
||||
|
||||
inner' getH `finally` cleanup
|
||||
|
||||
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
|
||||
tell' $ "--libdir=" ++ fpToText (pbLibDir pb)
|
||||
tell' $ "--bindir=" ++ fpToText (pbBinDir pb)
|
||||
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:)
|
||||
|
||||
flags :: Text
|
||||
flags = unwords $ map go $ mapToList pcFlagOverrides
|
||||
where
|
||||
go (name', isOn) = concat
|
||||
[ if isOn then "" else "-"
|
||||
, unFlagName name'
|
||||
]
|
||||
|
||||
PackageConstraints {..} = ppConstraints $ piPlan sbPackageInfo
|
||||
|
||||
buildLibrary = wf libOut $ \getOutH -> do
|
||||
let run a b = do when pbVerbose $ log' (unwords (a : b))
|
||||
runChild getOutH a b
|
||||
|
||||
isUnpacked <- newIORef False
|
||||
let withUnpacked inner = do
|
||||
unlessM (readIORef isUnpacked) $ do
|
||||
log' $ "Unpacking " ++ namever
|
||||
runParent getOutH "cabal" ["unpack", namever]
|
||||
writeIORef isUnpacked True
|
||||
inner
|
||||
|
||||
isConfiged <- newIORef False
|
||||
let withConfiged inner = withUnpacked $ do
|
||||
unlessM (readIORef isConfiged) $ do
|
||||
log' $ "Configuring " ++ namever
|
||||
run "cabal" $ "configure" : configArgs
|
||||
writeIORef isConfiged True
|
||||
inner
|
||||
|
||||
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
|
||||
--
|
||||
-- FIXME do we need to wait to do this until after Haddocks build?
|
||||
-- otherwise, we could have a race condition and try to build a
|
||||
-- dependency's haddocks before this finishes
|
||||
atomically $ putTMVar (piResult sbPackageInfo) True
|
||||
|
||||
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
|
||||
[ "--haddock-options=--read-interface="
|
||||
, "../"
|
||||
, pkgVer
|
||||
, "/,"
|
||||
, fpToText hf
|
||||
]
|
||||
args = ($ hfsOpts) $ execWriter $ do
|
||||
let tell' x = tell (x:)
|
||||
tell' "haddock"
|
||||
tell' "--hyperlink-source"
|
||||
tell' "--html"
|
||||
when pbBuildHoogle $ tell' "--hoogle"
|
||||
tell' "--html-location=../$pkg-$version/"
|
||||
|
||||
eres <- tryAny $ run "cabal" args
|
||||
|
||||
forM_ eres $ \() -> do
|
||||
renameOrCopy
|
||||
(childDir </> "dist" </> "doc" </> "html" </> fpFromText name)
|
||||
(pbDocDir pb </> fpFromText namever)
|
||||
|
||||
enewPath <- tryIO
|
||||
$ canonicalizePath
|
||||
$ pbDocDir pb
|
||||
</> fpFromText namever
|
||||
</> fpFromText name <.> "haddock"
|
||||
case enewPath of
|
||||
Left e -> warn $ tshow e
|
||||
Right newPath -> atomically
|
||||
$ 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 ()
|
||||
|
||||
return withUnpacked
|
||||
|
||||
runTests withUnpacked = wf testOut $ \getOutH -> do
|
||||
let run = runChild getOutH
|
||||
|
||||
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
|
||||
|
||||
eres <- tryAny $ do
|
||||
log' $ "Test build " ++ namever
|
||||
run "cabal" ["build"]
|
||||
|
||||
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"
|
||||
_ -> return ()
|
||||
|
||||
warn t = atomically $ modifyTVar sbWarningsVar (. (t:))
|
||||
|
||||
updateErrs exc = do
|
||||
log' $ concat
|
||||
[ display (piName sbPackageInfo)
|
||||
, ": "
|
||||
, tshow exc
|
||||
]
|
||||
atomically $ modifyTVar sbErrsVar $ insertMap (piName sbPackageInfo) exc'
|
||||
where
|
||||
exc' =
|
||||
case fromException exc of
|
||||
Just bf -> bf
|
||||
Nothing -> BuildFailureException exc
|
||||
|
||||
renameOrCopy :: FilePath -> FilePath -> IO ()
|
||||
renameOrCopy src dest = rename src dest `catchIO` \_ -> copyDir src dest
|
||||
|
||||
copyBuiltInHaddocks :: FilePath -> IO ()
|
||||
copyBuiltInHaddocks docdir = do
|
||||
mghc <- findExecutable "ghc"
|
||||
case mghc of
|
||||
Nothing -> error "GHC not found on PATH"
|
||||
Just ghc -> 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
|
||||
@ -1,116 +0,0 @@
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
module Stackage.Prelude
|
||||
( module X
|
||||
, module Stackage.Prelude
|
||||
) where
|
||||
|
||||
import ClassyPrelude.Conduit as X
|
||||
import Data.Aeson (FromJSON, ToJSON)
|
||||
import Data.Conduit.Process as X
|
||||
import qualified Data.Map as Map
|
||||
import Data.Typeable (TypeRep, typeOf)
|
||||
import Distribution.Package as X (PackageIdentifier (..), PackageName (PackageName))
|
||||
import Distribution.PackageDescription as X (FlagName (..), GenericPackageDescription)
|
||||
import qualified Distribution.Text as DT
|
||||
import Distribution.Version as X (Version (..),
|
||||
VersionRange)
|
||||
import Distribution.Version as X (withinRange)
|
||||
import qualified Distribution.Version as C
|
||||
import Filesystem (createTree)
|
||||
import Filesystem.Path (parent)
|
||||
import qualified Filesystem.Path as F
|
||||
|
||||
unPackageName :: PackageName -> Text
|
||||
unPackageName (PackageName str) = pack str
|
||||
|
||||
unFlagName :: FlagName -> Text
|
||||
unFlagName (FlagName str) = pack str
|
||||
|
||||
mkPackageName :: Text -> PackageName
|
||||
mkPackageName = PackageName . unpack
|
||||
|
||||
mkFlagName :: Text -> FlagName
|
||||
mkFlagName = FlagName . unpack
|
||||
|
||||
display :: DT.Text a => a -> Text
|
||||
display = fromString . DT.display
|
||||
|
||||
simpleParse :: (MonadThrow m, DT.Text a, Typeable a) => Text -> m a
|
||||
simpleParse orig = withTypeRep $ \rep ->
|
||||
case DT.simpleParse str of
|
||||
Nothing -> throwM (ParseFailedException rep (pack str))
|
||||
Just v -> return v
|
||||
where
|
||||
str = unpack orig
|
||||
|
||||
withTypeRep :: Typeable a => (TypeRep -> m a) -> m a
|
||||
withTypeRep f =
|
||||
res
|
||||
where
|
||||
res = f (typeOf (unwrap res))
|
||||
|
||||
unwrap :: m a -> a
|
||||
unwrap _ = error "unwrap"
|
||||
|
||||
data ParseFailedException = ParseFailedException TypeRep Text
|
||||
deriving (Show, Typeable)
|
||||
instance Exception ParseFailedException
|
||||
|
||||
newtype Maintainer = Maintainer { unMaintainer :: Text }
|
||||
deriving (Show, Eq, Ord, Hashable, ToJSON, FromJSON, IsString)
|
||||
|
||||
-- | Name of an executable.
|
||||
newtype ExeName = ExeName { unExeName :: Text }
|
||||
deriving (Show, Eq, Ord, Hashable, ToJSON, FromJSON, IsString)
|
||||
|
||||
intersectVersionRanges :: VersionRange -> VersionRange -> VersionRange
|
||||
intersectVersionRanges x y = C.simplifyVersionRange $ C.intersectVersionRanges x y
|
||||
|
||||
-- | There seems to be a bug in Cabal where serializing and deserializing
|
||||
-- version ranges winds up with different representations. So we have a
|
||||
-- super-simplifier to deal with that.
|
||||
simplifyVersionRange :: VersionRange -> VersionRange
|
||||
simplifyVersionRange vr =
|
||||
fromMaybe (assert False vr') $ simpleParse $ display vr'
|
||||
where
|
||||
vr' = C.simplifyVersionRange vr
|
||||
|
||||
-- | Topologically sort so that items with dependencies occur after those
|
||||
-- dependencies.
|
||||
topologicalSort :: (Ord key, Show key, MonadThrow m, Typeable key)
|
||||
=> (value -> finalValue)
|
||||
-> (value -> Set key) -- ^ deps
|
||||
-> Map key value
|
||||
-> m (Vector (key, finalValue))
|
||||
topologicalSort toFinal toDeps =
|
||||
loop id . mapWithKey removeSelfDeps . fmap (toDeps &&& toFinal)
|
||||
where
|
||||
removeSelfDeps k (deps, final) = (deleteSet k deps, final)
|
||||
loop front toProcess | null toProcess = return $ pack $ front []
|
||||
loop front toProcess
|
||||
| null noDeps = throwM $ NoEmptyDeps (map fst toProcess')
|
||||
| otherwise = loop (front . noDeps') (mapFromList hasDeps)
|
||||
where
|
||||
toProcess' = fmap (first removeUnavailable) toProcess
|
||||
allKeys = Map.keysSet toProcess
|
||||
removeUnavailable = asSet . setFromList . filter (`member` allKeys) . setToList
|
||||
(noDeps, hasDeps) = partition (null . fst . snd) $ mapToList toProcess'
|
||||
noDeps' = (map (second snd) noDeps ++)
|
||||
|
||||
data TopologicalSortException key = NoEmptyDeps (Map key (Set key))
|
||||
deriving (Show, Typeable)
|
||||
instance (Show key, Typeable key) => Exception (TopologicalSortException key)
|
||||
|
||||
copyDir :: FilePath -> FilePath -> IO ()
|
||||
copyDir src dest =
|
||||
runResourceT $ sourceDirectoryDeep False src $$ mapM_C go
|
||||
where
|
||||
src' = src </> ""
|
||||
go fp = forM_ (F.stripPrefix src' fp) $ \suffix -> do
|
||||
let dest' = dest </> suffix
|
||||
liftIO $ createTree $ parent dest'
|
||||
sourceFile fp $$ (sinkFile dest' :: Sink ByteString (ResourceT IO) ())
|
||||
@ -1,271 +0,0 @@
|
||||
-- | Create a bundle to be uploaded to Stackage Server.
|
||||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
module Stackage.ServerBundle
|
||||
( serverBundle
|
||||
, epochTime
|
||||
, bpAllPackages
|
||||
, docsListing
|
||||
, createBundleV2
|
||||
, CreateBundleV2 (..)
|
||||
, SnapshotType (..)
|
||||
, writeIndexStyle
|
||||
, DocMap
|
||||
, PackageDocs (..)
|
||||
) where
|
||||
|
||||
import qualified Codec.Archive.Tar as Tar
|
||||
import qualified Codec.Archive.Tar.Entry as Tar
|
||||
import qualified Codec.Compression.GZip as GZip
|
||||
import qualified Data.Map as M
|
||||
import Data.Aeson (ToJSON (..), (.=), object, FromJSON (..), (.:), withObject)
|
||||
import System.IO.Temp (withTempDirectory)
|
||||
import qualified Data.Yaml as Y
|
||||
import Filesystem (isFile, getWorkingDirectory, listDirectory, isDirectory, canonicalizePath)
|
||||
import Foreign.C.Types (CTime (CTime))
|
||||
import Stackage.BuildConstraints
|
||||
import Stackage.BuildPlan
|
||||
import Stackage.Prelude
|
||||
import System.IO.Temp (withTempDirectory)
|
||||
import qualified System.PosixCompat.Time as PC
|
||||
import qualified Text.XML as X
|
||||
import Text.XML.Cursor
|
||||
import System.PosixCompat.Files (createSymbolicLink)
|
||||
|
||||
-- | Get current time
|
||||
epochTime :: IO Tar.EpochTime
|
||||
epochTime = (\(CTime t) -> fromIntegral t) <$> PC.epochTime
|
||||
|
||||
-- | All package/versions in a build plan, including core packages.
|
||||
--
|
||||
-- Note that this may include packages not available on Hackage.
|
||||
bpAllPackages :: BuildPlan -> Map PackageName Version
|
||||
bpAllPackages BuildPlan {..} =
|
||||
siCorePackages bpSystemInfo ++ map ppVersion bpPackages
|
||||
|
||||
serverBundle :: Tar.EpochTime
|
||||
-> Text -- ^ title
|
||||
-> Text -- ^ slug
|
||||
-> BuildPlan
|
||||
-> LByteString
|
||||
serverBundle time title slug bp@BuildPlan {..} = GZip.compress $ Tar.write
|
||||
[ fe "build-plan.yaml" (fromStrict $ Y.encode bp)
|
||||
, fe "hackage" hackage
|
||||
, fe "slug" (fromStrict $ encodeUtf8 slug)
|
||||
, fe "desc" (fromStrict $ encodeUtf8 title)
|
||||
, fe "core" corePackagesList
|
||||
]
|
||||
where
|
||||
fe name contents =
|
||||
case Tar.toTarPath False name of
|
||||
Left s -> error s
|
||||
Right name' -> (Tar.fileEntry name' contents)
|
||||
{ Tar.entryTime = time
|
||||
}
|
||||
hackage = builderToLazy $ foldMap goPair $ mapToList packageMap
|
||||
|
||||
-- need to remove some packages that don't exist on Hackage
|
||||
packageMap = foldr deleteMap (bpAllPackages bp) $ map PackageName
|
||||
[ "bin-package-db"
|
||||
, "ghc"
|
||||
, "rts"
|
||||
]
|
||||
|
||||
goPair (name, version) =
|
||||
toBuilder (display name) ++
|
||||
toBuilder (asText "-") ++
|
||||
toBuilder (display version) ++
|
||||
toBuilder (asText "\n")
|
||||
|
||||
corePackagesList =
|
||||
builderToLazy $ toBuilder $ unlines $
|
||||
map (\(PackageName name) -> name)
|
||||
(M.keys $ siCorePackages bpSystemInfo)
|
||||
|
||||
-- | Package name is key
|
||||
type DocMap = Map Text PackageDocs
|
||||
data PackageDocs = PackageDocs
|
||||
{ pdVersion :: Text
|
||||
, pdModules :: Map Text [Text]
|
||||
-- ^ module name, path
|
||||
}
|
||||
instance ToJSON PackageDocs where
|
||||
toJSON PackageDocs {..} = object
|
||||
[ "version" .= pdVersion
|
||||
, "modules" .= pdModules
|
||||
]
|
||||
instance FromJSON PackageDocs where
|
||||
parseJSON = withObject "PackageDocs" $ \o -> PackageDocs
|
||||
<$> o .: "version"
|
||||
<*> o .: "modules"
|
||||
|
||||
docsListing :: BuildPlan
|
||||
-> FilePath -- ^ docs directory
|
||||
-> IO DocMap
|
||||
docsListing bp docsDir =
|
||||
fmap fold $ mapM go $ mapToList $ bpAllPackages bp
|
||||
where
|
||||
go :: (PackageName, Version) -> IO DocMap
|
||||
go (package, version) = do -- handleAny (const $ return mempty) $ do
|
||||
let dirname = fpFromText (concat
|
||||
[ display package
|
||||
, "-"
|
||||
, display version
|
||||
])
|
||||
indexFP = (docsDir </> dirname </> "index.html")
|
||||
ie <- isFile indexFP
|
||||
if ie
|
||||
then do
|
||||
doc <- flip X.readFile indexFP X.def
|
||||
{ X.psDecodeEntities = X.decodeHtmlEntities
|
||||
}
|
||||
let cursor = fromDocument doc
|
||||
getPair x = take 1 $ do
|
||||
href <- attribute "href" x
|
||||
let name = concat $ x $// content
|
||||
guard $ not $ null name
|
||||
return (href, name)
|
||||
pairs = cursor $// attributeIs "class" "module"
|
||||
&/ laxElement "a" >=> getPair
|
||||
m <- fmap fold $ forM pairs $ \(href, name) -> do
|
||||
let suffix = dirname </> fpFromText href
|
||||
e <- isFile $ docsDir </> suffix
|
||||
return $ if e
|
||||
then asMap $ singletonMap name [fpToText dirname, href]
|
||||
else mempty
|
||||
return $ singletonMap (display package) $ PackageDocs
|
||||
{ pdVersion = display version
|
||||
, pdModules = m
|
||||
}
|
||||
else return mempty
|
||||
|
||||
data SnapshotType = STNightly
|
||||
| STLTS !Int !Int -- ^ major, minor
|
||||
deriving (Show, Read, Eq, Ord)
|
||||
|
||||
instance ToJSON SnapshotType where
|
||||
toJSON STNightly = object
|
||||
[ "type" .= asText "nightly"
|
||||
]
|
||||
toJSON (STLTS major minor) = object
|
||||
[ "type" .= asText "lts"
|
||||
, "major" .= major
|
||||
, "minor" .= minor
|
||||
]
|
||||
instance FromJSON SnapshotType where
|
||||
parseJSON = withObject "SnapshotType" $ \o -> do
|
||||
t <- o .: "type"
|
||||
case asText t of
|
||||
"nightly" -> return STNightly
|
||||
"lts" -> STLTS
|
||||
<$> o .: "major"
|
||||
<*> o .: "minor"
|
||||
_ -> fail $ "Unknown type for SnapshotType: " ++ unpack t
|
||||
|
||||
data CreateBundleV2 = CreateBundleV2
|
||||
{ cb2Plan :: BuildPlan
|
||||
, cb2Type :: SnapshotType
|
||||
, cb2DocsDir :: FilePath
|
||||
, cb2Dest :: FilePath
|
||||
}
|
||||
|
||||
-- | Create a V2 bundle, which contains the build plan, metadata, docs, and doc
|
||||
-- map.
|
||||
createBundleV2 :: CreateBundleV2 -> IO ()
|
||||
createBundleV2 CreateBundleV2 {..} = do
|
||||
docsDir <- canonicalizePath cb2DocsDir
|
||||
docMap <- docsListing cb2Plan cb2DocsDir
|
||||
|
||||
Y.encodeFile (fpToString $ docsDir </> "build-plan.yaml") cb2Plan
|
||||
Y.encodeFile (fpToString $ docsDir </> "build-type.yaml") cb2Type
|
||||
Y.encodeFile (fpToString $ docsDir </> "docs-map.yaml") docMap
|
||||
void $ writeIndexStyle Nothing cb2DocsDir
|
||||
|
||||
currentDir <- getWorkingDirectory
|
||||
files <- listDirectory docsDir
|
||||
|
||||
let args = "cfJ"
|
||||
: fpToString (currentDir </> cb2Dest)
|
||||
: "--dereference"
|
||||
: map (fpToString . filename) files
|
||||
cp = (proc "tar" args) { cwd = Just $ fpToString docsDir }
|
||||
withCheckedProcess cp $ \ClosedStream Inherited Inherited -> return ()
|
||||
|
||||
writeIndexStyle :: Maybe Text -- ^ snapshot id
|
||||
-> FilePath -- ^ docs dir
|
||||
-> IO [String]
|
||||
writeIndexStyle msnapid dir = do
|
||||
dirs <- fmap sort
|
||||
$ runResourceT
|
||||
$ sourceDirectory dir
|
||||
$$ filterMC (liftIO . isDirectory)
|
||||
=$ mapC (fpToString . filename)
|
||||
=$ sinkList
|
||||
writeFile (dir </> "index.html") $ mkIndex
|
||||
(unpack <$> msnapid)
|
||||
dirs
|
||||
writeFile (dir </> "style.css") styleCss
|
||||
return dirs
|
||||
|
||||
mkIndex :: Maybe String -> [String] -> String
|
||||
mkIndex msnapid dirs = concat
|
||||
[ "<!DOCTYPE html>\n<html lang='en'><head><title>Haddocks index</title>"
|
||||
, "<link rel='stylesheet' href='https://maxcdn.bootstrapcdn.com/bootstrap/3.2.0/css/bootstrap.min.css'>"
|
||||
, "<link rel='stylesheet' href='style.css'>"
|
||||
, "<link rel='shortcut icon' href='http://www.stackage.org/static/img/favicon.ico' />"
|
||||
, "</head>"
|
||||
, "<body><div class='container'>"
|
||||
, "<div class='row'><div class='span12 col-md-12'>"
|
||||
, "<h1>Haddock documentation index</h1>"
|
||||
, flip foldMap msnapid $ \snapid -> concat
|
||||
[ "<p class='return'><a href=\"http://www.stackage.org/stackage/"
|
||||
, snapid
|
||||
, "\">Return to snapshot</a></p>"
|
||||
]
|
||||
, "<ul>"
|
||||
, concatMap toLI dirs
|
||||
, "</ul></div></div></div></body></html>"
|
||||
]
|
||||
where
|
||||
toLI name = concat
|
||||
[ "<li><a href='"
|
||||
, name
|
||||
, "/index.html'>"
|
||||
, name
|
||||
, "</a></li>"
|
||||
]
|
||||
|
||||
styleCss :: String
|
||||
styleCss = concat
|
||||
[ "@media (min-width: 530px) {"
|
||||
, "ul { -webkit-column-count: 2; -moz-column-count: 2; column-count: 2 }"
|
||||
, "}"
|
||||
, "@media (min-width: 760px) {"
|
||||
, "ul { -webkit-column-count: 3; -moz-column-count: 3; column-count: 3 }"
|
||||
, "}"
|
||||
, "ul {"
|
||||
, " margin-left: 0;"
|
||||
, " padding-left: 0;"
|
||||
, " list-style-type: none;"
|
||||
, "}"
|
||||
, "body {"
|
||||
, " background: #f0f0f0;"
|
||||
, " font-family: 'Lato', sans-serif;"
|
||||
, " text-shadow: 1px 1px 1px #ffffff;"
|
||||
, " font-size: 20px;"
|
||||
, " line-height: 30px;"
|
||||
, " padding-bottom: 5em;"
|
||||
, "}"
|
||||
, "h1 {"
|
||||
, " font-weight: normal;"
|
||||
, " color: #06537d;"
|
||||
, " font-size: 45px;"
|
||||
, "}"
|
||||
, ".return a {"
|
||||
, " color: #06537d;"
|
||||
, " font-style: italic;"
|
||||
, "}"
|
||||
, ".return {"
|
||||
, " margin-bottom: 1em;"
|
||||
, "}"]
|
||||
@ -1,54 +0,0 @@
|
||||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
-- | Take an existing build plan and bump all packages to the newest version in
|
||||
-- the same major version number.
|
||||
module Stackage.UpdateBuildPlan
|
||||
( updateBuildConstraints
|
||||
, updateBuildPlan
|
||||
) where
|
||||
|
||||
import qualified Data.Map as Map
|
||||
import Distribution.Version (anyVersion, earlierVersion,
|
||||
orLaterVersion)
|
||||
import Stackage.BuildConstraints
|
||||
import Stackage.BuildPlan
|
||||
import Stackage.Prelude
|
||||
|
||||
updateBuildPlan :: Map PackageName PackagePlan -> BuildPlan -> IO BuildPlan
|
||||
updateBuildPlan packagesOrig
|
||||
= newBuildPlan packagesOrig . updateBuildConstraints
|
||||
|
||||
updateBuildConstraints :: BuildPlan -> BuildConstraints
|
||||
updateBuildConstraints BuildPlan {..} =
|
||||
BuildConstraints {..}
|
||||
where
|
||||
bcSystemInfo = bpSystemInfo
|
||||
bcPackages = Map.keysSet bpPackages
|
||||
bcGithubUsers = bpGithubUsers
|
||||
|
||||
bcPackageConstraints name = PackageConstraints
|
||||
{ pcVersionRange = addBumpRange (maybe anyVersion pcVersionRange moldPC)
|
||||
, pcMaintainer = moldPC >>= pcMaintainer
|
||||
, pcTests = maybe ExpectSuccess pcTests moldPC
|
||||
, 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
|
||||
moldPC = ppConstraints <$> moldBP
|
||||
|
||||
addBumpRange oldRange =
|
||||
case moldBP of
|
||||
Nothing -> oldRange
|
||||
Just bp -> intersectVersionRanges oldRange
|
||||
$ bumpRange $ ppVersion bp
|
||||
|
||||
bumpRange version = intersectVersionRanges
|
||||
(orLaterVersion version)
|
||||
(earlierVersion $ bumpVersion version)
|
||||
bumpVersion (Version (x:y:_) _) = Version [x, y + 1] []
|
||||
bumpVersion (Version [x] _) = Version [x, 1] []
|
||||
bumpVersion (Version [] _) = assert False $ Version [1, 0] []
|
||||
@ -1,272 +0,0 @@
|
||||
-- | Upload to Stackage and Hackage
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
module Stackage.Upload
|
||||
( UploadBundle (..)
|
||||
, SnapshotIdent (..)
|
||||
, uploadBundle
|
||||
, UploadDocs (..)
|
||||
, uploadDocs
|
||||
, uploadHackageDistro
|
||||
, uploadHackageDistroNamed
|
||||
, UploadDocMap (..)
|
||||
, uploadDocMap
|
||||
, uploadBundleV2
|
||||
, UploadBundleV2 (..)
|
||||
, def
|
||||
, StackageServer
|
||||
, unStackageServer
|
||||
) where
|
||||
|
||||
import Control.Monad.Writer.Strict (execWriter, tell)
|
||||
import Data.Default.Class (Default (..))
|
||||
import Data.Function (fix)
|
||||
import Filesystem (isDirectory, isFile)
|
||||
import Network.HTTP.Client
|
||||
import qualified Network.HTTP.Client.Conduit as HCC
|
||||
import Network.HTTP.Client.MultipartFormData
|
||||
import Stackage.BuildPlan (BuildPlan)
|
||||
import Stackage.Prelude
|
||||
import Stackage.ServerBundle (bpAllPackages, docsListing, writeIndexStyle)
|
||||
import System.IO.Temp (withSystemTempFile)
|
||||
import qualified System.IO as IO
|
||||
import qualified Data.Yaml as Y
|
||||
|
||||
newtype StackageServer = StackageServer { unStackageServer :: Text }
|
||||
deriving (Show, Eq, Ord, Hashable, IsString)
|
||||
instance Default StackageServer where
|
||||
def = "http://www.stackage.org"
|
||||
|
||||
data UploadBundle = UploadBundle
|
||||
{ ubServer :: StackageServer
|
||||
, ubContents :: LByteString
|
||||
, ubAlias :: Maybe Text
|
||||
, ubNightly :: Maybe Text -- ^ should be GHC version
|
||||
, ubLTS :: Maybe Text -- ^ e.g. 2.3
|
||||
, ubAuthToken :: Text
|
||||
}
|
||||
instance Default UploadBundle where
|
||||
def = UploadBundle
|
||||
{ ubServer = def
|
||||
, ubContents = mempty
|
||||
, ubAlias = Nothing
|
||||
, ubNightly = Nothing
|
||||
, ubLTS = Nothing
|
||||
, ubAuthToken = "no-auth-token-provided"
|
||||
}
|
||||
|
||||
newtype SnapshotIdent = SnapshotIdent { unSnapshotIdent :: Text }
|
||||
deriving (Show, Eq, Ord, Hashable, IsString)
|
||||
|
||||
uploadBundle :: UploadBundle -> Manager -> IO (SnapshotIdent, Maybe Text)
|
||||
uploadBundle UploadBundle {..} man = do
|
||||
req1 <- parseUrl $ unpack $ unStackageServer ubServer ++ "/upload"
|
||||
req2 <- formDataBody formData req1
|
||||
let req3 = req2
|
||||
{ method = "PUT"
|
||||
, requestHeaders =
|
||||
[ ("Authorization", encodeUtf8 ubAuthToken)
|
||||
, ("Accept", "application/json")
|
||||
] ++ requestHeaders req2
|
||||
, redirectCount = 0
|
||||
, checkStatus = \_ _ _ -> Nothing
|
||||
, responseTimeout = Just 300000000
|
||||
}
|
||||
res <- httpLbs req3 man
|
||||
case lookup "x-stackage-ident" $ responseHeaders res of
|
||||
Just snapid -> return
|
||||
( SnapshotIdent $ decodeUtf8 snapid
|
||||
, decodeUtf8 <$> lookup "location" (responseHeaders res)
|
||||
)
|
||||
Nothing -> error $ "An error occurred: " ++ show res
|
||||
where
|
||||
params = mapMaybe (\(x, y) -> (x, ) <$> y)
|
||||
[ ("alias", ubAlias)
|
||||
, ("nightly", ubNightly)
|
||||
, ("lts", ubLTS)
|
||||
]
|
||||
formData = ($ []) $ execWriter $ do
|
||||
forM_ params $ \(key, value) ->
|
||||
tell' $ partBS key $ encodeUtf8 value
|
||||
tell' $ partFileRequestBody "stackage" "stackage"
|
||||
$ RequestBodyLBS ubContents
|
||||
|
||||
tell' x = tell (x:)
|
||||
|
||||
data UploadDocs = UploadDocs
|
||||
{ udServer :: StackageServer
|
||||
, udDocs :: FilePath -- ^ may be a directory or a tarball
|
||||
, udAuthToken :: Text
|
||||
, udSnapshot :: SnapshotIdent
|
||||
}
|
||||
|
||||
uploadDocs :: UploadDocs -> Manager -> IO (Response LByteString)
|
||||
uploadDocs (UploadDocs (StackageServer host) fp0 token ident) man = do
|
||||
fe <- isFile fp0
|
||||
if fe
|
||||
then uploadDocsFile $ fpToString fp0
|
||||
else do
|
||||
de <- isDirectory fp0
|
||||
if de
|
||||
then uploadDocsDir
|
||||
else error $ "Path not found: " ++ fpToString fp0
|
||||
where
|
||||
uploadDocsDir = withSystemTempFile "haddocks.tar.xz" $ \fp h -> do
|
||||
hClose h
|
||||
dirs <- writeIndexStyle (Just $ unSnapshotIdent ident) fp0
|
||||
let cp = (proc "tar" $ "cJf" : fp : "index.html" : "style.css" : dirs)
|
||||
{ cwd = Just $ fpToString fp0
|
||||
}
|
||||
withCheckedProcess cp $ \Inherited Inherited Inherited -> return ()
|
||||
uploadDocsFile fp
|
||||
uploadDocsFile fp = do
|
||||
req1 <- parseUrl $ unpack $ concat
|
||||
[ host
|
||||
, "/upload-haddock/"
|
||||
, unSnapshotIdent ident
|
||||
]
|
||||
let formData =
|
||||
[ partFileSource "tarball" fp
|
||||
]
|
||||
req2 <- formDataBody formData req1
|
||||
let req3 = req2
|
||||
{ method = "PUT"
|
||||
, requestHeaders =
|
||||
[ ("Authorization", encodeUtf8 token)
|
||||
, ("Accept", "application/json")
|
||||
] ++ requestHeaders req2
|
||||
, redirectCount = 0
|
||||
, checkStatus = \_ _ _ -> Nothing
|
||||
, responseTimeout = Just 300000000
|
||||
}
|
||||
httpLbs req3 man
|
||||
|
||||
uploadHackageDistro :: BuildPlan
|
||||
-> ByteString -- ^ Hackage username
|
||||
-> ByteString -- ^ Hackage password
|
||||
-> Manager
|
||||
-> IO (Response LByteString)
|
||||
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
|
||||
$ mconcat
|
||||
$ intersperse "\n"
|
||||
$ map go
|
||||
$ mapToList
|
||||
$ bpAllPackages bp
|
||||
go (name, version) =
|
||||
"\"" ++
|
||||
(toBuilder $ display name) ++
|
||||
"\",\"" ++
|
||||
(toBuilder $ display version) ++
|
||||
"\",\"http://www.stackage.org/package/" ++
|
||||
(toBuilder $ display name) ++
|
||||
"\""
|
||||
|
||||
data UploadDocMap = UploadDocMap
|
||||
{ udmServer :: StackageServer
|
||||
, udmAuthToken :: Text
|
||||
, udmSnapshot :: SnapshotIdent
|
||||
, udmDocDir :: FilePath
|
||||
, udmPlan :: BuildPlan
|
||||
}
|
||||
|
||||
uploadDocMap :: UploadDocMap -> Manager -> IO (Response LByteString)
|
||||
uploadDocMap UploadDocMap {..} man = do
|
||||
docmap <- docsListing udmPlan udmDocDir
|
||||
req1 <- parseUrl $ unpack $ unStackageServer udmServer ++ "/upload-doc-map"
|
||||
req2 <- formDataBody (formData $ Y.encode docmap) req1
|
||||
let req3 = req2
|
||||
{ method = "PUT"
|
||||
, requestHeaders =
|
||||
[ ("Authorization", encodeUtf8 udmAuthToken)
|
||||
, ("Accept", "application/json")
|
||||
] ++ requestHeaders req2
|
||||
, redirectCount = 0
|
||||
, checkStatus = \_ _ _ -> Nothing
|
||||
, responseTimeout = Just 300000000
|
||||
}
|
||||
httpLbs req3 man
|
||||
where
|
||||
formData docmap =
|
||||
[ partBS "snapshot" (encodeUtf8 $ unSnapshotIdent udmSnapshot)
|
||||
, partFileRequestBody "docmap" "docmap" $ RequestBodyBS docmap
|
||||
]
|
||||
|
||||
data UploadBundleV2 = UploadBundleV2
|
||||
{ ub2Server :: StackageServer
|
||||
, ub2AuthToken :: Text
|
||||
, ub2Bundle :: FilePath
|
||||
}
|
||||
|
||||
uploadBundleV2 :: UploadBundleV2 -> Manager -> IO Text
|
||||
uploadBundleV2 UploadBundleV2 {..} man = IO.withBinaryFile (fpToString ub2Bundle) IO.ReadMode $ \h -> do
|
||||
size <- IO.hFileSize h
|
||||
putStrLn $ "Bundle size: " ++ tshow size
|
||||
req1 <- parseUrl $ unpack $ unStackageServer ub2Server ++ "/upload2"
|
||||
let req2 = req1
|
||||
{ method = "PUT"
|
||||
, requestHeaders =
|
||||
[ ("Authorization", encodeUtf8 ub2AuthToken)
|
||||
, ("Accept", "application/json")
|
||||
, ("Content-Type", "application/x-tar")
|
||||
]
|
||||
, requestBody = HCC.requestBodySource (fromIntegral size)
|
||||
$ sourceHandle h $= printProgress size
|
||||
}
|
||||
sink = decodeUtf8C =$ fix (\loop -> do
|
||||
mx <- peekC
|
||||
case mx of
|
||||
Nothing -> error $ "uploadBundleV2: premature end of stream"
|
||||
Just _ -> do
|
||||
l <- lineC $ takeCE 4096 =$ foldC
|
||||
let (cmd, msg') = break (== ':') l
|
||||
msg = dropWhile (== ' ') $ dropWhile (== ':') msg'
|
||||
case cmd of
|
||||
"CONT" -> do
|
||||
putStrLn msg
|
||||
loop
|
||||
"FAILURE" -> error $ "uploadBundleV2 failed: " ++ unpack msg
|
||||
"SUCCESS" -> return msg
|
||||
_ -> error $ "uploadBundleV2: unknown command " ++ unpack cmd
|
||||
)
|
||||
withResponse req2 man $ \res -> HCC.bodyReaderSource (responseBody res) $$ sink
|
||||
where
|
||||
printProgress total =
|
||||
loop 0 0
|
||||
where
|
||||
loop sent lastPercent =
|
||||
await >>= maybe (putStrLn "Upload complete") go
|
||||
where
|
||||
go bs = do
|
||||
yield bs
|
||||
let sent' = sent + fromIntegral (length bs)
|
||||
percent = sent' * 100 `div` total
|
||||
when (percent /= lastPercent)
|
||||
$ putStrLn $ "Upload progress: " ++ tshow percent ++ "%"
|
||||
loop sent' percent
|
||||
210
app/stackage.hs
210
app/stackage.hs
@ -1,210 +0,0 @@
|
||||
{-# 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 Stackage.Upload
|
||||
import Stackage.InstallBuild
|
||||
import Network.HTTP.Client (withManager)
|
||||
import Network.HTTP.Client.TLS (tlsManagerSettings)
|
||||
import qualified Data.Text as T
|
||||
|
||||
main :: IO ()
|
||||
main =
|
||||
join $
|
||||
execParser $
|
||||
info
|
||||
(helpOption <*> versionOption <*> config)
|
||||
(header "Stackage" <>
|
||||
fullDesc)
|
||||
where
|
||||
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
|
||||
uploadv2
|
||||
uploadv2Flags
|
||||
"upload2"
|
||||
"Upload a pre-existing v2 bundle"
|
||||
]
|
||||
|
||||
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") <*>
|
||||
switch
|
||||
(long "upload-v1" <>
|
||||
help "Use the V1 upload code") <*>
|
||||
(fmap fromString (strOption
|
||||
(long "server-url" <>
|
||||
metavar "SERVER-URL" <>
|
||||
showDefault <> value (T.unpack $ unStackageServer def) <>
|
||||
help "Server to upload bundle to"))) <*>
|
||||
fmap
|
||||
not
|
||||
(switch
|
||||
(long "skip-hoogle" <>
|
||||
help "Skip generating Hoogle input files"))
|
||||
|
||||
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") <*>
|
||||
fmap
|
||||
not
|
||||
(switch
|
||||
(long "skip-hoogle" <>
|
||||
help "Skip generating Hoogle input files"))
|
||||
|
||||
uploadv2 (path, url) = withManager tlsManagerSettings $ \man -> do
|
||||
token <- getStackageAuthToken
|
||||
res <- flip uploadBundleV2 man UploadBundleV2
|
||||
{ ub2AuthToken = token
|
||||
, ub2Server = fromString url
|
||||
, ub2Bundle = decodeString path
|
||||
}
|
||||
putStrLn $ "New URL: " ++ T.unpack res
|
||||
|
||||
uploadv2Flags = (,)
|
||||
<$> (strArgument
|
||||
(metavar "BUNDLE-PATH" <>
|
||||
help "Bundle path"))
|
||||
<*> strOption
|
||||
(long "server-url" <>
|
||||
metavar "SERVER-URL" <>
|
||||
showDefault <> value (T.unpack $ unStackageServer def) <>
|
||||
help "Server to upload bundle to")
|
||||
@ -93,6 +93,7 @@ packages:
|
||||
- shelly
|
||||
- smtLib
|
||||
- stackage
|
||||
- stackage-curator
|
||||
- statistics-linreg
|
||||
- th-expand-syns
|
||||
- thyme
|
||||
|
||||
847
cabal.config
847
cabal.config
@ -1,847 +0,0 @@
|
||||
-- Stackage snapshot from: http://www.stackage.org/snapshot/nightly-2014-12-24
|
||||
-- Please place this file next to your .cabal file as cabal.config
|
||||
-- To only use tested packages, uncomment the following line:
|
||||
-- remote-repo: stackage-nightly-2014-12-24:http://www.stackage.org/snapshot/nightly-2014-12-24
|
||||
constraints: abstract-deque ==0.3,
|
||||
abstract-par ==0.3.3,
|
||||
accelerate ==0.15.0.0,
|
||||
ace ==0.6,
|
||||
action-permutations ==0.0.0.1,
|
||||
active ==0.1.0.17,
|
||||
AC-Vector ==2.3.2,
|
||||
ad ==4.2.1.1,
|
||||
adjunctions ==4.2,
|
||||
aeson ==0.8.0.2,
|
||||
aeson-pretty ==0.7.2,
|
||||
aeson-qq ==0.7.4,
|
||||
aeson-utils ==0.2.2.1,
|
||||
alarmclock ==0.2.0.5,
|
||||
alex ==3.1.3,
|
||||
amqp ==0.10.1,
|
||||
ansi-terminal ==0.6.2.1,
|
||||
ansi-wl-pprint ==0.6.7.1,
|
||||
appar ==0.1.4,
|
||||
approximate ==0.2.1.1,
|
||||
arbtt ==0.8.1.4,
|
||||
arithmoi ==0.4.1.1,
|
||||
array installed,
|
||||
arrow-list ==0.6.1.5,
|
||||
asn1-data ==0.7.1,
|
||||
asn1-encoding ==0.9.0,
|
||||
asn1-parse ==0.9.0,
|
||||
asn1-types ==0.3.0,
|
||||
async ==2.0.2,
|
||||
atto-lisp ==0.2.2,
|
||||
attoparsec ==0.12.1.2,
|
||||
attoparsec-conduit ==1.1.0,
|
||||
attoparsec-enumerator ==0.3.3,
|
||||
attoparsec-expr ==0.1.1.1,
|
||||
authenticate ==1.3.2.11,
|
||||
auto-update ==0.1.2.1,
|
||||
aws ==0.11,
|
||||
bake ==0.2,
|
||||
bank-holidays-england ==0.1.0.1,
|
||||
barecheck ==0.2.0.6,
|
||||
base16-bytestring ==0.1.1.6,
|
||||
base64-bytestring ==1.0.0.1,
|
||||
base-compat ==0.5.0,
|
||||
base-prelude ==0.1.8,
|
||||
base-unicode-symbols ==0.2.2.4,
|
||||
basic-prelude ==0.3.10,
|
||||
bifunctors ==4.2,
|
||||
binary installed,
|
||||
binary-list ==1.0.1.0,
|
||||
bindings-DSL ==1.0.21,
|
||||
bioace ==0.0.1,
|
||||
bioalign ==0.0.5,
|
||||
biocore ==0.3.1,
|
||||
biofasta ==0.0.3,
|
||||
biofastq ==0.1,
|
||||
biophd ==0.0.5,
|
||||
biopsl ==0.4,
|
||||
biosff ==0.3.7.1,
|
||||
bits ==0.4,
|
||||
BlastHTTP ==1.0.1,
|
||||
blastxml ==0.3.2,
|
||||
blaze-builder ==0.3.3.4,
|
||||
blaze-builder-enumerator ==0.2.0.6,
|
||||
blaze-html ==0.7.0.3,
|
||||
blaze-markup ==0.6.1.1,
|
||||
blaze-svg ==0.3.4,
|
||||
blaze-textual ==0.2.0.9,
|
||||
BlogLiterately ==0.7.1.7,
|
||||
BlogLiterately-diagrams ==0.1.4.3,
|
||||
bloodhound ==0.5.0.1,
|
||||
bmp ==1.2.5.2,
|
||||
Boolean ==0.2.3,
|
||||
bool-extras ==0.4.0,
|
||||
bound ==1.0.4,
|
||||
BoundedChan ==1.0.3.0,
|
||||
bson ==0.3.1,
|
||||
bumper ==0.6.0.2,
|
||||
byteable ==0.1.1,
|
||||
bytedump ==1.0,
|
||||
byteorder ==1.0.4,
|
||||
bytes ==0.14.1.2,
|
||||
bytestring installed,
|
||||
bytestring-builder ==0.10.4.0.1,
|
||||
bytestring-lexing ==0.4.3.2,
|
||||
bytestring-mmap ==0.2.2,
|
||||
bytestring-progress ==1.0.3,
|
||||
bytestring-trie ==0.2.4,
|
||||
bzlib ==0.5.0.4,
|
||||
bzlib-conduit ==0.2.1.3,
|
||||
c2hs ==0.20.1,
|
||||
Cabal installed,
|
||||
cabal-install ==1.18.0.6,
|
||||
cabal-src ==0.2.5,
|
||||
cairo ==0.13.0.5,
|
||||
case-insensitive ==1.2.0.3,
|
||||
cases ==0.1.2,
|
||||
cassava ==0.4.2.1,
|
||||
cautious-file ==1.0.2,
|
||||
cereal ==0.4.1.0,
|
||||
cereal-conduit ==0.7.2.3,
|
||||
certificate ==1.3.9,
|
||||
charset ==0.3.7,
|
||||
Chart ==1.3.2,
|
||||
Chart-diagrams ==1.3.2,
|
||||
ChasingBottoms ==1.3.0.8,
|
||||
check-email ==1.0,
|
||||
checkers ==0.4.1,
|
||||
chell ==0.4,
|
||||
chell-quickcheck ==0.2.4,
|
||||
chunked-data ==0.1.0.1,
|
||||
cipher-aes ==0.2.9,
|
||||
cipher-blowfish ==0.0.3,
|
||||
cipher-camellia ==0.0.2,
|
||||
cipher-des ==0.0.6,
|
||||
cipher-rc4 ==0.1.4,
|
||||
circle-packing ==0.1.0.3,
|
||||
classy-prelude ==0.10.2,
|
||||
classy-prelude-conduit ==0.10.2,
|
||||
classy-prelude-yesod ==0.10.2,
|
||||
clientsession ==0.9.1.1,
|
||||
clock ==0.4.1.3,
|
||||
cmdargs ==0.10.12,
|
||||
code-builder ==0.1.3,
|
||||
colour ==2.3.3,
|
||||
comonad ==4.2.2,
|
||||
comonads-fd ==4.0,
|
||||
comonad-transformers ==4.0,
|
||||
compdata ==0.9,
|
||||
compensated ==0.6.1,
|
||||
composition ==1.0.1.0,
|
||||
compressed ==3.10,
|
||||
concatenative ==1.0.1,
|
||||
concurrent-extra ==0.7.0.9,
|
||||
concurrent-supply ==0.1.7,
|
||||
cond ==0.4.1.1,
|
||||
conduit ==1.2.3.1,
|
||||
conduit-combinators ==0.3.0.5,
|
||||
conduit-extra ==1.1.5.1,
|
||||
configurator ==0.3.0.0,
|
||||
connection ==0.2.3,
|
||||
constraints ==0.4.1.1,
|
||||
containers installed,
|
||||
containers-unicode-symbols ==0.3.1.1,
|
||||
contravariant ==1.2,
|
||||
control-monad-free ==0.5.3,
|
||||
control-monad-loop ==0.1,
|
||||
convertible ==1.1.0.0,
|
||||
cookie ==0.4.1.4,
|
||||
courier ==0.1.0.15,
|
||||
cpphs ==1.18.6,
|
||||
cprng-aes ==0.6.1,
|
||||
cpu ==0.1.2,
|
||||
criterion ==1.0.2.0,
|
||||
crypto-api ==0.13.2,
|
||||
cryptocipher ==0.6.2,
|
||||
crypto-cipher-tests ==0.0.11,
|
||||
crypto-cipher-types ==0.0.9,
|
||||
cryptohash ==0.11.6,
|
||||
cryptohash-conduit ==0.1.1,
|
||||
cryptohash-cryptoapi ==0.1.3,
|
||||
crypto-numbers ==0.2.3,
|
||||
crypto-pubkey ==0.2.6,
|
||||
crypto-pubkey-types ==0.4.2.3,
|
||||
crypto-random ==0.0.8,
|
||||
crypto-random-api ==0.2.0,
|
||||
css-text ==0.1.2.1,
|
||||
csv ==0.1.2,
|
||||
csv-conduit ==0.6.3,
|
||||
curl ==1.3.8,
|
||||
data-accessor ==0.2.2.6,
|
||||
data-accessor-mtl ==0.2.0.4,
|
||||
data-binary-ieee754 ==0.4.4,
|
||||
data-default ==0.5.3,
|
||||
data-default-class ==0.0.1,
|
||||
data-default-instances-base ==0.0.1,
|
||||
data-default-instances-containers ==0.0.1,
|
||||
data-default-instances-dlist ==0.0.1,
|
||||
data-default-instances-old-locale ==0.0.1,
|
||||
data-inttrie ==0.1.0,
|
||||
data-lens-light ==0.1.2.1,
|
||||
data-memocombinators ==0.5.1,
|
||||
data-reify ==0.6,
|
||||
DAV ==1.0.3,
|
||||
deepseq installed,
|
||||
deepseq-generics ==0.1.1.2,
|
||||
derive ==2.5.18,
|
||||
diagrams ==1.2,
|
||||
diagrams-builder ==0.6.0.2,
|
||||
diagrams-cairo ==1.2.0.4,
|
||||
diagrams-contrib ==1.1.2.4,
|
||||
diagrams-core ==1.2.0.4,
|
||||
diagrams-haddock ==0.2.2.12,
|
||||
diagrams-lib ==1.2.0.7,
|
||||
diagrams-postscript ==1.1.0.3,
|
||||
diagrams-svg ==1.1.0.3,
|
||||
Diff ==0.3.0,
|
||||
digest ==0.0.1.2,
|
||||
digestive-functors ==0.7.1.3,
|
||||
dimensional ==0.13.0.1,
|
||||
directory installed,
|
||||
directory-tree ==0.12.0,
|
||||
direct-sqlite ==2.3.14,
|
||||
distributed-process ==0.5.3,
|
||||
distributed-process-async ==0.2.0,
|
||||
distributed-process-client-server ==0.1.1,
|
||||
distributed-process-execution ==0.1.0,
|
||||
distributed-process-extras ==0.1.1,
|
||||
distributed-process-simplelocalnet ==0.2.2.0,
|
||||
distributed-process-supervisor ==0.1.1,
|
||||
distributed-process-task ==0.1.0,
|
||||
distributed-static ==0.3.1.0,
|
||||
distributive ==0.4.4,
|
||||
djinn-ghc ==0.0.2.2,
|
||||
djinn-lib ==0.0.1.2,
|
||||
dlist ==0.7.1,
|
||||
dlist-instances ==0.1,
|
||||
doctest ==0.9.11.1,
|
||||
double-conversion ==2.0.1.0,
|
||||
dual-tree ==0.2.0.5,
|
||||
easy-file ==0.2.0,
|
||||
either ==4.3.2.1,
|
||||
elm-build-lib ==0.14.0.0,
|
||||
elm-compiler ==0.14,
|
||||
elm-core-sources ==1.0.0,
|
||||
elm-package ==0.2.2,
|
||||
email-validate ==2.0.1,
|
||||
enclosed-exceptions ==1.0.1,
|
||||
entropy ==0.3.4.1,
|
||||
enumerator ==0.4.20,
|
||||
eq ==4.0.3,
|
||||
erf ==2.0.0.0,
|
||||
errorcall-eq-instance ==0.1.0,
|
||||
errors ==1.4.7,
|
||||
ersatz ==0.2.6.1,
|
||||
esqueleto ==2.1.2.1,
|
||||
exceptions ==0.6.1,
|
||||
exception-transformers ==0.3.0.4,
|
||||
executable-path ==0.0.3,
|
||||
ex-pool ==0.2,
|
||||
extensible-exceptions ==0.1.1.4,
|
||||
extra ==1.0,
|
||||
failure ==0.2.0.3,
|
||||
fast-logger ==2.2.3,
|
||||
fay ==0.21.2.1,
|
||||
fay-base ==0.19.4.1,
|
||||
fay-builder ==0.2.0.1,
|
||||
fay-dom ==0.5,
|
||||
fay-jquery ==0.6.0.2,
|
||||
fay-text ==0.3.2,
|
||||
fay-uri ==0.2.0.0,
|
||||
fb ==1.0.7,
|
||||
fb-persistent ==0.3.4,
|
||||
fclabels ==2.0.2,
|
||||
FenwickTree ==0.1.1,
|
||||
fgl ==5.5.0.1,
|
||||
file-embed ==0.0.7,
|
||||
file-location ==0.4.5.3,
|
||||
filemanip ==0.3.6.2,
|
||||
filepath installed,
|
||||
fingertree ==0.1.0.0,
|
||||
fixed ==0.2.1,
|
||||
fixed-list ==0.1.5,
|
||||
flexible-defaults ==0.0.1.1,
|
||||
focus ==0.1.3,
|
||||
foldl ==1.0.7,
|
||||
force-layout ==0.3.0.8,
|
||||
foreign-store ==0.1,
|
||||
formatting ==6.0.0,
|
||||
fpco-api ==1.2.0.4,
|
||||
free ==4.10.0.1,
|
||||
freenect ==1.2,
|
||||
frisby ==0.2,
|
||||
fsnotify ==0.1.0.3,
|
||||
fuzzcheck ==0.1.1,
|
||||
gd ==3000.7.3,
|
||||
generic-aeson ==0.2.0.2,
|
||||
generic-deriving ==1.6.3,
|
||||
generics-sop ==0.1.0.4,
|
||||
ghc-heap-view ==0.5.3,
|
||||
ghcid ==0.3.3,
|
||||
ghc-mod ==5.2.1.1,
|
||||
ghc-mtl ==1.2.1.0,
|
||||
ghc-paths ==0.1.0.9,
|
||||
ghc-prim installed,
|
||||
ghc-syb-utils ==0.2.2,
|
||||
gio ==0.13.0.3,
|
||||
git-embed ==0.1.0,
|
||||
gl ==0.6.2,
|
||||
glib ==0.13.0.6,
|
||||
Glob ==0.7.5,
|
||||
GLURaw ==1.4.0.1,
|
||||
GLUT ==2.5.1.1,
|
||||
graph-core ==0.2.1.0,
|
||||
graphs ==0.5.0.1,
|
||||
graphviz ==2999.17.0.1,
|
||||
gravatar ==0.6,
|
||||
groundhog ==0.7.0.1,
|
||||
groundhog-mysql ==0.7.0.1,
|
||||
groundhog-postgresql ==0.7.0.1,
|
||||
groundhog-sqlite ==0.7.0.1,
|
||||
groundhog-th ==0.7.0,
|
||||
groupoids ==4.0,
|
||||
groups ==0.4.0.0,
|
||||
gtk ==0.13.3,
|
||||
gtk2hs-buildtools ==0.13.0.3,
|
||||
haddock-api ==2.15.0.1,
|
||||
haddock-library ==1.1.1,
|
||||
half ==0.2.0.1,
|
||||
HandsomeSoup ==0.3.5,
|
||||
happstack-server ==7.3.9,
|
||||
happy ==1.19.4,
|
||||
hashable ==1.2.3.1,
|
||||
hashable-extras ==0.2.0.1,
|
||||
hashmap ==1.3.0.1,
|
||||
hashtables ==1.2.0.1,
|
||||
haskeline installed,
|
||||
haskell2010 installed,
|
||||
haskell98 installed,
|
||||
haskell-lexer ==1.0,
|
||||
haskell-names ==0.4.1,
|
||||
haskell-packages ==0.2.4.3,
|
||||
haskell-src ==1.0.1.6,
|
||||
haskell-src-exts ==1.16.0.1,
|
||||
haskell-src-meta ==0.6.0.8,
|
||||
hasql ==0.4.1,
|
||||
hasql-backend ==0.2.2,
|
||||
hasql-postgres ==0.9.1,
|
||||
hastache ==0.6.1,
|
||||
HaTeX ==3.16.0.0,
|
||||
HaXml ==1.24.1,
|
||||
haxr ==3000.10.3.1,
|
||||
HCodecs ==0.5,
|
||||
hdaemonize ==0.5.0.0,
|
||||
hdevtools ==0.1.0.6,
|
||||
heaps ==0.3.1,
|
||||
hebrew-time ==0.1.1,
|
||||
heist ==0.14.0.1,
|
||||
here ==1.2.6,
|
||||
heredoc ==0.2.0.0,
|
||||
highlighting-kate ==0.5.11.1,
|
||||
hinotify ==0.3.7,
|
||||
hint ==0.4.2.1,
|
||||
histogram-fill ==0.8.3.0,
|
||||
hit ==0.6.2,
|
||||
hjsmin ==0.1.4.7,
|
||||
hledger ==0.23.3,
|
||||
hledger-lib ==0.23.3,
|
||||
hlibgit2 ==0.18.0.13,
|
||||
hlint ==1.9.13,
|
||||
hmatrix ==0.16.1.2,
|
||||
hmatrix-gsl ==0.16.0.2,
|
||||
holy-project ==0.1.1.1,
|
||||
hoogle ==4.2.36,
|
||||
hoopl installed,
|
||||
hOpenPGP ==1.11,
|
||||
hopenpgp-tools ==0.13,
|
||||
hostname ==1.0,
|
||||
hostname-validate ==1.0.0,
|
||||
hourglass ==0.2.6,
|
||||
hpc installed,
|
||||
hPDB ==1.2.0,
|
||||
hPDB-examples ==1.1.2,
|
||||
hs-bibutils ==5.5,
|
||||
hscolour ==1.20.3,
|
||||
hse-cpp ==0.1,
|
||||
hslogger ==1.2.6,
|
||||
hslua ==0.3.13,
|
||||
hspec ==2.1.2,
|
||||
hspec2 ==0.6.1,
|
||||
hspec-core ==2.1.2,
|
||||
hspec-discover ==2.1.2,
|
||||
hspec-expectations ==0.6.1,
|
||||
hspec-meta ==2.0.0,
|
||||
hspec-wai ==0.6.2,
|
||||
hspec-wai-json ==0.6.0,
|
||||
HStringTemplate ==0.7.3,
|
||||
hsyslog ==2.0,
|
||||
HTF ==0.12.2.3,
|
||||
html ==1.0.1.2,
|
||||
html-conduit ==1.1.1.1,
|
||||
HTTP ==4000.2.19,
|
||||
http-client ==0.4.6.1,
|
||||
http-client-tls ==0.2.2,
|
||||
http-conduit ==2.1.5,
|
||||
http-date ==0.0.4,
|
||||
http-reverse-proxy ==0.4.1.2,
|
||||
http-types ==0.8.5,
|
||||
HUnit ==1.2.5.2,
|
||||
hweblib ==0.6.3,
|
||||
hxt ==9.3.1.10,
|
||||
hxt-charproperties ==9.2.0.0,
|
||||
hxt-http ==9.1.5,
|
||||
hxt-pickle-utils ==0.1.0.2,
|
||||
hxt-regex-xmlschema ==9.2.0,
|
||||
hxt-relaxng ==9.1.5.1,
|
||||
hxt-unicode ==9.0.2.2,
|
||||
hybrid-vectors ==0.1.2,
|
||||
hyphenation ==0.4,
|
||||
idna ==0.3.0,
|
||||
ieee754 ==0.7.4,
|
||||
imagesize-conduit ==1.0.0.4,
|
||||
immortal ==0.2,
|
||||
incremental-parser ==0.2.3.3,
|
||||
indents ==0.3.3,
|
||||
ini ==0.2.2,
|
||||
integer-gmp installed,
|
||||
integration ==0.2.0.1,
|
||||
interpolate ==0.1.0,
|
||||
interpolatedstring-perl6 ==0.9.0,
|
||||
intervals ==0.7.0.1,
|
||||
io-choice ==0.0.5,
|
||||
io-manager ==0.1.0.2,
|
||||
io-memoize ==1.1.1.0,
|
||||
iproute ==1.3.1,
|
||||
iterable ==3.0,
|
||||
ixset ==1.0.6,
|
||||
js-flot ==0.8.3,
|
||||
js-jquery ==1.11.1,
|
||||
json-schema ==0.7.3.0,
|
||||
JuicyPixels ==3.1.7.1,
|
||||
JuicyPixels-repa ==0.7,
|
||||
kan-extensions ==4.1.1,
|
||||
kdt ==0.2.2,
|
||||
keter ==1.3.7.1,
|
||||
keys ==3.10.1,
|
||||
kure ==2.4.10,
|
||||
language-c ==0.4.7,
|
||||
language-ecmascript ==0.16.2,
|
||||
language-glsl ==0.1.1,
|
||||
language-haskell-extract ==0.2.4,
|
||||
language-java ==0.2.7,
|
||||
language-javascript ==0.5.13,
|
||||
lazy-csv ==0.5,
|
||||
lca ==0.2.4,
|
||||
lens ==4.6.0.1,
|
||||
lens-aeson ==1.0.0.3,
|
||||
lens-family-th ==0.4.0.0,
|
||||
lhs2tex ==1.18.1,
|
||||
libgit ==0.3.0,
|
||||
libnotify ==0.1.1.0,
|
||||
lifted-async ==0.2.0.2,
|
||||
lifted-base ==0.2.3.3,
|
||||
linear ==1.15.5,
|
||||
linear-accelerate ==0.2,
|
||||
list-t ==0.3.1,
|
||||
loch-th ==0.2.1,
|
||||
log-domain ==0.9.3,
|
||||
logfloat ==0.12.1,
|
||||
logict ==0.6.0.2,
|
||||
loop ==0.2.0,
|
||||
lucid ==2.5,
|
||||
machines ==0.4.1,
|
||||
mandrill ==0.1.1.0,
|
||||
map-syntax ==0.2,
|
||||
markdown ==0.1.13,
|
||||
markdown-unlit ==0.2.0.1,
|
||||
math-functions ==0.1.5.2,
|
||||
matrix ==0.3.4.0,
|
||||
MaybeT ==0.1.2,
|
||||
MemoTrie ==0.6.2,
|
||||
mersenne-random-pure64 ==0.2.0.4,
|
||||
messagepack ==0.3.0,
|
||||
messagepack-rpc ==0.1.0.3,
|
||||
mime-mail ==0.4.6.2,
|
||||
mime-mail-ses ==0.3.2.1,
|
||||
mime-types ==0.1.0.5,
|
||||
missing-foreign ==0.1.1,
|
||||
MissingH ==1.3.0.1,
|
||||
mmap ==0.5.9,
|
||||
mmorph ==1.0.4,
|
||||
MonadCatchIO-transformers ==0.3.1.3,
|
||||
monad-control ==0.3.3.0,
|
||||
monad-coroutine ==0.8.0.1,
|
||||
monadcryptorandom ==0.6.1,
|
||||
monad-extras ==0.5.9,
|
||||
monadic-arrays ==0.2.1.3,
|
||||
monad-journal ==0.6.0.2,
|
||||
monad-logger ==0.3.11.1,
|
||||
monad-loops ==0.4.2.1,
|
||||
monad-par ==0.3.4.7,
|
||||
monad-parallel ==0.7.1.3,
|
||||
monad-par-extras ==0.3.3,
|
||||
monad-primitive ==0.1,
|
||||
monad-products ==4.0.0.1,
|
||||
MonadPrompt ==1.0.0.5,
|
||||
MonadRandom ==0.3.0.1,
|
||||
monad-st ==0.2.4,
|
||||
monads-tf ==0.1.0.2,
|
||||
mongoDB ==2.0.3,
|
||||
monoid-extras ==0.3.3.5,
|
||||
monoid-subclasses ==0.3.6.2,
|
||||
mono-traversable ==0.7.0,
|
||||
mtl ==2.1.3.1,
|
||||
mtlparse ==0.1.2,
|
||||
mtl-prelude ==1.0.1,
|
||||
multimap ==1.2.1,
|
||||
multipart ==0.1.2,
|
||||
MusicBrainz ==0.2.2,
|
||||
mwc-random ==0.13.2.2,
|
||||
mysql ==0.1.1.7,
|
||||
mysql-simple ==0.2.2.4,
|
||||
nanospec ==0.2.0,
|
||||
nats ==1,
|
||||
neat-interpolation ==0.2.2,
|
||||
nettle ==0.1.0,
|
||||
network ==2.6.0.2,
|
||||
network-conduit-tls ==1.1.0.2,
|
||||
network-info ==0.2.0.5,
|
||||
network-multicast ==0.0.11,
|
||||
network-simple ==0.4.0.2,
|
||||
network-transport ==0.4.1.0,
|
||||
network-transport-tcp ==0.4.1,
|
||||
network-transport-tests ==0.2.1.0,
|
||||
network-uri ==2.6.0.1,
|
||||
newtype ==0.2,
|
||||
nsis ==0.2.4,
|
||||
numbers ==3000.2.0.1,
|
||||
numeric-extras ==0.0.3,
|
||||
NumInstances ==1.4,
|
||||
numtype ==1.1,
|
||||
Octree ==0.5.3,
|
||||
old-locale installed,
|
||||
old-time installed,
|
||||
OneTuple ==0.2.1,
|
||||
opaleye ==0.3,
|
||||
OpenGL ==2.9.2.0,
|
||||
OpenGLRaw ==1.5.0.0,
|
||||
openpgp-asciiarmor ==0.1,
|
||||
operational ==0.2.3.2,
|
||||
options ==1.2.1,
|
||||
optparse-applicative ==0.11.0.1,
|
||||
osdkeys ==0.0,
|
||||
pandoc ==1.13.2,
|
||||
pandoc-citeproc ==0.6,
|
||||
pandoc-types ==1.12.4.1,
|
||||
pango ==0.13.0.4,
|
||||
parallel ==3.2.0.5,
|
||||
parallel-io ==0.3.3,
|
||||
parseargs ==0.1.5.2,
|
||||
parsec ==3.1.7,
|
||||
parsers ==0.12.1.1,
|
||||
partial-handler ==0.1.0,
|
||||
path-pieces ==0.1.5,
|
||||
patience ==0.1.1,
|
||||
pcre-light ==0.4.0.3,
|
||||
pdfinfo ==1.5.1,
|
||||
pem ==0.2.2,
|
||||
persistent ==2.1.1.3,
|
||||
persistent-mongoDB ==2.1.2,
|
||||
persistent-mysql ==2.1.2,
|
||||
persistent-postgresql ==2.1.2,
|
||||
persistent-sqlite ==2.1.1.2,
|
||||
persistent-template ==2.1.0.1,
|
||||
phantom-state ==0.2.0.2,
|
||||
pipes ==4.1.4,
|
||||
pipes-concurrency ==2.0.2,
|
||||
pipes-parse ==3.0.2,
|
||||
placeholders ==0.1,
|
||||
pointed ==4.1.1,
|
||||
polyparse ==1.9,
|
||||
pool-conduit ==0.1.2.3,
|
||||
postgresql-binary ==0.5.0,
|
||||
postgresql-libpq ==0.9.0.1,
|
||||
postgresql-simple ==0.4.8.0,
|
||||
pqueue ==1.2.1,
|
||||
prefix-units ==0.1.0.2,
|
||||
prelude-extras ==0.4,
|
||||
present ==2.2,
|
||||
pretty installed,
|
||||
prettyclass ==1.0.0.0,
|
||||
pretty-class ==1.0.1.1,
|
||||
pretty-show ==1.6.8,
|
||||
primes ==0.2.1.0,
|
||||
primitive ==0.5.4.0,
|
||||
process installed,
|
||||
process-conduit ==1.2.0.1,
|
||||
process-extras ==0.2.0,
|
||||
product-profunctors ==0.6,
|
||||
profunctor-extras ==4.0,
|
||||
profunctors ==4.3.2,
|
||||
project-template ==0.1.4.2,
|
||||
publicsuffixlist ==0.1,
|
||||
punycode ==2.0,
|
||||
pure-io ==0.2.1,
|
||||
pureMD5 ==2.1.2.1,
|
||||
pwstore-fast ==2.4.4,
|
||||
quandl-api ==0.2.0.0,
|
||||
QuasiText ==0.1.2.5,
|
||||
QuickCheck ==2.7.6,
|
||||
quickcheck-assertions ==0.1.1,
|
||||
quickcheck-instances ==0.3.9,
|
||||
quickcheck-io ==0.1.1,
|
||||
quickpull ==0.4.0.0,
|
||||
rainbow ==0.20.0.4,
|
||||
rainbow-tests ==0.20.0.4,
|
||||
random ==1.0.1.1,
|
||||
random-fu ==0.2.6.1,
|
||||
random-shuffle ==0.0.4,
|
||||
random-source ==0.3.0.6,
|
||||
rank1dynamic ==0.2.0.1,
|
||||
raw-strings-qq ==1.0.2,
|
||||
ReadArgs ==1.2.2,
|
||||
reducers ==3.10.3,
|
||||
reflection ==1.5.1,
|
||||
regex-applicative ==0.3.0.3,
|
||||
regex-base ==0.93.2,
|
||||
regex-compat ==0.95.1,
|
||||
regex-pcre-builtin ==0.94.4.8.8.35,
|
||||
regex-posix ==0.95.2,
|
||||
regexpr ==0.5.4,
|
||||
regex-tdfa ==1.2.0,
|
||||
regex-tdfa-rc ==1.1.8.3,
|
||||
regular ==0.3.4.3,
|
||||
regular-xmlpickler ==0.2,
|
||||
rematch ==0.2.0.0,
|
||||
repa ==3.3.1.2,
|
||||
repa-algorithms ==3.3.1.2,
|
||||
repa-devil ==0.3.2.2,
|
||||
repa-io ==3.3.1.2,
|
||||
reroute ==0.2.2.1,
|
||||
resource-pool ==0.2.3.2,
|
||||
resourcet ==1.1.3.3,
|
||||
rest-client ==0.4.0.2,
|
||||
rest-core ==0.33.1.2,
|
||||
rest-gen ==0.16.1.3,
|
||||
rest-happstack ==0.2.10.3,
|
||||
rest-snap ==0.1.17.14,
|
||||
rest-stringmap ==0.2.0.2,
|
||||
rest-types ==1.11.1.1,
|
||||
rest-wai ==0.1.0.4,
|
||||
rev-state ==0.1,
|
||||
rfc5051 ==0.1.0.3,
|
||||
runmemo ==1.0.0.1,
|
||||
rvar ==0.2.0.2,
|
||||
safe ==0.3.8,
|
||||
safecopy ==0.8.3,
|
||||
scientific ==0.3.3.3,
|
||||
scotty ==0.9.0,
|
||||
scrobble ==0.2.1.1,
|
||||
securemem ==0.1.4,
|
||||
semigroupoid-extras ==4.0,
|
||||
semigroupoids ==4.2,
|
||||
semigroups ==0.16.0.1,
|
||||
sendfile ==0.7.9,
|
||||
seqloc ==0.6,
|
||||
setenv ==0.1.1.2,
|
||||
SHA ==1.6.4.1,
|
||||
shake ==0.14.2,
|
||||
shake-language-c ==0.6.3,
|
||||
shakespeare ==2.0.2.1,
|
||||
shakespeare-i18n ==1.1.0,
|
||||
shakespeare-text ==1.1.0,
|
||||
shell-conduit ==4.5,
|
||||
shelly ==1.5.6,
|
||||
silently ==1.2.4.1,
|
||||
simple-reflect ==0.3.2,
|
||||
simple-sendfile ==0.2.18,
|
||||
singletons ==1.0,
|
||||
siphash ==1.0.3,
|
||||
skein ==1.0.9.2,
|
||||
slave-thread ==0.1.5,
|
||||
smallcheck ==1.1.1,
|
||||
smtLib ==1.0.7,
|
||||
snap ==0.13.3.2,
|
||||
snap-core ==0.9.6.4,
|
||||
snaplet-fay ==0.3.3.8,
|
||||
snap-server ==0.9.4.6,
|
||||
socks ==0.5.4,
|
||||
sodium ==0.11.0.2,
|
||||
sourcemap ==0.1.3.0,
|
||||
speculation ==1.5.0.1,
|
||||
sphinx ==0.6.0.1,
|
||||
split ==0.2.2,
|
||||
Spock ==0.7.5.1,
|
||||
spoon ==0.3.1,
|
||||
sqlite-simple ==0.4.8.0,
|
||||
stateref ==0.3,
|
||||
statestack ==0.2.0.3,
|
||||
statistics ==0.13.2.1,
|
||||
statistics-linreg ==0.3,
|
||||
stm ==2.4.4,
|
||||
stm-chans ==3.0.0.2,
|
||||
stm-conduit ==2.5.2,
|
||||
stm-containers ==0.2.7,
|
||||
stm-stats ==0.2.0.0,
|
||||
storable-complex ==0.2.1,
|
||||
storable-endian ==0.2.5,
|
||||
streaming-commons ==0.1.8,
|
||||
streams ==3.2,
|
||||
strict ==0.3.2,
|
||||
stringable ==0.1.3,
|
||||
stringbuilder ==0.5.0,
|
||||
stringprep ==1.0.0,
|
||||
stringsearch ==0.3.6.5,
|
||||
stylish-haskell ==0.5.11.0,
|
||||
SVGFonts ==1.4.0.3,
|
||||
syb ==0.4.2,
|
||||
syb-with-class ==0.6.1.5,
|
||||
system-canonicalpath ==0.2.0.0,
|
||||
system-fileio ==0.3.16,
|
||||
system-filepath ==0.4.13,
|
||||
system-posix-redirect ==1.1.0.1,
|
||||
tabular ==0.2.2.5,
|
||||
tagged ==0.7.3,
|
||||
tagshare ==0.0,
|
||||
tagsoup ==0.13.3,
|
||||
tagstream-conduit ==0.5.5.3,
|
||||
tar ==0.4.0.1,
|
||||
tardis ==0.3.0.0,
|
||||
tasty ==0.10.1,
|
||||
tasty-ant-xml ==1.0.1,
|
||||
tasty-golden ==2.2.2.4,
|
||||
tasty-hunit ==0.9.0.1,
|
||||
tasty-quickcheck ==0.8.3.2,
|
||||
tasty-smallcheck ==0.8.0.1,
|
||||
tasty-th ==0.1.3,
|
||||
template-haskell installed,
|
||||
temporary ==1.2.0.3,
|
||||
temporary-rc ==1.2.0.3,
|
||||
terminal-progress-bar ==0.0.1.4,
|
||||
terminal-size ==0.3.0,
|
||||
terminfo installed,
|
||||
test-framework ==0.8.1.0,
|
||||
test-framework-hunit ==0.3.0.1,
|
||||
test-framework-quickcheck2 ==0.3.0.3,
|
||||
test-framework-th ==0.2.4,
|
||||
testing-feat ==0.4.0.2,
|
||||
testpack ==2.1.3.0,
|
||||
texmath ==0.8.0.1,
|
||||
text ==1.1.1.3,
|
||||
text-binary ==0.1.0,
|
||||
text-format ==0.3.1.1,
|
||||
text-icu ==0.7.0.0,
|
||||
tf-random ==0.5,
|
||||
th-desugar ==1.4.2,
|
||||
th-expand-syns ==0.3.0.4,
|
||||
th-extras ==0.0.0.2,
|
||||
th-lift ==0.7,
|
||||
th-orphans ==0.8.2,
|
||||
threads ==0.5.1.2,
|
||||
th-reify-many ==0.1.2,
|
||||
thyme ==0.3.5.5,
|
||||
time installed,
|
||||
time-compat ==0.1.0.3,
|
||||
time-lens ==0.4.0.1,
|
||||
timezone-olson ==0.1.6,
|
||||
timezone-series ==0.1.4,
|
||||
tls ==1.2.13,
|
||||
tls-debug ==0.3.4,
|
||||
tostring ==0.2.1,
|
||||
transformers installed,
|
||||
transformers-base ==0.4.3,
|
||||
transformers-compat ==0.3.3.3,
|
||||
traverse-with-class ==0.2.0.3,
|
||||
tree-view ==0.4,
|
||||
tuple ==0.3.0.2,
|
||||
type-eq ==0.4.2,
|
||||
type-list ==0.0.0.0,
|
||||
udbus ==0.2.1,
|
||||
unbounded-delays ==0.1.0.8,
|
||||
union-find ==0.2,
|
||||
uniplate ==1.6.12,
|
||||
unix installed,
|
||||
unix-compat ==0.4.1.3,
|
||||
unix-time ==0.3.4,
|
||||
unordered-containers ==0.2.5.1,
|
||||
uri-encode ==1.5.0.3,
|
||||
url ==2.1.3,
|
||||
utf8-light ==0.4.2,
|
||||
utf8-string ==0.3.8,
|
||||
uuid ==1.3.7,
|
||||
vault ==0.3.0.4,
|
||||
vector ==0.10.12.2,
|
||||
vector-algorithms ==0.6.0.3,
|
||||
vector-binary-instances ==0.2.1.0,
|
||||
vector-instances ==3.3,
|
||||
vector-space ==0.8.7,
|
||||
vector-space-points ==0.2,
|
||||
vector-th-unbox ==0.2.1.0,
|
||||
vhd ==0.2.2,
|
||||
void ==0.7,
|
||||
wai ==3.0.2.1,
|
||||
wai-app-static ==3.0.0.5,
|
||||
wai-conduit ==3.0.0.2,
|
||||
wai-eventsource ==3.0.0,
|
||||
wai-extra ==3.0.3.1,
|
||||
wai-logger ==2.2.3,
|
||||
wai-middleware-static ==0.6.0.1,
|
||||
wai-websockets ==3.0.0.3,
|
||||
warp ==3.0.4.1,
|
||||
warp-tls ==3.0.1.1,
|
||||
webdriver ==0.6.0.3,
|
||||
web-fpco ==0.1.1.0,
|
||||
websockets ==0.9.2.1,
|
||||
wizards ==1.0.1,
|
||||
wl-pprint ==1.1,
|
||||
wl-pprint-extras ==3.5.0.3,
|
||||
wl-pprint-terminfo ==3.7.1.3,
|
||||
wl-pprint-text ==1.1.0.2,
|
||||
word8 ==0.1.1,
|
||||
X11 ==1.6.1.2,
|
||||
x509 ==1.5.0.1,
|
||||
x509-store ==1.5.0,
|
||||
x509-system ==1.5.0,
|
||||
x509-validation ==1.5.1,
|
||||
xenstore ==0.1.1,
|
||||
xhtml installed,
|
||||
xml ==1.3.13,
|
||||
xml-conduit ==1.2.3.1,
|
||||
xmlgen ==0.6.2.1,
|
||||
xml-hamlet ==0.4.0.9,
|
||||
xmlhtml ==0.2.3.3,
|
||||
xml-types ==0.3.4,
|
||||
xss-sanitize ==0.3.5.4,
|
||||
yackage ==0.7.0.6,
|
||||
yaml ==0.8.10.1,
|
||||
Yampa ==0.9.6,
|
||||
YampaSynth ==0.2,
|
||||
yesod ==1.4.1.3,
|
||||
yesod-auth ==1.4.1.1,
|
||||
yesod-auth-deskcom ==1.4.0,
|
||||
yesod-auth-fb ==1.6.6,
|
||||
yesod-auth-hashdb ==1.4.1.1,
|
||||
yesod-bin ==1.4.3.1,
|
||||
yesod-core ==1.4.7.1,
|
||||
yesod-eventsource ==1.4.0.1,
|
||||
yesod-fay ==0.7.0,
|
||||
yesod-fb ==0.3.4,
|
||||
yesod-form ==1.4.3.1,
|
||||
yesod-gitrepo ==0.1.1.0,
|
||||
yesod-newsfeed ==1.4.0.1,
|
||||
yesod-persistent ==1.4.0.2,
|
||||
yesod-sitemap ==1.4.0.1,
|
||||
yesod-static ==1.4.0.4,
|
||||
yesod-test ==1.4.2.1,
|
||||
yesod-text-markdown ==0.1.7,
|
||||
yesod-websockets ==0.2.1.1,
|
||||
zeromq4-haskell ==0.6.2,
|
||||
zip-archive ==0.2.3.5,
|
||||
zlib ==0.5.4.2,
|
||||
zlib-bindings ==0.1.1.5,
|
||||
zlib-enum ==0.2.3.1,
|
||||
zlib-lens ==0.1
|
||||
@ -1,71 +0,0 @@
|
||||
#!/bin/bash -ex
|
||||
|
||||
# Work in progress: create a list of commands necessary to get Stackage
|
||||
# up-and-running on a freshly installed Debian-based system (includin Ubuntu).
|
||||
|
||||
# Quick start:
|
||||
# wget -O - https://raw.github.com/fpco/stackage/master/debian-bootstrap.sh | bash -ex
|
||||
|
||||
# NOTE: Requires that GHC and Cabal are installed and on your PATH. For
|
||||
# instructions, see:
|
||||
# http://www.stackage.org/install
|
||||
|
||||
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 \
|
||||
libedit2 \
|
||||
libedit-dev \
|
||||
freeglut3-dev \
|
||||
libglu1-mesa-dev \
|
||||
libglib2.0-dev \
|
||||
libcairo2-dev \
|
||||
libpango1.0-dev \
|
||||
libgtk2.0-dev \
|
||||
zip \
|
||||
libdevil-dev \
|
||||
llvm \
|
||||
libbz2-dev \
|
||||
libjudy-dev \
|
||||
libsqlite3-dev \
|
||||
libmysqlclient-dev \
|
||||
libpq-dev \
|
||||
libicu-dev \
|
||||
libssl-dev \
|
||||
libgsl0-dev \
|
||||
libblas-dev \
|
||||
liblapack-dev \
|
||||
libcurl4-openssl-dev \
|
||||
libfreenect-dev \
|
||||
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
|
||||
105
stackage.cabal
105
stackage.cabal
@ -1,105 +0,0 @@
|
||||
name: stackage
|
||||
version: 0.6.0.1
|
||||
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
|
||||
license: MIT
|
||||
license-file: LICENSE
|
||||
author: Michael Snoyman
|
||||
maintainer: michael@fpcomplete.com
|
||||
category: Distribution
|
||||
build-type: Simple
|
||||
cabal-version: >=1.10
|
||||
extra-source-files: README.md
|
||||
ChangeLog.md
|
||||
test/test-build-constraints.yaml
|
||||
|
||||
library
|
||||
default-language: Haskell2010
|
||||
exposed-modules: Stackage.Prelude
|
||||
Stackage.BuildConstraints
|
||||
Stackage.CorePackages
|
||||
Stackage.PackageIndex
|
||||
Stackage.BuildPlan
|
||||
Stackage.CheckBuildPlan
|
||||
Stackage.UpdateBuildPlan
|
||||
Stackage.GhcPkg
|
||||
Stackage.GithubPings
|
||||
Stackage.InstallBuild
|
||||
Stackage.PackageDescription
|
||||
Stackage.ServerBundle
|
||||
Stackage.Upload
|
||||
Stackage.PerformBuild
|
||||
Stackage.CompleteBuild
|
||||
build-depends: base >= 4 && < 5
|
||||
, containers
|
||||
, Cabal >= 1.14
|
||||
, tar >= 0.3
|
||||
, zlib
|
||||
, bytestring
|
||||
, directory
|
||||
, filepath
|
||||
, transformers
|
||||
, process
|
||||
, old-locale
|
||||
, time
|
||||
, utf8-string
|
||||
|
||||
, conduit-extra
|
||||
, classy-prelude-conduit
|
||||
, text
|
||||
, system-fileio
|
||||
, system-filepath
|
||||
, mtl
|
||||
, aeson
|
||||
, yaml
|
||||
, unix-compat
|
||||
, http-client
|
||||
, http-conduit
|
||||
, http-client-tls
|
||||
, temporary
|
||||
, data-default-class
|
||||
, stm
|
||||
, mono-traversable
|
||||
, async
|
||||
, streaming-commons >= 0.1.7.1
|
||||
, semigroups
|
||||
, xml-conduit
|
||||
, conduit
|
||||
|
||||
executable stackage
|
||||
default-language: Haskell2010
|
||||
hs-source-dirs: app
|
||||
main-is: stackage.hs
|
||||
build-depends: base
|
||||
, stackage
|
||||
, optparse-applicative >= 0.11
|
||||
, system-filepath
|
||||
, http-client
|
||||
, http-client-tls
|
||||
, text
|
||||
ghc-options: -rtsopts -threaded -with-rtsopts=-N
|
||||
|
||||
test-suite spec
|
||||
type: exitcode-stdio-1.0
|
||||
default-language: Haskell2010
|
||||
hs-source-dirs: test
|
||||
main-is: Spec.hs
|
||||
other-modules: Stackage.CorePackagesSpec
|
||||
Stackage.PackageIndexSpec
|
||||
Stackage.BuildPlanSpec
|
||||
build-depends: base
|
||||
, stackage
|
||||
, hspec
|
||||
, QuickCheck
|
||||
, text
|
||||
, classy-prelude-conduit
|
||||
, Cabal
|
||||
, yaml
|
||||
, containers
|
||||
, http-client
|
||||
, http-client-tls
|
||||
|
||||
source-repository head
|
||||
type: git
|
||||
location: https://github.com/fpco/stackage
|
||||
@ -1 +0,0 @@
|
||||
{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
|
||||
@ -1,143 +0,0 @@
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE OverloadedStrings, NoImplicitPrelude #-}
|
||||
module Stackage.BuildPlanSpec (spec) where
|
||||
|
||||
import qualified Data.Map as Map
|
||||
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 = 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
|
||||
|
||||
bp' <- either error return ebp'
|
||||
|
||||
let allPackages = Map.keysSet (bpPackages bp) ++ Map.keysSet (bpPackages bp')
|
||||
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 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"
|
||||
@ -1,19 +0,0 @@
|
||||
{-# LANGUAGE OverloadedStrings, NoImplicitPrelude #-}
|
||||
module Stackage.CorePackagesSpec (spec) where
|
||||
|
||||
import Stackage.CorePackages
|
||||
import Stackage.Prelude
|
||||
import Test.Hspec
|
||||
|
||||
spec :: Spec
|
||||
spec = do
|
||||
it "works" $ void getCorePackages
|
||||
it "contains known core packages" $ do
|
||||
m <- getCorePackages
|
||||
forM_ (words "ghc containers base") $ \p ->
|
||||
m `shouldSatisfy` (member (PackageName p))
|
||||
it "getCoreExecutables includes known executables" $ do
|
||||
s <- getCoreExecutables
|
||||
s `shouldSatisfy` member "ghc"
|
||||
s `shouldSatisfy` member "hsc2hs"
|
||||
s `shouldSatisfy` member "runghc"
|
||||
@ -1,21 +0,0 @@
|
||||
{-# LANGUAGE OverloadedStrings, NoImplicitPrelude #-}
|
||||
module Stackage.PackageIndexSpec (spec) where
|
||||
|
||||
import Stackage.PackageIndex
|
||||
import Stackage.Prelude
|
||||
import Test.Hspec
|
||||
import Distribution.Package (packageId)
|
||||
|
||||
spec :: Spec
|
||||
spec = do
|
||||
it "works" $ (runResourceT $ sourcePackageIndex $$ sinkNull :: IO ())
|
||||
it "getLatestDescriptions gives reasonable results" $ do
|
||||
let f x y = (display x, display y) `member` asSet (setFromList
|
||||
[ (asText "base", asText "4.5.0.0")
|
||||
, ("does-not-exist", "9999999999999999999")
|
||||
])
|
||||
m <- getLatestDescriptions f return
|
||||
length m `shouldBe` 1
|
||||
p <- simpleParse $ asText "base"
|
||||
v <- simpleParse $ asText "4.5.0.0"
|
||||
(pkgVersion . packageId <$> m) `shouldBe` singletonMap p v
|
||||
@ -1,20 +0,0 @@
|
||||
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