X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Data%2FMonoid.hs;h=8a30b73de16a92f97acb4ed29949c9589cdf2ed5;hb=4c8f5d13c302abce56a276b130fc4eb7c4b4cf0a;hp=bc8633bbd028b982063ff479a34d56803d2be70d;hpb=6cd8e25a9ad88133e04f424b6daf0c6a7db2bba8;p=haskell-directory.git

diff --git a/Data/Monoid.hs b/Data/Monoid.hs
index bc8633b..8a30b73 100644
--- a/Data/Monoid.hs
+++ b/Data/Monoid.hs
@@ -7,9 +7,9 @@
 -- 
 -- Maintainer  :  libraries@haskell.org
 -- Stability   :  experimental
--- Portability :  non-portable (requires extended type classes)
+-- Portability :  portable
 --
--- Declaration of the Monoid class, and instances for list and functions.
+-- The Monoid class with various general-purpose instances.
 --
 --	  Inspired by the paper
 --	  /Functional Programming with Overloading and
@@ -19,18 +19,16 @@
 -----------------------------------------------------------------------------
 
 module Data.Monoid (
- 	Monoid(..)
+ 	Monoid(..),
+	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.
@@ -57,9 +55,9 @@ instance Monoid [a] where
 	mempty  = []
 	mappend = (++)
 
-instance Monoid (a -> a) where
-	mempty  = id
-	mappend = (.)
+instance Monoid b => Monoid (a -> b) where
+	mempty _ = mempty
+	mappend f g x = f x `mappend` g x
 
 instance Monoid () where
 	-- Should it be strict?
@@ -97,22 +95,48 @@ instance Monoid Ordering where
 	EQ `mappend` y = y
 	GT `mappend` _ = GT
 
-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
+-- | The dual of a monoid, obtained by swapping the arguments of 'mappend'.
+newtype Dual a = Dual { getDual :: a }
+
+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 }
+
+instance Monoid (Endo a) where
+	mempty = Endo id
+	Endo f `mappend` Endo g = Endo (f . g)
+
+-- | Boolean monoid under conjunction.
+newtype All = All { getAll :: Bool }
+	deriving (Eq, Ord, Read, Show, Bounded)
+
+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
+	Sum x `mappend` Sum y = Sum (x + y)
+
+-- | 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)