{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Data.Functor.Utils where
import Data.Coerce (Coercible, coerce)
import GHC.Base ( Applicative(..), Functor(..), Maybe(..), Monoid(..), Ord(..)
, Semigroup(..), ($), otherwise )
import qualified GHC.List as List
newtype Max a = Max {forall a. Max a -> Maybe a
getMax :: Maybe a}
newtype Min a = Min {forall a. Min a -> Maybe a
getMin :: Maybe a}
instance Ord a => Semigroup (Max a) where
{-# INLINE (<>) #-}
Max a
m <> :: Max a -> Max a -> Max a
<> Max Maybe a
Nothing = Max a
m
Max Maybe a
Nothing <> Max a
n = Max a
n
(Max m :: Maybe a
m@(Just a
x)) <> (Max n :: Maybe a
n@(Just a
y))
| a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
y = Maybe a -> Max a
forall a. Maybe a -> Max a
Max Maybe a
m
| Bool
otherwise = Maybe a -> Max a
forall a. Maybe a -> Max a
Max Maybe a
n
instance Ord a => Monoid (Max a) where
mempty :: Max a
mempty = Maybe a -> Max a
forall a. Maybe a -> Max a
Max Maybe a
forall a. Maybe a
Nothing
mconcat :: [Max a] -> Max a
mconcat = (Max a -> Max a -> Max a) -> Max a -> [Max a] -> Max a
forall a b. (b -> a -> b) -> b -> [a] -> b
List.foldl' Max a -> Max a -> Max a
forall a. Semigroup a => a -> a -> a
(<>) Max a
forall a. Monoid a => a
mempty
{-# INLINE mconcat #-}
instance Ord a => Semigroup (Min a) where
{-# INLINE (<>) #-}
Min a
m <> :: Min a -> Min a -> Min a
<> Min Maybe a
Nothing = Min a
m
Min Maybe a
Nothing <> Min a
n = Min a
n
(Min m :: Maybe a
m@(Just a
x)) <> (Min n :: Maybe a
n@(Just a
y))
| a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
y = Maybe a -> Min a
forall a. Maybe a -> Min a
Min Maybe a
m
| Bool
otherwise = Maybe a -> Min a
forall a. Maybe a -> Min a
Min Maybe a
n
instance Ord a => Monoid (Min a) where
mempty :: Min a
mempty = Maybe a -> Min a
forall a. Maybe a -> Min a
Min Maybe a
forall a. Maybe a
Nothing
mconcat :: [Min a] -> Min a
mconcat = (Min a -> Min a -> Min a) -> Min a -> [Min a] -> Min a
forall a b. (b -> a -> b) -> b -> [a] -> b
List.foldl' Min a -> Min a -> Min a
forall a. Semigroup a => a -> a -> a
(<>) Min a
forall a. Monoid a => a
mempty
{-# INLINE mconcat #-}
newtype StateL s a = StateL { forall s a. StateL s a -> s -> (s, a)
runStateL :: s -> (s, a) }
instance Functor (StateL s) where
fmap :: forall a b. (a -> b) -> StateL s a -> StateL s b
fmap a -> b
f (StateL s -> (s, a)
k) = (s -> (s, b)) -> StateL s b
forall s a. (s -> (s, a)) -> StateL s a
StateL ((s -> (s, b)) -> StateL s b) -> (s -> (s, b)) -> StateL s b
forall a b. (a -> b) -> a -> b
$ \ s
s -> let (s
s', a
v) = s -> (s, a)
k s
s in (s
s', a -> b
f a
v)
instance Applicative (StateL s) where
pure :: forall a. a -> StateL s a
pure a
x = (s -> (s, a)) -> StateL s a
forall s a. (s -> (s, a)) -> StateL s a
StateL (\ s
s -> (s
s, a
x))
StateL s -> (s, a -> b)
kf <*> :: forall a b. StateL s (a -> b) -> StateL s a -> StateL s b
<*> StateL s -> (s, a)
kv = (s -> (s, b)) -> StateL s b
forall s a. (s -> (s, a)) -> StateL s a
StateL ((s -> (s, b)) -> StateL s b) -> (s -> (s, b)) -> StateL s b
forall a b. (a -> b) -> a -> b
$ \ s
s ->
let (s
s', a -> b
f) = s -> (s, a -> b)
kf s
s
(s
s'', a
v) = s -> (s, a)
kv s
s'
in (s
s'', a -> b
f a
v)
liftA2 :: forall a b c.
(a -> b -> c) -> StateL s a -> StateL s b -> StateL s c
liftA2 a -> b -> c
f (StateL s -> (s, a)
kx) (StateL s -> (s, b)
ky) = (s -> (s, c)) -> StateL s c
forall s a. (s -> (s, a)) -> StateL s a
StateL ((s -> (s, c)) -> StateL s c) -> (s -> (s, c)) -> StateL s c
forall a b. (a -> b) -> a -> b
$ \s
s ->
let (s
s', a
x) = s -> (s, a)
kx s
s
(s
s'', b
y) = s -> (s, b)
ky s
s'
in (s
s'', a -> b -> c
f a
x b
y)
newtype StateR s a = StateR { forall s a. StateR s a -> s -> (s, a)
runStateR :: s -> (s, a) }
instance Functor (StateR s) where
fmap :: forall a b. (a -> b) -> StateR s a -> StateR s b
fmap a -> b
f (StateR s -> (s, a)
k) = (s -> (s, b)) -> StateR s b
forall s a. (s -> (s, a)) -> StateR s a
StateR ((s -> (s, b)) -> StateR s b) -> (s -> (s, b)) -> StateR s b
forall a b. (a -> b) -> a -> b
$ \ s
s -> let (s
s', a
v) = s -> (s, a)
k s
s in (s
s', a -> b
f a
v)
instance Applicative (StateR s) where
pure :: forall a. a -> StateR s a
pure a
x = (s -> (s, a)) -> StateR s a
forall s a. (s -> (s, a)) -> StateR s a
StateR (\ s
s -> (s
s, a
x))
StateR s -> (s, a -> b)
kf <*> :: forall a b. StateR s (a -> b) -> StateR s a -> StateR s b
<*> StateR s -> (s, a)
kv = (s -> (s, b)) -> StateR s b
forall s a. (s -> (s, a)) -> StateR s a
StateR ((s -> (s, b)) -> StateR s b) -> (s -> (s, b)) -> StateR s b
forall a b. (a -> b) -> a -> b
$ \ s
s ->
let (s
s', a
v) = s -> (s, a)
kv s
s
(s
s'', a -> b
f) = s -> (s, a -> b)
kf s
s'
in (s
s'', a -> b
f a
v)
liftA2 :: forall a b c.
(a -> b -> c) -> StateR s a -> StateR s b -> StateR s c
liftA2 a -> b -> c
f (StateR s -> (s, a)
kx) (StateR s -> (s, b)
ky) = (s -> (s, c)) -> StateR s c
forall s a. (s -> (s, a)) -> StateR s a
StateR ((s -> (s, c)) -> StateR s c) -> (s -> (s, c)) -> StateR s c
forall a b. (a -> b) -> a -> b
$ \ s
s ->
let (s
s', b
y) = s -> (s, b)
ky s
s
(s
s'', a
x) = s -> (s, a)
kx s
s'
in (s
s'', a -> b -> c
f a
x b
y)
(#.) :: Coercible b c => (b -> c) -> (a -> b) -> (a -> c)
#. :: forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
(#.) b -> c
_f = (a -> b) -> a -> c
forall a b. Coercible a b => a -> b
coerce
{-# INLINE (#.) #-}