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 -- The Monoid class with various general-purpose instances.
14 -- Inspired by the paper
15 -- /Functional Programming with Overloading and
16 -- Higher-Order Polymorphism/,
17 -- Mark P Jones (<http://www.cse.ogi.edu/~mpj/>)
18 -- Advanced School of Functional Programming, 1995.
19 -----------------------------------------------------------------------------
43 import Test.QuickCheck
46 -- ---------------------------------------------------------------------------
47 -- | The monoid class.
48 -- A minimal complete definition must supply 'mempty' and 'mappend',
49 -- and these should satisfy the monoid laws.
53 -- ^ Identity of 'mappend'
54 mappend :: a -> a -> a
55 -- ^ An associative operation
58 -- ^ Fold a list using the monoid.
59 -- For most types, the default definition for 'mconcat' will be
60 -- used, but the function is included in the class definition so
61 -- that an optimized version can be provided for specific types.
63 mconcat = foldr mappend mempty
67 instance Monoid [a] where
71 instance Monoid b => Monoid (a -> b) where
73 mappend f g x = f x `mappend` g x
75 instance Monoid () where
76 -- Should it be strict?
81 instance (Monoid a, Monoid b) => Monoid (a,b) where
82 mempty = (mempty, mempty)
83 (a1,b1) `mappend` (a2,b2) =
84 (a1 `mappend` a2, b1 `mappend` b2)
86 instance (Monoid a, Monoid b, Monoid c) => Monoid (a,b,c) where
87 mempty = (mempty, mempty, mempty)
88 (a1,b1,c1) `mappend` (a2,b2,c2) =
89 (a1 `mappend` a2, b1 `mappend` b2, c1 `mappend` c2)
91 instance (Monoid a, Monoid b, Monoid c, Monoid d) => Monoid (a,b,c,d) where
92 mempty = (mempty, mempty, mempty, mempty)
93 (a1,b1,c1,d1) `mappend` (a2,b2,c2,d2) =
94 (a1 `mappend` a2, b1 `mappend` b2,
95 c1 `mappend` c2, d1 `mappend` d2)
97 instance (Monoid a, Monoid b, Monoid c, Monoid d, Monoid e) =>
98 Monoid (a,b,c,d,e) where
99 mempty = (mempty, mempty, mempty, mempty, mempty)
100 (a1,b1,c1,d1,e1) `mappend` (a2,b2,c2,d2,e2) =
101 (a1 `mappend` a2, b1 `mappend` b2, c1 `mappend` c2,
102 d1 `mappend` d2, e1 `mappend` e2)
104 -- lexicographical ordering
105 instance Monoid Ordering where
111 -- | The dual of a monoid, obtained by swapping the arguments of 'mappend'.
112 newtype Dual a = Dual { getDual :: a }
113 deriving (Eq, Ord, Read, Show, Bounded)
115 instance Monoid a => Monoid (Dual a) where
117 Dual x `mappend` Dual y = Dual (y `mappend` x)
119 -- | The monoid of endomorphisms under composition.
120 newtype Endo a = Endo { appEndo :: a -> a }
122 instance Monoid (Endo a) where
124 Endo f `mappend` Endo g = Endo (f . g)
126 -- | Boolean monoid under conjunction.
127 newtype All = All { getAll :: Bool }
128 deriving (Eq, Ord, Read, Show, Bounded)
130 instance Monoid All where
132 All x `mappend` All y = All (x && y)
134 -- | Boolean monoid under disjunction.
135 newtype Any = Any { getAny :: Bool }
136 deriving (Eq, Ord, Read, Show, Bounded)
138 instance Monoid Any where
140 Any x `mappend` Any y = Any (x || y)
142 -- | Monoid under addition.
143 newtype Sum a = Sum { getSum :: a }
144 deriving (Eq, Ord, Read, Show, Bounded)
146 instance Num a => Monoid (Sum a) where
148 Sum x `mappend` Sum y = Sum (x + y)
150 -- | Monoid under multiplication.
151 newtype Product a = Product { getProduct :: a }
152 deriving (Eq, Ord, Read, Show, Bounded)
154 instance Num a => Monoid (Product a) where
156 Product x `mappend` Product y = Product (x * y)
159 -- To implement @find@ or @findLast@ on any 'Foldable':
162 -- findLast :: Foldable t => (a -> Bool) -> t a -> Maybe a
163 -- findLast pred = getLast . foldMap (\x -> if pred x
164 -- then Last (Just x)
165 -- else Last Nothing)
168 -- Much of "Data.Map"'s interface can be implemented with
169 -- 'Data.Map.alter'. Some of the rest can be implemented with a new
170 -- @alterA@ function and either 'First' or 'Last':
172 -- > alterA :: (Applicative f, Ord k) =>
173 -- > (Maybe a -> f (Maybe a)) -> k -> Map k a -> f (Map k a)
175 -- > instance Monoid a => Applicative ((,) a) -- from Control.Applicative
178 -- insertLookupWithKey :: Ord k => (k -> v -> v -> v) -> k -> v
179 -- -> Map k v -> (Maybe v, Map k v)
180 -- insertLookupWithKey combine key value =
181 -- Arrow.first getFirst . alterA doChange key
183 -- doChange Nothing = (First Nothing, Just value)
184 -- doChange (Just oldValue) =
185 -- (First (Just oldValue),
186 -- Just (combine key value oldValue))
189 -- | Lift a semigroup into 'Maybe' forming a 'Monoid' according to
190 -- <http://en.wikipedia.org/wiki/Monoid>: \"Any semigroup @S@ may be
191 -- turned into a monoid simply by adjoining an element @e@ not in @S@
192 -- and defining @e*e = e@ and @e*s = s = s*e@ for all @s ∈ S@.\" Since
193 -- there is no \"Semigroup\" typeclass providing just 'mappend', we
194 -- use 'Monoid' instead.
195 instance Monoid a => Monoid (Maybe a) where
197 Nothing `mappend` m = m
198 m `mappend` Nothing = m
199 Just m1 `mappend` Just m2 = Just (m1 `mappend` m2)
202 -- | Maybe monoid returning the leftmost non-Nothing value.
203 newtype First a = First { getFirst :: Maybe a }
205 deriving (Eq, Ord, Read, Show)
206 #else /* __HADDOCK__ */
207 instance Eq a => Eq (First a)
208 instance Ord a => Ord (First a)
209 instance Read a => Read (First a)
210 instance Show a => Show (First a)
213 instance Monoid (First a) where
214 mempty = First Nothing
215 r@(First (Just _)) `mappend` _ = r
216 First Nothing `mappend` r = r
218 -- | Maybe monoid returning the rightmost non-Nothing value.
219 newtype Last a = Last { getLast :: Maybe a }
221 deriving (Eq, Ord, Read, Show)
222 #else /* __HADDOCK__ */
223 instance Eq a => Eq (Last a)
224 instance Ord a => Ord (Last a)
225 instance Read a => Read (Last a)
226 instance Show a => Show (Last a)
229 instance Monoid (Last a) where
230 mempty = Last Nothing
231 _ `mappend` r@(Last (Just _)) = r
232 r `mappend` Last Nothing = r
235 {--------------------------------------------------------------------
237 --------------------------------------------------------------------}
238 instance Arbitrary a => Arbitrary (Maybe a) where
239 arbitrary = oneof [return Nothing, Just `fmap` arbitrary]
241 prop_mconcatMaybe :: [Maybe [Int]] -> Bool
242 prop_mconcatMaybe x =
243 fromMaybe [] (mconcat x) == mconcat (catMaybes x)
245 prop_mconcatFirst :: [Maybe Int] -> Bool
246 prop_mconcatFirst x =
247 getFirst (mconcat (map First x)) == listToMaybe (catMaybes x)
248 prop_mconcatLast :: [Maybe Int] -> Bool
250 getLast (mconcat (map Last x)) == listLastToMaybe (catMaybes x)
251 where listLastToMaybe [] = Nothing
252 listLastToMaybe lst = Just (last lst)