X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Data%2FMonoid.hs;h=cba69933c23e356f5a3f58e6eabb0d4d10f3c952;hb=6ff8c23c29a6936f7e2f85663ccf5f1709dee181;hp=a328639b50ed5daf48f5c5ab3df7dc573480d718;hpb=bc9366635bdecd7a3476f33fb4118b4976a5ebd8;p=haskell-directory.git

diff --git a/Data/Monoid.hs b/Data/Monoid.hs
index a328639..cba6993 100644
--- a/Data/Monoid.hs
+++ b/Data/Monoid.hs
@@ -2,14 +2,14 @@
 -- |
 -- Module      :  Data.Monoid
 -- Copyright   :  (c) Andy Gill 2001,
---		  (c) Oregon Graduate Institute of Science and Technology, 2001
+-- 		  (c) Oregon Graduate Institute of Science and Technology, 2001
 -- License     :  BSD-style (see the file libraries/base/LICENSE)
 -- 
 -- 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,7 +19,13 @@
 -----------------------------------------------------------------------------
 
 module Data.Monoid (
- 	Monoid(..)
+ 	Monoid(..),
+	Dual(..),
+	Endo(..),
+	All(..),
+	Any(..),
+	Sum(..),
+	Product(..)
   ) where
 
 import Prelude
@@ -49,12 +55,84 @@ 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?
 	mempty        = ()
 	_ `mappend` _ = ()
 	mconcat _     = ()
+
+instance (Monoid a, Monoid b) => Monoid (a,b) where
+	mempty = (mempty, mempty)
+	(a1,b1) `mappend` (a2,b2) =
+		(a1 `mappend` a2, b1 `mappend` b2)
+
+instance (Monoid a, Monoid b, Monoid c) => Monoid (a,b,c) where
+	mempty = (mempty, mempty, mempty)
+	(a1,b1,c1) `mappend` (a2,b2,c2) =
+		(a1 `mappend` a2, b1 `mappend` b2, c1 `mappend` c2)
+
+instance (Monoid a, Monoid b, Monoid c, Monoid d) => Monoid (a,b,c,d) where
+	mempty = (mempty, mempty, mempty, mempty)
+	(a1,b1,c1,d1) `mappend` (a2,b2,c2,d2) =
+		(a1 `mappend` a2, b1 `mappend` b2,
+		 c1 `mappend` c2, d1 `mappend` d2)
+
+instance (Monoid a, Monoid b, Monoid c, Monoid d, Monoid e) =>
+		Monoid (a,b,c,d,e) where
+	mempty = (mempty, mempty, mempty, mempty, mempty)
+	(a1,b1,c1,d1,e1) `mappend` (a2,b2,c2,d2,e2) =
+		(a1 `mappend` a2, b1 `mappend` b2, c1 `mappend` c2,
+		 d1 `mappend` d2, e1 `mappend` e2)
+
+-- lexicographical ordering
+instance Monoid Ordering where
+	mempty         = EQ
+	LT `mappend` _ = LT
+	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 }
+
+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 }
+
+instance Monoid All where
+	mempty = All True
+	All x `mappend` All y = All (x && y)
+
+-- | Boolean monoid under disjunction.
+newtype Any = Any { getAny :: Bool }
+
+instance Monoid Any where
+	mempty = Any False
+	Any x `mappend` Any y = Any (x || y)
+
+-- | Monoid under addition.
+newtype Sum a = Sum { getSum :: a }
+
+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 }
+
+instance Num a => Monoid (Product a) where
+	mempty = Product 1
+	Product x `mappend` Product y = Product (x * y)