X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Data%2FMonoid.hs;h=c51c4ca4bb0a90a25d798d10be388090c3e9a5c5;hb=2e317d707ce3512be60ada74a22119cd0a054ca1;hp=052472721ebb931dbec7bd476abae0f2775a9e41;hpb=dbf490ac992de84156826d846b25ecfbc4346744;p=ghc-base.git diff --git a/Data/Monoid.hs b/Data/Monoid.hs index 0524727..c51c4ca 100644 --- a/Data/Monoid.hs +++ b/Data/Monoid.hs @@ -20,21 +20,15 @@ module Data.Monoid ( Monoid(..), - Endo(..), Dual(..), + Endo(..), + All(..), + Any(..), Sum(..), Product(..) ) where import Prelude -import Data.Map ( Map ) -import qualified Data.Map as Map hiding ( Map ) -import Data.IntMap ( IntMap ) -import qualified Data.IntMap as IntMap hiding ( IntMap ) -import Data.Set ( Set ) -import qualified Data.Set as Set hiding ( Set ) -import Data.IntSet ( IntSet ) -import qualified Data.IntSet as IntSet hiding ( IntSet ) -- --------------------------------------------------------------------------- -- | The monoid class. @@ -101,6 +95,14 @@ instance Monoid Ordering where EQ `mappend` y = y GT `mappend` _ = GT +-- | The dual of a monoid, obtained by swapping the arguments of 'mappend'. +newtype Dual a = Dual { getDual :: a } + deriving (Eq, Ord, Read, Show, Bounded) + +instance Monoid a => Monoid (Dual a) where + mempty = Dual mempty + Dual x `mappend` Dual y = Dual (y `mappend` x) + -- | The monoid of endomorphisms under composition. newtype Endo a = Endo { appEndo :: a -> a } @@ -108,15 +110,25 @@ instance Monoid (Endo a) where mempty = Endo id Endo f `mappend` Endo g = Endo (f . g) --- | The dual of a monoid, obtained by swapping the arguments of 'mappend'. -newtype Dual a = Dual { getDual :: a } +-- | Boolean monoid under conjunction. +newtype All = All { getAll :: Bool } + deriving (Eq, Ord, Read, Show, Bounded) -instance Monoid a => Monoid (Dual a) where - mempty = Dual mempty - Dual x `mappend` Dual y = Dual (y `mappend` x) +instance Monoid All where + mempty = All True + All x `mappend` All y = All (x && y) + +-- | Boolean monoid under disjunction. +newtype Any = Any { getAny :: Bool } + deriving (Eq, Ord, Read, Show, Bounded) + +instance Monoid Any where + mempty = Any False + Any x `mappend` Any y = Any (x || y) -- | Monoid under addition. newtype Sum a = Sum { getSum :: a } + deriving (Eq, Ord, Read, Show, Bounded) instance Num a => Monoid (Sum a) where mempty = Sum 0 @@ -124,27 +136,8 @@ instance Num a => Monoid (Sum a) where -- | Monoid under multiplication. newtype Product a = Product { getProduct :: a } + deriving (Eq, Ord, Read, Show, Bounded) instance Num a => Monoid (Product a) where mempty = Product 1 Product x `mappend` Product y = Product (x * y) - -instance (Ord k) => Monoid (Map k v) where - mempty = Map.empty - mappend = Map.union - mconcat = Map.unions - -instance Ord a => Monoid (IntMap a) where - mempty = IntMap.empty - mappend = IntMap.union - mconcat = IntMap.unions - -instance Ord a => Monoid (Set a) where - mempty = Set.empty - mappend = Set.union - mconcat = Set.unions - -instance Monoid IntSet where - mempty = IntSet.empty - mappend = IntSet.union - mconcat = IntSet.unions