haskell/stackage
1
0
Fork 0
mirror of https://github.com/commercialhaskell/stackage.git synced 2026-02-05 11:00:25 +01:00
Code Issues Actions 1 Packages Projects Releases Wiki Activity

PackageMap: better Monoid for packages

Browse Source
This commit is contained in:
Michael Snoyman 2013-01-08 08:29:48 +02:00
parent 1efddcaa20
commit c14d1b0795
2 changed files with 13 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
Stackage/Config.hs
View File

@ -53,7 +53,7 @@ defaultExpectedFailures = fromList $ map PackageName
-- included as well. Please indicate who will be maintaining the package -- included as well. Please indicate who will be maintaining the package
-- via comments. -- via comments.
defaultStablePackages :: Map PackageName (VersionRange, Maintainer) defaultStablePackages :: Map PackageName (VersionRange, Maintainer)
defaultStablePackages = execWriter $ do defaultStablePackages = unPackageMap $ execWriter $ do
mapM_ (add "michael@snoyman.com") $ words =<< mapM_ (add "michael@snoyman.com") $ words =<<
[ "yesod yesod-newsfeed yesod-sitemap yesod-static yesod-test" [ "yesod yesod-newsfeed yesod-sitemap yesod-static yesod-test"
, "markdown filesystem-conduit mime-mail-ses" , "markdown filesystem-conduit mime-mail-ses"
@ -124,4 +124,4 @@ defaultStablePackages = execWriter $ do
addRange maintainer package range = addRange maintainer package range =
case simpleParse range of case simpleParse range of
Nothing -> error $ "Invalid range " ++ show range ++ " for " ++ package 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)

11
Stackage/Types.hs
View File

@ -11,6 +11,7 @@ import Data.Version as X (Version)
import Distribution.Package as X (PackageIdentifier (..), import Distribution.Package as X (PackageIdentifier (..),
PackageName (..)) PackageName (..))
import Distribution.Version as X (VersionRange (..)) import Distribution.Version as X (VersionRange (..))
import Distribution.Version (intersectVersionRanges)
import Distribution.PackageDescription (GenericPackageDescription) import Distribution.PackageDescription (GenericPackageDescription)
newtype PackageDB = PackageDB (Map PackageName PackageInfo) 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 -- Returns a reason for stripping in Left, or Right if the package is
-- allowed. -- 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)