add Data.Function

[haskell-directory.git] / Data / Monoid.hs

diff --git a/Data/Monoid.hs b/Data/Monoid.hs
index cfc8dd2..8a30b73 100644 (file)
--- 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,7 +19,13 @@
 -----------------------------------------------------------------------------
 
 module Data.Monoid (
-       Monoid(..)
+       Monoid(..),
+       Dual(..),
+       Endo(..),
+       All(..),
+       Any(..),
+       Sum(..),
+       Product(..)
   ) where
 
 import Prelude
@@ -49,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?
@@ -88,3 +94,49 @@ instance Monoid Ordering where
        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 }
+       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)