Add missing Semigroup instances for Monoidal datatypes in base
[ghc.git] / libraries / base / Data / Semigroup.hs
1 {-# LANGUAGE DefaultSignatures #-}
2 {-# LANGUAGE DeriveDataTypeable #-}
3 {-# LANGUAGE DeriveGeneric #-}
4 {-# LANGUAGE FlexibleContexts #-}
5 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
6 {-# LANGUAGE PolyKinds #-}
7 {-# LANGUAGE ScopedTypeVariables #-}
8 {-# LANGUAGE Trustworthy #-}
9 {-# LANGUAGE TypeOperators #-}
10
11 -----------------------------------------------------------------------------
12 -- |
13 -- Module : Data.Semigroup
14 -- Copyright : (C) 2011-2015 Edward Kmett
15 -- License : BSD-style (see the file LICENSE)
16 --
17 -- Maintainer : libraries@haskell.org
18 -- Stability : provisional
19 -- Portability : portable
20 --
21 -- In mathematics, a semigroup is an algebraic structure consisting of a
22 -- set together with an associative binary operation. A semigroup
23 -- generalizes a monoid in that there might not exist an identity
24 -- element. It also (originally) generalized a group (a monoid with all
25 -- inverses) to a type where every element did not have to have an inverse,
26 -- thus the name semigroup.
27 --
28 -- The use of @(\<\>)@ in this module conflicts with an operator with the same
29 -- name that is being exported by Data.Monoid. However, this package
30 -- re-exports (most of) the contents of Data.Monoid, so to use semigroups
31 -- and monoids in the same package just
32 --
33 -- > import Data.Semigroup
34 --
35 -- @since 4.9.0.0
36 ----------------------------------------------------------------------------
37 module Data.Semigroup (
38 Semigroup(..)
39 , stimesMonoid
40 , stimesIdempotent
41 , stimesIdempotentMonoid
42 , mtimesDefault
43 -- * Semigroups
44 , Min(..)
45 , Max(..)
46 , First(..)
47 , Last(..)
48 , WrappedMonoid(..)
49 -- * Re-exported monoids from Data.Monoid
50 , Monoid(..)
51 , Dual(..)
52 , Endo(..)
53 , All(..)
54 , Any(..)
55 , Sum(..)
56 , Product(..)
57 -- * A better monoid for Maybe
58 , Option(..)
59 , option
60 -- * Difference lists of a semigroup
61 , diff
62 , cycle1
63 -- * ArgMin, ArgMax
64 , Arg(..)
65 , ArgMin
66 , ArgMax
67 ) where
68
69 import Prelude hiding (foldr1)
70
71 import Control.Applicative
72 import Control.Monad
73 import Control.Monad.Fix
74 import Data.Bifoldable
75 import Data.Bifunctor
76 import Data.Bitraversable
77 import Data.Coerce
78 import Data.Data
79 import Data.Functor.Identity
80 import Data.List.NonEmpty
81 import Data.Monoid (All (..), Any (..), Dual (..), Endo (..),
82 Product (..), Sum (..))
83 import Data.Monoid (Alt (..))
84 import qualified Data.Monoid as Monoid
85 import Data.Void
86 import GHC.Event (Event, Lifetime (..))
87 import GHC.Generics
88
89 infixr 6 <>
90
91 -- | The class of semigroups (types with an associative binary operation).
92 --
93 -- @since 4.9.0.0
94 class Semigroup a where
95 -- | An associative operation.
96 --
97 -- @
98 -- (a '<>' b) '<>' c = a '<>' (b '<>' c)
99 -- @
100 --
101 -- If @a@ is also a 'Monoid' we further require
102 --
103 -- @
104 -- ('<>') = 'mappend'
105 -- @
106 (<>) :: a -> a -> a
107
108 default (<>) :: Monoid a => a -> a -> a
109 (<>) = mappend
110
111 -- | Reduce a non-empty list with @\<\>@
112 --
113 -- The default definition should be sufficient, but this can be
114 -- overridden for efficiency.
115 --
116 sconcat :: NonEmpty a -> a
117 sconcat (a :| as) = go a as where
118 go b (c:cs) = b <> go c cs
119 go b [] = b
120
121 -- | Repeat a value @n@ times.
122 --
123 -- Given that this works on a 'Semigroup' it is allowed to fail if
124 -- you request 0 or fewer repetitions, and the default definition
125 -- will do so.
126 --
127 -- By making this a member of the class, idempotent semigroups and monoids can
128 -- upgrade this to execute in /O(1)/ by picking
129 -- @stimes = stimesIdempotent@ or @stimes = stimesIdempotentMonoid@
130 -- respectively.
131 stimes :: Integral b => b -> a -> a
132 stimes y0 x0
133 | y0 <= 0 = errorWithoutStackTrace "stimes: positive multiplier expected"
134 | otherwise = f x0 y0
135 where
136 f x y
137 | even y = f (x <> x) (y `quot` 2)
138 | y == 1 = x
139 | otherwise = g (x <> x) (pred y `quot` 2) x
140 g x y z
141 | even y = g (x <> x) (y `quot` 2) z
142 | y == 1 = x <> z
143 | otherwise = g (x <> x) (pred y `quot` 2) (x <> z)
144
145 -- | A generalization of 'Data.List.cycle' to an arbitrary 'Semigroup'.
146 -- May fail to terminate for some values in some semigroups.
147 cycle1 :: Semigroup m => m -> m
148 cycle1 xs = xs' where xs' = xs <> xs'
149
150 -- | @since 4.9.0.0
151 instance Semigroup () where
152 _ <> _ = ()
153 sconcat _ = ()
154 stimes _ _ = ()
155
156 -- | @since 4.9.0.0
157 instance Semigroup b => Semigroup (a -> b) where
158 f <> g = \a -> f a <> g a
159 stimes n f e = stimes n (f e)
160
161 -- | @since 4.9.0.0
162 instance Semigroup [a] where
163 (<>) = (++)
164 stimes n x
165 | n < 0 = errorWithoutStackTrace "stimes: [], negative multiplier"
166 | otherwise = rep n
167 where
168 rep 0 = []
169 rep i = x ++ rep (i - 1)
170
171 -- | @since 4.9.0.0
172 instance Semigroup a => Semigroup (Maybe a) where
173 Nothing <> b = b
174 a <> Nothing = a
175 Just a <> Just b = Just (a <> b)
176 stimes _ Nothing = Nothing
177 stimes n (Just a) = case compare n 0 of
178 LT -> errorWithoutStackTrace "stimes: Maybe, negative multiplier"
179 EQ -> Nothing
180 GT -> Just (stimes n a)
181
182 -- | @since 4.9.0.0
183 instance Semigroup (Either a b) where
184 Left _ <> b = b
185 a <> _ = a
186 stimes = stimesIdempotent
187
188 -- | @since 4.9.0.0
189 instance (Semigroup a, Semigroup b) => Semigroup (a, b) where
190 (a,b) <> (a',b') = (a<>a',b<>b')
191 stimes n (a,b) = (stimes n a, stimes n b)
192
193 -- | @since 4.9.0.0
194 instance (Semigroup a, Semigroup b, Semigroup c) => Semigroup (a, b, c) where
195 (a,b,c) <> (a',b',c') = (a<>a',b<>b',c<>c')
196 stimes n (a,b,c) = (stimes n a, stimes n b, stimes n c)
197
198 -- | @since 4.9.0.0
199 instance (Semigroup a, Semigroup b, Semigroup c, Semigroup d)
200 => Semigroup (a, b, c, d) where
201 (a,b,c,d) <> (a',b',c',d') = (a<>a',b<>b',c<>c',d<>d')
202 stimes n (a,b,c,d) = (stimes n a, stimes n b, stimes n c, stimes n d)
203
204 -- | @since 4.9.0.0
205 instance (Semigroup a, Semigroup b, Semigroup c, Semigroup d, Semigroup e)
206 => Semigroup (a, b, c, d, e) where
207 (a,b,c,d,e) <> (a',b',c',d',e') = (a<>a',b<>b',c<>c',d<>d',e<>e')
208 stimes n (a,b,c,d,e) =
209 (stimes n a, stimes n b, stimes n c, stimes n d, stimes n e)
210
211 -- | @since 4.9.0.0
212 instance Semigroup Ordering where
213 LT <> _ = LT
214 EQ <> y = y
215 GT <> _ = GT
216 stimes = stimesIdempotentMonoid
217
218 -- | @since 4.9.0.0
219 instance Semigroup a => Semigroup (Dual a) where
220 Dual a <> Dual b = Dual (b <> a)
221 stimes n (Dual a) = Dual (stimes n a)
222
223 -- | @since 4.9.0.0
224 instance Semigroup (Endo a) where
225 (<>) = coerce ((.) :: (a -> a) -> (a -> a) -> (a -> a))
226 stimes = stimesMonoid
227
228 -- | @since 4.9.0.0
229 instance Semigroup All where
230 (<>) = coerce (&&)
231 stimes = stimesIdempotentMonoid
232
233 -- | @since 4.9.0.0
234 instance Semigroup Any where
235 (<>) = coerce (||)
236 stimes = stimesIdempotentMonoid
237
238
239 -- | @since 4.9.0.0
240 instance Num a => Semigroup (Sum a) where
241 (<>) = coerce ((+) :: a -> a -> a)
242 stimes n (Sum a) = Sum (fromIntegral n * a)
243
244 -- | @since 4.9.0.0
245 instance Num a => Semigroup (Product a) where
246 (<>) = coerce ((*) :: a -> a -> a)
247 stimes n (Product a) = Product (a ^ n)
248
249 -- | This is a valid definition of 'stimes' for a 'Monoid'.
250 --
251 -- Unlike the default definition of 'stimes', it is defined for 0
252 -- and so it should be preferred where possible.
253 stimesMonoid :: (Integral b, Monoid a) => b -> a -> a
254 stimesMonoid n x0 = case compare n 0 of
255 LT -> errorWithoutStackTrace "stimesMonoid: negative multiplier"
256 EQ -> mempty
257 GT -> f x0 n
258 where
259 f x y
260 | even y = f (x `mappend` x) (y `quot` 2)
261 | y == 1 = x
262 | otherwise = g (x `mappend` x) (pred y `quot` 2) x
263 g x y z
264 | even y = g (x `mappend` x) (y `quot` 2) z
265 | y == 1 = x `mappend` z
266 | otherwise = g (x `mappend` x) (pred y `quot` 2) (x `mappend` z)
267
268 -- | This is a valid definition of 'stimes' for an idempotent 'Monoid'.
269 --
270 -- When @mappend x x = x@, this definition should be preferred, because it
271 -- works in /O(1)/ rather than /O(log n)/
272 stimesIdempotentMonoid :: (Integral b, Monoid a) => b -> a -> a
273 stimesIdempotentMonoid n x = case compare n 0 of
274 LT -> errorWithoutStackTrace "stimesIdempotentMonoid: negative multiplier"
275 EQ -> mempty
276 GT -> x
277
278 -- | This is a valid definition of 'stimes' for an idempotent 'Semigroup'.
279 --
280 -- When @x <> x = x@, this definition should be preferred, because it
281 -- works in /O(1)/ rather than /O(log n)/.
282 stimesIdempotent :: Integral b => b -> a -> a
283 stimesIdempotent n x
284 | n <= 0 = errorWithoutStackTrace "stimesIdempotent: positive multiplier expected"
285 | otherwise = x
286
287 -- | @since 4.9.0.0
288 instance Semigroup a => Semigroup (Identity a) where
289 (<>) = coerce ((<>) :: a -> a -> a)
290 stimes n (Identity a) = Identity (stimes n a)
291
292 -- | @since 4.9.0.0
293 instance Semigroup a => Semigroup (Const a b) where
294 (<>) = coerce ((<>) :: a -> a -> a)
295 stimes n (Const a) = Const (stimes n a)
296
297 -- | @since 4.9.0.0
298 instance Semigroup (Monoid.First a) where
299 Monoid.First Nothing <> b = b
300 a <> _ = a
301 stimes = stimesIdempotentMonoid
302
303 -- | @since 4.9.0.0
304 instance Semigroup (Monoid.Last a) where
305 a <> Monoid.Last Nothing = a
306 _ <> b = b
307 stimes = stimesIdempotentMonoid
308
309 -- | @since 4.9.0.0
310 instance Alternative f => Semigroup (Alt f a) where
311 (<>) = coerce ((<|>) :: f a -> f a -> f a)
312 stimes = stimesMonoid
313
314 -- | @since 4.9.0.0
315 instance Semigroup Void where
316 a <> _ = a
317 stimes = stimesIdempotent
318
319 -- | @since 4.9.0.0
320 instance Semigroup (NonEmpty a) where
321 (a :| as) <> ~(b :| bs) = a :| (as ++ b : bs)
322
323
324 newtype Min a = Min { getMin :: a }
325 deriving (Bounded, Eq, Ord, Show, Read, Data, Generic, Generic1)
326
327 -- | @since 4.9.0.0
328 instance Enum a => Enum (Min a) where
329 succ (Min a) = Min (succ a)
330 pred (Min a) = Min (pred a)
331 toEnum = Min . toEnum
332 fromEnum = fromEnum . getMin
333 enumFrom (Min a) = Min <$> enumFrom a
334 enumFromThen (Min a) (Min b) = Min <$> enumFromThen a b
335 enumFromTo (Min a) (Min b) = Min <$> enumFromTo a b
336 enumFromThenTo (Min a) (Min b) (Min c) = Min <$> enumFromThenTo a b c
337
338
339 -- | @since 4.9.0.0
340 instance Ord a => Semigroup (Min a) where
341 (<>) = coerce (min :: a -> a -> a)
342 stimes = stimesIdempotent
343
344 -- | @since 4.9.0.0
345 instance (Ord a, Bounded a) => Monoid (Min a) where
346 mempty = maxBound
347 mappend = (<>)
348
349 -- | @since 4.9.0.0
350 instance Functor Min where
351 fmap f (Min x) = Min (f x)
352
353 -- | @since 4.9.0.0
354 instance Foldable Min where
355 foldMap f (Min a) = f a
356
357 -- | @since 4.9.0.0
358 instance Traversable Min where
359 traverse f (Min a) = Min <$> f a
360
361 -- | @since 4.9.0.0
362 instance Applicative Min where
363 pure = Min
364 a <* _ = a
365 _ *> a = a
366 Min f <*> Min x = Min (f x)
367
368 -- | @since 4.9.0.0
369 instance Monad Min where
370 (>>) = (*>)
371 Min a >>= f = f a
372
373 -- | @since 4.9.0.0
374 instance MonadFix Min where
375 mfix f = fix (f . getMin)
376
377 -- | @since 4.9.0.0
378 instance Num a => Num (Min a) where
379 (Min a) + (Min b) = Min (a + b)
380 (Min a) * (Min b) = Min (a * b)
381 (Min a) - (Min b) = Min (a - b)
382 negate (Min a) = Min (negate a)
383 abs (Min a) = Min (abs a)
384 signum (Min a) = Min (signum a)
385 fromInteger = Min . fromInteger
386
387 newtype Max a = Max { getMax :: a }
388 deriving (Bounded, Eq, Ord, Show, Read, Data, Generic, Generic1)
389
390 -- | @since 4.9.0.0
391 instance Enum a => Enum (Max a) where
392 succ (Max a) = Max (succ a)
393 pred (Max a) = Max (pred a)
394 toEnum = Max . toEnum
395 fromEnum = fromEnum . getMax
396 enumFrom (Max a) = Max <$> enumFrom a
397 enumFromThen (Max a) (Max b) = Max <$> enumFromThen a b
398 enumFromTo (Max a) (Max b) = Max <$> enumFromTo a b
399 enumFromThenTo (Max a) (Max b) (Max c) = Max <$> enumFromThenTo a b c
400
401 -- | @since 4.9.0.0
402 instance Ord a => Semigroup (Max a) where
403 (<>) = coerce (max :: a -> a -> a)
404 stimes = stimesIdempotent
405
406 -- | @since 4.9.0.0
407 instance (Ord a, Bounded a) => Monoid (Max a) where
408 mempty = minBound
409 mappend = (<>)
410
411 -- | @since 4.9.0.0
412 instance Functor Max where
413 fmap f (Max x) = Max (f x)
414
415 -- | @since 4.9.0.0
416 instance Foldable Max where
417 foldMap f (Max a) = f a
418
419 -- | @since 4.9.0.0
420 instance Traversable Max where
421 traverse f (Max a) = Max <$> f a
422
423 -- | @since 4.9.0.0
424 instance Applicative Max where
425 pure = Max
426 a <* _ = a
427 _ *> a = a
428 Max f <*> Max x = Max (f x)
429
430 -- | @since 4.9.0.0
431 instance Monad Max where
432 (>>) = (*>)
433 Max a >>= f = f a
434
435 -- | @since 4.9.0.0
436 instance MonadFix Max where
437 mfix f = fix (f . getMax)
438
439 -- | @since 4.9.0.0
440 instance Num a => Num (Max a) where
441 (Max a) + (Max b) = Max (a + b)
442 (Max a) * (Max b) = Max (a * b)
443 (Max a) - (Max b) = Max (a - b)
444 negate (Max a) = Max (negate a)
445 abs (Max a) = Max (abs a)
446 signum (Max a) = Max (signum a)
447 fromInteger = Max . fromInteger
448
449 -- | 'Arg' isn't itself a 'Semigroup' in its own right, but it can be
450 -- placed inside 'Min' and 'Max' to compute an arg min or arg max.
451 data Arg a b = Arg a b deriving
452 (Show, Read, Data, Generic, Generic1)
453
454 type ArgMin a b = Min (Arg a b)
455 type ArgMax a b = Max (Arg a b)
456
457 -- | @since 4.9.0.0
458 instance Functor (Arg a) where
459 fmap f (Arg x a) = Arg x (f a)
460
461 -- | @since 4.9.0.0
462 instance Foldable (Arg a) where
463 foldMap f (Arg _ a) = f a
464
465 -- | @since 4.9.0.0
466 instance Traversable (Arg a) where
467 traverse f (Arg x a) = Arg x <$> f a
468
469 -- | @since 4.9.0.0
470 instance Eq a => Eq (Arg a b) where
471 Arg a _ == Arg b _ = a == b
472
473 -- | @since 4.9.0.0
474 instance Ord a => Ord (Arg a b) where
475 Arg a _ `compare` Arg b _ = compare a b
476 min x@(Arg a _) y@(Arg b _)
477 | a <= b = x
478 | otherwise = y
479 max x@(Arg a _) y@(Arg b _)
480 | a >= b = x
481 | otherwise = y
482
483 -- | @since 4.9.0.0
484 instance Bifunctor Arg where
485 bimap f g (Arg a b) = Arg (f a) (g b)
486
487 -- | @since 4.10.0.0
488 instance Bifoldable Arg where
489 bifoldMap f g (Arg a b) = f a `mappend` g b
490
491 -- | @since 4.10.0.0
492 instance Bitraversable Arg where
493 bitraverse f g (Arg a b) = Arg <$> f a <*> g b
494
495 -- | Use @'Option' ('First' a)@ to get the behavior of
496 -- 'Data.Monoid.First' from "Data.Monoid".
497 newtype First a = First { getFirst :: a } deriving
498 (Bounded, Eq, Ord, Show, Read, Data, Generic, Generic1)
499
500 -- | @since 4.9.0.0
501 instance Enum a => Enum (First a) where
502 succ (First a) = First (succ a)
503 pred (First a) = First (pred a)
504 toEnum = First . toEnum
505 fromEnum = fromEnum . getFirst
506 enumFrom (First a) = First <$> enumFrom a
507 enumFromThen (First a) (First b) = First <$> enumFromThen a b
508 enumFromTo (First a) (First b) = First <$> enumFromTo a b
509 enumFromThenTo (First a) (First b) (First c) = First <$> enumFromThenTo a b c
510
511 -- | @since 4.9.0.0
512 instance Semigroup (First a) where
513 a <> _ = a
514 stimes = stimesIdempotent
515
516 -- | @since 4.9.0.0
517 instance Functor First where
518 fmap f (First x) = First (f x)
519
520 -- | @since 4.9.0.0
521 instance Foldable First where
522 foldMap f (First a) = f a
523
524 -- | @since 4.9.0.0
525 instance Traversable First where
526 traverse f (First a) = First <$> f a
527
528 -- | @since 4.9.0.0
529 instance Applicative First where
530 pure x = First x
531 a <* _ = a
532 _ *> a = a
533 First f <*> First x = First (f x)
534
535 -- | @since 4.9.0.0
536 instance Monad First where
537 (>>) = (*>)
538 First a >>= f = f a
539
540 -- | @since 4.9.0.0
541 instance MonadFix First where
542 mfix f = fix (f . getFirst)
543
544 -- | Use @'Option' ('Last' a)@ to get the behavior of
545 -- 'Data.Monoid.Last' from "Data.Monoid"
546 newtype Last a = Last { getLast :: a } deriving
547 (Bounded, Eq, Ord, Show, Read, Data, Generic, Generic1)
548
549 -- | @since 4.9.0.0
550 instance Enum a => Enum (Last a) where
551 succ (Last a) = Last (succ a)
552 pred (Last a) = Last (pred a)
553 toEnum = Last . toEnum
554 fromEnum = fromEnum . getLast
555 enumFrom (Last a) = Last <$> enumFrom a
556 enumFromThen (Last a) (Last b) = Last <$> enumFromThen a b
557 enumFromTo (Last a) (Last b) = Last <$> enumFromTo a b
558 enumFromThenTo (Last a) (Last b) (Last c) = Last <$> enumFromThenTo a b c
559
560 -- | @since 4.9.0.0
561 instance Semigroup (Last a) where
562 _ <> b = b
563 stimes = stimesIdempotent
564
565 -- | @since 4.9.0.0
566 instance Functor Last where
567 fmap f (Last x) = Last (f x)
568 a <$ _ = Last a
569
570 -- | @since 4.9.0.0
571 instance Foldable Last where
572 foldMap f (Last a) = f a
573
574 -- | @since 4.9.0.0
575 instance Traversable Last where
576 traverse f (Last a) = Last <$> f a
577
578 -- | @since 4.9.0.0
579 instance Applicative Last where
580 pure = Last
581 a <* _ = a
582 _ *> a = a
583 Last f <*> Last x = Last (f x)
584
585 -- | @since 4.9.0.0
586 instance Monad Last where
587 (>>) = (*>)
588 Last a >>= f = f a
589
590 -- | @since 4.9.0.0
591 instance MonadFix Last where
592 mfix f = fix (f . getLast)
593
594 -- | Provide a Semigroup for an arbitrary Monoid.
595 newtype WrappedMonoid m = WrapMonoid { unwrapMonoid :: m }
596 deriving (Bounded, Eq, Ord, Show, Read, Data, Generic, Generic1)
597
598 -- | @since 4.9.0.0
599 instance Monoid m => Semigroup (WrappedMonoid m) where
600 (<>) = coerce (mappend :: m -> m -> m)
601
602 -- | @since 4.9.0.0
603 instance Monoid m => Monoid (WrappedMonoid m) where
604 mempty = WrapMonoid mempty
605 mappend = (<>)
606
607 -- | @since 4.9.0.0
608 instance Enum a => Enum (WrappedMonoid a) where
609 succ (WrapMonoid a) = WrapMonoid (succ a)
610 pred (WrapMonoid a) = WrapMonoid (pred a)
611 toEnum = WrapMonoid . toEnum
612 fromEnum = fromEnum . unwrapMonoid
613 enumFrom (WrapMonoid a) = WrapMonoid <$> enumFrom a
614 enumFromThen (WrapMonoid a) (WrapMonoid b) = WrapMonoid <$> enumFromThen a b
615 enumFromTo (WrapMonoid a) (WrapMonoid b) = WrapMonoid <$> enumFromTo a b
616 enumFromThenTo (WrapMonoid a) (WrapMonoid b) (WrapMonoid c) =
617 WrapMonoid <$> enumFromThenTo a b c
618
619 -- | Repeat a value @n@ times.
620 --
621 -- > mtimesDefault n a = a <> a <> ... <> a -- using <> (n-1) times
622 --
623 -- Implemented using 'stimes' and 'mempty'.
624 --
625 -- This is a suitable definition for an 'mtimes' member of 'Monoid'.
626 mtimesDefault :: (Integral b, Monoid a) => b -> a -> a
627 mtimesDefault n x
628 | n == 0 = mempty
629 | otherwise = unwrapMonoid (stimes n (WrapMonoid x))
630
631 -- | 'Option' is effectively 'Maybe' with a better instance of
632 -- 'Monoid', built off of an underlying 'Semigroup' instead of an
633 -- underlying 'Monoid'.
634 --
635 -- Ideally, this type would not exist at all and we would just fix the
636 -- 'Monoid' instance of 'Maybe'
637 newtype Option a = Option { getOption :: Maybe a }
638 deriving (Eq, Ord, Show, Read, Data, Generic, Generic1)
639
640 -- | @since 4.9.0.0
641 instance Functor Option where
642 fmap f (Option a) = Option (fmap f a)
643
644 -- | @since 4.9.0.0
645 instance Applicative Option where
646 pure a = Option (Just a)
647 Option a <*> Option b = Option (a <*> b)
648
649 Option Nothing *> _ = Option Nothing
650 _ *> b = b
651
652 -- | @since 4.9.0.0
653 instance Monad Option where
654 Option (Just a) >>= k = k a
655 _ >>= _ = Option Nothing
656 (>>) = (*>)
657
658 -- | @since 4.9.0.0
659 instance Alternative Option where
660 empty = Option Nothing
661 Option Nothing <|> b = b
662 a <|> _ = a
663
664 -- | @since 4.9.0.0
665 instance MonadPlus Option
666
667 -- | @since 4.9.0.0
668 instance MonadFix Option where
669 mfix f = Option (mfix (getOption . f))
670
671 -- | @since 4.9.0.0
672 instance Foldable Option where
673 foldMap f (Option (Just m)) = f m
674 foldMap _ (Option Nothing) = mempty
675
676 -- | @since 4.9.0.0
677 instance Traversable Option where
678 traverse f (Option (Just a)) = Option . Just <$> f a
679 traverse _ (Option Nothing) = pure (Option Nothing)
680
681 -- | Fold an 'Option' case-wise, just like 'maybe'.
682 option :: b -> (a -> b) -> Option a -> b
683 option n j (Option m) = maybe n j m
684
685 -- | @since 4.9.0.0
686 instance Semigroup a => Semigroup (Option a) where
687 (<>) = coerce ((<>) :: Maybe a -> Maybe a -> Maybe a)
688
689 stimes _ (Option Nothing) = Option Nothing
690 stimes n (Option (Just a)) = case compare n 0 of
691 LT -> errorWithoutStackTrace "stimes: Option, negative multiplier"
692 EQ -> Option Nothing
693 GT -> Option (Just (stimes n a))
694
695 -- | @since 4.9.0.0
696 instance Semigroup a => Monoid (Option a) where
697 mempty = Option Nothing
698 mappend = (<>)
699
700 -- | This lets you use a difference list of a 'Semigroup' as a 'Monoid'.
701 diff :: Semigroup m => m -> Endo m
702 diff = Endo . (<>)
703
704 -- | @since 4.9.0.0
705 instance Semigroup (Proxy s) where
706 _ <> _ = Proxy
707 sconcat _ = Proxy
708 stimes _ _ = Proxy
709
710 -- | @since 4.10.0.0
711 instance Semigroup a => Semigroup (IO a) where
712 (<>) = liftA2 (<>)
713
714 -- | @since 4.10.0.0
715 instance Semigroup Event where
716 (<>) = mappend
717 stimes = stimesMonoid
718
719 -- | @since 4.10.0.0
720 instance Semigroup Lifetime where
721 (<>) = mappend
722 stimes = stimesMonoid