#ifdef __GLASGOW_HASKELL__
#define LANGUAGE_DeriveDataTypeable
#endif
#if __GLASGOW_HASKELL__ >= 702
#define LANGUAGE_DefaultSignatures
#if defined(MIN_VERSION_hashable) || __GLASGOW_HASKELL__ >= 708
#else
#endif
#endif
#if __GLASGOW_HASKELL__ >= 704
#define LANGUAGE_DeriveGeneric
#endif
#if __GLASGOW_HASKELL__ >= 706
#endif
#if __GLASGOW_HASKELL__ >= 708
#define USE_COERCE
#endif
#ifndef MIN_VERSION_base
#define MIN_VERSION_base(x,y,z) 1
#endif
module Data.Semigroup (
Semigroup(..)
, stimesMonoid
, stimesIdempotent
, stimesIdempotentMonoid
, mtimesDefault
, Min(..)
, Max(..)
, First(..)
, Last(..)
, WrappedMonoid(..)
, Monoid(..)
, Dual(..)
, Endo(..)
, All(..)
, Any(..)
, Sum(..)
, Product(..)
, Option(..)
, option
, diff
, cycle1
, Arg(..)
, ArgMin
, ArgMax
) where
import Prelude hiding (foldr1)
#if MIN_VERSION_base(4,8,0)
import Data.Bifunctor
import Data.Void
#else
import Data.Monoid (Monoid(..))
import Data.Foldable
import Data.Traversable
#endif
import Data.Monoid (Dual(..),Endo(..),All(..),Any(..),Sum(..),Product(..))
#if MIN_VERSION_base(4,8,0)
import Data.Monoid (Alt(..))
#endif
import Control.Applicative
import Control.Monad
import Control.Monad.Fix
import qualified Data.Monoid as Monoid
import Data.List.NonEmpty
#ifdef MIN_VERSION_deepseq
import Control.DeepSeq (NFData(..))
#endif
#ifdef MIN_VERSION_containers
import Data.Sequence (Seq, (><))
import Data.Set (Set)
import Data.IntSet (IntSet)
import Data.Map (Map)
import Data.IntMap (IntMap)
#endif
#ifdef MIN_VERSION_binary
import qualified Data.Binary.Builder as Builder
#endif
#ifdef MIN_VERSION_bytestring
import Data.ByteString as Strict
import Data.ByteString.Lazy as Lazy
# if MIN_VERSION_bytestring(0,10,2)
import qualified Data.ByteString.Builder as ByteString
# elif MIN_VERSION_bytestring(0,10,0)
import qualified Data.ByteString.Lazy.Builder as ByteString
# endif
# if MIN_VERSION_bytestring(0,10,4)
import Data.ByteString.Short
# endif
#endif
#if MIN_VERSION_base(4,8,0) || defined(MIN_VERSION_transformers)
import Data.Functor.Identity
#endif
#if MIN_VERSION_base(4,7,0) || defined(MIN_VERSION_tagged)
import Data.Proxy
#endif
#ifdef MIN_VERSION_tagged
import Data.Tagged
#endif
#ifdef MIN_VERSION_text
import qualified Data.Text as Strict
import qualified Data.Text.Lazy as Lazy
import qualified Data.Text.Lazy.Builder as Text
#endif
#ifdef MIN_VERSION_hashable
import Data.Hashable
#endif
#ifdef MIN_VERSION_unordered_containers
import Data.HashMap.Lazy as Lazy
import Data.HashSet
#endif
#ifdef LANGUAGE_DeriveDataTypeable
import Data.Data
#endif
#ifdef LANGUAGE_DeriveGeneric
import GHC.Generics
#endif
#ifdef USE_COERCE
import Data.Coerce
#endif
infixr 6 <>
class Semigroup a where
(<>) :: a -> a -> a
#ifdef LANGUAGE_DefaultSignatures
default (<>) :: Monoid a => a -> a -> a
(<>) = mappend
#endif
sconcat :: NonEmpty a -> a
sconcat (a :| as) = go a as where
go b (c:cs) = b <> go c cs
go b [] = b
stimes :: Integral b => b -> a -> a
stimes y0 x0
| y0 <= 0 = error "stimes: positive multiplier expected"
| otherwise = f x0 y0
where
f x y
| even y = f (x <> x) (y `quot` 2)
| y == 1 = x
| otherwise = g (x <> x) (pred y `quot` 2) x
g x y z
| even y = g (x <> x) (y `quot` 2) z
| y == 1 = x <> z
| otherwise = g (x <> x) (pred y `quot` 2) (x <> z)
cycle1 :: Semigroup m => m -> m
cycle1 xs = xs' where xs' = xs <> xs'
instance Semigroup () where
_ <> _ = ()
sconcat _ = ()
stimes _ _ = ()
instance Semigroup b => Semigroup (a -> b) where
f <> g = \a -> f a <> g a
stimes n f e = stimes n (f e)
instance Semigroup [a] where
(<>) = (++)
stimes n x
| n < 0 = error "stimes: [], negative multiplier"
| otherwise = rep n
where
rep 0 = []
rep i = x ++ rep (i 1)
instance Semigroup a => Semigroup (Maybe a) where
Nothing <> b = b
a <> Nothing = a
Just a <> Just b = Just (a <> b)
stimes _ Nothing = Nothing
stimes n (Just a) = case compare n 0 of
LT -> error "stimes: Maybe, negative multiplier"
EQ -> Nothing
GT -> Just (stimes n a)
instance Semigroup (Either a b) where
Left _ <> b = b
a <> _ = a
stimes = stimesIdempotent
instance (Semigroup a, Semigroup b) => Semigroup (a, b) where
(a,b) <> (a',b') = (a<>a',b<>b')
stimes n (a,b) = (stimes n a, stimes n b)
instance (Semigroup a, Semigroup b, Semigroup c) => Semigroup (a, b, c) where
(a,b,c) <> (a',b',c') = (a<>a',b<>b',c<>c')
stimes n (a,b,c) = (stimes n a, stimes n b, stimes n c)
instance (Semigroup a, Semigroup b, Semigroup c, Semigroup d) => Semigroup (a, b, c, d) where
(a,b,c,d) <> (a',b',c',d') = (a<>a',b<>b',c<>c',d<>d')
stimes n (a,b,c,d) = (stimes n a, stimes n b, stimes n c, stimes n d)
instance (Semigroup a, Semigroup b, Semigroup c, Semigroup d, Semigroup e) => Semigroup (a, b, c, d, e) where
(a,b,c,d,e) <> (a',b',c',d',e') = (a<>a',b<>b',c<>c',d<>d',e<>e')
stimes n (a,b,c,d,e) = (stimes n a, stimes n b, stimes n c, stimes n d, stimes n e)
instance Semigroup Ordering where
LT <> _ = LT
EQ <> y = y
GT <> _ = GT
stimes = stimesIdempotentMonoid
instance Semigroup a => Semigroup (Dual a) where
Dual a <> Dual b = Dual (b <> a)
stimes n (Dual a) = Dual (stimes n a)
instance Semigroup (Endo a) where
#ifdef USE_COERCE
(<>) = coerce ((.) :: (a -> a) -> (a -> a) -> (a -> a))
#else
Endo f <> Endo g = Endo (f . g)
#endif
stimes = stimesMonoid
instance Semigroup All where
#ifdef USE_COERCE
(<>) = coerce (&&)
#else
All a <> All b = All (a && b)
#endif
stimes = stimesIdempotentMonoid
instance Semigroup Any where
#ifdef USE_COERCE
(<>) = coerce (||)
#else
Any a <> Any b = Any (a || b)
#endif
stimes = stimesIdempotentMonoid
instance Num a => Semigroup (Sum a) where
#ifdef USE_COERCE
(<>) = coerce ((+) :: a -> a -> a)
#else
Sum a <> Sum b = Sum (a + b)
#endif
stimes n (Sum a) = Sum (fromIntegral n * a)
instance Num a => Semigroup (Product a) where
#ifdef USE_COERCE
(<>) = coerce ((*) :: a -> a -> a)
#else
Product a <> Product b = Product (a * b)
#endif
stimes n (Product a) = Product (a ^ n)
stimesMonoid :: (Integral b, Monoid a) => b -> a -> a
stimesMonoid n x0 = case compare n 0 of
LT -> error "stimesMonoid: negative multiplier"
EQ -> mempty
GT -> f x0 n
where
f x y
| even y = f (x `mappend` x) (y `quot` 2)
| y == 1 = x
| otherwise = g (x `mappend` x) (pred y `quot` 2) x
g x y z
| even y = g (x `mappend` x) (y `quot` 2) z
| y == 1 = x `mappend` z
| otherwise = g (x `mappend` x) (pred y `quot` 2) (x `mappend` z)
stimesIdempotentMonoid :: (Integral b, Monoid a) => b -> a -> a
stimesIdempotentMonoid n x = case compare n 0 of
LT -> error "stimesIdempotentMonoid: negative multiplier"
EQ -> mempty
GT -> x
stimesIdempotent :: Integral b => b -> a -> a
stimesIdempotent n x
| n <= 0 = error "stimesIdempotent: positive multiplier expected"
| otherwise = x
instance Semigroup a => Semigroup (Const a b) where
#ifdef USE_COERCE
(<>) = coerce ((<>) :: a -> a -> a)
#else
Const a <> Const b = Const (a <> b)
#endif
stimes n (Const a) = Const (stimes n a)
#if MIN_VERSION_base(3,0,0)
instance Semigroup (Monoid.First a) where
Monoid.First Nothing <> b = b
a <> _ = a
stimes = stimesIdempotentMonoid
instance Semigroup (Monoid.Last a) where
a <> Monoid.Last Nothing = a
_ <> b = b
stimes = stimesIdempotentMonoid
#endif
#if MIN_VERSION_base(4,8,0)
instance Alternative f => Semigroup (Alt f a) where
# ifdef USE_COERCE
(<>) = coerce ((<|>) :: f a -> f a -> f a)
# else
Alt a <> Alt b = Alt (a <|> b)
# endif
stimes = stimesMonoid
#endif
#if MIN_VERSION_base(4,8,0)
instance Semigroup Void where
a <> _ = a
stimes = stimesIdempotent
#endif
instance Semigroup (NonEmpty a) where
(a :| as) <> ~(b :| bs) = a :| (as ++ b : bs)
newtype Min a = Min { getMin :: a } deriving
( Eq, Ord, Show, Read
#ifdef LANGUAGE_DeriveDataTypeable
, Data, Typeable
#endif
#ifdef LANGUAGE_DeriveGeneric
, Generic
#if __GLASGOW_HASKELL__ >= 706
, Generic1
#endif
#endif
)
instance Bounded a => Bounded (Min a) where
minBound = Min minBound
maxBound = Min maxBound
instance Enum a => Enum (Min a) where
succ (Min a) = Min (succ a)
pred (Min a) = Min (pred a)
toEnum = Min . toEnum
fromEnum = fromEnum . getMin
enumFrom (Min a) = Min <$> enumFrom a
enumFromThen (Min a) (Min b) = Min <$> enumFromThen a b
enumFromTo (Min a) (Min b) = Min <$> enumFromTo a b
enumFromThenTo (Min a) (Min b) (Min c) = Min <$> enumFromThenTo a b c
#ifdef MIN_VERSION_hashable
instance Hashable a => Hashable (Min a) where
#if MIN_VERSION_hashable(1,2,0)
hashWithSalt p (Min a) = hashWithSalt p a
#else
hash (Min a) = hash a
#endif
#endif
instance Ord a => Semigroup (Min a) where
#ifdef USE_COERCE
(<>) = coerce (min :: a -> a -> a)
#else
Min a <> Min b = Min (a `min` b)
#endif
stimes = stimesIdempotent
instance (Ord a, Bounded a) => Monoid (Min a) where
mempty = maxBound
mappend = (<>)
instance Functor Min where
fmap f (Min x) = Min (f x)
instance Foldable Min where
foldMap f (Min a) = f a
instance Traversable Min where
traverse f (Min a) = Min <$> f a
instance Applicative Min where
pure = Min
a <* _ = a
_ *> a = a
Min f <*> Min x = Min (f x)
instance Monad Min where
return = Min
_ >> a = a
Min a >>= f = f a
instance MonadFix Min where
mfix f = fix (f . getMin)
#ifdef MIN_VERSION_deepseq
instance NFData a => NFData (Min a) where
rnf (Min a) = rnf a
#endif
instance Num a => Num (Min a) where
(Min a) + (Min b) = Min (a + b)
(Min a) * (Min b) = Min (a * b)
(Min a) (Min b) = Min (a b)
negate (Min a) = Min (negate a)
abs (Min a) = Min (abs a)
signum (Min a) = Min (signum a)
fromInteger = Min . fromInteger
newtype Max a = Max { getMax :: a } deriving
( Eq, Ord, Show, Read
#ifdef LANGUAGE_DeriveDataTypeable
, Data, Typeable
#endif
#ifdef LANGUAGE_DeriveGeneric
, Generic
#if __GLASGOW_HASKELL__ >= 706
, Generic1
#endif
#endif
)
instance Bounded a => Bounded (Max a) where
minBound = Max minBound
maxBound = Max maxBound
instance Enum a => Enum (Max a) where
succ (Max a) = Max (succ a)
pred (Max a) = Max (pred a)
toEnum = Max . toEnum
fromEnum = fromEnum . getMax
enumFrom (Max a) = Max <$> enumFrom a
enumFromThen (Max a) (Max b) = Max <$> enumFromThen a b
enumFromTo (Max a) (Max b) = Max <$> enumFromTo a b
enumFromThenTo (Max a) (Max b) (Max c) = Max <$> enumFromThenTo a b c
#ifdef MIN_VERSION_hashable
instance Hashable a => Hashable (Max a) where
#if MIN_VERSION_hashable(1,2,0)
hashWithSalt p (Max a) = hashWithSalt p a
#else
hash (Max a) = hash a
#endif
#endif
instance Ord a => Semigroup (Max a) where
#ifdef USE_COERCE
(<>) = coerce (max :: a -> a -> a)
#else
Max a <> Max b = Max (a `max` b)
#endif
stimes = stimesIdempotent
instance (Ord a, Bounded a) => Monoid (Max a) where
mempty = minBound
mappend = (<>)
instance Functor Max where
fmap f (Max x) = Max (f x)
instance Foldable Max where
foldMap f (Max a) = f a
instance Traversable Max where
traverse f (Max a) = Max <$> f a
instance Applicative Max where
pure = Max
a <* _ = a
_ *> a = a
Max f <*> Max x = Max (f x)
instance Monad Max where
return = Max
_ >> a = a
Max a >>= f = f a
instance MonadFix Max where
mfix f = fix (f . getMax)
#ifdef MIN_VERSION_deepseq
instance NFData a => NFData (Max a) where
rnf (Max a) = rnf a
#endif
instance Num a => Num (Max a) where
(Max a) + (Max b) = Max (a + b)
(Max a) * (Max b) = Max (a * b)
(Max a) (Max b) = Max (a b)
negate (Max a) = Max (negate a)
abs (Max a) = Max (abs a)
signum (Max a) = Max (signum a)
fromInteger = Max . fromInteger
data Arg a b = Arg a b deriving
( Show, Read
#ifdef LANGUAGE_DeriveDataTypeable
, Data, Typeable
#endif
#ifdef LANGUAGE_DeriveGeneric
, Generic
#if __GLASGOW_HASKELL__ >= 706
, Generic1
#endif
#endif
)
type ArgMin a b = Min (Arg a b)
type ArgMax a b = Max (Arg a b)
instance Functor (Arg a) where
fmap f (Arg x a) = Arg x (f a)
instance Foldable (Arg a) where
foldMap f (Arg _ a) = f a
instance Traversable (Arg a) where
traverse f (Arg x a) = Arg x <$> f a
instance Eq a => Eq (Arg a b) where
Arg a _ == Arg b _ = a == b
instance Ord a => Ord (Arg a b) where
Arg a _ `compare` Arg b _ = compare a b
min x@(Arg a _) y@(Arg b _)
| a <= b = x
| otherwise = y
max x@(Arg a _) y@(Arg b _)
| a >= b = x
| otherwise = y
#ifdef MIN_VERSION_deepseq
instance (NFData a, NFData b) => NFData (Arg a b) where
rnf (Arg a b) = rnf a `seq` rnf b `seq` ()
#endif
#ifdef MIN_VERSION_hashable
instance (Hashable a, Hashable b) => Hashable (Arg a b) where
#if MIN_VERSION_hashable(1,2,0)
hashWithSalt p (Arg a b) = hashWithSalt p a `hashWithSalt` b
#else
hash (Arg a b) = hashWithSalt (hash a) b
#endif
#endif
#if MIN_VERSION_base(4,8,0)
instance Bifunctor Arg where
bimap f g (Arg a b) = Arg (f a) (g b)
#endif
newtype First a = First { getFirst :: a } deriving
( Eq, Ord, Show, Read
#ifdef LANGUAGE_DeriveDataTypeable
, Data
, Typeable
#endif
#ifdef LANGUAGE_DeriveGeneric
, Generic
#if __GLASGOW_HASKELL__ >= 706
, Generic1
#endif
#endif
)
instance Bounded a => Bounded (First a) where
minBound = First minBound
maxBound = First maxBound
instance Enum a => Enum (First a) where
succ (First a) = First (succ a)
pred (First a) = First (pred a)
toEnum = First . toEnum
fromEnum = fromEnum . getFirst
enumFrom (First a) = First <$> enumFrom a
enumFromThen (First a) (First b) = First <$> enumFromThen a b
enumFromTo (First a) (First b) = First <$> enumFromTo a b
enumFromThenTo (First a) (First b) (First c) = First <$> enumFromThenTo a b c
#ifdef MIN_VERSION_hashable
instance Hashable a => Hashable (First a) where
#if MIN_VERSION_hashable(1,2,0)
hashWithSalt p (First a) = hashWithSalt p a
#else
hash (First a) = hash a
#endif
#endif
instance Semigroup (First a) where
a <> _ = a
stimes = stimesIdempotent
instance Functor First where
fmap f (First x) = First (f x)
instance Foldable First where
foldMap f (First a) = f a
instance Traversable First where
traverse f (First a) = First <$> f a
instance Applicative First where
pure x = First x
a <* _ = a
_ *> a = a
First f <*> First x = First (f x)
instance Monad First where
return = First
_ >> a = a
First a >>= f = f a
instance MonadFix First where
mfix f = fix (f . getFirst)
#ifdef MIN_VERSION_deepseq
instance NFData a => NFData (First a) where
rnf (First a) = rnf a
#endif
newtype Last a = Last { getLast :: a } deriving
( Eq, Ord, Show, Read
#ifdef LANGUAGE_DeriveDataTypeable
, Data, Typeable
#endif
#ifdef LANGUAGE_DeriveGeneric
, Generic
#if __GLASGOW_HASKELL__ >= 706
, Generic1
#endif
#endif
)
instance Bounded a => Bounded (Last a) where
minBound = Last minBound
maxBound = Last maxBound
instance Enum a => Enum (Last a) where
succ (Last a) = Last (succ a)
pred (Last a) = Last (pred a)
toEnum = Last . toEnum
fromEnum = fromEnum . getLast
enumFrom (Last a) = Last <$> enumFrom a
enumFromThen (Last a) (Last b) = Last <$> enumFromThen a b
enumFromTo (Last a) (Last b) = Last <$> enumFromTo a b
enumFromThenTo (Last a) (Last b) (Last c) = Last <$> enumFromThenTo a b c
#ifdef MIN_VERSION_hashable
instance Hashable a => Hashable (Last a) where
#if MIN_VERSION_hashable(1,2,0)
hashWithSalt p (Last a) = hashWithSalt p a
#else
hash (Last a) = hash a
#endif
#endif
instance Semigroup (Last a) where
_ <> b = b
stimes = stimesIdempotent
instance Functor Last where
fmap f (Last x) = Last (f x)
a <$ _ = Last a
instance Foldable Last where
foldMap f (Last a) = f a
instance Traversable Last where
traverse f (Last a) = Last <$> f a
instance Applicative Last where
pure = Last
a <* _ = a
_ *> a = a
Last f <*> Last x = Last (f x)
instance Monad Last where
return = Last
_ >> a = a
Last a >>= f = f a
instance MonadFix Last where
mfix f = fix (f . getLast)
#ifdef MIN_VERSION_deepseq
instance NFData a => NFData (Last a) where
rnf (Last a) = rnf a
#endif
#ifdef MIN_VERSION_binary
instance Semigroup Builder.Builder where
(<>) = mappend
#endif
#ifdef MIN_VERSION_bytestring
instance Semigroup Strict.ByteString where
(<>) = mappend
instance Semigroup Lazy.ByteString where
(<>) = mappend
# if MIN_VERSION_bytestring(0,10,0)
instance Semigroup ByteString.Builder where
(<>) = mappend
# endif
# if MIN_VERSION_bytestring(0,10,4)
instance Semigroup ShortByteString where
(<>) = mappend
# endif
#endif
#ifdef MIN_VERSION_text
instance Semigroup Strict.Text where
(<>) = mappend
instance Semigroup Lazy.Text where
(<>) = mappend
instance Semigroup Text.Builder where
(<>) = mappend
#endif
#ifdef MIN_VERSION_unordered_containers
instance (Hashable k, Eq k) => Semigroup (Lazy.HashMap k a) where
(<>) = mappend
stimes = stimesIdempotentMonoid
instance (Hashable a, Eq a) => Semigroup (HashSet a) where
(<>) = mappend
stimes = stimesIdempotentMonoid
#endif
newtype WrappedMonoid m = WrapMonoid
{ unwrapMonoid :: m } deriving
( Eq, Ord, Show, Read
#ifdef LANGUAGE_DeriveDataTypeable
, Data, Typeable
#endif
#ifdef LANGUAGE_DeriveGeneric
, Generic
#if __GLASGOW_HASKELL__ >= 706
, Generic1
#endif
#endif
)
#ifdef MIN_VERSION_hashable
instance Hashable a => Hashable (WrappedMonoid a) where
#if MIN_VERSION_hashable(1,2,0)
hashWithSalt p (WrapMonoid a) = hashWithSalt p a
#else
hash (WrapMonoid a) = hash a
#endif
#endif
instance Monoid m => Semigroup (WrappedMonoid m) where
#ifdef USE_COERCE
(<>) = coerce (mappend :: m -> m -> m)
#else
WrapMonoid a <> WrapMonoid b = WrapMonoid (a `mappend` b)
#endif
instance Monoid m => Monoid (WrappedMonoid m) where
mempty = WrapMonoid mempty
mappend = (<>)
instance Bounded a => Bounded (WrappedMonoid a) where
minBound = WrapMonoid minBound
maxBound = WrapMonoid maxBound
instance Enum a => Enum (WrappedMonoid a) where
succ (WrapMonoid a) = WrapMonoid (succ a)
pred (WrapMonoid a) = WrapMonoid (pred a)
toEnum = WrapMonoid . toEnum
fromEnum = fromEnum . unwrapMonoid
enumFrom (WrapMonoid a) = WrapMonoid <$> enumFrom a
enumFromThen (WrapMonoid a) (WrapMonoid b) = WrapMonoid <$> enumFromThen a b
enumFromTo (WrapMonoid a) (WrapMonoid b) = WrapMonoid <$> enumFromTo a b
enumFromThenTo (WrapMonoid a) (WrapMonoid b) (WrapMonoid c) = WrapMonoid <$> enumFromThenTo a b c
#ifdef MIN_VERSION_deepseq
instance NFData m => NFData (WrappedMonoid m) where
rnf (WrapMonoid a) = rnf a
#endif
mtimesDefault :: (Integral b, Monoid a) => b -> a -> a
mtimesDefault n x
| n == 0 = mempty
| otherwise = unwrapMonoid (stimes n (WrapMonoid x))
newtype Option a = Option
{ getOption :: Maybe a } deriving
( Eq, Ord, Show, Read
#ifdef LANGUAGE_DeriveDataTypeable
, Data, Typeable
#endif
#ifdef LANGUAGE_DeriveGeneric
, Generic
#if __GLASGOW_HASKELL__ >= 706
, Generic1
#endif
#endif
)
#ifdef MIN_VERSION_hashable
instance Hashable a => Hashable (Option a) where
#if MIN_VERSION_hashable(1,2,0)
hashWithSalt p (Option a) = hashWithSalt p a
#else
hash (Option a) = hash a
#endif
#endif
instance Functor Option where
fmap f (Option a) = Option (fmap f a)
instance Applicative Option where
pure a = Option (Just a)
Option a <*> Option b = Option (a <*> b)
instance Monad Option where
return = pure
Option (Just a) >>= k = k a
_ >>= _ = Option Nothing
Option Nothing >> _ = Option Nothing
_ >> b = b
instance Alternative Option where
empty = Option Nothing
Option Nothing <|> b = b
a <|> _ = a
instance MonadPlus Option where
mzero = Option Nothing
mplus = (<|>)
instance MonadFix Option where
mfix f = Option (mfix (getOption . f))
instance Foldable Option where
foldMap f (Option (Just m)) = f m
foldMap _ (Option Nothing) = mempty
instance Traversable Option where
traverse f (Option (Just a)) = Option . Just <$> f a
traverse _ (Option Nothing) = pure (Option Nothing)
#ifdef MIN_VERSION_deepseq
instance NFData a => NFData (Option a) where
rnf (Option a) = rnf a
#endif
option :: b -> (a -> b) -> Option a -> b
option n j (Option m) = maybe n j m
instance Semigroup a => Semigroup (Option a) where
#ifdef USE_COERCE
(<>) = coerce ((<>) :: Maybe a -> Maybe a -> Maybe a)
#else
Option a <> Option b = Option (a <> b)
#endif
stimes _ (Option Nothing) = Option Nothing
stimes n (Option (Just a)) = case compare n 0 of
LT -> error "stimes: Option, negative multiplier"
EQ -> Option Nothing
GT -> Option (Just (stimes n a))
instance Semigroup a => Monoid (Option a) where
mempty = Option Nothing
mappend = (<>)
diff :: Semigroup m => m -> Endo m
diff = Endo . (<>)
#ifdef MIN_VERSION_containers
instance Semigroup (Seq a) where
(<>) = (><)
instance Semigroup IntSet where
(<>) = mappend
stimes = stimesIdempotentMonoid
instance Ord a => Semigroup (Set a) where
(<>) = mappend
stimes = stimesIdempotentMonoid
instance Semigroup (IntMap v) where
(<>) = mappend
stimes = stimesIdempotentMonoid
instance Ord k => Semigroup (Map k v) where
(<>) = mappend
stimes = stimesIdempotentMonoid
#endif
#if MIN_VERSION_base(4,8,0) || defined(MIN_VERSION_transformers)
instance Semigroup a => Semigroup (Identity a) where
# ifdef USE_COERCE
(<>) = coerce ((<>) :: a -> a -> a)
# else
Identity a <> Identity b = Identity (a <> b)
# endif
stimes n (Identity a) = Identity (stimes n a)
#endif
#if MIN_VERSION_base(4,7,0) || defined(MIN_VERSION_tagged)
instance Semigroup (Proxy s) where
_ <> _ = Proxy
sconcat _ = Proxy
stimes _ _ = Proxy
#endif
#ifdef MIN_VERSION_tagged
instance Semigroup a => Semigroup (Tagged s a) where
# ifdef USE_COERCE
(<>) = coerce ((<>) :: a -> a -> a)
# else
Tagged a <> Tagged b = Tagged (a <> b)
# endif
stimes n (Tagged a) = Tagged (stimes n a)
#endif