{-# LANGUAGE Safe #-}
module Yaya.Functor
( DFunctor (dmap),
HFunctor (hmap),
firstMap,
)
where
import "base" Control.Category (Category ((.)))
import "base" Data.Bifunctor (Bifunctor, first)
import "base" Data.Function (($))
import "base" Data.Functor (Functor (fmap))
import "base" Data.Functor.Compose (Compose (Compose))
import "base" Data.Functor.Product (Product (Pair))
import "base" Data.Kind (Type)
import "transformers" Control.Applicative.Backwards (Backwards (Backwards))
import "transformers" Control.Applicative.Lift (Lift (Other, Pure))
import qualified "transformers" Control.Monad.Trans.Except as Ex
import qualified "transformers" Control.Monad.Trans.Identity as I
import qualified "transformers" Control.Monad.Trans.Maybe as M
import qualified "transformers" Control.Monad.Trans.RWS.Lazy as RWS
import qualified "transformers" Control.Monad.Trans.RWS.Strict as RWS'
import qualified "transformers" Control.Monad.Trans.Reader as R
import qualified "transformers" Control.Monad.Trans.State.Lazy as S
import qualified "transformers" Control.Monad.Trans.State.Strict as S'
import qualified "transformers" Control.Monad.Trans.Writer.Lazy as W'
import qualified "transformers" Control.Monad.Trans.Writer.Strict as W
class DFunctor (d :: (Type -> Type) -> Type) where
dmap :: (forall x. f x -> g x) -> d f -> d g
firstMap :: (DFunctor d, Bifunctor f) => (a -> b) -> d (f a) -> d (f b)
firstMap :: forall (d :: (* -> *) -> *) (f :: * -> * -> *) a b.
(DFunctor d, Bifunctor f) =>
(a -> b) -> d (f a) -> d (f b)
firstMap a -> b
f = (forall x. f a x -> f b x) -> d (f a) -> d (f b)
forall (f :: * -> *) (g :: * -> *).
(forall x. f x -> g x) -> d f -> d g
forall (d :: (* -> *) -> *) (f :: * -> *) (g :: * -> *).
DFunctor d =>
(forall x. f x -> g x) -> d f -> d g
dmap ((a -> b) -> f a x -> f b x
forall a b c. (a -> b) -> f a c -> f b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first a -> b
f)
class HFunctor (h :: (Type -> Type) -> Type -> Type) where
hmap :: (forall x. f x -> g x) -> h f a -> h g a
instance HFunctor (Ex.ExceptT e) where
hmap :: forall (f :: * -> *) (g :: * -> *) a.
(forall x. f x -> g x) -> ExceptT e f a -> ExceptT e g a
hmap forall x. f x -> g x
nat ExceptT e f a
m = g (Either e a) -> ExceptT e g a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
Ex.ExceptT (f (Either e a) -> g (Either e a)
forall x. f x -> g x
nat (ExceptT e f a -> f (Either e a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
Ex.runExceptT ExceptT e f a
m))
instance HFunctor I.IdentityT where
hmap :: forall (f :: * -> *) (g :: * -> *) a.
(forall x. f x -> g x) -> IdentityT f a -> IdentityT g a
hmap forall x. f x -> g x
nat IdentityT f a
m = g a -> IdentityT g a
forall {k} (f :: k -> *) (a :: k). f a -> IdentityT f a
I.IdentityT (f a -> g a
forall x. f x -> g x
nat (IdentityT f a -> f a
forall {k} (f :: k -> *) (a :: k). IdentityT f a -> f a
I.runIdentityT IdentityT f a
m))
instance HFunctor M.MaybeT where
hmap :: forall (f :: * -> *) (g :: * -> *) a.
(forall x. f x -> g x) -> MaybeT f a -> MaybeT g a
hmap forall x. f x -> g x
nat MaybeT f a
m = g (Maybe a) -> MaybeT g a
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
M.MaybeT (f (Maybe a) -> g (Maybe a)
forall x. f x -> g x
nat (MaybeT f a -> f (Maybe a)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
M.runMaybeT MaybeT f a
m))
instance HFunctor (R.ReaderT r) where
hmap :: forall (f :: * -> *) (g :: * -> *) a.
(forall x. f x -> g x) -> ReaderT r f a -> ReaderT r g a
hmap forall x. f x -> g x
nat ReaderT r f a
m = (r -> g a) -> ReaderT r g a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
R.ReaderT ((r -> g a) -> ReaderT r g a) -> (r -> g a) -> ReaderT r g a
forall a b. (a -> b) -> a -> b
$ f a -> g a
forall x. f x -> g x
nat (f a -> g a) -> (r -> f a) -> r -> g a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ReaderT r f a -> r -> f a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
R.runReaderT ReaderT r f a
m
instance HFunctor (RWS.RWST r w s) where
hmap :: forall (f :: * -> *) (g :: * -> *) a.
(forall x. f x -> g x) -> RWST r w s f a -> RWST r w s g a
hmap forall x. f x -> g x
nat RWST r w s f a
m = (r -> s -> g (a, s, w)) -> RWST r w s g a
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
RWS.RWST (\r
r s
s -> f (a, s, w) -> g (a, s, w)
forall x. f x -> g x
nat (RWST r w s f a -> r -> s -> f (a, s, w)
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
RWS.runRWST RWST r w s f a
m r
r s
s))
instance HFunctor (RWS'.RWST r w s) where
hmap :: forall (f :: * -> *) (g :: * -> *) a.
(forall x. f x -> g x) -> RWST r w s f a -> RWST r w s g a
hmap forall x. f x -> g x
nat RWST r w s f a
m = (r -> s -> g (a, s, w)) -> RWST r w s g a
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
RWS'.RWST (\r
r s
s -> f (a, s, w) -> g (a, s, w)
forall x. f x -> g x
nat (RWST r w s f a -> r -> s -> f (a, s, w)
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
RWS'.runRWST RWST r w s f a
m r
r s
s))
instance HFunctor (S.StateT s) where
hmap :: forall (f :: * -> *) (g :: * -> *) a.
(forall x. f x -> g x) -> StateT s f a -> StateT s g a
hmap forall x. f x -> g x
nat StateT s f a
m = (s -> g (a, s)) -> StateT s g a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
S.StateT ((s -> g (a, s)) -> StateT s g a)
-> (s -> g (a, s)) -> StateT s g a
forall a b. (a -> b) -> a -> b
$ f (a, s) -> g (a, s)
forall x. f x -> g x
nat (f (a, s) -> g (a, s)) -> (s -> f (a, s)) -> s -> g (a, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. StateT s f a -> s -> f (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
S.runStateT StateT s f a
m
instance HFunctor (S'.StateT s) where
hmap :: forall (f :: * -> *) (g :: * -> *) a.
(forall x. f x -> g x) -> StateT s f a -> StateT s g a
hmap forall x. f x -> g x
nat StateT s f a
m = (s -> g (a, s)) -> StateT s g a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
S'.StateT ((s -> g (a, s)) -> StateT s g a)
-> (s -> g (a, s)) -> StateT s g a
forall a b. (a -> b) -> a -> b
$ f (a, s) -> g (a, s)
forall x. f x -> g x
nat (f (a, s) -> g (a, s)) -> (s -> f (a, s)) -> s -> g (a, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. StateT s f a -> s -> f (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
S'.runStateT StateT s f a
m
instance HFunctor (W.WriterT w) where
hmap :: forall (f :: * -> *) (g :: * -> *) a.
(forall x. f x -> g x) -> WriterT w f a -> WriterT w g a
hmap forall x. f x -> g x
nat WriterT w f a
m = g (a, w) -> WriterT w g a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
W.WriterT (f (a, w) -> g (a, w)
forall x. f x -> g x
nat (WriterT w f a -> f (a, w)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
W.runWriterT WriterT w f a
m))
instance HFunctor (W'.WriterT w) where
hmap :: forall (f :: * -> *) (g :: * -> *) a.
(forall x. f x -> g x) -> WriterT w f a -> WriterT w g a
hmap forall x. f x -> g x
nat WriterT w f a
m = g (a, w) -> WriterT w g a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
W'.WriterT (f (a, w) -> g (a, w)
forall x. f x -> g x
nat (WriterT w f a -> f (a, w)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
W'.runWriterT WriterT w f a
m))
instance (Functor f) => HFunctor (Compose f) where
hmap :: forall (f :: * -> *) (g :: * -> *) a.
(forall x. f x -> g x) -> Compose f f a -> Compose f g a
hmap forall x. f x -> g x
nat (Compose f (f a)
f) = f (g a) -> Compose f g a
forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose ((f a -> g a) -> f (f a) -> f (g a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f a -> g a
forall x. f x -> g x
nat f (f a)
f)
instance HFunctor (Product f) where
hmap :: forall (f :: * -> *) (g :: * -> *) a.
(forall x. f x -> g x) -> Product f f a -> Product f g a
hmap forall x. f x -> g x
nat (Pair f a
f f a
g) = f a -> g a -> Product f g a
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair f a
f (f a -> g a
forall x. f x -> g x
nat f a
g)
instance HFunctor Backwards where
hmap :: forall (f :: * -> *) (g :: * -> *) a.
(forall x. f x -> g x) -> Backwards f a -> Backwards g a
hmap forall x. f x -> g x
nat (Backwards f a
f) = g a -> Backwards g a
forall {k} (f :: k -> *) (a :: k). f a -> Backwards f a
Backwards (f a -> g a
forall x. f x -> g x
nat f a
f)
instance HFunctor Lift where
hmap :: forall (f :: * -> *) (g :: * -> *) a.
(forall x. f x -> g x) -> Lift f a -> Lift g a
hmap forall x. f x -> g x
_ (Pure a
a) = a -> Lift g a
forall (f :: * -> *) a. a -> Lift f a
Pure a
a
hmap forall x. f x -> g x
nat (Other f a
f) = g a -> Lift g a
forall (f :: * -> *) a. f a -> Lift f a
Other (f a -> g a
forall x. f x -> g x
nat f a
f)