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