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