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