diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -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 diff --git a/Stackage/BuildConstraints.hs b/Stackage/BuildConstraints.hs --- a/Stackage/BuildConstraints.hs +++ b/Stackage/BuildConstraints.hs @@ -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 diff --git a/Stackage/BuildPlan.hs b/Stackage/BuildPlan.hs --- a/Stackage/BuildPlan.hs +++ b/Stackage/BuildPlan.hs @@ -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 = diff --git a/Stackage/CheckBuildPlan.hs b/Stackage/CheckBuildPlan.hs --- a/Stackage/CheckBuildPlan.hs +++ b/Stackage/CheckBuildPlan.hs @@ -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) diff --git a/Stackage/CompleteBuild.hs b/Stackage/CompleteBuild.hs --- a/Stackage/CompleteBuild.hs +++ b/Stackage/CompleteBuild.hs @@ -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!" diff --git a/Stackage/CorePackages.hs b/Stackage/CorePackages.hs --- a/Stackage/CorePackages.hs +++ b/Stackage/CorePackages.hs @@ -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. diff --git a/Stackage/InstallBuild.hs b/Stackage/InstallBuild.hs --- a/Stackage/InstallBuild.hs +++ b/Stackage/InstallBuild.hs @@ -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 diff --git a/Stackage/PackageDescription.hs b/Stackage/PackageDescription.hs --- a/Stackage/PackageDescription.hs +++ b/Stackage/PackageDescription.hs @@ -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 diff --git a/Stackage/PackageIndex.hs b/Stackage/PackageIndex.hs --- a/Stackage/PackageIndex.hs +++ b/Stackage/PackageIndex.hs @@ -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 diff --git a/Stackage/PerformBuild.hs b/Stackage/PerformBuild.hs --- a/Stackage/PerformBuild.hs +++ b/Stackage/PerformBuild.hs @@ -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 diff --git a/Stackage/ShowBuildPlan.hs b/Stackage/ShowBuildPlan.hs --- a/Stackage/ShowBuildPlan.hs +++ b/Stackage/ShowBuildPlan.hs @@ -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) diff --git a/Stackage/Types.hs b/Stackage/Types.hs --- a/Stackage/Types.hs +++ b/Stackage/Types.hs @@ -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 diff --git a/Stackage/UpdateBuildPlan.hs b/Stackage/UpdateBuildPlan.hs --- a/Stackage/UpdateBuildPlan.hs +++ b/Stackage/UpdateBuildPlan.hs @@ -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 diff --git a/app/stackage-build-plan.hs b/app/stackage-build-plan.hs --- a/app/stackage-build-plan.hs +++ b/app/stackage-build-plan.hs @@ -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 diff --git a/app/stackage.hs b/app/stackage.hs --- a/app/stackage.hs +++ b/app/stackage.hs @@ -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 diff --git a/stackage-curator.cabal b/stackage-curator.cabal --- a/stackage-curator.cabal +++ b/stackage-curator.cabal @@ -1,8 +1,8 @@ name: stackage-curator -version: 0.14.0 +version: 0.14.1 synopsis: Tools for curating Stackage bundles description: Please see 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 diff --git a/test/Stackage/BuildPlanSpec.hs b/test/Stackage/BuildPlanSpec.hs --- a/test/Stackage/BuildPlanSpec.hs +++ b/test/Stackage/BuildPlanSpec.hs @@ -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 diff --git a/test/Stackage/PackageIndexSpec.hs b/test/Stackage/PackageIndexSpec.hs --- a/test/Stackage/PackageIndexSpec.hs +++ b/test/Stackage/PackageIndexSpec.hs @@ -4,7 +4,6 @@ import Stackage.PackageIndex import Stackage.Prelude import Test.Hspec -import Distribution.Package (packageId) import System.Directory (doesFileExist, getAppUserDataDirectory) spec :: Spec