1 -----------------------------------------------------------------------------
3 -- Module : Data.Monoid
4 -- Copyright : (c) Andy Gill 2001,
5 -- (c) Oregon Graduate Institute of Science and Technology, 2001
6 -- License : BSD-style (see the file libraries/base/LICENSE)
8 -- Maintainer : libraries@haskell.org
9 -- Stability : experimental
10 -- Portability : portable
12 -- A class for monoids (types with an associative binary operation that
13 -- has an identity) with various general-purpose instances.
14 -----------------------------------------------------------------------------
38 import Test.QuickCheck
41 -- ---------------------------------------------------------------------------
42 -- | The class of monoids (types with an associative binary operation that
43 -- has an identity). Instances should satisfy the following laws:
45 -- * @mappend mempty x = x@
47 -- * @mappend x mempty = x@
49 -- * @mappend x (mappend y z) = mappend (mappend x y) z@
51 -- * @mconcat = 'foldr' mappend mempty@
53 -- The method names refer to the monoid of lists under concatenation,
54 -- but there are many other instances.
56 -- Minimal complete definition: 'mempty' and 'mappend'.
58 -- Some types can be viewed as a monoid in more than one way,
59 -- e.g. both addition and multiplication on numbers.
60 -- In such cases we often define @newtype@s and make those instances
61 -- of 'Monoid', e.g. 'Sum' and 'Product'.
65 -- ^ Identity of 'mappend'
66 mappend :: a -> a -> a
67 -- ^ An associative operation
70 -- ^ Fold a list using the monoid.
71 -- For most types, the default definition for 'mconcat' will be
72 -- used, but the function is included in the class definition so
73 -- that an optimized version can be provided for specific types.
75 mconcat = foldr mappend mempty
79 instance Monoid [a] where
83 instance Monoid b => Monoid (a -> b) where
85 mappend f g x = f x `mappend` g x
87 instance Monoid () where
88 -- Should it be strict?
93 instance (Monoid a, Monoid b) => Monoid (a,b) where
94 mempty = (mempty, mempty)
95 (a1,b1) `mappend` (a2,b2) =
96 (a1 `mappend` a2, b1 `mappend` b2)
98 instance (Monoid a, Monoid b, Monoid c) => Monoid (a,b,c) where
99 mempty = (mempty, mempty, mempty)
100 (a1,b1,c1) `mappend` (a2,b2,c2) =
101 (a1 `mappend` a2, b1 `mappend` b2, c1 `mappend` c2)
103 instance (Monoid a, Monoid b, Monoid c, Monoid d) => Monoid (a,b,c,d) where
104 mempty = (mempty, mempty, mempty, mempty)
105 (a1,b1,c1,d1) `mappend` (a2,b2,c2,d2) =
106 (a1 `mappend` a2, b1 `mappend` b2,
107 c1 `mappend` c2, d1 `mappend` d2)
109 instance (Monoid a, Monoid b, Monoid c, Monoid d, Monoid e) =>
110 Monoid (a,b,c,d,e) where
111 mempty = (mempty, mempty, mempty, mempty, mempty)
112 (a1,b1,c1,d1,e1) `mappend` (a2,b2,c2,d2,e2) =
113 (a1 `mappend` a2, b1 `mappend` b2, c1 `mappend` c2,
114 d1 `mappend` d2, e1 `mappend` e2)
116 -- lexicographical ordering
117 instance Monoid Ordering where
123 -- | The dual of a monoid, obtained by swapping the arguments of 'mappend'.
124 newtype Dual a = Dual { getDual :: a }
125 deriving (Eq, Ord, Read, Show, Bounded)
127 instance Monoid a => Monoid (Dual a) where
129 Dual x `mappend` Dual y = Dual (y `mappend` x)
131 -- | The monoid of endomorphisms under composition.
132 newtype Endo a = Endo { appEndo :: a -> a }
134 instance Monoid (Endo a) where
136 Endo f `mappend` Endo g = Endo (f . g)
138 -- | Boolean monoid under conjunction.
139 newtype All = All { getAll :: Bool }
140 deriving (Eq, Ord, Read, Show, Bounded)
142 instance Monoid All where
144 All x `mappend` All y = All (x && y)
146 -- | Boolean monoid under disjunction.
147 newtype Any = Any { getAny :: Bool }
148 deriving (Eq, Ord, Read, Show, Bounded)
150 instance Monoid Any where
152 Any x `mappend` Any y = Any (x || y)
154 -- | Monoid under addition.
155 newtype Sum a = Sum { getSum :: a }
156 deriving (Eq, Ord, Read, Show, Bounded)
158 instance Num a => Monoid (Sum a) where
160 Sum x `mappend` Sum y = Sum (x + y)
162 -- | Monoid under multiplication.
163 newtype Product a = Product { getProduct :: a }
164 deriving (Eq, Ord, Read, Show, Bounded)
166 instance Num a => Monoid (Product a) where
168 Product x `mappend` Product y = Product (x * y)
171 -- To implement @find@ or @findLast@ on any 'Foldable':
174 -- findLast :: Foldable t => (a -> Bool) -> t a -> Maybe a
175 -- findLast pred = getLast . foldMap (\x -> if pred x
176 -- then Last (Just x)
177 -- else Last Nothing)
180 -- Much of Data.Map's interface can be implemented with
181 -- Data.Map.alter. Some of the rest can be implemented with a new
182 -- @alterA@ function and either 'First' or 'Last':
184 -- > alterA :: (Applicative f, Ord k) =>
185 -- > (Maybe a -> f (Maybe a)) -> k -> Map k a -> f (Map k a)
187 -- > instance Monoid a => Applicative ((,) a) -- from Control.Applicative
190 -- insertLookupWithKey :: Ord k => (k -> v -> v -> v) -> k -> v
191 -- -> Map k v -> (Maybe v, Map k v)
192 -- insertLookupWithKey combine key value =
193 -- Arrow.first getFirst . alterA doChange key
195 -- doChange Nothing = (First Nothing, Just value)
196 -- doChange (Just oldValue) =
197 -- (First (Just oldValue),
198 -- Just (combine key value oldValue))
201 -- | Lift a semigroup into 'Maybe' forming a 'Monoid' according to
202 -- <http://en.wikipedia.org/wiki/Monoid>: \"Any semigroup @S@ may be
203 -- turned into a monoid simply by adjoining an element @e@ not in @S@
204 -- and defining @e*e = e@ and @e*s = s = s*e@ for all @s ∈ S@.\" Since
205 -- there is no \"Semigroup\" typeclass providing just 'mappend', we
206 -- use 'Monoid' instead.
207 instance Monoid a => Monoid (Maybe a) where
209 Nothing `mappend` m = m
210 m `mappend` Nothing = m
211 Just m1 `mappend` Just m2 = Just (m1 `mappend` m2)
214 -- | Maybe monoid returning the leftmost non-Nothing value.
215 newtype First a = First { getFirst :: Maybe a }
217 deriving (Eq, Ord, Read, Show)
218 #else /* __HADDOCK__ */
219 instance Eq a => Eq (First a)
220 instance Ord a => Ord (First a)
221 instance Read a => Read (First a)
222 instance Show a => Show (First a)
225 instance Monoid (First a) where
226 mempty = First Nothing
227 r@(First (Just _)) `mappend` _ = r
228 First Nothing `mappend` r = r
230 -- | Maybe monoid returning the rightmost non-Nothing value.
231 newtype Last a = Last { getLast :: Maybe a }
233 deriving (Eq, Ord, Read, Show)
234 #else /* __HADDOCK__ */
235 instance Eq a => Eq (Last a)
236 instance Ord a => Ord (Last a)
237 instance Read a => Read (Last a)
238 instance Show a => Show (Last a)
241 instance Monoid (Last a) where
242 mempty = Last Nothing
243 _ `mappend` r@(Last (Just _)) = r
244 r `mappend` Last Nothing = r
247 {--------------------------------------------------------------------
249 --------------------------------------------------------------------}
250 instance Arbitrary a => Arbitrary (Maybe a) where
251 arbitrary = oneof [return Nothing, Just `fmap` arbitrary]
253 prop_mconcatMaybe :: [Maybe [Int]] -> Bool
254 prop_mconcatMaybe x =
255 fromMaybe [] (mconcat x) == mconcat (catMaybes x)
257 prop_mconcatFirst :: [Maybe Int] -> Bool
258 prop_mconcatFirst x =
259 getFirst (mconcat (map First x)) == listToMaybe (catMaybes x)
260 prop_mconcatLast :: [Maybe Int] -> Bool
262 getLast (mconcat (map Last x)) == listLastToMaybe (catMaybes x)
263 where listLastToMaybe [] = Nothing
264 listLastToMaybe lst = Just (last lst)