on master help sign in
PackageMap: better Monoid for packages
c14d1b0Michael Snoyman
Stackage/Config.hs+2−2
@@ -53,7 +53,7 @@ defaultExpectedFailures = fromList $ map PackageName
53-- included as well. Please indicate who will be maintaining the package
53-- included as well. Please indicate who will be maintaining the package
54-- via comments.
54-- via comments.
55defaultStablePackages :: Map PackageName (VersionRange, Maintainer)
55defaultStablePackages :: Map PackageName (VersionRange, Maintainer)
56−defaultStablePackages = execWriter $ do
56+defaultStablePackages = unPackageMap $ execWriter $ do
57 mapM_ (add "michael@snoyman.com") $ words =<<
57 mapM_ (add "michael@snoyman.com") $ words =<<
58 [ "yesod yesod-newsfeed yesod-sitemap yesod-static yesod-test"
58 [ "yesod yesod-newsfeed yesod-sitemap yesod-static yesod-test"
59 , "markdown filesystem-conduit mime-mail-ses"
59 , "markdown filesystem-conduit mime-mail-ses"
@@ -124,4 +124,4 @@ defaultStablePackages = execWriter $ do
124 addRange maintainer package range =
124 addRange maintainer package range =
125 case simpleParse range of
125 case simpleParse range of
126 Nothing -> error $ "Invalid range " ++ show range ++ " for " ++ package
126 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)
11import Distribution.Package as X (PackageIdentifier (..),
11import Distribution.Package as X (PackageIdentifier (..),
12 PackageName (..))
12 PackageName (..))
13import Distribution.Version as X (VersionRange (..))
13import Distribution.Version as X (VersionRange (..))
14+import Distribution.Version (intersectVersionRanges)
14import Distribution.PackageDescription (GenericPackageDescription)
15import Distribution.PackageDescription (GenericPackageDescription)
15
16
16newtype PackageDB = PackageDB (Map PackageName PackageInfo)
17newtype PackageDB = PackageDB (Map PackageName PackageInfo)
@@ -91,3 +92,13 @@ data BuildSettings = BuildSettings
91 -- Returns a reason for stripping in Left, or Right if the package is
92 -- Returns a reason for stripping in Left, or Right if the package is
92 -- allowed.
93 -- allowed.
93 }
94 }
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)