3ccc779 · stackage · git.iko.soy

git.iko.soy/stackage

Update build plans

commit3ccc779af24d0b71e2ea35677cd0cefe6185836d authorMichael Snoyman <michael@snoyman.com> dateSun 7 Dec 2014, 19:10 (12 years ago) parentff2dd38

7 files changed+113−17

compare with master

unifiedsplit

Stackage2/BuildPlan.hs+38−7 Stackage2/PackageConstraints.hs+7−5 Stackage2/PackageDescription.hs+3−3 Stackage2/Prelude.hs+1−1 Stackage2/UpdateBuildPlan.hs+42 stackage.cabal+2 test/Stackage2/BuildPlanSpec.hs+20−1

Stackage2/BuildPlan.hs+38−7

@@ -17,7 +17,7 @@ module Stackage2.BuildPlan

1717

1818import Distribution.Package (Dependency (..))

1919import Distribution.PackageDescription

20−import Distribution.Version (withinRange, intersectVersionRanges)

20+import Distribution.Version (withinRange, anyVersion, simplifyVersionRange)

2121import Stackage2.PackageConstraints

2222import Stackage2.PackageIndex

2323import Stackage2.Prelude

@@ -32,6 +32,10 @@ import qualified Distribution.Compiler

3232

3333data BuildPlan desc = BuildPlan

3434 { bpCore :: Map PackageName Version

35+ , bpCoreExecutables :: Set ExeName

36+ , bpGhcVersion :: Version

37+ , bpOS :: Distribution.System.OS

38+ , bpArch :: Distribution.System.Arch

3539 , bpTools :: Vector (PackageName, Version)

3640 , bpExtra :: Map PackageName (PackageBuild desc)

3741 }

@@ -44,6 +48,10 @@ instance MonoTraversable (BuildPlan desc)

4448instance ToJSON (BuildPlan desc) where

4549 toJSON BuildPlan {..} = object

4650 [ "core" .= asMap (mapFromList $ map toCore $ mapToList bpCore)

51+ , "core-exes" .= bpCoreExecutables

52+ , "ghc-version" .= asText (display bpGhcVersion)

53+ , "os" .= asText (display bpOS)

54+ , "arch" .= asText (display bpArch)

4755 , "tools" .= map goTool bpTools

4856 , "extra" .= Map.mapKeysWith const (unPackageName) bpExtra

4957 ]

@@ -54,10 +62,15 @@ instance ToJSON (BuildPlan desc) where

5462 , "version" .= asText (display version)

5563 ]

5664instance desc ~ () => FromJSON (BuildPlan desc) where

57− parseJSON = withObject "BuildPlan" $ \o -> BuildPlan

58− <$> ((o .: "core") >>= goCore)

59− <*> ((o .: "tools") >>= mapM goTool)

60− <*> (goExtra <$> (o .: "extra"))

65+ parseJSON = withObject "BuildPlan" $ \o -> do

66+ bpCore <- (o .: "core") >>= goCore

67+ bpCoreExecutables <- o .: "core-exes"

68+ bpGhcVersion <- (o .: "ghc-version") >>= either (fail . show) return . simpleParse . asText

69+ bpOS <- o .: "os" >>= either (fail . show) return . simpleParse . asText

70+ bpArch <- (o .: "arch") >>= either (fail . show) return . simpleParse . asText

71+ bpTools <- (o .: "tools") >>= mapM goTool

72+ bpExtra <- goExtra <$> (o .: "extra")

73+ return BuildPlan {..}

6174 where

6275 goCore =

6376 fmap mapFromList . mapM goCore' . mapToList . asHashMap

@@ -77,6 +90,8 @@ instance desc ~ () => FromJSON (BuildPlan desc) where

7790

7891data PackageBuild desc = PackageBuild

