diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,10 @@ +## 0.15.0.0 + +* Ignore packages with invalid flag definitions [fpco/stackage#2468](https://github.com/fpco/stackage/issues/2468) +* Support a `no-revisions` field to ignore Hackage revisions (experimental) [fpco/stackage#2469](https://github.com/fpco/stackage/issues/2469) +* Cabal 2.0 +* cabal-format-version + ## 0.14.5 * Add support for the `hide` field [yesodweb/wai#579](https://github.com/yesodweb/wai/issues/579) diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,6 +1,9 @@ ## stackage-curator [![Build Status](https://travis-ci.org/fpco/stackage-curator.svg?branch=master)](https://travis-ci.org/fpco/stackage-curator) +[![Hackage](http://img.shields.io/hackage/v/stackage-curator.png)](http://hackage.haskell.org/package/stackage-curator) +[![Stackage LTS](http://stackage.org/package/stackage-curator/badge/lts)](http://stackage.org/lts/package/stackage-curator) +[![Stackage Nightly](http://stackage.org/package/stackage-curator/badge/nightly)](http://stackage.org/nightly/package/stackage-curator) This repository contains the code for curating Stackage package sets and building reusable package databases. It was originally simply called the diff --git a/Stackage/BuildConstraints.hs b/Stackage/BuildConstraints.hs --- a/Stackage/BuildConstraints.hs +++ b/Stackage/BuildConstraints.hs @@ -49,6 +49,12 @@ -- cabal executable , bcTellMeWhenItsReleased :: Map PackageName Version + + , bcNoRevisions :: !(Set PackageName) + -- ^ see 'cfNoRevisions' + + , bcCabalFormatVersion :: !(Maybe Version) + -- ^ Maximum supported Cabal file format version } -- | Modify the version bounds with the given Dependencies @@ -124,10 +130,14 @@ , cfBuildToolOverrides :: Map Text (Set Text) , cfSkippedLibProfiling :: Set PackageName , cfGhcMajorVersion :: Maybe (Int, Int) + , cfCabalFormatVersion :: Maybe (Int, Int) + -- ^ Maximum supported Cabal file format version , cfTreatAsNonCore :: Set PackageName , cfTellMeWhenItsReleased :: Map PackageName Version , cfHide :: Set PackageName -- ^ Packages which should be hidden after registering + , cfNoRevisions :: !(Set PackageName) + -- ^ Packages where we should ignore any Hackage revisions } instance FromJSON ConstraintFile where @@ -148,15 +158,17 @@ cfGithubUsers <- o .: "github-users" cfBuildToolOverrides <- o .:? "build-tool-overrides" .!= mempty cfGhcMajorVersion <- o .:? "ghc-major-version" >>= mapM parseMajorVersion + cfCabalFormatVersion <- o .:? "cabal-format-version" >>= mapM parseMajorVersion cfTreatAsNonCore <- getPackages o "treat-as-non-core" <|> return mempty cfTellMeWhenItsReleased <- (fmap mconcat $ o .: "tell-me-when-its-released" >>= mapM toNameVerMap) Key "tell-me-when-its-released" - cfHide <- Set.map PackageName <$> o .:? "hide" .!= mempty + cfHide <- Set.map mkPackageName <$> o .:? "hide" .!= mempty + cfNoRevisions <- Set.map mkPackageName <$> o .:? "no-revisions" .!= mempty return ConstraintFile {..} where - goFlagMap = Map.mapKeysWith const FlagName - goPackageMap = Map.mapKeysWith const PackageName - getPackages o name = (setFromList . map PackageName) <$> o .: name + goFlagMap = Map.mapKeysWith const mkFlagName + goPackageMap = Map.mapKeysWith const mkPackageName + getPackages o name = (setFromList . map mkPackageName) <$> o .: name toDep :: Monad m => Text -> m Dependency toDep = either (fail . show) return . simpleParse @@ -166,7 +178,7 @@ . simpleParse parseMajorVersion t = - case versionBranch <$> simpleParse t of + case versionNumbers <$> simpleParse t of Just [x, y] -> return (x, y) _ -> fail $ "Invalid GHC major version: " ++ unpack t @@ -189,7 +201,7 @@ toBC ConstraintFile {..} = do bcSystemInfo <- removeFromCore cfTreatAsNonCore <$> getSystemInfo forM_ cfGhcMajorVersion $ \(major, minor) -> - case versionBranch $ siGhcVersion bcSystemInfo of + case versionNumbers $ siGhcVersion bcSystemInfo of major':minor':_ | major == major' && minor == minor' -> return () _ -> throwIO $ MismatchedGhcVersion (siGhcVersion bcSystemInfo) major minor return BuildConstraints {..} @@ -231,3 +243,7 @@ bcGithubUsers = cfGithubUsers bcBuildToolOverrides = cfBuildToolOverrides bcTellMeWhenItsReleased = cfTellMeWhenItsReleased + bcNoRevisions = cfNoRevisions + bcCabalFormatVersion = fmap + (\(x, y) -> mkVersion [x, y]) + cfCabalFormatVersion diff --git a/Stackage/BuildPlan.hs b/Stackage/BuildPlan.hs --- a/Stackage/BuildPlan.hs +++ b/Stackage/BuildPlan.hs @@ -79,6 +79,8 @@ , bpGithubUsers = bcGithubUsers , bpBuildToolOverrides = bcBuildToolOverrides , bpAllCabalHashesCommit = either (const Nothing) Just eallCabalHashesCommit + , bpNoRevisions = bcNoRevisions + , bpCabalFormatVersion = bcCabalFormatVersion } where SystemInfo {..} = bcSystemInfo @@ -96,7 +98,7 @@ overrides' :: Map ExeName (Set PackageName) overrides' = Map.mapKeysWith (++) ExeName - $ fmap (Set.map mkPackageName) overrides + $ fmap (Set.map (mkPackageName . unpack)) overrides topologicalSortTools :: MonadThrow m => Map ExeName (Set PackageName) @@ -194,5 +196,6 @@ getLatestAllowedPlans :: MonadIO m => BuildConstraints -> m (Map PackageName PackagePlan, Map PackageName Version) getLatestAllowedPlans bc = getLatestDescriptions + (bcNoRevisions bc) (isAllowed bc) (mkPackagePlan bc) diff --git a/Stackage/CheckBuildPlan.hs b/Stackage/CheckBuildPlan.hs --- a/Stackage/CheckBuildPlan.hs +++ b/Stackage/CheckBuildPlan.hs @@ -34,7 +34,7 @@ map (ppVersion &&& M.keys . M.filter libAndExe . sdPackages . ppDesc) bpPackages errs@(BadBuildPlan errs1 errs2) = execWriter $ do mapM_ (checkDeps getMaint allPackages) $ mapToList bpPackages - let cabalName = PackageName "Cabal" + let cabalName = mkPackageName "Cabal" case lookup cabalName bpPackages of Nothing | failMissingCabal -> tell @@ -43,7 +43,11 @@ $ singleton "Cabal not found in build plan" | otherwise -> return () Just (ppVersion -> cabalVersion) -> - mapM_ (checkCabalVersion cabalVersion) (mapToList bpPackages) + let cabalVersion' = + case bpCabalFormatVersion of + Nothing -> cabalVersion + Just formatVersion -> min formatVersion cabalVersion + in 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). diff --git a/Stackage/CorePackages.hs b/Stackage/CorePackages.hs --- a/Stackage/CorePackages.hs +++ b/Stackage/CorePackages.hs @@ -2,6 +2,7 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ViewPatterns #-} module Stackage.CorePackages ( getCorePackages , getCoreExecutables @@ -18,7 +19,7 @@ import System.FilePath (takeDirectory, takeFileName) addDeepDepends :: PackageName -> StateT (Map PackageName Version) IO () -addDeepDepends name@(PackageName name') = do +addDeepDepends name@(unPackageName -> name') = do m <- get case lookup name m of Just _ -> return () @@ -104,7 +105,7 @@ -- 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 = flip execStateT mempty $ mapM_ (addDeepDepends . PackageName) +getCorePackages = flip execStateT mempty $ mapM_ (addDeepDepends . mkPackageName) [ "ghc" {- , "haskell2010" diff --git a/Stackage/Curator/RevDeps.hs b/Stackage/Curator/RevDeps.hs --- a/Stackage/Curator/RevDeps.hs +++ b/Stackage/Curator/RevDeps.hs @@ -13,7 +13,7 @@ -> Bool -- ^ deep revdeps -> PackageName -- ^ package to check -> IO () -listRevDeps planFile deep pkg0 = do +listRevDeps planFile _FIXMEdeep pkg0 = do BuildPlan {..} <- decodeFileEither planFile >>= either throwIO return let go pkg = do visited <- get @@ -23,4 +23,4 @@ Nothing -> return () Just PackagePlan {..} -> mapM_ go ppUsers let pkgs = execState (go pkg0) (asSet mempty) - mapM_ (putStrLn . unPackageName) pkgs + mapM_ (putStrLn . pack . unPackageName) pkgs diff --git a/Stackage/Curator/UploadDocs.hs b/Stackage/Curator/UploadDocs.hs --- a/Stackage/Curator/UploadDocs.hs +++ b/Stackage/Curator/UploadDocs.hs @@ -30,7 +30,7 @@ import qualified Filesystem as F import qualified Filesystem.Path.CurrentOS as F import Network.AWS (Credentials (Discover), Env, - Region (NorthVirginia), newEnv, + newEnv, send, toBody, runAWS) import Network.AWS.S3 (ObjectCannedACL (OPublicRead), poACL, poCacheControl, diff --git a/Stackage/Curator/UploadIndex.hs b/Stackage/Curator/UploadIndex.hs --- a/Stackage/Curator/UploadIndex.hs +++ b/Stackage/Curator/UploadIndex.hs @@ -16,8 +16,7 @@ import qualified Codec.Archive.Tar as Tar import Data.Conduit.Lazy (lazyConsume) import Codec.Compression.GZip (compress) -import Network.AWS (Credentials (Discover), - Region (NorthVirginia), newEnv) +import Network.AWS (Credentials (Discover), newEnv) import Stackage.Curator.UploadDocs (upload) uploadIndex diff --git a/Stackage/DiffPlans.hs b/Stackage/DiffPlans.hs --- a/Stackage/DiffPlans.hs +++ b/Stackage/DiffPlans.hs @@ -1,5 +1,5 @@ {-# LANGUAGE FlexibleContexts, GADTs, NoImplicitPrelude, OverloadedStrings, - ScopedTypeVariables #-} + ScopedTypeVariables, ViewPatterns #-} module Stackage.DiffPlans ( diffPlans ) where @@ -9,7 +9,6 @@ import Data.Yaml (decodeFileEither) import Network.HTTP.Client import Network.HTTP.Simple (httpSink) -import Network.HTTP.Client.TLS (tlsManagerSettings) import Stackage.Prelude import Data.Maybe @@ -76,7 +75,7 @@ (singletonMap name $ (display x, Just $ display y)) isMajor :: Version -> Version -> Bool -isMajor (Version old _) (Version new _) = +isMajor (versionNumbers -> old) (versionNumbers -> new) = toPair old /= toPair new where toPair [] = (0, 0) diff --git a/Stackage/PackageDescription.hs b/Stackage/PackageDescription.hs --- a/Stackage/PackageDescription.hs +++ b/Stackage/PackageDescription.hs @@ -23,6 +23,7 @@ import Distribution.Compiler (CompilerFlavor) import Distribution.Package (Dependency (..)) import Distribution.PackageDescription +import Distribution.Types.CondTree (CondBranch (..)) import Distribution.System (Arch, OS) import Stackage.PackageIndex import Stackage.Prelude @@ -39,7 +40,7 @@ tell mempty { sdProvidedExes = setFromList $ map (fromString . fst) $ spdCondExecutables spd - , sdCabalVersion = Option $ Max <$> spdCabalVersion spd + , sdCabalVersion = Option $ Just $ Max $ spdCabalVersion spd , sdPackages = unionsWith (<>) $ maybe [] (map $ \(Dependency x y) -> singletonMap x DepInfo { diComponents = setFromList [minBound..maxBound] @@ -72,17 +73,17 @@ , diRange = simplifyVersionRange y } , sdTools = unionsWith (<>) $ flip map (sciBuildTools dat) - $ \(Dependency name range) -> singletonMap + $ \(name, range) -> singletonMap -- In practice, cabal files refer to the exe name, not the -- package name. - (ExeName $ unPackageName name) + name DepInfo { diComponents = singletonSet component , diRange = simplifyVersionRange range } , sdModules = sciModules dat } - forM_ comps $ \(cond, ontrue, onfalse) -> do + forM_ comps $ \(CondBranch cond ontrue onfalse) -> do b <- checkCond cc cond if b then loop ontrue diff --git a/Stackage/PackageIndex.hs b/Stackage/PackageIndex.hs --- a/Stackage/PackageIndex.hs +++ b/Stackage/PackageIndex.hs @@ -29,8 +29,11 @@ lazyConsume) import qualified Data.Text as T import Distribution.Compiler (CompilerFlavor) +import Distribution.Types.CondTree (CondBranch (..)) +import Distribution.Types.UnqualComponentName (unUnqualComponentName) +import Distribution.Types.ExeDependency import Distribution.Version (VersionRange (..)) -import Distribution.Package (Dependency) +import Distribution.Package (Dependency (..)) import Distribution.PackageDescription import Distribution.PackageDescription.Parse (ParseResult (..), parsePackageDescription) @@ -46,7 +49,7 @@ SHA512 (..), Skein512_512 (..), hashlazy, Digest, HashAlgorithm, digestToHexByteString) import qualified Crypto.Hash.SHA1 as SHA1 -import Data.Store (Store) +import Data.Store (Store (..), Size (..)) import qualified Data.Store as Store import qualified Data.Store.TypeHash as Store @@ -87,7 +90,7 @@ } data SimplifiedComponentInfo = SimplifiedComponentInfo - { sciBuildTools :: [Dependency] + { sciBuildTools :: [(ExeName, VersionRange)] , sciModules :: Set Text } deriving Generic @@ -104,7 +107,7 @@ , spdSetupDeps :: Maybe [Dependency] , spdPackageFlags :: Map FlagName Bool , spdGithubPings :: Set Text - , spdCabalVersion :: Maybe Version + , spdCabalVersion :: Version } deriving Generic @@ -114,16 +117,29 @@ instance Store SimplifiedPackageDescription instance Store a => Store (CondTree ConfVar [Dependency] a) +instance Store a => Store (CondBranch 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 PackageName where + size = + case size of + VarSize f -> VarSize (f . unPackageName) + ConstSize _ -> error "impossible" + poke = poke . unPackageName + peek = mkPackageName <$> peek instance Store Version instance Store VersionRange -instance Store FlagName +instance Store FlagName where + size = + case size of + VarSize f -> VarSize (f . unFlagName) + ConstSize _ -> error "impossible" + poke = poke . unFlagName + peek = mkFlagName <$> peek -- END orphans Store.mkManyHasTypeHash @@ -157,54 +173,36 @@ ] } , 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 + , spdCondExecutables = map unqual $ map (fmap $ mapCondTree simpleExe) $ condExecutables gpd + , spdCondTestSuites = map unqual $ map (fmap $ mapCondTree simpleTest) $ condTestSuites gpd + , spdCondBenchmarks = map unqual $ map (fmap $ mapCondTree simpleBench) $ condBenchmarks gpd , spdSetupDeps = fmap 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 + , spdCabalVersion = specVersion $ packageDescription gpd } where PackageIdentifier name version = package $ packageDescription gpd + unqual = first unUnqualComponentName + simpleLib = helper getModules libBuildInfo simpleExe = helper noModules buildInfo simpleTest = helper noModules testBuildInfo simpleBench = helper noModules benchmarkBuildInfo helper getModules' getBI x = SimplifiedComponentInfo - { sciBuildTools = buildTools $ getBI x + { sciBuildTools = map + (\(ExeDependency _ name' range) -> (ExeName $ pack $ unUnqualComponentName name', range)) + (buildToolDepends $ getBI x) , sciModules = getModules' x } noModules = const mempty getModules = setFromList . map display . exposedModules -deriving instance Functor (CondTree v c) - mapCondTree :: (a -> b) -> CondTree v c a -> CondTree v c b mapCondTree = fmap @@ -299,10 +297,12 @@ -- | Get all of the latest descriptions for name/version pairs matching the -- given criterion. getLatestDescriptions :: MonadIO m - => (PackageName -> Version -> Bool) - -> (SimplifiedPackageDescription -> IO desc) + => Set PackageName + -- ^ packages where we ignore the Hackage revisions + -> (PackageName -> Version -> Bool) + -> (SimplifiedPackageDescription -> Either SomeException desc) -> m (Map PackageName desc, Map PackageName Version) -getLatestDescriptions f parseDesc = liftIO $ do +getLatestDescriptions noRevisions f parseDesc = liftIO $ do root <- fmap ( "curator") $ getAppUserDataDirectory "stackage" -- Parse twice to avoid keeping stuff in memory: once to determine which @@ -318,10 +318,13 @@ liftIO $ putStrLn "Parsing package descriptions" plans <- runResourceT $ sourcePackageIndex $$ flip foldMC mempty (\m ucf -> - if lookup (ucfName ucf) (asMap mvers) == Just (ucfVersion ucf) + if lookup (ucfName ucf) (asMap mvers) == Just (ucfVersion ucf) && + (ucfName ucf `notMember` noRevisions || ucfName ucf `notMember` m) then do - desc <- liftIO $ ucfParse root ucf >>= parseDesc - return $! insertMap (ucfName ucf) desc m + edesc <- liftIO $ parseDesc <$> ucfParse root ucf + case edesc of + Left e -> print e $> m + Right desc -> return $! insertMap (ucfName ucf) desc m else return m) return (plans, latests) where diff --git a/Stackage/PerformBuild.hs b/Stackage/PerformBuild.hs --- a/Stackage/PerformBuild.hs +++ b/Stackage/PerformBuild.hs @@ -6,6 +6,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE ScopedTypeVariables #-} module Stackage.PerformBuild ( performBuild @@ -26,6 +27,7 @@ condTestSuites) import Distribution.Package (Dependency (..)) import Distribution.PackageDescription.PrettyPrint (writeGenericPackageDescription) +import Distribution.Types.UnqualComponentName import Distribution.Version (anyVersion) import Filesystem (canonicalizePath, createTree, getWorkingDirectory, @@ -56,7 +58,7 @@ show (BuildException m warnings) = unlines $ "" : "" : "" : map go (mapToList m) ++ map unpack warnings where - go (PackageName name, bf) = concat + go (unPackageName -> name, bf) = concat [ name , ": " , take 500 $ show bf @@ -146,7 +148,7 @@ -- Since we build every package using the Cabal library, it's an implicit -- dependency of everything addCabal :: Set PackageName -> Set PackageName - addCabal = insertSet (PackageName "Cabal") + addCabal = insertSet (mkPackageName "Cabal") withCounter :: TVar Int -> IO a -> IO a withCounter counter = bracket_ @@ -304,7 +306,7 @@ testComps = insertSet CompTestSuite libComps benchComps = insertSet CompBenchmark libComps - thisIsCabal = pname == PackageName "Cabal" -- cue Sparta joke + thisIsCabal = pname == mkPackageName "Cabal" -- cue Sparta joke inner | thisIsCabal && pbNoRebuildCabal = @@ -327,6 +329,13 @@ , "-" , version ] + nameverrevhash = concat + [ namever + , fromMaybe (assert False "") $ do + cfi <- ppCabalFileInfo $ piPlan sbPackageInfo + hash <- lookup "GitSHA1" $ cfiHashes cfi + Just $ "@gitsha1:" ++ hash + ] quote :: Text -> Text quote s @@ -402,13 +411,17 @@ inner' getH `finally` cleanup - runghcArgs :: [Text] -> [Text] - runghcArgs rest = - "-clear-package-db" - : "-global-package-db" - : (case pbDatabase pb of - Nothing -> rest - Just db -> ("-package-db=" ++ pack db) : setupPackages ++ rest) + setup run args = do + _ <- run "ghc" $ runghcArgs ["Setup"] + run "./Setup" args + where + runghcArgs :: [Text] -> [Text] + runghcArgs rest = + "-clear-package-db" + : "-global-package-db" + : (case pbDatabase pb of + Nothing -> rest + Just db -> ("-package-db=" ++ pack db) : setupPackages ++ rest) setupPackages :: [Text] setupPackages = @@ -445,7 +458,7 @@ tell' x = tell (x:) flags :: Text - flags = unwords $ map go $ mapToList pcFlagOverrides + flags = pack $ unwords $ map go $ mapToList pcFlagOverrides where go (name', isOn) = concat [ if isOn then "" else "-" @@ -473,9 +486,9 @@ ] return $ sbBuildDir "cabal" "Cabal" else do - log' $ "Unpacking " ++ namever + log' $ "Unpacking " ++ nameverrevhash case ppSourceUrl $ piPlan sbPackageInfo of - Nothing -> runParent getOutH "stack" ["unpack", namever] + Nothing -> runParent getOutH "stack" ["unpack", nameverrevhash] Just url -> unpackFromURL sbBuildDir url return $ sbBuildDir unpack namever @@ -489,7 +502,7 @@ let withConfiged inner' = withUnpacked $ \_gpd childDir -> do let run a b = do when pbVerbose $ log' (unwords (a : b)) runIn childDir getOutH a b - cabal args = run "runghc" $ runghcArgs $ "Setup" : args + cabal = setup run unlessM (readIORef isConfiged) $ do log' $ "Configuring " ++ namever @@ -603,7 +616,7 @@ && not pcSkipBuild when needTest $ withUnpacked $ \gpd childDir -> do let run = runIn childDir getOutH - cabal args = run "runghc" $ runghcArgs $ "Setup" : args + cabal = setup run log' $ "Test configure " ++ namever cabal $ "configure" : "--enable-tests" : configArgs @@ -612,7 +625,7 @@ log' $ "Test build " ++ namever cabal ["build"] - let tests = map fst $ condTestSuites gpd + let tests = map (unUnqualComponentName . fst) $ condTestSuites gpd forM_ tests $ \test -> do log' $ concat [ "Test run " @@ -637,7 +650,7 @@ ] else do outH <- getOutH - hPut outH $ encodeUtf8 $ "Test suite not built: " ++ pack test + hPut outH $ encodeUtf8 $ asText $ "Test suite not built: " ++ pack test savePreviousResult pb Test pident $ either (const False) (const True) eres case (eres, pcTests) of @@ -652,7 +665,7 @@ && not pcSkipBuild when needTest $ withUnpacked $ \_gpd childDir -> do let run = runIn childDir getOutH - cabal args = run "runghc" $ runghcArgs $ "Setup" : args + cabal = setup run log' $ "Benchmark configure " ++ namever cabal $ "configure" : "--enable-benchmarks" : configArgs @@ -858,7 +871,7 @@ go dir = case simpleParse nameVerText of Nothing -> return mempty - Just (PackageIdentifier (PackageName name) _) -> do + Just (PackageIdentifier (unPackageName -> name) _) -> do let fp = dir name <.> "haddock" exists <- doesFileExist fp return $ if exists @@ -987,8 +1000,8 @@ -- If we have a previous successful build result which -- matches our version, then we'll need to check -- dependencies to know what to do - | Just (prevVer, prevRes) <- prevRes name Build - , prevVer == version && prevRes == PRSuccess = mempty + | Just (prevVer, prevRes') <- prevRes name Build + , prevVer == version && prevRes' == PRSuccess = mempty -- Something in the previous step failed, so do a full build | otherwise = singletonMap name BSFullBuild diff --git a/Stackage/Prelude.hs b/Stackage/Prelude.hs --- a/Stackage/Prelude.hs +++ b/Stackage/Prelude.hs @@ -11,11 +11,11 @@ import ClassyPrelude.Conduit as X import Data.Conduit.Process as X import qualified Data.Map as Map -import Distribution.Package as X (PackageIdentifier (..), PackageName (PackageName)) -import Distribution.PackageDescription as X (FlagName (..), GenericPackageDescription) -import Distribution.Version as X (Version (..), - VersionRange) -import Distribution.Version as X (withinRange) +import Distribution.Package as X (PackageIdentifier (..)) +import Distribution.PackageDescription as X (FlagName, GenericPackageDescription) +import Distribution.Version as X (Version, VersionRange) +import Distribution.Version as X (withinRange, versionNumbers, mkVersion) +import Distribution.Types.PackageName as X (PackageName, mkPackageName, unPackageName) import qualified Distribution.Version as C import Filesystem (createTree) import Filesystem.Path (parent) diff --git a/Stackage/ServerBundle.hs b/Stackage/ServerBundle.hs --- a/Stackage/ServerBundle.hs +++ b/Stackage/ServerBundle.hs @@ -66,7 +66,7 @@ hackage = builderToLazy $ foldMap goPair $ mapToList packageMap -- need to remove some packages that don't exist on Hackage - packageMap = foldr deleteMap (bpAllPackages bp) $ map PackageName + packageMap = foldr deleteMap (bpAllPackages bp) $ map mkPackageName [ "bin-package-db" , "ghc" , "rts" @@ -80,7 +80,7 @@ corePackagesList = builderToLazy $ toBuilder $ unlines $ - map (\(PackageName name) -> name) + map unPackageName (M.keys $ siCorePackages bpSystemInfo) docsListing :: BuildPlan @@ -164,10 +164,10 @@ $$ filterMC (liftIO . doesDirectoryExist) =$ mapC takeFileName =$ sinkList - writeFile (dir "index.html") $ encodeUtf8 $ pack $ mkIndex + writeFile (dir "index.html") $ encodeUtf8 $ asText $ pack $ mkIndex (unpack <$> msnapid) dirs - writeFile (dir "style.css") $ encodeUtf8 $ pack styleCss + writeFile (dir "style.css") $ encodeUtf8 $ asText $ pack styleCss return dirs mkIndex :: Maybe String -> [String] -> String diff --git a/Stackage/ShowBuildPlan.hs b/Stackage/ShowBuildPlan.hs --- a/Stackage/ShowBuildPlan.hs +++ b/Stackage/ShowBuildPlan.hs @@ -45,7 +45,7 @@ import Data.Text.Read (decimal) import Data.Time (Day) import Data.Typeable (Typeable) -import Data.Version (Version) +import Distribution.Version (Version) import Data.Yaml (decodeFileEither) import Distribution.Package (PackageName) import Network.HTTP.Client (Manager, brRead, httpLbs, @@ -356,7 +356,7 @@ forM_ (Map.toList $ sdPackages $ ppDesc pp) $ \(name', depInfo) -> when (includeDep depInfo) (goName name') addToList name (ppVersion pp) - (Map.mapKeysWith const unFlagName + (Map.mapKeysWith const (T.pack . unFlagName) $ pcFlagOverrides $ ppConstraints pp) False diff --git a/Stackage/Types.hs b/Stackage/Types.hs --- a/Stackage/Types.hs +++ b/Stackage/Types.hs @@ -24,10 +24,10 @@ -- * Helper functions , display , simpleParse - , unPackageName - , mkPackageName - , unFlagName - , mkFlagName + , C.unPackageName + , C.mkPackageName + , C.unFlagName + , C.mkFlagName , intersectVersionRanges , compToText ) where @@ -53,8 +53,10 @@ import qualified Data.Traversable as T import Data.Typeable (TypeRep, Typeable, typeOf) import Data.Vector (Vector) -import Distribution.Package (PackageName (PackageName)) -import Distribution.PackageDescription (FlagName (..)) +import Distribution.Types.PackageName (PackageName) +import qualified Distribution.Types.PackageName as C +import qualified Distribution.PackageDescription as C +import Distribution.PackageDescription (FlagName) import Distribution.System (Arch, OS) import qualified Distribution.Text as DT import Distribution.Version (Version, VersionRange) @@ -124,17 +126,23 @@ , bpGithubUsers :: Map Text (Set Text) , bpBuildToolOverrides :: Map Text (Set Text) , bpAllCabalHashesCommit :: Maybe Text + , bpNoRevisions :: !(Set PackageName) + -- ^ Packages where we ignore Hackage revisions + , bpCabalFormatVersion :: !(Maybe Version) + -- ^ Maximum allowed version of the Cabal file format } deriving (Show, Eq) instance ToJSON BuildPlan where toJSON BuildPlan {..} = object $ maybe id (\x -> (("all-cabal-hashes-commit" .= x):)) bpAllCabalHashesCommit + $ maybe id (\x -> (("cabal-format-version" .= display x):)) bpCabalFormatVersion [ "system-info" .= bpSystemInfo , "tools" .= fmap goTool bpTools , "packages" .= Map.mapKeysWith const unPackageName bpPackages , "github-users" .= bpGithubUsers , "build-tool-overrides" .= bpBuildToolOverrides + , "no-revisions" .= Set.map unPackageName bpNoRevisions ] where goTool (k, v) = object @@ -149,6 +157,9 @@ bpGithubUsers <- o .:? "github-users" .!= mempty bpBuildToolOverrides <- o .:? "build-tool-overrides" .!= mempty bpAllCabalHashesCommit <- o .:? "all-cabal-hashes-commit" + bpNoRevisions <- Set.map C.mkPackageName <$> o .:? "no-revisions" .!= mempty + bpCabalFormatVersion <- o .:? "cabal-format-version" >>= T.mapM + (either (fail . show) return . simpleParse . asText) return BuildPlan {..} where goTool = withObject "Tool" $ \o -> (,) @@ -185,7 +196,7 @@ . simpleParse . asText ppCabalFileInfo <- o .:? "cabal-file-info" ppGithubPings <- o .:? "github-pings" .!= mempty - ppUsers <- Set.map PackageName <$> (o .:? "users" .!= mempty) + ppUsers <- Set.map C.mkPackageName <$> (o .:? "users" .!= mempty) ppConstraints <- o .: "constraints" ppDesc <- o .: "description" ppSourceUrl <- o .:? "source-url" @@ -236,10 +247,10 @@ instance Exception ParseFailedException unPackageName :: PackageName -> Text -unPackageName (PackageName str) = pack str +unPackageName = pack . C.unPackageName mkPackageName :: Text -> PackageName -mkPackageName = PackageName . unpack +mkPackageName = C.mkPackageName . unpack data PackageConstraints = PackageConstraints { pcVersionRange :: VersionRange @@ -350,17 +361,17 @@ . Map.mapKeysWith const mkPackageName unFlagName :: FlagName -> Text -unFlagName (FlagName str) = pack str +unFlagName = pack . C.unFlagName mkFlagName :: Text -> FlagName -mkFlagName = FlagName . unpack +mkFlagName = C.mkFlagName . unpack 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) + deriving (Show, Eq, Ord, Hashable, ToJSON, FromJSON, IsString, Generic, Store) -- | A simplified package description that tracks: -- diff --git a/Stackage/UpdateBuildPlan.hs b/Stackage/UpdateBuildPlan.hs --- a/Stackage/UpdateBuildPlan.hs +++ b/Stackage/UpdateBuildPlan.hs @@ -31,6 +31,8 @@ bcGithubUsers = bpGithubUsers bcBuildToolOverrides = bpBuildToolOverrides bcTellMeWhenItsReleased = mempty -- we don't care when doing an update + bcNoRevisions = bpNoRevisions + bcCabalFormatVersion = bpCabalFormatVersion bcPackageConstraints name = PackageConstraints { pcVersionRange = addBumpRange (maybe anyVersion pcVersionRange moldPC) @@ -56,7 +58,7 @@ 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] [] + (earlierVersion $ bumpVersion $ versionNumbers version) + bumpVersion (x:y:_) = mkVersion [x, y + 1] + bumpVersion [x] = mkVersion [x, 1] + bumpVersion [] = assert False $ mkVersion [1, 0] 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 @@ -20,7 +20,7 @@ "Calculate and print (in different formats) Stackage build plans" options empty - tis <- getBuildPlan set $ map (mkPackageName . T.pack) packages + tis <- getBuildPlan set $ map mkPackageName packages TLIO.putStr $ render set tis where options = (,,) diff --git a/stackage-curator.cabal b/stackage-curator.cabal --- a/stackage-curator.cabal +++ b/stackage-curator.cabal @@ -1,5 +1,5 @@ name: stackage-curator -version: 0.14.5 +version: 0.15.0.0 synopsis: Tools for curating Stackage bundles description: Please see for a description and documentation. homepage: https://github.com/fpco/stackage-curator @@ -41,7 +41,7 @@ Stackage.Types build-depends: base >= 4 && < 5 , containers - , Cabal >= 1.24 + , Cabal >= 2.0 && < 2.1 , tar >= 0.3 , zlib , bytestring diff --git a/test/Stackage/BuildPlanSpec.hs b/test/Stackage/BuildPlanSpec.hs --- a/test/Stackage/BuildPlanSpec.hs +++ b/test/Stackage/BuildPlanSpec.hs @@ -96,12 +96,12 @@ M.fromList $ map (\(name,ver,deps) -> - ( PackageName name + ( mkPackageName name , dummyPackage ver $ M.fromList $ map (\(dname,dver) -> - ( PackageName dname + ( mkPackageName dname , DepInfo {diComponents = S.fromList [CompLibrary] ,diRange = dver})) @@ -110,7 +110,7 @@ where dummyPackage v deps = PackagePlan - {ppVersion = Version v [] + {ppVersion = mkVersion v ,ppCabalFileInfo = Nothing ,ppSourceUrl = Nothing ,ppGithubPings = mempty @@ -138,7 +138,7 @@ -- | This exact version is required. thisV :: [Int] -> VersionRange -thisV ver = thisVersion (Version ver []) +thisV ver = thisVersion (mkVersion ver) -- | Accept any version. anyV :: VersionRange diff --git a/test/Stackage/CorePackagesSpec.hs b/test/Stackage/CorePackagesSpec.hs --- a/test/Stackage/CorePackagesSpec.hs +++ b/test/Stackage/CorePackagesSpec.hs @@ -11,7 +11,7 @@ it "contains known core packages" $ do m <- getCorePackages forM_ (words "ghc containers base") $ \p -> - m `shouldSatisfy` (member (PackageName p)) + m `shouldSatisfy` (member (mkPackageName p)) it "getCoreExecutables includes known executables" $ do s <- getCoreExecutables s `shouldSatisfy` member "ghc" diff --git a/test/Stackage/PackageIndexSpec.hs b/test/Stackage/PackageIndexSpec.hs --- a/test/Stackage/PackageIndexSpec.hs +++ b/test/Stackage/PackageIndexSpec.hs @@ -14,7 +14,7 @@ [ (asText "base", asText "4.5.0.0") , ("does-not-exist", "9999999999999999999") ]) - (m, _) <- getLatestDescriptions f return + (m, _) <- getLatestDescriptions mempty f return length m `shouldBe` 1 p <- simpleParse $ asText "base" v <- simpleParse $ asText "4.5.0.0"