PackageMap: better Monoid for packages

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)

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)