7992 { pbVersion :: Version

93+ , pbVersionRange :: VersionRange

94+ -- ^ This is vital for ensuring old constraints are kept in place when bumping

8095 , pbMaintainer :: Maybe Maintainer

8196 , pbGithubPings :: Set Text

8297 , pbUsers :: Set PackageName

@@ -92,11 +107,21 @@ instance MonoFunctor (PackageBuild desc)

92107instance MonoFoldable (PackageBuild desc)

93108instance MonoTraversable (PackageBuild desc)

94109

110+-- | There seems to be a bug in Cabal where serializing and deserializing

111+-- version ranges winds up with different representations. So we have a

112+-- super-simplifier to deal with that.

113+superSimplifyVersionRange :: VersionRange -> VersionRange

114+superSimplifyVersionRange vr =

115+ fromMaybe (assert False vr') $ simpleParse $ asList $ display vr'

116+ where

117+ vr' = simplifyVersionRange vr

118+

95119instance ToJSON (PackageBuild desc) where

96120 toJSON PackageBuild {..} = object $ concat

97121 [ maybe [] (\m -> ["maintainer" .= m]) pbMaintainer

98122 ,

99123 [ "version" .= asText (display pbVersion)

124+ , "version-range" .= asText (display $ superSimplifyVersionRange pbVersionRange)

100125 , "github-pings" .= pbGithubPings

101126 , "users" .= map unPackageName (unpack pbUsers)

102127 , "flags" .= Map.mapKeysWith const (\(FlagName f) -> asText $ pack f) pbFlags

@@ -108,6 +133,7 @@ instance ToJSON (PackageBuild desc) where

108133instance desc ~ () => FromJSON (PackageBuild desc) where

109134 parseJSON = withObject "PackageBuild" $ \o -> PackageBuild

110135 <$> (o .: "version" >>= efail . simpleParse . asText)

136+ <*> (o .: "version-range" >>= fmap superSimplifyVersionRange . efail . simpleParse . asText)

111137 <*> o .:? "maintainer"

112138 <*> o .:? "github-pings" .!= mempty

113139 <*> (Set.map PackageName <$> (o .:? "users" .!= mempty))

@@ -137,7 +163,10 @@ newBuildPlan pc = liftIO $ do

137163 -- FIXME topologically sort packages? maybe just leave that to the build phase

138164 return BuildPlan

139165 { bpCore = pcCorePackages pc

140− -- bpCoreExes = pcCoreExecutables pc

166+ , bpCoreExecutables = pcCoreExecutables pc

167+ , bpGhcVersion = pcGhcVersion pc

168+ , bpOS = pcOS pc

169+ , bpArch = pcArch pc

141170 , bpTools = tools

142171 , bpExtra = extra

143172 }

@@ -253,7 +282,9 @@ mkPackageBuild pc gpd = do

253282 gpd

254283 return PackageBuild

255284 { pbVersion = version

256− , pbMaintainer = fmap snd $ lookup name $ pcPackages pc

285+ , pbVersionRange = superSimplifyVersionRange

286+ $ maybe anyVersion fst $ lookup name $ pcPackages pc

287+ , pbMaintainer = lookup name (pcPackages pc) >>= snd

257288 , pbGithubPings = getGithubPings gpd

258289 , pbUsers = mempty -- must be filled in later

259290 , pbFlags = flags

Stackage2/PackageConstraints.hs+7−5

@@ -39,18 +39,20 @@ instance FromJSON TestState where

3939 $ map (\x -> (testStateToText x, x)) [minBound..maxBound]

4040

4141data PackageConstraints = PackageConstraints

42− { pcPackages :: Map PackageName (VersionRange, Maintainer)

42+ { pcPackages :: Map PackageName (VersionRange, Maybe Maintainer)

4343 -- ^ This does not include core packages or dependencies, just packages

4444 -- added by some maintainer.

4545 , pcGhcVersion :: Version

4646 , pcOS :: OS

4747 , pcArch :: Arch

48− , pcFlagOverrides :: PackageName -> Map FlagName Bool

48+ , pcCorePackages :: Map PackageName Version

49+ , pcCoreExecutables :: Set ExeName

50+

51+ -- Have a single lookup function with all of the package-specific stuff?

4952 , pcTests :: PackageName -> TestState

5053 , pcHaddocks :: PackageName -> TestState

5154 , pcBuildBenchmark :: PackageName -> Bool

52− , pcCorePackages :: Map PackageName Version

53− , pcCoreExecutables :: Set ExeName

55+ , pcFlagOverrides :: PackageName -> Map FlagName Bool

5456 }

5557

5658-- | The proposed plan from the requirements provided by contributors.

@@ -78,7 +80,7 @@ defaultPackageConstraints = do

7880 old = setFromList $ map unPackageName $ setToList $ Old.skippedTests oldSettings

7981

8082 return PackageConstraints

81− { pcPackages = fmap (Maintainer . pack . Old.unMaintainer)

83+ { pcPackages = fmap (Just . Maintainer . pack . Old.unMaintainer)

8284 <$> Old.defaultStablePackages oldGhcVer False

8385 , pcCorePackages = core

8486 , pcCoreExecutables = coreExes

Stackage2/PackageDescription.hs+3−3

@@ -41,11 +41,11 @@ instance Monoid SimpleTree where

4141 (b ++ y)

4242 (c ++ z)

4343

44−data SimpleExtra = SimpleExtra

44+data SimpleExtra = SimpleExtra -- FIXME fold into FlatComponent?

4545 { seTools :: Map ExeName VersionRange

4646 , seProvidedExes :: Set ExeName

4747 }

48− deriving Show

48+ deriving (Show, Eq)

4949instance Monoid SimpleExtra where

5050 mempty = SimpleExtra mempty mempty

5151 mappend (SimpleExtra a b) (SimpleExtra x y) = SimpleExtra

@@ -102,7 +102,7 @@ data FlatComponent = FlatComponent

102102 { fcDeps :: Map PackageName VersionRange

103103 , fcExtra :: SimpleExtra

104104 }

105− deriving Show

105+ deriving (Show, Eq)

106106instance Monoid FlatComponent where

107107 mempty = FlatComponent mempty mempty

108108 mappend (FlatComponent a b) (FlatComponent x y) = FlatComponent

Stackage2/Prelude.hs+1−1

@@ -79,7 +79,7 @@ withCheckedProcess cp f = do

7979 return res

8080

8181newtype Maintainer = Maintainer { unMaintainer :: Text }

82− deriving (Show, Eq, Ord, Hashable, ToJSON, FromJSON)

82+ deriving (Show, Eq, Ord, Hashable, ToJSON, FromJSON, IsString)

8383

8484-- | Name of an executable.

8585newtype ExeName = ExeName { unExeName :: Text }

Stackage2/UpdateBuildPlan.hsnew file+42

@@ -0,0 +1,42 @@

1+{-# LANGUAGE NoImplicitPrelude #-}

2+{-# LANGUAGE OverloadedStrings #-}

3+{-# LANGUAGE RecordWildCards #-}

4+-- | Take an existing build plan and bump all packages to the newest version in

5+-- the same major version number.

6+module Stackage2.UpdateBuildPlan

7+ ( updatePackageConstraints

8+ , updateBuildPlan

9+ ) where

10+

11+import Stackage2.Prelude

12+import Stackage2.BuildPlan

13+import Stackage2.PackageConstraints

14+import Stackage2.PackageDescription

15+import Distribution.Version (orLaterVersion, earlierVersion)

16+

17+updateBuildPlan :: BuildPlan a -> IO (BuildPlan FlatComponent)

18+updateBuildPlan = newBuildPlan . updatePackageConstraints

19+

20+updatePackageConstraints :: BuildPlan a -> PackageConstraints

21+updatePackageConstraints BuildPlan {..} = PackageConstraints

22+ { pcPackages = flip map bpExtra $ \pb ->

23+ ( intersectVersionRanges (bumpRange (pbVersion pb)) (pbVersionRange pb)

24+ , pbMaintainer pb

25+ )

26+ , pcCorePackages = bpCore

27+ , pcCoreExecutables = bpCoreExecutables

28+ , pcGhcVersion = bpGhcVersion

29+ , pcOS = bpOS

30+ , pcArch = bpArch

31+ , pcTests = maybe ExpectSuccess pbTestState . flip lookup bpExtra

32+ , pcHaddocks = maybe ExpectSuccess pbHaddockState . flip lookup bpExtra

33+ , pcBuildBenchmark = maybe True pbTryBuildBenchmark . flip lookup bpExtra

34+ , pcFlagOverrides = maybe mempty pbFlags . flip lookup bpExtra

35+ }

36+ where

37+ bumpRange version = intersectVersionRanges

38+ (orLaterVersion version)

39+ (earlierVersion $ bumpVersion version)

40+ bumpVersion (Version (x:y:_) _) = Version [x, y + 1] []

41+ bumpVersion (Version [x] _) = Version [x, 1] []

42+ bumpVersion (Version [] _) = assert False $ Version [1, 0] []

stackage.cabal+2

@@ -37,6 +37,7 @@ library

3737 Stackage2.PackageIndex

3838 Stackage2.BuildPlan

3939 Stackage2.CheckBuildPlan

40+ Stackage2.UpdateBuildPlan

4041 Stackage2.GithubPings

4142 Stackage2.PackageDescription

4243 build-depends: base >= 4 && < 5

@@ -84,6 +85,7 @@ test-suite spec

8485 , classy-prelude-conduit

8586 , Cabal

8687 , yaml

88+ , containers

8789

8890source-repository head

8991 type: git

test/Stackage2/BuildPlanSpec.hs+20−1

@@ -4,13 +4,32 @@ module Stackage2.BuildPlanSpec (spec) where

44import Stackage2.BuildPlan

55import Stackage2.Prelude

66import Stackage2.PackageConstraints

7+import Stackage2.UpdateBuildPlan

78import Test.Hspec

89import qualified Data.Yaml as Y

910import Control.Exception (evaluate)

11+import Distribution.Version (anyVersion)

12+import qualified Data.Map as Map

1013

1114spec :: Spec

1215spec = it "works" $ do

13− bp <- defaultPackageConstraints >>= newBuildPlan

16+ pc <- defaultPackageConstraints

17+ bp <- newBuildPlan pc

1418 let bs = Y.encode bp

1519 mbp' = Y.decode bs

20+

21+ bp' <- maybe (error "decoding failed") return mbp'

22+

23+ let allPackages = Map.keysSet (bpExtra bp) ++ Map.keysSet (bpExtra bp')

24+ forM_ allPackages $ \name ->

25+ (name, lookup name (bpExtra bp')) `shouldBe`

26+ (name, lookup name (bpExtra $ () <$ bp))

27+

1628 mbp' `shouldBe` Just (() <$ bp)

29+ bp2 <- newBuildPlan $ updatePackageConstraints bp

30+ dropVersionRanges bp2 `shouldBe` dropVersionRanges bp

31+ where

32+ dropVersionRanges bp =

33+ bp { bpExtra = map go $ bpExtra bp }

34+ where

35+ go pb = pb { pbVersionRange = anyVersion }