Data/Monoid.hs

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