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