aaefd42169c7bdc85ba028ddd1d1df4aeda4089b
[ghc.git] / libraries / base / 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 -- -}