stackage-curator 0.8.0.1 → 0.8.1
raw patch · 7 files changed
+133/−130 lines, 7 files
Files
- ChangeLog.md +5/−0
- Stackage/BuildConstraints.hs +17/−0
- Stackage/CompleteBuild.hs +4/−2
- Stackage/CorePackages.hs +85/−24
- Stackage/PackageIndex.hs +4/−1
- app/stackage.hs +17/−102
- stackage-curator.cabal +1/−1
ChangeLog.md view
@@ -1,3 +1,8 @@+## 0.8.1++* Redefine core packages [#395](https://github.com/fpco/stackage/issues/395)+* Add --constraint flag for create-plan+ ## 0.8.0.1 * GHC 7.10 support
Stackage/BuildConstraints.hs view
@@ -14,6 +14,7 @@ , toBC , BuildConstraintsSource (..) , loadBuildConstraints+ , setConstraints ) where import Control.Monad.Writer.Strict (execWriter, tell)@@ -39,6 +40,22 @@ , bcGithubUsers :: Map Text (Set Text) -- ^ map an account to set of pingees }++-- | Modify the version bounds with the given Dependencies+setConstraints :: [Dependency] -> BuildConstraints -> BuildConstraints+setConstraints deps bc =+ bc { bcPackageConstraints = f }+ where+ depMap = unionsWith intersectVersionRanges $ map toMap deps+ toMap (Dependency k v) = asMap $ singletonMap k v++ f' = bcPackageConstraints bc+ f pkg =+ case lookup pkg depMap of+ Nothing -> pc+ Just vr -> pc { pcVersionRange = vr }+ where+ pc = f' pkg -- | The proposed plan from the requirements provided by contributors. --
Stackage/CompleteBuild.hs view
@@ -19,6 +19,7 @@ ) where import System.Directory (getAppUserDataDirectory)+import Distribution.Package (Dependency) import Filesystem (isDirectory, createTree, isFile, rename) import Filesystem.Path (parent) import Control.Concurrent (threadDelay, getNumCapabilities)@@ -232,8 +233,9 @@ createPlan :: Target -> FilePath+ -> [Dependency] -- ^ additional constraints -> IO ()-createPlan target dest = withManager tlsManagerSettings $ \man -> do+createPlan target dest constraints = withManager tlsManagerSettings $ \man -> do putStrLn $ "Creating plan for: " ++ tshow target bc <- case target of@@ -253,7 +255,7 @@ return $ updateBuildConstraints oldplan _ -> defaultBuildConstraints man - plan <- planFromConstraints bc+ plan <- planFromConstraints $ setConstraints constraints bc putStrLn $ "Writing build plan to " ++ fpToText dest encodeFile (fpToString dest) plan
Stackage/CorePackages.hs view
@@ -1,43 +1,104 @@-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-} module Stackage.CorePackages ( getCorePackages , getCoreExecutables , getGhcVersion ) where -import qualified Data.Text as T-import Filesystem (listDirectory)+import Control.Monad.State.Strict (StateT, execStateT, get, modify,+ put)+import qualified Data.Map.Lazy as Map+import qualified Data.Text as T+import Filesystem (listDirectory) import Stackage.Prelude-import System.Directory (findExecutable)+import System.Directory (findExecutable) +addDeepDepends :: PackageName -> StateT (Map PackageName Version) IO ()+addDeepDepends name@(PackageName name') = do+ m <- get+ case lookup name m of+ Just _ -> return ()+ Nothing -> do+ -- Specifically use a lazy Map insert since we inject bottom as a+ -- value. If anyone's curious as the presence of the bottom: we+ -- need to insert something to avoid cycles. We could keep a+ -- separate Set of already-traversed packages, but this is easier+ -- (if a bit hackier).+ put $ Map.insert name (error "Version prematurely forced") m+ let cp = proc "ghc-pkg" ["--no-user-package-conf", "describe", name']+ version <- withCheckedProcess cp $ \ClosedStream src Inherited ->+ src $$ decodeUtf8C =$ linesUnboundedC =$ getZipSink (+ ZipSink (dependsConduit =$ dependsSink)+ *> ZipSink versionSink)+ modify $ insertMap name version+ where+ -- This sink finds the first line starting with "version: " and parses the+ -- value+ versionSink =+ loop+ where+ loop = await >>= maybe (error "version: not found") go++ go t =+ case stripPrefix "version: " t of+ Nothing -> loop+ Just x -> simpleParse x++ -- Finds the beginning of the depends: block and parses the value. Lots of+ -- ugly text hacking here to try and be compatible with multiple versions+ -- of GHC.+ dependsConduit = do+ dropWhileC $ not . ("depends:" `isPrefixOf`)+ takeWhileC isGood =$= concatMapC sanitize+ where+ -- GHC 7.8 puts a package on the first line with "depends:", GHC 7.10+ -- does not. We want to take all lines that have a dependency and then+ -- stop. This finds them.+ isGood t = "depends:" `isPrefixOf` t || " " `isPrefixOf` t++ -- Strip off: leading whitespace, the word buildin_rts for some reason, and+ -- the depends:. If we end up with an empty line or a line with just+ -- builtin_rts, ignore it.+ sanitize t1+ | null t2 = Nothing+ | t2 == "builtin_rts" = Nothing+ | otherwise = Just t2+ where+ t2 = dropPrefixMaybe "builtin_rts " $ dropPrefixMaybe "depends:" t1++ dropPrefixMaybe x y' =+ fromMaybe y $ stripPrefix x y+ where+ y = dropWhile (== ' ') y'++ -- For each dependency we find: parse it to a package name and then add its+ -- dependencies.+ dependsSink = mapM_C $ \t -> do+ pn <- simpleParse $ getPackageName t+ addDeepDepends pn++ -- Strip off the hash and version number+ getPackageName =+ reverse . dropSeg . dropSeg . reverse . dropWhile (== ' ')+ where+ dropSeg = drop 1 . dropWhile (/= '-')+ -- | 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+getCorePackages = flip execStateT mempty $ mapM_ (addDeepDepends . PackageName)+ [ "ghc"+ {-+ , "haskell2010"+ , "haskell98"+ -}+ ] -- | A list of executables that are shipped with GHC. getCoreExecutables :: IO (Set ExeName)
Stackage/PackageIndex.hs view
@@ -80,7 +80,7 @@ | otherwise = return () goContent fp name version lbs =- case parsePackageDescription $ unpack $ decodeUtf8 lbs of+ case parsePackageDescription $ unpack $ dropBOM $ decodeUtf8 lbs of ParseFailed e -> throwM $ CabalParseException (fpFromString fp) e ParseOk _warnings gpd -> do let pd = packageDescription gpd@@ -89,6 +89,9 @@ throwM $ MismatchedNameVersion (fpFromString fp) name name' version version' return gpd++ -- https://github.com/haskell/hackage-server/issues/351+ dropBOM t = fromMaybe t $ stripPrefix "\xFEFF" t parseNameVersion t1 = do let (p', t2) = break (== '/') $ T.replace "\\" "/" t1
app/stackage.hs view
@@ -40,7 +40,11 @@ addCommand "update" "Update the package index" id (pure $ stackageUpdate defaultStackageUpdateSettings) addCommand "create-plan" "Generate a new plan file (possibly based on a previous LTS)" id- (createPlan <$> target <*> planFile)+ (createPlan+ <$> target+ <*> planFile+ <*> many constraint+ ) addCommand "check" "Verify that a plan is valid" id (checkPlan <$> (fmap Just planFile <|> pure Nothing)) addCommand "fetch" "Fetch all tarballs needed by a plan" id@@ -74,107 +78,6 @@ <*> allowNewer - {-- config =- subparser $- mconcat- [ cmnd- (uncurry completeBuild)- (fmap (Nightly, ) buildFlags)- "nightly"- "Build, test and upload the Nightly snapshot"- , cmnd- (uncurry completeBuild)- (lts Major)- "lts-major"- "Build, test and upload the LTS (major) snapshot"- , cmnd- (uncurry completeBuild)- (lts Minor)- "lts-minor"- "Build, test and upload the LTS (minor) snapshot"- , cmnd- (const justCheck)- (pure ())- "check"- "Just check that the build plan is ok"- , cmnd- installBuild- installFlags- "install"- , cmnd- upload- uploadFlags- "upload"- "Upload a pre-existing bundle"- , cmnd- printStats- printStatsFlags- "stats"- "Print statistics on a build plan"- , cmnd- (uncurry diffPlans)- diffPlansFlags- "diff"- "Show the high-level differences between two build plans"- ]-- 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 "skip-check" <>- help "Skip the check phase, and pass --allow-newer to cabal configure") <*>- (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")) <*>- (fmap (Just . fromString) (strOption- (long "bundle-dest" <> metavar "FILENAME"))- <|> pure Nothing) <*>- (fmap not (switch- (long "skip-git-push" <>- help "Do not perform a git push after completion (for LTS builds only)"))) <*>- (fmap (Just . fromString) (strOption- (long "plan-file" <> metavar "FILENAME"))- <|> pure Nothing) <*>- (switch- (long "pre-build" <>- help "Only perform operations up until the actual build")) <*>- (switch- (long "load-plan" <>- help "Load plan from file"))- -}- installFlags :: Parser InstallFlags installFlags = InstallFlags <$>@@ -330,3 +233,15 @@ metavar "SERVER-URL" ++ showDefault ++ value (T.unpack $ unStackageServer def) ++ help "Server to upload bundle to")))++ constraint =+ option constraintRead+ (long "constraint" +++ metavar "CONSTRAINT" +++ help "New constraints for plan construction")++ constraintRead = do+ s <- str+ case simpleParse $ T.pack s of+ Nothing -> fail $ "Invalid constraint: " ++ s+ Just d -> return d
stackage-curator.cabal view
@@ -1,5 +1,5 @@ name: stackage-curator-version: 0.8.0.1+version: 0.8.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