Add kind equalities to GHC.
[ghc.git] / libraries / base / Data / Monoid.hs
1 {-# LANGUAGE Trustworthy #-}
2 {-# LANGUAGE NoImplicitPrelude #-}
3 {-# LANGUAGE DeriveGeneric #-}
4 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
5 {-# LANGUAGE PolyKinds #-}
6 {-# LANGUAGE ScopedTypeVariables #-}
7
8 -----------------------------------------------------------------------------
9 -- |
10 -- Module : Data.Monoid
11 -- Copyright : (c) Andy Gill 2001,
12 -- (c) Oregon Graduate Institute of Science and Technology, 2001
13 -- License : BSD-style (see the file libraries/base/LICENSE)
14 --
15 -- Maintainer : libraries@haskell.org
16 -- Stability : experimental
17 -- Portability : portable
18 --
19 -- A class for monoids (types with an associative binary operation that
20 -- has an identity) with various general-purpose instances.
21 --
22 -----------------------------------------------------------------------------
23
24 module Data.Monoid (
25 -- * 'Monoid' typeclass
26 Monoid(..),
27 (<>),
28 Dual(..),
29 Endo(..),
30 -- * 'Bool' wrappers
31 All(..),
32 Any(..),
33 -- * 'Num' wrappers
34 Sum(..),
35 Product(..),
36 -- * 'Maybe' wrappers
37 -- $MaybeExamples
38 First(..),
39 Last(..),
40 -- * 'Alternative' wrapper
41 Alt (..)
42 ) where
43
44 -- Push down the module in the dependency hierarchy.
45 import GHC.Base hiding (Any)
46 import GHC.Enum
47 import GHC.Num
48 import GHC.Read
49 import GHC.Show
50 import GHC.Generics
51
52 {-
53 -- just for testing
54 import Data.Maybe
55 import Test.QuickCheck
56 -- -}
57
58 infixr 6 <>
59
60 -- | An infix synonym for 'mappend'.
61 --
62 -- @since 4.5.0.0
63 (<>) :: Monoid m => m -> m -> m
64 (<>) = mappend
65 {-# INLINE (<>) #-}
66
67 -- Monoid instances.
68
69 -- | The dual of a 'Monoid', obtained by swapping the arguments of 'mappend'.
70 newtype Dual a = Dual { getDual :: a }
71 deriving (Eq, Ord, Read, Show, Bounded, Generic, Generic1)
72
73 instance Monoid a => Monoid (Dual a) where
74 mempty = Dual mempty
75 Dual x `mappend` Dual y = Dual (y `mappend` x)
76
77 instance Functor Dual where
78 fmap = coerce
79
80 instance Applicative Dual where
81 pure = Dual
82 (<*>) = coerce
83
84 instance Monad Dual where
85 m >>= k = k (getDual m)
86
87 -- | The monoid of endomorphisms under composition.
88 newtype Endo a = Endo { appEndo :: a -> a }
89 deriving (Generic)
90
91 instance Monoid (Endo a) where
92 mempty = Endo id
93 Endo f `mappend` Endo g = Endo (f . g)
94
95 -- | Boolean monoid under conjunction ('&&').
96 newtype All = All { getAll :: Bool }
97 deriving (Eq, Ord, Read, Show, Bounded, Generic)
98
99 instance Monoid All where
100 mempty = All True
101 All x `mappend` All y = All (x && y)
102
103 -- | Boolean monoid under disjunction ('||').
104 newtype Any = Any { getAny :: Bool }
105 deriving (Eq, Ord, Read, Show, Bounded, Generic)
106
107 instance Monoid Any where
108 mempty = Any False
109 Any x `mappend` Any y = Any (x || y)
110
111 -- | Monoid under addition.
112 newtype Sum a = Sum { getSum :: a }
113 deriving (Eq, Ord, Read, Show, Bounded, Generic, Generic1, Num)
114
115 instance Num a => Monoid (Sum a) where
116 mempty = Sum 0
117 mappend = coerce ((+) :: a -> a -> a)
118 -- Sum x `mappend` Sum y = Sum (x + y)
119
120 instance Functor Sum where
121 fmap = coerce
122
123 instance Applicative Sum where
124 pure = Sum
125 (<*>) = coerce
126
127 instance Monad Sum where
128 m >>= k = k (getSum m)
129
130 -- | Monoid under multiplication.
131 newtype Product a = Product { getProduct :: a }
132 deriving (Eq, Ord, Read, Show, Bounded, Generic, Generic1, Num)
133
134 instance Num a => Monoid (Product a) where
135 mempty = Product 1
136 mappend = coerce ((*) :: a -> a -> a)
137 -- Product x `mappend` Product y = Product (x * y)
138
139 instance Functor Product where
140 fmap = coerce
141
142 instance Applicative Product where
143 pure = Product
144 (<*>) = coerce
145
146 instance Monad Product where
147 m >>= k = k (getProduct m)
148
149 -- $MaybeExamples
150 -- To implement @find@ or @findLast@ on any 'Foldable':
151 --
152 -- @
153 -- findLast :: Foldable t => (a -> Bool) -> t a -> Maybe a
154 -- findLast pred = getLast . foldMap (\x -> if pred x
155 -- then Last (Just x)
156 -- else Last Nothing)
157 -- @
158 --
159 -- Much of Data.Map's interface can be implemented with
160 -- Data.Map.alter. Some of the rest can be implemented with a new
161 -- @alterA@ function and either 'First' or 'Last':
162 --
163 -- > alterA :: (Applicative f, Ord k) =>
164 -- > (Maybe a -> f (Maybe a)) -> k -> Map k a -> f (Map k a)
165 -- >
166 -- > instance Monoid a => Applicative ((,) a) -- from Control.Applicative
167 --
168 -- @
169 -- insertLookupWithKey :: Ord k => (k -> v -> v -> v) -> k -> v
170 -- -> Map k v -> (Maybe v, Map k v)
171 -- insertLookupWithKey combine key value =
172 -- Arrow.first getFirst . alterA doChange key
173 -- where
174 -- doChange Nothing = (First Nothing, Just value)
175 -- doChange (Just oldValue) =
176 -- (First (Just oldValue),
177 -- Just (combine key value oldValue))
178 -- @
179
180
181 -- | Maybe monoid returning the leftmost non-Nothing value.
182 --
183 -- @'First' a@ is isomorphic to @'Alt' 'Maybe' a@, but precedes it
184 -- historically.
185 newtype First a = First { getFirst :: Maybe a }
186 deriving (Eq, Ord, Read, Show, Generic, Generic1,
187 Functor, Applicative, Monad)
188
189 instance Monoid (First a) where
190 mempty = First Nothing
191 First Nothing `mappend` r = r
192 l `mappend` _ = l
193
194 -- | Maybe monoid returning the rightmost non-Nothing value.
195 --
196 -- @'Last' a@ is isomorphic to @'Dual' ('First' a)@, and thus to
197 -- @'Dual' ('Alt' 'Maybe' a)@
198 newtype Last a = Last { getLast :: Maybe a }
199 deriving (Eq, Ord, Read, Show, Generic, Generic1,
200 Functor, Applicative, Monad)
201
202 instance Monoid (Last a) where
203 mempty = Last Nothing
204 l `mappend` Last Nothing = l
205 _ `mappend` r = r
206
207 -- | Monoid under '<|>'.
208 --
209 -- @since 4.8.0.0
210 newtype Alt f a = Alt {getAlt :: f a}
211 deriving (Generic, Generic1, Read, Show, Eq, Ord, Num, Enum,
212 Monad, MonadPlus, Applicative, Alternative, Functor)
213
214 instance Alternative f => Monoid (Alt f a) where
215 mempty = Alt empty
216 mappend = coerce ((<|>) :: f a -> f a -> f a)
217
218 {-
219 {--------------------------------------------------------------------
220 Testing
221 --------------------------------------------------------------------}
222 instance Arbitrary a => Arbitrary (Maybe a) where
223 arbitrary = oneof [return Nothing, Just `fmap` arbitrary]
224
225 prop_mconcatMaybe :: [Maybe [Int]] -> Bool
226 prop_mconcatMaybe x =
227 fromMaybe [] (mconcat x) == mconcat (catMaybes x)
228
229 prop_mconcatFirst :: [Maybe Int] -> Bool
230 prop_mconcatFirst x =
231 getFirst (mconcat (map First x)) == listToMaybe (catMaybes x)
232 prop_mconcatLast :: [Maybe Int] -> Bool
233 prop_mconcatLast x =
234 getLast (mconcat (map Last x)) == listLastToMaybe (catMaybes x)
235 where listLastToMaybe [] = Nothing
236 listLastToMaybe lst = Just (last lst)
237 -- -}