stackage-curator 0.14.0 → 0.14.1
raw patch · 18 files changed
+232/−120 lines, 18 filesdep +storedep −binarydep −binary-orphansdep −binary-taggeddep ~Cabal
Dependencies added: store
Dependencies removed: binary, binary-orphans, binary-tagged, stackage-cli
Dependency ranges changed: Cabal
Files
- ChangeLog.md +7/−0
- Stackage/BuildConstraints.hs +3/−0
- Stackage/BuildPlan.hs +2/−2
- Stackage/CheckBuildPlan.hs +53/−18
- Stackage/CompleteBuild.hs +2/−2
- Stackage/CorePackages.hs +15/−4
- Stackage/InstallBuild.hs +1/−1
- Stackage/PackageDescription.hs +7/−0
- Stackage/PackageIndex.hs +59/−57
- Stackage/PerformBuild.hs +45/−7
- Stackage/ShowBuildPlan.hs +0/−1
- Stackage/Types.hs +25/−14
- Stackage/UpdateBuildPlan.hs +1/−0
- app/stackage-build-plan.hs +1/−1
- app/stackage.hs +1/−2
- stackage-curator.cabal +5/−8
- test/Stackage/BuildPlanSpec.hs +5/−2
- test/Stackage/PackageIndexSpec.hs +0/−1
ChangeLog.md view
@@ -1,3 +1,10 @@+## 0.14.1++* configure-args+* Support for GHC 8's documentation directory location+* Checked cabal-version in .cabal files+* Switch to store+ ## 0.14.0 * Move stackage-types into this package
Stackage/BuildConstraints.hs view
@@ -108,6 +108,7 @@ data ConstraintFile = ConstraintFile { cfPackageFlags :: Map PackageName (Map FlagName Bool)+ , cfConfigureArgs :: Map PackageName (Vector Text) , cfSkippedTests :: Set PackageName , cfSkippedBuilds :: Set PackageName , cfExpectedTestFailures :: Set PackageName@@ -125,6 +126,7 @@ instance FromJSON ConstraintFile where parseJSON = withObject "ConstraintFile" $ \o -> do cfPackageFlags <- (goPackageMap . fmap goFlagMap) <$> o .: "package-flags"+ cfConfigureArgs <- goPackageMap <$> o .:? "configure-args" .!= mempty cfSkippedTests <- getPackages o "skipped-tests" cfSkippedBuilds <- getPackages o "skipped-builds" <|> return mempty cfExpectedTestFailures <- getPackages o "expected-test-failures"@@ -208,6 +210,7 @@ | otherwise = ExpectSuccess pcFlagOverrides = fromMaybe mempty $ lookup name cfPackageFlags+ pcConfigureArgs = fromMaybe mempty $ lookup name cfConfigureArgs pcSkipBuild = name `member` cfSkippedBuilds bcGithubUsers = cfGithubUsers
Stackage/BuildPlan.hs view
@@ -22,7 +22,6 @@ 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@@ -137,6 +136,7 @@ ppGithubPings = applyGithubMapping bc $ spdGithubPings spd ppConstraints = onlyRelevantFlags $ bcPackageConstraints bc name ppUsers = mempty -- must be filled in later+ ppSourceUrl = Nothing -- Only include flags that are actually provided by the package. For more -- information, see: https://github.com/fpco/stackage-curator/issues/11@@ -159,7 +159,7 @@ overrides = pcFlagOverrides ppConstraints flags = mapWithKey overrideFlag $ spdPackageFlags spd- overrideFlag name defVal = fromMaybe defVal $ lookup name overrides+ overrideFlag name' defVal = fromMaybe defVal $ lookup name' overrides getLatestAllowedPlans :: MonadIO m => BuildConstraints -> m (Map PackageName PackagePlan) getLatestAllowedPlans bc =
Stackage/CheckBuildPlan.hs view
@@ -14,6 +14,7 @@ import Control.Monad.Writer.Strict (Writer, execWriter, tell) import qualified Data.Map.Strict as M+import Data.Semigroup (Option (..), Max (..)) import qualified Data.Text as T import Stackage.BuildConstraints import Stackage.BuildPlan@@ -21,15 +22,28 @@ import Stackage.Prelude -- | Check the build plan for missing deps, wrong versions, etc.-checkBuildPlan :: (MonadThrow m) => BuildPlan -> m ()-checkBuildPlan BuildPlan {..}- | null errs' = return ()+checkBuildPlan :: (MonadThrow m)+ => Bool -- ^ fail on missing Cabal package+ -> BuildPlan+ -> m ()+checkBuildPlan failMissingCabal BuildPlan {..}+ | null errs1 && null errs2 = 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 getMaint allPackages) $ mapToList bpPackages+ errs@(BadBuildPlan errs1 errs2) = execWriter $ do+ mapM_ (checkDeps getMaint allPackages) $ mapToList bpPackages+ let cabalName = PackageName "Cabal"+ case lookup cabalName bpPackages of+ Nothing+ | failMissingCabal -> tell+ $ BadBuildPlan mempty+ $ singletonMap cabalName+ $ singleton "Cabal not found in build plan"+ | otherwise -> return ()+ Just (ppVersion -> cabalVersion) ->+ mapM_ (checkCabalVersion cabalVersion) (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).@@ -54,20 +68,20 @@ where go (dep, diRange -> range) = case lookup dep allPackages of- Nothing -> tell $ BadBuildPlan $ singletonMap (dep, getMaint dep, Nothing) errMap+ Nothing -> tell $ BadBuildPlan (singletonMap (dep, getMaint dep, Nothing) errMap) mempty Just (version,deps) | version `withinRange` range -> occursCheck allPackages (\d v ->- tell $ BadBuildPlan $ singletonMap+ tell $ BadBuildPlan (singletonMap (d, getMaint dep, v)- errMap)+ errMap) mempty) dep deps []- | otherwise -> tell $ BadBuildPlan $ singletonMap+ | otherwise -> tell $ BadBuildPlan (singletonMap (dep, getMaint dep, Just version)- errMap+ errMap) mempty where errMap = singletonMap pu range pu = PkgUser@@ -77,6 +91,20 @@ , puGithubPings = ppGithubPings pb } +-- | Ensure our selected Cabal version is sufficient for the given+-- package+checkCabalVersion :: Version -> (PackageName, PackagePlan) -> Writer BadBuildPlan ()+checkCabalVersion cabalVersion (name, plan)+ | Option (Just (Max neededVersion)) <- sdCabalVersion (ppDesc plan) =+ unless (cabalVersion >= neededVersion) $ tell $ BadBuildPlan+ mempty $ singletonMap name $ singleton $ concat+ [ "Cabal version "+ , display cabalVersion+ , " not sufficient for "+ , display neededVersion+ ]+ | otherwise = return ()+ -- | Check whether the package(s) occurs within its own dependency -- tree. occursCheck@@ -129,15 +157,16 @@ $ (maybe "No maintainer" unMaintainer puMaintainer ++ ".") : map (cons '@') (setToList puGithubPings) -newtype BadBuildPlan =- BadBuildPlan (Map (PackageName, Maybe Maintainer, Maybe Version) (Map PkgUser VersionRange))+data BadBuildPlan = BadBuildPlan+ (Map (PackageName, Maybe Maintainer, Maybe Version) (Map PkgUser VersionRange))+ (Map PackageName (Vector Text)) deriving Typeable instance Exception BadBuildPlan instance Show BadBuildPlan where- show (BadBuildPlan errs) =- unpack $ concatMap go $ mapToList errs+ show (BadBuildPlan errs1 errs2) =+ unpack $ concatMap go1 (mapToList errs1) ++ concatMap go2 (mapToList errs2) where- go ((dep, mmaint, mdepVer), users) = unlines+ go1 ((dep, mmaint, mdepVer), users) = unlines $ "" : showDepVer dep mmaint mdepVer : map showUser (mapToList users)@@ -178,7 +207,13 @@ , pkgUserShow2 pu ] + go2 :: (PackageName, Vector Text) -> Text+ go2 (name, errs) = unlines+ $ display name+ : map (\err -> " " ++ err) (toList errs)+ instance Monoid BadBuildPlan where- mempty = BadBuildPlan mempty- mappend (BadBuildPlan x) (BadBuildPlan y) =- BadBuildPlan $ unionWith (unionWith intersectVersionRanges) x y+ mempty = BadBuildPlan mempty mempty+ mappend (BadBuildPlan a x) (BadBuildPlan b y) = BadBuildPlan+ (unionWith (unionWith intersectVersionRanges) a b)+ (unionWith mappend x y)
Stackage/CompleteBuild.hs view
@@ -149,7 +149,7 @@ plan <- planFromConstraints bc - putStrLn $ "Writing build plan to check-plan.yaml"+ putStrLn "Writing build plan to check-plan.yaml" encodeFile "check-plan.yaml" plan return plan@@ -158,7 +158,7 @@ decodeFileEither fp >>= either throwM return putStrLn "Checking plan"- checkBuildPlan plan+ checkBuildPlan True plan putStrLn "Plan seems valid!"
Stackage/CorePackages.hs view
@@ -77,15 +77,26 @@ -- For each dependency we find: parse it to a package name and then add its -- dependencies.- dependsSink = mapM_C $ \t -> do+ --+ -- Also: break up multiple packages per line, and strip off the hash and+ dependsSink = mapM_C $ \t' -> forM_ (words t') $ \t -> unless (null t) $ do pn <- simpleParse $ getPackageName t addDeepDepends pn -- Strip off the hash and version number- getPackageName =- reverse . dropSeg . dropSeg . reverse . dropWhile (== ' ')+ getPackageName t0 =+ reverse . dropSegs . reverse . dropWhile (== ' ') $ t0 where- dropSeg = drop 1 . dropWhile (/= '-')+ dropSegs t+ | null y = t+ | Just y' <- stripPrefix "-" y =+ if all isVersionChar x+ then y'+ else dropSegs y'+ | otherwise = error $ "Got confused in getPackageName on: " ++ show t0+ where+ (x, y) = break (== '-') t+ isVersionChar c = c == '.' || ('0' <= c && c <= '9') -- | Get a @Map@ of all of the core packages. Core packages are defined as -- packages which ship with GHC itself.
Stackage/InstallBuild.hs view
@@ -84,7 +84,7 @@ then putStrLn "Skipping build plan check" else do putStrLn "Checking build plan"- checkBuildPlan plan+ checkBuildPlan True plan putStrLn "Performing build" performBuild (getPerformBuild plan installFlags) >>= mapM_ putStrLn
Stackage/PackageDescription.hs view
@@ -19,6 +19,7 @@ import Control.Monad.Writer.Strict (MonadWriter, execWriterT, tell)+import Data.Semigroup (Option (..), Max (..)) import Distribution.Compiler (CompilerFlavor) import Distribution.Package (Dependency (..)) import Distribution.PackageDescription@@ -38,6 +39,12 @@ tell mempty { sdProvidedExes = setFromList $ map (fromString . fst) $ spdCondExecutables spd+ , sdCabalVersion = Option $ Max <$> spdCabalVersion spd+ , sdPackages = unionsWith (<>) $ flip map (spdSetupDeps spd)+ $ \(Dependency x y) -> singletonMap x DepInfo+ { diComponents = setFromList [minBound..maxBound]+ , diRange = simplifyVersionRange y+ } } when (ccIncludeTests cc) $ forM_ (spdCondTestSuites spd) $ tellTree cc CompTestSuite . snd
Stackage/PackageIndex.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveGeneric #-}@@ -6,10 +8,11 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-deprecations #-} -- | Dealing with the 00-index file and all its cabal files. module Stackage.PackageIndex ( sourcePackageIndex@@ -25,7 +28,7 @@ lazyConsume) import qualified Data.Text as T import Distribution.Compiler (CompilerFlavor)-import Distribution.ModuleName (ModuleName)+import Distribution.Version (VersionRange (..)) import Distribution.Package (Dependency) import Distribution.PackageDescription import Distribution.PackageDescription.Parse (ParseResult (..),@@ -33,21 +36,18 @@ import Distribution.ParseUtils (PError) import Distribution.System (Arch, OS) import Stackage.Prelude-import Stackage.Types (CabalFileInfo (..)) import Stackage.GithubPings-import System.Directory (doesFileExist, getAppUserDataDirectory, createDirectoryIfMissing)+import System.Directory (getAppUserDataDirectory, createDirectoryIfMissing) import System.FilePath (takeDirectory)-import qualified Data.Binary as Bin (Binary)-import Data.Binary.Orphans ()-import qualified Data.Binary.Tagged as Bin import qualified Data.ByteString.Base16 as B16 import qualified Crypto.Hash.SHA256 as SHA256-import Language.Haskell.Extension (Extension, Language, KnownExtension)-import Data.Proxy import Crypto.Hash (MD5 (..), SHA1 (..), SHA256 (..), SHA512 (..), Skein512_512 (..), hashlazy, Digest, HashAlgorithm, digestToHexByteString) import qualified Crypto.Hash.SHA1 as SHA1+import Data.Store (Store)+import qualified Data.Store as Store+import qualified Data.Store.TypeHash as Store -- | Name of the 00-index.tar downloaded from Hackage. getPackageIndexPath :: MonadIO m => m FilePath@@ -55,10 +55,6 @@ stackRoot <- getAppUserDataDirectory "stack" let tarball = stackRoot </> "indices" </> "Hackage" </> "00-index.tar" return tarball- where- getRemoteCache s = do- ("remote-repo-cache", stripPrefix ":" -> Just v) <- Just $ break (== ':') s- Just $ unpack $ 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@@ -76,9 +72,7 @@ , sciModules :: Set Text } deriving Generic-instance Bin.Binary SimplifiedComponentInfo-instance Bin.HasStructuralInfo SimplifiedComponentInfo-instance Bin.HasSemanticVersion SimplifiedComponentInfo+instance Store SimplifiedComponentInfo data SimplifiedPackageDescription = SimplifiedPackageDescription { spdName :: PackageName@@ -88,49 +82,35 @@ , spdCondExecutables :: [(String, CondTree ConfVar [Dependency] SimplifiedComponentInfo)] , spdCondTestSuites :: [(String, CondTree ConfVar [Dependency] SimplifiedComponentInfo)] , spdCondBenchmarks :: [(String, CondTree ConfVar [Dependency] SimplifiedComponentInfo)]+ , spdSetupDeps :: [Dependency] , spdPackageFlags :: Map FlagName Bool , spdGithubPings :: Set Text+ , spdCabalVersion :: Maybe Version } deriving Generic-instance Bin.Binary SimplifiedPackageDescription-instance Bin.HasStructuralInfo SimplifiedPackageDescription-instance Bin.HasSemanticVersion SimplifiedPackageDescription --- BEGIN orphans-deriving instance Generic (CondTree v c a)-deriving instance Generic (Condition c)-deriving instance Generic ConfVar--instance (Bin.Binary v, Bin.Binary c, Bin.Binary a) => Bin.Binary (CondTree v c a)-instance Bin.Binary c => Bin.Binary (Condition c)-instance Bin.Binary ConfVar---- special treatment for recursive datatype-instance Bin.HasStructuralInfo a => Bin.HasStructuralInfo (CondTree ConfVar [Dependency] a) where- structuralInfo x = Bin.NominalType- "CondTree ConfVar [Dependency]"- -- FIXME? (Bin.structuralInfo $ getInnerProxy x)- where- getInnerProxy :: Proxy (CondTree c v a) -> Proxy a- getInnerProxy _ = Proxy+#if !MIN_VERSION_base(4, 9, 0)+deriving instance Generic Version+#endif -instance Bin.HasStructuralInfo Dependency-instance Bin.HasStructuralInfo v => Bin.HasStructuralInfo (Condition v) where- structuralInfo x = Bin.NominalNewtype- "Condition"- (Bin.structuralInfo $ getInnerProxy x)- where- getInnerProxy :: Proxy (Condition v) -> Proxy v- getInnerProxy _ = Proxy-instance Bin.HasStructuralInfo ConfVar-instance Bin.HasStructuralInfo Arch-instance Bin.HasStructuralInfo OS-instance Bin.HasStructuralInfo CompilerFlavor-instance Bin.HasStructuralInfo PackageName-instance Bin.HasStructuralInfo VersionRange-instance Bin.HasStructuralInfo FlagName+instance Store SimplifiedPackageDescription+instance Store a => Store (CondTree ConfVar [Dependency] a)+instance Store Dependency+instance Store v => Store (Condition v)+instance Store ConfVar+instance Store Arch+instance Store OS+instance Store CompilerFlavor+instance Store PackageName+instance Store Version+instance Store VersionRange+instance Store FlagName -- END orphans +Store.mkManyHasTypeHash+ [ [t|SimplifiedPackageDescription|]+ ]+ gpdToSpd :: LByteString -- ^ raw cabal file contents -> GenericPackageDescription -> SimplifiedPackageDescription gpdToSpd raw gpd = SimplifiedPackageDescription@@ -157,14 +137,36 @@ ]) ] }- , spdCondLibrary = fmap (mapCondTree simpleLib) $ condLibrary gpd+ , spdCondLibrary = mapCondTree simpleLib <$> condLibrary gpd , spdCondExecutables = map (fmap $ mapCondTree simpleExe) $ condExecutables gpd , spdCondTestSuites = map (fmap $ mapCondTree simpleTest) $ condTestSuites gpd , spdCondBenchmarks = map (fmap $ mapCondTree simpleBench) $ condBenchmarks gpd+ , spdSetupDeps = maybe [] setupDepends $ setupBuildInfo $ packageDescription gpd , spdPackageFlags = let getFlag MkFlag {..} = (flagName, flagDefault) in mapFromList $ map getFlag $ genPackageFlags gpd , spdGithubPings = getGithubPings gpd+ , spdCabalVersion =+ case specVersionRaw $ packageDescription gpd of+ Left v -> Just v+ Right range0 ->+ let maxRange AnyVersion = Nothing+ maxRange (ThisVersion v) = Just v+ maxRange (LaterVersion v) = Just v+ -- ideally the following case would never happen+ maxRange (EarlierVersion v) = Just v+ maxRange (WildcardVersion v) = Just v+ maxRange (UnionVersionRanges x y) = maxRanges x y+ maxRange (IntersectVersionRanges x y) = maxRanges x y+ maxRange (VersionRangeParens x) = maxRange x++ maxRanges x y =+ case (maxRange x, maxRange y) of+ (Nothing, Nothing) -> Nothing+ (Just x', Nothing) -> Just x'+ (Nothing, Just y') -> Just y'+ (Just x', Just y') -> Just (max x' y')+ in maxRange range0 } where PackageIdentifier name version = package $ packageDescription gpd@@ -174,9 +176,9 @@ simpleTest = helper noModules testBuildInfo simpleBench = helper noModules benchmarkBuildInfo - helper getModules getBI x = SimplifiedComponentInfo+ helper getModules' getBI x = SimplifiedComponentInfo { sciBuildTools = buildTools $ getBI x- , sciModules = getModules x+ , sciModules = getModules' x } noModules = const mempty@@ -192,13 +194,13 @@ -> UnparsedCabalFile -> m SimplifiedPackageDescription ucfParse root (UnparsedCabalFile name version fp lbs _entry) = liftIO $ do- eres <- tryIO $ Bin.taggedDecodeFileOrFail cache+ eres <- tryIO $ fmap Store.decode $ readFile cache case eres of- Right (Right x) -> return x+ Right (Right (Store.Tagged x)) -> return x _ -> do x <- parseFromText createDirectoryIfMissing True $ takeDirectory cache- Bin.taggedEncodeFile cache x+ writeFile cache $ Store.encode $ Store.Tagged x return x where -- location of the binary cache
Stackage/PerformBuild.hs view
@@ -31,20 +31,20 @@ removeTree, rename, removeFile) import Filesystem.Path (parent) import qualified Filesystem.Path.CurrentOS as F+import Network.HTTP.Simple import Stackage.BuildConstraints import Stackage.BuildPlan import Stackage.GhcPkg import Stackage.PackageDescription import Stackage.PackageIndex (gpdFromLBS) import Stackage.Prelude hiding (pi)-import System.Directory (doesDirectoryExist, doesFileExist, findExecutable,- getAppUserDataDirectory)+import System.Directory (doesDirectoryExist, doesFileExist, findExecutable, getDirectoryContents) import qualified System.FilePath as FP import System.Environment (getEnvironment) import System.Exit import System.IO (IOMode (WriteMode), openBinaryFile, hFlush)-import System.IO.Temp (withSystemTempDirectory)+import System.IO.Temp (withSystemTempDirectory, withSystemTempFile) import System.Timeout (timeout) data BuildException = BuildException (Map PackageName BuildFailure) [Text]@@ -420,6 +420,8 @@ when (pbEnableLibProfiling && pcEnableLibProfile) $ tell' "--enable-library-profiling" when pbEnableExecDyn $ tell' "--enable-executable-dynamic"++ tell (toList pcConfigureArgs ++) where tell' x = tell (x:) @@ -453,7 +455,9 @@ return $ sbBuildDir </> "cabal" </> "Cabal" else do log' $ "Unpacking " ++ namever- runParent getOutH "stack" ["unpack", namever]+ case ppSourceUrl $ piPlan sbPackageInfo of+ Nothing -> runParent getOutH "stack" ["unpack", namever]+ Just url -> unpackFromURL sbBuildDir url return $ sbBuildDir </> unpack namever gpd <- createSetupHs childDir name pbAllowNewer@@ -625,7 +629,7 @@ let needTest = pbEnableBenches && checkPrevResult prevBenchResult pcBenches && not pcSkipBuild- when needTest $ withUnpacked $ \gpd childDir -> do+ when needTest $ withUnpacked $ \_gpd childDir -> do let run = runIn childDir getOutH cabal args = run "runghc" $ runghcArgs $ "Setup" : args @@ -657,6 +661,22 @@ Just bf -> bf Nothing -> BuildFailureException exc +-- | Unpack the file at the given URL into the given directory+unpackFromURL :: MonadIO m+ => FilePath -- ^ dest directory+ -> Text -- ^ URL+ -> m ()+unpackFromURL destDir url = liftIO $ do+ req <- parseRequest $ unpack url+ withSystemTempFile "unpack-from-url.tar.gz" $ \fp h -> do+ httpSink req (const $ sinkHandle h)+ hClose h+ let cp = (proc "tar" ["xf", fp])+ { cwd = Just destDir+ }+ withCheckedProcessCleanup cp+ $ \ClosedStream ClosedStream ClosedStream -> return ()+ -- | Maximum time (in microseconds) to run a single test suite maximumTestSuiteTime :: Int maximumTestSuiteTime = 10 * 60 * 1000 * 1000 -- ten minutes@@ -672,8 +692,26 @@ case mghc of Nothing -> error "GHC not found on PATH" Just ghc -> do- src <- canonicalizePath $ fromString- (F.encodeString (parent (fromString ghc)) </> "../share/doc/ghc/html/libraries")+ -- Starting with GHC 8, the doc/ghc directory is now+ -- doc/ghc-8.0.1 (and so on). Let's put in a hacky trick+ -- to find the right directory.++ let root = F.encodeString (parent (fromString ghc)) </>+ "../share/doc"+ names <- getDirectoryContents root+ let hidden ('.':_) = True+ hidden _ = False+ name <-+ case filter (not . hidden) names of+ [x] -> return x+ _ -> error $ concat+ [ "Unexpected list of contents in "+ , root+ , ": "+ , show names+ ]+ src <- canonicalizePath $ fromString $+ root </> name </> "html/libraries" copyDir (F.encodeString src) docdir ------------- Previous results
Stackage/ShowBuildPlan.hs view
@@ -32,7 +32,6 @@ import qualified Data.Aeson as A import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L-import Data.Foldable (Foldable) import qualified Data.Foldable as F import Data.Function (fix) import Data.Map (Map)
Stackage/Types.hs view
@@ -31,7 +31,7 @@ , intersectVersionRanges ) where -import Control.Applicative ((<$>), (<*>), (<|>))+import Control.Applicative ((<|>)) import Control.Arrow ((&&&)) import Control.Exception (Exception) import Control.Monad.Catch (MonadThrow, throwM)@@ -43,13 +43,11 @@ import Data.Map (Map) import qualified Data.Map as Map import Data.Maybe (fromMaybe)-import Data.Monoid (Monoid, mappend, mempty)-import Data.Semigroup (Semigroup, (<>))+import Data.Semigroup (Semigroup, (<>), Option (..), Max (..)) import Data.Set (Set) import qualified Data.Set as Set import Data.String (IsString, fromString) import Data.Text (Text, pack, unpack)-import qualified Data.Text as T import Data.Time (Day) import qualified Data.Traversable as T import Data.Typeable (TypeRep, Typeable, typeOf)@@ -61,10 +59,8 @@ import Distribution.Version (Version, VersionRange) import qualified Distribution.Version as C import Safe (readMay)-import qualified Data.Binary as Bin (Binary)-import qualified Data.Binary.Tagged as Bin-import qualified Data.ByteString.Base16 as B16 import GHC.Generics (Generic)+import Data.Store (Store) data SnapshotType = STNightly | STNightly2 !Day@@ -164,12 +160,14 @@ , ppUsers :: Set PackageName , ppConstraints :: PackageConstraints , ppDesc :: SimpleDesc+ , ppSourceUrl :: Maybe Text } deriving (Show, Eq) instance ToJSON PackagePlan where toJSON PackagePlan {..} = object- $ maybe id (\cfi -> (("cabal-file-info" .= cfi):)) ppCabalFileInfo $+ $ maybe id (\cfi -> (("cabal-file-info" .= cfi):)) ppCabalFileInfo+ $ maybe id (\cfi -> (("source-url" .= cfi):)) ppSourceUrl $ [ "version" .= asText (display ppVersion) , "github-pings" .= ppGithubPings , "users" .= Set.map unPackageName ppUsers@@ -186,6 +184,7 @@ ppUsers <- Set.map PackageName <$> (o .:? "users" .!= mempty) ppConstraints <- o .: "constraints" ppDesc <- o .: "description"+ ppSourceUrl <- o .:? "source-url" return PackagePlan {..} -- | Information on the contents of a cabal file@@ -196,9 +195,7 @@ -- ^ Various hashes of the file contents } deriving (Show, Eq, Generic)-instance Bin.Binary CabalFileInfo-instance Bin.HasStructuralInfo CabalFileInfo-instance Bin.HasSemanticVersion CabalFileInfo+instance Store CabalFileInfo instance ToJSON CabalFileInfo where toJSON CabalFileInfo {..} = object [ "size" .= cfiSize@@ -247,6 +244,7 @@ , pcBenches :: TestState , pcHaddocks :: TestState , pcFlagOverrides :: Map FlagName Bool+ , pcConfigureArgs :: Vector Text , pcEnableLibProfile :: Bool , pcSkipBuild :: Bool -- ^ Don't even bother building this library, useful when dealing with@@ -270,6 +268,7 @@ , "flags" .= Map.mapKeysWith const unFlagName pcFlagOverrides , "library-profiling" .= pcEnableLibProfile , "skip-build" .= pcSkipBuild+ , "configure-args" .= pcConfigureArgs ] where addMaintainer = maybe id (\m -> (("maintainer" .= m):)) pcMaintainer@@ -287,6 +286,7 @@ pcMaintainer <- o .:? "maintainer" pcEnableLibProfile <- fmap (fromMaybe True) (o .:? "library-profiling") pcSkipBuild <- o .:? "skip-build" .!= False+ pcConfigureArgs <- o .:? "configure-args" .!= mempty return PackageConstraints {..} data TestState = ExpectSuccess@@ -368,28 +368,39 @@ , sdProvidedExes :: Set ExeName , sdModules :: Set Text -- ^ modules exported by the library+ , sdCabalVersion :: Option (Max Version)+ -- ^ minimum acceptable Cabal version } 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+ mempty = SimpleDesc mempty mempty mempty mempty mempty+ mappend (SimpleDesc a b c d e) (SimpleDesc w x y z e') = SimpleDesc (Map.unionWith (<>) a w) (Map.unionWith (<>) b x) (c <> y) (d <> z)+ (e <> e') instance ToJSON SimpleDesc where- toJSON SimpleDesc {..} = object+ toJSON SimpleDesc {..} = object $ addCabalVersion [ "packages" .= Map.mapKeysWith const unPackageName sdPackages , "tools" .= Map.mapKeysWith const unExeName sdTools , "provided-exes" .= sdProvidedExes , "modules" .= sdModules ]+ where+ addCabalVersion rest =+ case sdCabalVersion of+ Option (Just (Max v)) -> ("cabal-version" .= display v) : rest+ Option Nothing -> rest 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"+ sdCabalVersion <- o .:? "cabal-version" >>= maybe+ (return $ Option Nothing)+ (either (fail . show) (return . Option . Just . Max) . simpleParse) return SimpleDesc {..} data DepInfo = DepInfo
Stackage/UpdateBuildPlan.hs view
@@ -30,6 +30,7 @@ bcPackageConstraints name = PackageConstraints { pcVersionRange = addBumpRange (maybe anyVersion pcVersionRange moldPC)+ , pcConfigureArgs = maybe mempty pcConfigureArgs moldPC , pcMaintainer = moldPC >>= pcMaintainer , pcTests = maybe ExpectSuccess pcTests moldPC , pcHaddocks = maybe ExpectSuccess pcHaddocks moldPC
app/stackage-build-plan.hs view
@@ -7,9 +7,9 @@ import Data.Text.Lazy.Builder (toLazyText) import qualified Data.Text.Lazy.IO as TLIO import Options.Applicative+import Options.Applicative.Simple (simpleOptions, simpleVersion) import Paths_stackage_curator (version) import Stackage.ShowBuildPlan-import Stackage.CLI (simpleOptions, simpleVersion) main :: IO () main = do
app/stackage.hs view
@@ -6,9 +6,8 @@ import qualified Data.Text as T import Data.Text.Read (decimal) import Options.Applicative+import Options.Applicative.Simple (simpleOptions, simpleVersion, addCommand) import Paths_stackage_curator (version)-import qualified Prelude-import Stackage.CLI import Stackage.CompleteBuild import Stackage.Curator.UploadIndex import Stackage.DiffPlans
stackage-curator.cabal view
@@ -1,8 +1,8 @@ name: stackage-curator-version: 0.14.0+version: 0.14.1 synopsis: Tools for curating Stackage bundles description: Please see <http://www.stackage.org/package/stackage-curator> for a description and documentation.-homepage: https://github.com/fpco/stackage+homepage: https://github.com/fpco/stackage-curator license: MIT license-file: LICENSE author: Michael Snoyman@@ -45,7 +45,7 @@ Stackage.Types build-depends: base >= 4 && < 5 , containers- , Cabal >= 1.14+ , Cabal >= 1.24 , tar >= 0.3 , zlib , bytestring@@ -93,9 +93,7 @@ , resourcet , stackage-install >= 0.1.1 , lucid- , binary- , binary-tagged- , binary-orphans+ , store , syb , safe , vector@@ -119,7 +117,6 @@ , stackage-curator , optparse-applicative >= 0.11 , optparse-simple- , stackage-cli , system-filepath , http-client , http-client-tls@@ -132,8 +129,8 @@ hs-source-dirs: app build-depends: base , stackage-curator- , stackage-cli , optparse-applicative+ , optparse-simple , text , aeson default-language: Haskell2010
test/Stackage/BuildPlanSpec.hs view
@@ -76,7 +76,7 @@ when (bp' /= bp) $ error "bp' /= bp" bp2 <- updateBuildPlan plans bp when (dropVersionRanges bp2 /= dropVersionRanges bp) $ error "bp2 /= bp"- checkBuildPlan bp+ checkBuildPlan False bp where dropVersionRanges bp = bp { bpPackages = map go $ bpPackages bp }@@ -110,11 +110,13 @@ PackagePlan {ppVersion = Version v [] ,ppCabalFileInfo = Nothing+ ,ppSourceUrl = Nothing ,ppGithubPings = mempty ,ppUsers = mempty ,ppConstraints = PackageConstraints {pcVersionRange = anyV+ ,pcConfigureArgs = mempty ,pcMaintainer = Nothing ,pcTests = Don'tBuild ,pcHaddocks = Don'tBuild@@ -127,7 +129,8 @@ {sdPackages = deps ,sdTools = mempty ,sdProvidedExes = mempty- ,sdModules = mempty}}+ ,sdModules = mempty+ ,sdCabalVersion = mempty}} -- | This exact version is required. thisV :: [Int] -> VersionRange
test/Stackage/PackageIndexSpec.hs view
@@ -4,7 +4,6 @@ import Stackage.PackageIndex import Stackage.Prelude import Test.Hspec-import Distribution.Package (packageId) import System.Directory (doesFileExist, getAppUserDataDirectory) spec :: Spec