git.iko.soy/stackage
on master help sign in
Constrain core packages
commita9d7c3006acd0be1da4c3b03ed075c24590f378b authorMichael Snoyman <michael@snoyman.com> dateThu 17 Apr 2014, 19:18 (13 years ago) parentcce5002
5 files changed+22−9
compare with master
unifiedsplit
Stackage/BuildPlan.hs+12−2 Stackage/InstallInfo.hs+6−4 Stackage/ServerFiles.hs+1 Stackage/Tarballs.hs+1−1 Stackage/Types.hs+2−2
Stackage/BuildPlan.hs+12−2
@@ -11,6 +11,7 @@ import qualified Data.Set as Set
1111import Distribution.Text (display, simpleParse)
1212import Stackage.Types
1313import qualified System.IO.UTF8
14+import Data.Char (isSpace)
1415
1516readBuildPlan :: FilePath -> IO BuildPlan
1617readBuildPlan fp = do
@@ -31,7 +32,7 @@ instance AsString BuildPlan where
3132 toString BuildPlan {..} = concat
3233 [ makeSection "tools" bpTools
3334 , makeSection "packages" $ Map.toList bpPackages
34− , makeSection "core" $ Set.toList bpCore
35+ , makeSection "core" $ Map.toList bpCore
3536 , makeSection "optional-core" $ Map.toList bpOptionalCore
3637 , makeSection "skipped-tests" $ Set.toList bpSkippedTests
3738 ]
@@ -44,7 +45,7 @@ instance AsString BuildPlan where
4445 let bp = BuildPlan
4546 { bpTools = tools
4647 , bpPackages = Map.fromList packages
47− , bpCore = Set.fromList core
48+ , bpCore = Map.fromList core
4849 , bpOptionalCore = Map.fromList optionalCore
4950 , bpSkippedTests = Set.fromList skipped
5051 }
@@ -64,6 +65,15 @@ instance AsString PackageName where
6465 toString (PackageName pn) = pn
6566 fromString s = Right (PackageName s, "")
6667
68+instance AsString (Maybe Version) where
69+ toString Nothing = ""
70+ toString (Just x) = toString x
71+ fromString s
72+ | all isSpace s = return (Nothing, s)
73+ | otherwise = do
74+ (v, s') <- fromString s
75+ return (Just v, s')
76+
6777instance AsString a => AsString (PackageName, a) where
6878 toString (PackageName pn, s) = concat [pn, " ", toString s]
6979 fromString s = do
Stackage/InstallInfo.hs+6−4
@@ -1,4 +1,5 @@
11{-# LANGUAGE RecordWildCards #-}
2+{-# LANGUAGE TupleSections #-}
23module Stackage.InstallInfo
34 ( getInstallInfo
45 , bpPackageList
@@ -54,15 +55,16 @@ getInstallInfo settings = do
5455 allPackages = dropExcluded settings allPackages'
5556 let totalCore
5657 | ignoreUpgradeableCore settings =
57− Set.fromList $ map PackageName $ words "base containers template-haskell"
58+ Map.fromList $ map (\n -> (PackageName n, Nothing)) $ words "base containers template-haskell"
5859 | otherwise =
59− extraCore settings `Set.union` Set.map (\(PackageIdentifier p _) -> p) core
60+ Map.fromList (map (\(PackageIdentifier p v) -> (p, Just v)) (Set.toList core))
61+ `Map.union` Map.fromList (map (, Nothing) (Set.toList $ extraCore settings))
6062
6163 putStrLn "Loading package database"
62− pdb <- loadPackageDB settings coreMap totalCore allPackages
64+ pdb <- loadPackageDB settings coreMap (Map.keysSet totalCore) allPackages
6365
6466 putStrLn "Narrowing package database"
65− (final, errs) <- narrowPackageDB settings totalCore pdb $ Set.fromList $ Map.toList $ Map.map snd $ allPackages
67+ (final, errs) <- narrowPackageDB settings (Map.keysSet totalCore) pdb $ Set.fromList $ Map.toList $ Map.map snd $ allPackages
6668
6769 putStrLn "Printing build plan to build-plan.log"
6870 System.IO.UTF8.writeFile "build-plan.log" $ unlines $ map showDep $ Map.toList final
Stackage/ServerFiles.hs+1
@@ -22,6 +22,7 @@ createHackageFile ii h = do
2222 selected = Map.fromList . map toStrs . Map.toList $
2323 fmap spiVersion (iiPackages ii)
2424 `Map.union` iiOptionalCore ii
25+ `Map.union` Map.mapMaybe id (iiCore ii)
2526
2627 toStrs (PackageName name, version) = (name, display version)
2728
Stackage/Tarballs.hs+1−1
@@ -41,5 +41,5 @@ makeTarballs bp = do
4141 | version == spiVersion spi -> (stable . (e:), extra)
4242 | otherwise -> (stable, extra)
4343 Nothing
44− | package `Set.member` bpCore bp -> (stable, extra)
44+ | package `Map.member` bpCore bp -> (stable, extra)
4545 | otherwise -> (stable, extra . (e:))
Stackage/Types.hs+2−2
@@ -61,7 +61,7 @@ instance Monoid HaskellPlatform where
6161 HaskellPlatform a x `mappend` HaskellPlatform b y = HaskellPlatform (mappend a b) (mappend x y)
6262
6363data InstallInfo = InstallInfo
64− { iiCore :: Set PackageName
64+ { iiCore :: Map PackageName (Maybe Version)
6565 , iiPackages :: Map PackageName SelectedPackageInfo
6666 , iiOptionalCore :: Map PackageName Version
6767 -- ^ This is intended to hold onto packages which might be automatically
@@ -81,7 +81,7 @@ data SelectedPackageInfo = SelectedPackageInfo
8181data BuildPlan = BuildPlan
8282 { bpTools :: [String]
8383 , bpPackages :: Map PackageName SelectedPackageInfo
84− , bpCore :: Set PackageName
84+ , bpCore :: Map PackageName (Maybe Version)
8585 , bpOptionalCore :: Map PackageName Version
8686 -- ^ See 'iiOptionalCore'
8787 , bpSkippedTests :: Set PackageName