Data/Monoid.hs

   1 -----------------------------------------------------------------------------
   2 -- |
   3 -- Module      :  Data.Monoid
   4 -- Copyright   :  (c) Andy Gill 2001,
   5 --                (c) Oregon Graduate Institute of Science and Technology, 2001
   6 -- License     :  BSD-style (see the file libraries/base/LICENSE)
   7 --
   8 -- Maintainer  :  libraries@haskell.org
   9 -- Stability   :  experimental
  10 -- Portability :  portable
  11 --
  12 -- A class for monoids (types with an associative binary operation that
  13 -- has an identity) with various general-purpose instances.
  14 -----------------------------------------------------------------------------
  15
  16 module Data.Monoid (
  17         -- * Monoid typeclass
  18         Monoid(..),
  19         Dual(..),
  20         Endo(..),
  21         -- * Bool wrappers
  22         All(..),
  23         Any(..),
  24         -- * Num wrappers
  25         Sum(..),
  26         Product(..),
  27         -- * Maybe wrappers
  28         -- $MaybeExamples
  29         First(..),
  30         Last(..)
  31   ) where
  32
  33 import Prelude
  34
  35 {-
  36 -- just for testing
  37 import Data.Maybe
  38 import Test.QuickCheck
  39 -- -}
  40
  41 -- ---------------------------------------------------------------------------
  42 -- | The class of monoids (types with an associative binary operation that
  43 -- has an identity).  Instances should satisfy the following laws:
  44 --
  45 --  * @mempty `mappend` x = x@
  46 --
  47 --  * @x `mappend` mempty = x@
  48 --
  49 --  * @x `mappend` (y `mappend` z) = (x `mappend` y) `mappend` z@
  50 --
  51 --  * @mconcat = 'foldr' mappend mempty@
  52 --
  53 -- The method names refer to the monoid of lists under concatenation,
  54 -- but there are many other instances.
  55 --
  56 -- Minimal complete definition: 'mempty' and 'mappend'.
  57 --
  58 -- Some types can be viewed as a monoid in more than one way,
  59 -- e.g. both addition and multiplication on numbers.
  60 -- In such cases we often define @newtype@s and make those instances
  61 -- of 'Monoid', e.g. 'Sum' and 'Product'.
  62
  63 class Monoid a where
  64         mempty  :: a
  65         -- ^ Identity of 'mappend'
  66         mappend :: a -> a -> a
  67         -- ^ An associative operation
  68         mconcat :: [a] -> a
  69
  70         -- ^ Fold a list using the monoid.
  71         -- For most types, the default definition for 'mconcat' will be
  72         -- used, but the function is included in the class definition so
  73         -- that an optimized version can be provided for specific types.
  74
  75         mconcat = foldr mappend mempty
  76
  77 -- Monoid instances.
  78
  79 instance Monoid [a] where
  80         mempty  = []
  81         mappend = (++)
  82
  83 instance Monoid b => Monoid (a -> b) where
  84         mempty _ = mempty
  85         mappend f g x = f x `mappend` g x
  86
  87 instance Monoid () where
  88         -- Should it be strict?
  89         mempty        = ()
  90         _ `mappend` _ = ()
  91         mconcat _     = ()
  92
  93 instance (Monoid a, Monoid b) => Monoid (a,b) where
  94         mempty = (mempty, mempty)
  95         (a1,b1) `mappend` (a2,b2) =
  96                 (a1 `mappend` a2, b1 `mappend` b2)
  97
  98 instance (Monoid a, Monoid b, Monoid c) => Monoid (a,b,c) where
  99         mempty = (mempty, mempty, mempty)
 100         (a1,b1,c1) `mappend` (a2,b2,c2) =
 101                 (a1 `mappend` a2, b1 `mappend` b2, c1 `mappend` c2)
 102
 103 instance (Monoid a, Monoid b, Monoid c, Monoid d) => Monoid (a,b,c,d) where
 104         mempty = (mempty, mempty, mempty, mempty)
 105         (a1,b1,c1,d1) `mappend` (a2,b2,c2,d2) =
 106                 (a1 `mappend` a2, b1 `mappend` b2,
 107                  c1 `mappend` c2, d1 `mappend` d2)
 108
 109 instance (Monoid a, Monoid b, Monoid c, Monoid d, Monoid e) =>
 110                 Monoid (a,b,c,d,e) where
 111         mempty = (mempty, mempty, mempty, mempty, mempty)
 112         (a1,b1,c1,d1,e1) `mappend` (a2,b2,c2,d2,e2) =
 113                 (a1 `mappend` a2, b1 `mappend` b2, c1 `mappend` c2,
 114                  d1 `mappend` d2, e1 `mappend` e2)
 115
 116 -- lexicographical ordering
 117 instance Monoid Ordering where
 118         mempty         = EQ
 119         LT `mappend` _ = LT
 120         EQ `mappend` y = y
 121         GT `mappend` _ = GT
 122
 123 -- | The dual of a monoid, obtained by swapping the arguments of 'mappend'.
 124 newtype Dual a = Dual { getDual :: a }
 125         deriving (Eq, Ord, Read, Show, Bounded)
 126
 127 instance Monoid a => Monoid (Dual a) where
 128         mempty = Dual mempty
 129         Dual x `mappend` Dual y = Dual (y `mappend` x)
 130
 131 -- | The monoid of endomorphisms under composition.
 132 newtype Endo a = Endo { appEndo :: a -> a }
 133
 134 instance Monoid (Endo a) where
 135         mempty = Endo id
 136         Endo f `mappend` Endo g = Endo (f . g)
 137
 138 -- | Boolean monoid under conjunction.
 139 newtype All = All { getAll :: Bool }
 140         deriving (Eq, Ord, Read, Show, Bounded)
 141
 142 instance Monoid All where
 143         mempty = All True
 144         All x `mappend` All y = All (x && y)
 145
 146 -- | Boolean monoid under disjunction.
 147 newtype Any = Any { getAny :: Bool }
 148         deriving (Eq, Ord, Read, Show, Bounded)
 149
 150 instance Monoid Any where
 151         mempty = Any False
 152         Any x `mappend` Any y = Any (x || y)
 153
 154 -- | Monoid under addition.
 155 newtype Sum a = Sum { getSum :: a }
 156         deriving (Eq, Ord, Read, Show, Bounded)
 157
 158 instance Num a => Monoid (Sum a) where
 159         mempty = Sum 0
 160         Sum x `mappend` Sum y = Sum (x + y)
 161
 162 -- | Monoid under multiplication.
 163 newtype Product a = Product { getProduct :: a }
 164         deriving (Eq, Ord, Read, Show, Bounded)
 165
 166 instance Num a => Monoid (Product a) where
 167         mempty = Product 1
 168         Product x `mappend` Product y = Product (x * y)
 169
 170 -- $MaybeExamples
 171 -- To implement @find@ or @findLast@ on any 'Foldable':
 172 --
 173 -- @
 174 -- findLast :: Foldable t => (a -> Bool) -> t a -> Maybe a
 175 -- findLast pred = getLast . foldMap (\x -> if pred x
 176 --                                            then Last (Just x)
 177 --                                            else Last Nothing)
 178 -- @
 179 --
 180 -- Much of Data.Map's interface can be implemented with
 181 -- Data.Map.alter. Some of the rest can be implemented with a new
 182 -- @alterA@ function and either 'First' or 'Last':
 183 --
 184 -- > alterA :: (Applicative f, Ord k) =>
 185 -- >           (Maybe a -> f (Maybe a)) -> k -> Map k a -> f (Map k a)
 186 -- >
 187 -- > instance Monoid a => Applicative ((,) a)  -- from Control.Applicative
 188 --
 189 -- @
 190 -- insertLookupWithKey :: Ord k => (k -> v -> v -> v) -> k -> v
 191 --                     -> Map k v -> (Maybe v, Map k v)
 192 -- insertLookupWithKey combine key value =
 193 --   Arrow.first getFirst . alterA doChange key
 194 --   where
 195 --   doChange Nothing = (First Nothing, Just value)
 196 --   doChange (Just oldValue) =
 197 --     (First (Just oldValue),
 198 --      Just (combine key value oldValue))
 199 -- @
 200
 201 -- | Lift a semigroup into 'Maybe' forming a 'Monoid' according to
 202 -- <http://en.wikipedia.org/wiki/Monoid>: \"Any semigroup @S@ may be
 203 -- turned into a monoid simply by adjoining an element @e@ not in @S@
 204 -- and defining @e*e = e@ and @e*s = s = s*e@ for all @s ∈ S@.\" Since
 205 -- there is no \"Semigroup\" typeclass providing just 'mappend', we
 206 -- use 'Monoid' instead.
 207 instance Monoid a => Monoid (Maybe a) where
 208   mempty = Nothing
 209   Nothing `mappend` m = m
 210   m `mappend` Nothing = m
 211   Just m1 `mappend` Just m2 = Just (m1 `mappend` m2)
 212
 213
 214 -- | Maybe monoid returning the leftmost non-Nothing value.
 215 newtype First a = First { getFirst :: Maybe a }
 216 #ifndef __HADDOCK__
 217         deriving (Eq, Ord, Read, Show)
 218 #else  /* __HADDOCK__ */
 219 instance Eq a => Eq (First a)
 220 instance Ord a => Ord (First a)
 221 instance Read a => Read (First a)
 222 instance Show a => Show (First a)
 223 #endif
 224
 225 instance Monoid (First a) where
 226         mempty = First Nothing
 227         r@(First (Just _)) `mappend` _ = r
 228         First Nothing `mappend` r = r
 229
 230 -- | Maybe monoid returning the rightmost non-Nothing value.
 231 newtype Last a = Last { getLast :: Maybe a }
 232 #ifndef __HADDOCK__
 233         deriving (Eq, Ord, Read, Show)
 234 #else  /* __HADDOCK__ */
 235 instance Eq a => Eq (Last a)
 236 instance Ord a => Ord (Last a)
 237 instance Read a => Read (Last a)
 238 instance Show a => Show (Last a)
 239 #endif
 240
 241 instance Monoid (Last a) where
 242         mempty = Last Nothing
 243         _ `mappend` r@(Last (Just _)) = r
 244         r `mappend` Last Nothing = r
 245
 246 {-
 247 {--------------------------------------------------------------------
 248   Testing
 249 --------------------------------------------------------------------}
 250 instance Arbitrary a => Arbitrary (Maybe a) where
 251   arbitrary = oneof [return Nothing, Just `fmap` arbitrary]
 252
 253 prop_mconcatMaybe :: [Maybe [Int]] -> Bool
 254 prop_mconcatMaybe x =
 255   fromMaybe [] (mconcat x) == mconcat (catMaybes x)
 256
 257 prop_mconcatFirst :: [Maybe Int] -> Bool
 258 prop_mconcatFirst x =
 259   getFirst (mconcat (map First x)) == listToMaybe (catMaybes x)
 260 prop_mconcatLast :: [Maybe Int] -> Bool
 261 prop_mconcatLast x =
 262   getLast (mconcat (map Last x)) == listLastToMaybe (catMaybes x)
 263         where listLastToMaybe [] = Nothing
 264               listLastToMaybe lst = Just (last lst)
 265 -- -}