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