c14d1b0 · stackage · git.iko.soy

git.iko.soy/stackage

PackageMap: better Monoid for packages

commitc14d1b07953586b7d58c55dade4c018aa1ba944d authorMichael Snoyman <michael@snoyman.com> dateTue 8 Jan 2013, 08:29 (14 years ago) parent1efddca

2 files changed+13−2

unifiedsplit

Stackage/Config.hs+2−2

@@ -53,7 +53,7 @@ defaultExpectedFailures = fromList $ map PackageName

5353-- included as well. Please indicate who will be maintaining the package

5454-- via comments.

5555defaultStablePackages :: Map PackageName (VersionRange, Maintainer)

56−defaultStablePackages = execWriter $ do

56+defaultStablePackages = unPackageMap $ execWriter $ do

5757 mapM_ (add "michael@snoyman.com") $ words =<<

5858 [ "yesod yesod-newsfeed yesod-sitemap yesod-static yesod-test"

5959 , "markdown filesystem-conduit mime-mail-ses"

@@ -124,4 +124,4 @@ defaultStablePackages = execWriter $ do

124124 addRange maintainer package range =

125125 case simpleParse range of

126126 Nothing -> error $ "Invalid range " ++ show range ++ " for " ++ package

127− Just range' -> tell $ Map.singleton (PackageName package) (range', Maintainer maintainer)

127+ Just range' -> tell $ PackageMap $ Map.singleton (PackageName package) (range', Maintainer maintainer)

Stackage/Types.hs+11

@@ -11,6 +11,7 @@ import Data.Version as X (Version)

1111import Distribution.Package as X (PackageIdentifier (..),

1212 PackageName (..))

1313import Distribution.Version as X (VersionRange (..))

14+import Distribution.Version (intersectVersionRanges)

1415import Distribution.PackageDescription (GenericPackageDescription)

1516

1617newtype PackageDB = PackageDB (Map PackageName PackageInfo)

@@ -91,3 +92,13 @@ data BuildSettings = BuildSettings

9192 -- Returns a reason for stripping in Left, or Right if the package is

9293 -- allowed.

9394 }

95+

96+-- | A wrapper around a @Map@ providing a better @Monoid@ instance.

97+newtype PackageMap = PackageMap { unPackageMap :: Map PackageName (VersionRange, Maintainer) }

98+

99+instance Monoid PackageMap where

100+ mempty = PackageMap mempty

101+ PackageMap x `mappend` PackageMap y =

102+ PackageMap $ unionWith go x y

103+ where

104+ go (r1, m1) (r2, _) = (intersectVersionRanges r1 r2, m1)