{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Data.Semigroup.Internal where
import GHC.Base hiding (Any)
import GHC.Enum
import GHC.Num
import GHC.Read
import GHC.Show
import GHC.Generics
import GHC.Real
stimesIdempotent :: Integral b => b -> a -> a
stimesIdempotent :: b -> a -> a
stimesIdempotent n :: b
n x :: a
x
| b
n b -> b -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = [Char] -> a
forall a. [Char] -> a
errorWithoutStackTrace "stimesIdempotent: positive multiplier expected"
| Bool
otherwise = a
x
stimesIdempotentMonoid :: (Integral b, Monoid a) => b -> a -> a
stimesIdempotentMonoid :: b -> a -> a
stimesIdempotentMonoid n :: b
n x :: a
x = case b -> b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare b
n 0 of
LT -> [Char] -> a
forall a. [Char] -> a
errorWithoutStackTrace "stimesIdempotentMonoid: negative multiplier"
EQ -> a
forall a. Monoid a => a
mempty
GT -> a
x
stimesMonoid :: (Integral b, Monoid a) => b -> a -> a
stimesMonoid :: b -> a -> a
stimesMonoid n :: b
n x0 :: a
x0 = case b -> b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare b
n 0 of
LT -> [Char] -> a
forall a. [Char] -> a
errorWithoutStackTrace "stimesMonoid: negative multiplier"
EQ -> a
forall a. Monoid a => a
mempty
GT -> a -> b -> a
forall a a. (Integral a, Monoid a) => a -> a -> a
f a
x0 b
n
where
f :: a -> a -> a
f x :: a
x y :: a
y
| a -> Bool
forall a. Integral a => a -> Bool
even a
y = a -> a -> a
f (a
x a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` a
x) (a
y a -> a -> a
forall a. Integral a => a -> a -> a
`quot` 2)
| a
y a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== 1 = a
x
| Bool
otherwise = a -> a -> a -> a
forall a a. (Integral a, Monoid a) => a -> a -> a -> a
g (a
x a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` a
x) (a
y a -> a -> a
forall a. Integral a => a -> a -> a
`quot` 2) a
x
g :: a -> a -> a -> a
g x :: a
x y :: a
y z :: a
z
| a -> Bool
forall a. Integral a => a -> Bool
even a
y = a -> a -> a -> a
g (a
x a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` a
x) (a
y a -> a -> a
forall a. Integral a => a -> a -> a
`quot` 2) a
z
| a
y a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== 1 = a
x a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` a
z
| Bool
otherwise = a -> a -> a -> a
g (a
x a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` a
x) (a
y a -> a -> a
forall a. Integral a => a -> a -> a
`quot` 2) (a
x a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` a
z)
stimesDefault :: (Integral b, Semigroup a) => b -> a -> a
stimesDefault :: b -> a -> a
stimesDefault y0 :: b
y0 x0 :: a
x0
| b
y0 b -> b -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = [Char] -> a
forall a. [Char] -> a
errorWithoutStackTrace "stimes: positive multiplier expected"
| Bool
otherwise = a -> b -> a
forall a a. (Integral a, Semigroup a) => a -> a -> a
f a
x0 b
y0
where
f :: a -> a -> a
f x :: a
x y :: a
y
| a -> Bool
forall a. Integral a => a -> Bool
even a
y = a -> a -> a
f (a
x a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
x) (a
y a -> a -> a
forall a. Integral a => a -> a -> a
`quot` 2)
| a
y a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== 1 = a
x
| Bool
otherwise = a -> a -> a -> a
forall a a. (Integral a, Semigroup a) => a -> a -> a -> a
g (a
x a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
x) (a
y a -> a -> a
forall a. Integral a => a -> a -> a
`quot` 2) a
x
g :: a -> a -> a -> a
g x :: a
x y :: a
y z :: a
z
| a -> Bool
forall a. Integral a => a -> Bool
even a
y = a -> a -> a -> a
g (a
x a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
x) (a
y a -> a -> a
forall a. Integral a => a -> a -> a
`quot` 2) a
z
| a
y a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== 1 = a
x a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
z
| Bool
otherwise = a -> a -> a -> a
g (a
x a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
x) (a
y a -> a -> a
forall a. Integral a => a -> a -> a
`quot` 2) (a
x a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
z)
stimesMaybe :: (Integral b, Semigroup a) => b -> Maybe a -> Maybe a
stimesMaybe :: b -> Maybe a -> Maybe a
stimesMaybe _ Nothing = Maybe a
forall a. Maybe a
Nothing
stimesMaybe n :: b
n (Just a :: a
a) = case b -> b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare b
n 0 of
LT -> [Char] -> Maybe a
forall a. [Char] -> a
errorWithoutStackTrace "stimes: Maybe, negative multiplier"
EQ -> Maybe a
forall a. Maybe a
Nothing
GT -> a -> Maybe a
forall a. a -> Maybe a
Just (b -> a -> a
forall a b. (Semigroup a, Integral b) => b -> a -> a
stimes b
n a
a)
stimesList :: Integral b => b -> [a] -> [a]
stimesList :: b -> [a] -> [a]
stimesList n :: b
n x :: [a]
x
| b
n b -> b -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = [Char] -> [a]
forall a. [Char] -> a
errorWithoutStackTrace "stimes: [], negative multiplier"
| Bool
otherwise = b -> [a]
forall t. (Eq t, Num t) => t -> [a]
rep b
n
where
rep :: t -> [a]
rep 0 = []
rep i :: t
i = [a]
x [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ t -> [a]
rep (t
i t -> t -> t
forall a. Num a => a -> a -> a
- 1)
newtype Dual a = Dual { Dual a -> a
getDual :: a }
deriving ( Eq
, Ord
, Read
, Show
, Bounded
, Generic
, Generic1
)
instance Semigroup a => Semigroup (Dual a) where
Dual a :: a
a <> :: Dual a -> Dual a -> Dual a
<> Dual b :: a
b = a -> Dual a
forall a. a -> Dual a
Dual (a
b a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
a)
stimes :: b -> Dual a -> Dual a
stimes n :: b
n (Dual a :: a
a) = a -> Dual a
forall a. a -> Dual a
Dual (b -> a -> a
forall a b. (Semigroup a, Integral b) => b -> a -> a
stimes b
n a
a)
instance Monoid a => Monoid (Dual a) where
mempty :: Dual a
mempty = a -> Dual a
forall a. a -> Dual a
Dual a
forall a. Monoid a => a
mempty
instance Functor Dual where
fmap :: (a -> b) -> Dual a -> Dual b
fmap = (a -> b) -> Dual a -> Dual b
forall a b. Coercible a b => a -> b
coerce
instance Applicative Dual where
pure :: a -> Dual a
pure = a -> Dual a
forall a. a -> Dual a
Dual
<*> :: Dual (a -> b) -> Dual a -> Dual b
(<*>) = Dual (a -> b) -> Dual a -> Dual b
forall a b. Coercible a b => a -> b
coerce
instance Monad Dual where
m :: Dual a
m >>= :: Dual a -> (a -> Dual b) -> Dual b
>>= k :: a -> Dual b
k = a -> Dual b
k (Dual a -> a
forall a. Dual a -> a
getDual Dual a
m)
newtype Endo a = Endo { Endo a -> a -> a
appEndo :: a -> a }
deriving ( Generic
)
instance Semigroup (Endo a) where
<> :: Endo a -> Endo a -> Endo a
(<>) = ((a -> a) -> (a -> a) -> a -> a) -> Endo a -> Endo a -> Endo a
forall a b. Coercible a b => a -> b
coerce ((a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) :: (a -> a) -> (a -> a) -> (a -> a))
stimes :: b -> Endo a -> Endo a
stimes = b -> Endo a -> Endo a
forall b a. (Integral b, Monoid a) => b -> a -> a
stimesMonoid
instance Monoid (Endo a) where
mempty :: Endo a
mempty = (a -> a) -> Endo a
forall a. (a -> a) -> Endo a
Endo a -> a
forall a. a -> a
id
newtype All = All { All -> Bool
getAll :: Bool }
deriving ( Eq
, Ord
, Read
, Show
, Bounded
, Generic
)
instance Semigroup All where
<> :: All -> All -> All
(<>) = (Bool -> Bool -> Bool) -> All -> All -> All
forall a b. Coercible a b => a -> b
coerce Bool -> Bool -> Bool
(&&)
stimes :: b -> All -> All
stimes = b -> All -> All
forall b a. (Integral b, Monoid a) => b -> a -> a
stimesIdempotentMonoid
instance Monoid All where
mempty :: All
mempty = Bool -> All
All Bool
True
newtype Any = Any { Any -> Bool
getAny :: Bool }
deriving ( Eq
, Ord
, Read
, Show
, Bounded
, Generic
)
instance Semigroup Any where
<> :: Any -> Any -> Any
(<>) = (Bool -> Bool -> Bool) -> Any -> Any -> Any
forall a b. Coercible a b => a -> b
coerce Bool -> Bool -> Bool
(||)
stimes :: b -> Any -> Any
stimes = b -> Any -> Any
forall b a. (Integral b, Monoid a) => b -> a -> a
stimesIdempotentMonoid
instance Monoid Any where
mempty :: Any
mempty = Bool -> Any
Any Bool
False
newtype Sum a = Sum { Sum a -> a
getSum :: a }
deriving ( Eq
, Ord
, Read
, Show
, Bounded
, Generic
, Generic1
, Num
)
instance Num a => Semigroup (Sum a) where
<> :: Sum a -> Sum a -> Sum a
(<>) = (a -> a -> a) -> Sum a -> Sum a -> Sum a
forall a b. Coercible a b => a -> b
coerce (a -> a -> a
forall a. Num a => a -> a -> a
(+) :: a -> a -> a)
stimes :: b -> Sum a -> Sum a
stimes n :: b
n (Sum a :: a
a) = a -> Sum a
forall a. a -> Sum a
Sum (b -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral b
n a -> a -> a
forall a. Num a => a -> a -> a
* a
a)
instance Num a => Monoid (Sum a) where
mempty :: Sum a
mempty = a -> Sum a
forall a. a -> Sum a
Sum 0
instance Functor Sum where
fmap :: (a -> b) -> Sum a -> Sum b
fmap = (a -> b) -> Sum a -> Sum b
forall a b. Coercible a b => a -> b
coerce
instance Applicative Sum where
pure :: a -> Sum a
pure = a -> Sum a
forall a. a -> Sum a
Sum
<*> :: Sum (a -> b) -> Sum a -> Sum b
(<*>) = Sum (a -> b) -> Sum a -> Sum b
forall a b. Coercible a b => a -> b
coerce
instance Monad Sum where
m :: Sum a
m >>= :: Sum a -> (a -> Sum b) -> Sum b
>>= k :: a -> Sum b
k = a -> Sum b
k (Sum a -> a
forall a. Sum a -> a
getSum Sum a
m)
newtype Product a = Product { Product a -> a
getProduct :: a }
deriving ( Eq
, Ord
, Read
, Show
, Bounded
, Generic
, Generic1
, Num
)
instance Num a => Semigroup (Product a) where
<> :: Product a -> Product a -> Product a
(<>) = (a -> a -> a) -> Product a -> Product a -> Product a
forall a b. Coercible a b => a -> b
coerce (a -> a -> a
forall a. Num a => a -> a -> a
(*) :: a -> a -> a)
stimes :: b -> Product a -> Product a
stimes n :: b
n (Product a :: a
a) = a -> Product a
forall a. a -> Product a
Product (a
a a -> b -> a
forall a b. (Num a, Integral b) => a -> b -> a
^ b
n)
instance Num a => Monoid (Product a) where
mempty :: Product a
mempty = a -> Product a
forall a. a -> Product a
Product 1
instance Functor Product where
fmap :: (a -> b) -> Product a -> Product b
fmap = (a -> b) -> Product a -> Product b
forall a b. Coercible a b => a -> b
coerce
instance Applicative Product where
pure :: a -> Product a
pure = a -> Product a
forall a. a -> Product a
Product
<*> :: Product (a -> b) -> Product a -> Product b
(<*>) = Product (a -> b) -> Product a -> Product b
forall a b. Coercible a b => a -> b
coerce
instance Monad Product where
m :: Product a
m >>= :: Product a -> (a -> Product b) -> Product b
>>= k :: a -> Product b
k = a -> Product b
k (Product a -> a
forall a. Product a -> a
getProduct Product a
m)
newtype Alt f a = Alt {Alt f a -> f a
getAlt :: f a}
deriving ( Generic
, Generic1
, Read
, Show
, Eq
, Ord
, Num
, Enum
, Monad
, MonadPlus
, Applicative
, Alternative
, Functor
)
instance Alternative f => Semigroup (Alt f a) where
<> :: Alt f a -> Alt f a -> Alt f a
(<>) = (f a -> f a -> f a) -> Alt f a -> Alt f a -> Alt f a
forall a b. Coercible a b => a -> b
coerce (f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) :: f a -> f a -> f a)
stimes :: b -> Alt f a -> Alt f a
stimes = b -> Alt f a -> Alt f a
forall b a. (Integral b, Monoid a) => b -> a -> a
stimesMonoid
instance Alternative f => Monoid (Alt f a) where
mempty :: Alt f a
mempty = f a -> Alt f a
forall k (f :: k -> *) (a :: k). f a -> Alt f a
Alt f a
forall (f :: * -> *) a. Alternative f => f a
empty