diff --git a/Stackage/Config.hs b/Stackage/Config.hs index 33e91fe5..48abf126 100644 --- a/Stackage/Config.hs +++ b/Stackage/Config.hs @@ -53,7 +53,7 @@ defaultExpectedFailures = fromList $ map PackageName -- included as well. Please indicate who will be maintaining the package -- via comments. defaultStablePackages :: Map PackageName (VersionRange, Maintainer) -defaultStablePackages = execWriter $ do +defaultStablePackages = unPackageMap $ execWriter $ do mapM_ (add "michael@snoyman.com") $ words =<< [ "yesod yesod-newsfeed yesod-sitemap yesod-static yesod-test" , "markdown filesystem-conduit mime-mail-ses" @@ -124,4 +124,4 @@ defaultStablePackages = execWriter $ do addRange maintainer package range = case simpleParse range of Nothing -> error $ "Invalid range " ++ show range ++ " for " ++ package - Just range' -> tell $ Map.singleton (PackageName package) (range', Maintainer maintainer) + Just range' -> tell $ PackageMap $ Map.singleton (PackageName package) (range', Maintainer maintainer) diff --git a/Stackage/Types.hs b/Stackage/Types.hs index db959552..52bd04c5 100644 --- a/Stackage/Types.hs +++ b/Stackage/Types.hs @@ -11,6 +11,7 @@ import Data.Version as X (Version) import Distribution.Package as X (PackageIdentifier (..), PackageName (..)) import Distribution.Version as X (VersionRange (..)) +import Distribution.Version (intersectVersionRanges) import Distribution.PackageDescription (GenericPackageDescription) newtype PackageDB = PackageDB (Map PackageName PackageInfo) @@ -91,3 +92,13 @@ data BuildSettings = BuildSettings -- Returns a reason for stripping in Left, or Right if the package is -- allowed. } + +-- | A wrapper around a @Map@ providing a better @Monoid@ instance. +newtype PackageMap = PackageMap { unPackageMap :: Map PackageName (VersionRange, Maintainer) } + +instance Monoid PackageMap where + mempty = PackageMap mempty + PackageMap x `mappend` PackageMap y = + PackageMap $ unionWith go x y + where + go (r1, m1) (r2, _) = (intersectVersionRanges r1 r2, m1)