{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DerivingVia #-}
module FFunctor
( type (~>),
FFunctor (..),
FUNCTOR,
FF,
)
where
import qualified Control.Applicative.Free as FreeAp
import qualified Control.Applicative.Free.Final as FreeApFinal
import Control.Applicative.Lift
import qualified Control.Applicative.Trans.FreeAp as FreeApT
import qualified Control.Monad.Free as FreeM
import qualified Control.Monad.Free.Church as FreeMChurch
import Control.Monad.Trans.Identity
import Control.Monad.Trans.Reader
import Control.Monad.Trans.State
import Control.Monad.Trans.Writer
import Data.Functor.Compose
import Data.Functor.Day
import Data.Functor.Day.Curried
import Data.Functor.Flip1
import Data.Functor.Kan.Lan
import Data.Functor.Kan.Ran
import Data.Functor.Product
import Data.Functor.Sum
import Data.Kind (Constraint, Type)
import qualified Data.Bifunctor.Sum as Bi
import qualified Data.Bifunctor.Product as Bi
import Control.Comonad.Env (EnvT(..))
import Control.Comonad.Traced (TracedT(..))
import Control.Comonad.Store (StoreT (..))
import Control.Comonad.Cofree (Cofree, hoistCofree)
import Control.Monad.Trans.Free (FreeT, hoistFreeT)
import GHC.Generics
( Rec1(..),
M1(..),
type (:+:)(..),
type (:*:)(..),
type (:.:)(..) )
type (~>) :: (k -> Type) -> (k -> Type) -> Type
type (~>) f g = forall x. f x -> g x
type FUNCTOR = Type -> Type
type FF = FUNCTOR -> FUNCTOR
type FFunctor :: FF -> Constraint
class (forall g. Functor g => Functor (ff g)) => FFunctor ff where
ffmap :: (Functor g, Functor h) => (g ~> h) -> (ff g x -> ff h x)
instance Functor f => FFunctor (Sum f) where
ffmap :: forall (g :: * -> *) (h :: * -> *) x.
(Functor g, Functor h) =>
(g ~> h) -> Sum f g x -> Sum f h x
ffmap g ~> h
_ (InL f x
fa) = f x -> Sum f h x
forall {k} (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
InL f x
fa
ffmap g ~> h
gh (InR g x
ga) = h x -> Sum f h x
forall {k} (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
InR (g x -> h x
g ~> h
gh g x
ga)
instance Functor f => FFunctor (Product f) where
ffmap :: forall (g :: * -> *) (h :: * -> *) x.
(Functor g, Functor h) =>
(g ~> h) -> Product f g x -> Product f h x
ffmap g ~> h
gh (Pair f x
fa g x
ga) = f x -> h x -> Product f h x
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair f x
fa (g x -> h x
g ~> h
gh g x
ga)
instance Functor f => FFunctor (Compose f) where
ffmap :: forall (g :: * -> *) (h :: * -> *) x.
(Functor g, Functor h) =>
(g ~> h) -> Compose f g x -> Compose f h x
ffmap g ~> h
gh = f (h x) -> Compose f h x
forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (f (h x) -> Compose f h x)
-> (Compose f g x -> f (h x)) -> Compose f g x -> Compose f h x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (g x -> h x) -> f (g x) -> f (h x)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap g x -> h x
g ~> h
gh (f (g x) -> f (h x))
-> (Compose f g x -> f (g x)) -> Compose f g x -> f (h x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose f g x -> f (g x)
forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose
instance Functor f => FFunctor ((:+:) f) where
ffmap :: forall (g :: * -> *) (h :: * -> *) x.
(Functor g, Functor h) =>
(g ~> h) -> (:+:) f g x -> (:+:) f h x
ffmap g ~> h
_ (L1 f x
fa) = f x -> (:+:) f h x
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 f x
fa
ffmap g ~> h
gh (R1 g x
ga) = h x -> (:+:) f h x
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (g x -> h x
g ~> h
gh g x
ga)
instance Functor f => FFunctor ((:*:) f) where
ffmap :: forall (g :: * -> *) (h :: * -> *) x.
(Functor g, Functor h) =>
(g ~> h) -> (:*:) f g x -> (:*:) f h x
ffmap g ~> h
gh (f x
fa :*: g x
ga) = f x
fa f x -> h x -> (:*:) f h x
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: g x -> h x
g ~> h
gh g x
ga
deriving
via (Compose (f :: Type -> Type))
instance Functor f => FFunctor ((:.:) f)
deriving
via IdentityT
instance FFunctor (M1 c m)
deriving
via IdentityT
instance FFunctor Rec1
instance FFunctor Lift where
ffmap :: forall (g :: * -> *) (h :: * -> *) x.
(Functor g, Functor h) =>
(g ~> h) -> Lift g x -> Lift h x
ffmap g ~> h
gh = (g x -> h x) -> Lift g x -> Lift h x
forall (f :: * -> *) a (g :: * -> *).
(f a -> g a) -> Lift f a -> Lift g a
mapLift g x -> h x
g ~> h
gh
instance FFunctor FreeM.Free where
ffmap :: forall (g :: * -> *) (h :: * -> *) x.
(Functor g, Functor h) =>
(g ~> h) -> Free g x -> Free h x
ffmap = (forall a. g a -> h a) -> Free g x -> Free h x
forall (g :: * -> *) (f :: * -> *) b.
Functor g =>
(forall a. f a -> g a) -> Free f b -> Free g b
FreeM.hoistFree
instance FFunctor FreeMChurch.F where
ffmap :: forall (g :: * -> *) (h :: * -> *) x.
(Functor g, Functor h) =>
(g ~> h) -> F g x -> F h x
ffmap = (forall x. g x -> h x) -> F g x -> F h x
forall (f :: * -> *) (g :: * -> *) a.
(forall x. f x -> g x) -> F f a -> F g a
FreeMChurch.hoistF
instance FFunctor FreeAp.Ap where
ffmap :: forall (g :: * -> *) (h :: * -> *) x.
(Functor g, Functor h) =>
(g ~> h) -> Ap g x -> Ap h x
ffmap = (forall a. g a -> h a) -> Ap g x -> Ap h x
forall (f :: * -> *) (g :: * -> *) b.
(forall a. f a -> g a) -> Ap f b -> Ap g b
FreeAp.hoistAp
instance FFunctor FreeApFinal.Ap where
ffmap :: forall (g :: * -> *) (h :: * -> *) x.
(Functor g, Functor h) =>
(g ~> h) -> Ap g x -> Ap h x
ffmap = (forall a. g a -> h a) -> Ap g x -> Ap h x
forall (f :: * -> *) (g :: * -> *) b.
(forall a. f a -> g a) -> Ap f b -> Ap g b
FreeApFinal.hoistAp
instance FFunctor IdentityT where
ffmap :: forall (g :: * -> *) (h :: * -> *) x.
(Functor g, Functor h) =>
(g ~> h) -> IdentityT g x -> IdentityT h x
ffmap g ~> h
fg = h x -> IdentityT h x
forall {k} (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT (h x -> IdentityT h x)
-> (IdentityT g x -> h x) -> IdentityT g x -> IdentityT h x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g x -> h x
g ~> h
fg (g x -> h x) -> (IdentityT g x -> g x) -> IdentityT g x -> h x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdentityT g x -> g x
forall {k} (f :: k -> *) (a :: k). IdentityT f a -> f a
runIdentityT
instance FFunctor (ReaderT e) where
ffmap :: forall (g :: * -> *) (h :: * -> *) x.
(Functor g, Functor h) =>
(g ~> h) -> ReaderT e g x -> ReaderT e h x
ffmap g ~> h
fg = (e -> h x) -> ReaderT e h x
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((e -> h x) -> ReaderT e h x)
-> (ReaderT e g x -> e -> h x) -> ReaderT e g x -> ReaderT e h x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (g x -> h x) -> (e -> g x) -> e -> h x
forall a b. (a -> b) -> (e -> a) -> e -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap g x -> h x
g ~> h
fg ((e -> g x) -> e -> h x)
-> (ReaderT e g x -> e -> g x) -> ReaderT e g x -> e -> h x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT e g x -> e -> g x
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT
instance FFunctor (WriterT m) where
ffmap :: forall (g :: * -> *) (h :: * -> *) x.
(Functor g, Functor h) =>
(g ~> h) -> WriterT m g x -> WriterT m h x
ffmap g ~> h
fg = h (x, m) -> WriterT m h x
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterT (h (x, m) -> WriterT m h x)
-> (WriterT m g x -> h (x, m)) -> WriterT m g x -> WriterT m h x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g (x, m) -> h (x, m)
g ~> h
fg (g (x, m) -> h (x, m))
-> (WriterT m g x -> g (x, m)) -> WriterT m g x -> h (x, m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT m g x -> g (x, m)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT
instance FFunctor (StateT s) where
ffmap :: forall (g :: * -> *) (h :: * -> *) x.
(Functor g, Functor h) =>
(g ~> h) -> StateT s g x -> StateT s h x
ffmap g ~> h
fg = (s -> h (x, s)) -> StateT s h x
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((s -> h (x, s)) -> StateT s h x)
-> (StateT s g x -> s -> h (x, s)) -> StateT s g x -> StateT s h x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (g (x, s) -> h (x, s)) -> (s -> g (x, s)) -> s -> h (x, s)
forall a b. (a -> b) -> (s -> a) -> s -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap g (x, s) -> h (x, s)
g ~> h
fg ((s -> g (x, s)) -> s -> h (x, s))
-> (StateT s g x -> s -> g (x, s)) -> StateT s g x -> s -> h (x, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT s g x -> s -> g (x, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT
instance FFunctor (Ran f) where
ffmap :: forall (g :: * -> *) (h :: * -> *) x.
(Functor g, Functor h) =>
(g ~> h) -> Ran f g x -> Ran f h x
ffmap g ~> h
gh (Ran forall b. (x -> f b) -> g b
ran) = (forall b. (x -> f b) -> h b) -> Ran f h x
forall {k} (g :: k -> *) (h :: k -> *) a.
(forall (b :: k). (a -> g b) -> h b) -> Ran g h a
Ran (g b -> h b
g ~> h
gh (g b -> h b) -> ((x -> f b) -> g b) -> (x -> f b) -> h b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (x -> f b) -> g b
forall b. (x -> f b) -> g b
ran)
instance FFunctor (Lan f) where
ffmap :: forall (g :: * -> *) (h :: * -> *) x.
(Functor g, Functor h) =>
(g ~> h) -> Lan f g x -> Lan f h x
ffmap g ~> h
gh (Lan f b -> x
e g b
g) = (f b -> x) -> h b -> Lan f h x
forall {k} (g :: k -> *) (b :: k) a (h :: k -> *).
(g b -> a) -> h b -> Lan g h a
Lan f b -> x
e (g b -> h b
g ~> h
gh g b
g)
instance FFunctor (Day f) where
ffmap :: forall (g :: * -> *) (h :: * -> *) x.
(Functor g, Functor h) =>
(g ~> h) -> Day f g x -> Day f h x
ffmap = (forall x. g x -> h x) -> Day f g x -> Day f h x
forall (g :: * -> *) (h :: * -> *) (f :: * -> *) a.
(forall x. g x -> h x) -> Day f g a -> Day f h a
trans2
instance Functor f => FFunctor (Curried f) where
ffmap :: forall (g :: * -> *) (h :: * -> *) x.
(Functor g, Functor h) =>
(g ~> h) -> Curried f g x -> Curried f h x
ffmap g ~> h
gh (Curried forall r. f (x -> r) -> g r
t) = (forall r. f (x -> r) -> h r) -> Curried f h x
forall (g :: * -> *) (h :: * -> *) a.
(forall r. g (a -> r) -> h r) -> Curried g h a
Curried (g r -> h r
g ~> h
gh (g r -> h r) -> (f (x -> r) -> g r) -> f (x -> r) -> h r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (x -> r) -> g r
forall r. f (x -> r) -> g r
t)
instance FFunctor (FreeApT.ApT f) where
ffmap :: forall (g :: * -> *) (h :: * -> *) x.
(Functor g, Functor h) =>
(g ~> h) -> ApT f g x -> ApT f h x
ffmap = (forall a. g a -> h a) -> ApT f g x -> ApT f h x
forall (g :: * -> *) (g' :: * -> *) (f :: * -> *) b.
(forall a. g a -> g' a) -> ApT f g b -> ApT f g' b
FreeApT.hoistApT
instance Functor f => FFunctor (FreeT f) where
ffmap :: forall (g :: * -> *) (h :: * -> *) x.
(Functor g, Functor h) =>
(g ~> h) -> FreeT f g x -> FreeT f h x
ffmap = (forall a. g a -> h a) -> FreeT f g x -> FreeT f h x
forall (m :: * -> *) (f :: * -> *) (n :: * -> *) b.
(Functor m, Functor f) =>
(forall a. m a -> n a) -> FreeT f m b -> FreeT f n b
hoistFreeT
instance Functor g => FFunctor (Flip1 FreeApT.ApT g) where
ffmap :: forall (g :: * -> *) (h :: * -> *) x.
(Functor g, Functor h) =>
(g ~> h) -> Flip1 ApT g g x -> Flip1 ApT g h x
ffmap g ~> h
f2g = ApT h g x -> Flip1 ApT g h x
forall k1 k2 k3 (t :: k1 -> k2 -> k3 -> *) (a :: k2) (b :: k1)
(c :: k3).
t b a c -> Flip1 t a b c
Flip1 (ApT h g x -> Flip1 ApT g h x)
-> (Flip1 ApT g g x -> ApT h g x)
-> Flip1 ApT g g x
-> Flip1 ApT g h x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (g ~> h) -> ApT g g x -> ApT h g x
forall (f :: * -> *) (f' :: * -> *) (g :: * -> *) b.
(forall a. f a -> f' a) -> ApT f g b -> ApT f' g b
FreeApT.transApT g a -> h a
g ~> h
f2g (ApT g g x -> ApT h g x)
-> (Flip1 ApT g g x -> ApT g g x) -> Flip1 ApT g g x -> ApT h g x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flip1 ApT g g x -> ApT g g x
forall k1 k2 k3 (t :: k1 -> k2 -> k3 -> *) (a :: k2) (b :: k1)
(c :: k3).
Flip1 t a b c -> t b a c
unFlip1
instance (FFunctor ff, FFunctor gg) => FFunctor (Bi.Sum ff gg) where
ffmap :: forall (g :: * -> *) (h :: * -> *) x.
(Functor g, Functor h) =>
(g ~> h) -> Sum ff gg g x -> Sum ff gg h x
ffmap g ~> h
t (Bi.L2 ff g x
ff) = ff h x -> Sum ff gg h x
forall {k} {k1} (p :: k -> k1 -> *) (q :: k -> k1 -> *) (a :: k)
(b :: k1).
p a b -> Sum p q a b
Bi.L2 ((g ~> h) -> ff g x -> ff h x
forall (g :: * -> *) (h :: * -> *) x.
(Functor g, Functor h) =>
(g ~> h) -> ff g x -> ff h x
forall (ff :: FF) (g :: * -> *) (h :: * -> *) x.
(FFunctor ff, Functor g, Functor h) =>
(g ~> h) -> ff g x -> ff h x
ffmap g x -> h x
g ~> h
t ff g x
ff)
ffmap g ~> h
t (Bi.R2 gg g x
gg) = gg h x -> Sum ff gg h x
forall {k} {k1} (p :: k -> k1 -> *) (q :: k -> k1 -> *) (a :: k)
(b :: k1).
q a b -> Sum p q a b
Bi.R2 ((g ~> h) -> gg g x -> gg h x
forall (g :: * -> *) (h :: * -> *) x.
(Functor g, Functor h) =>
(g ~> h) -> gg g x -> gg h x
forall (ff :: FF) (g :: * -> *) (h :: * -> *) x.
(FFunctor ff, Functor g, Functor h) =>
(g ~> h) -> ff g x -> ff h x
ffmap g x -> h x
g ~> h
t gg g x
gg)
instance (FFunctor ff, FFunctor gg) => FFunctor (Bi.Product ff gg) where
ffmap :: forall (g :: * -> *) (h :: * -> *) x.
(Functor g, Functor h) =>
(g ~> h) -> Product ff gg g x -> Product ff gg h x
ffmap g ~> h
t (Bi.Pair ff g x
ff gg g x
gg) = ff h x -> gg h x -> Product ff gg h x
forall {k} {k1} (f :: k -> k1 -> *) (g :: k -> k1 -> *) (a :: k)
(b :: k1).
f a b -> g a b -> Product f g a b
Bi.Pair ((g ~> h) -> ff g x -> ff h x
forall (g :: * -> *) (h :: * -> *) x.
(Functor g, Functor h) =>
(g ~> h) -> ff g x -> ff h x
forall (ff :: FF) (g :: * -> *) (h :: * -> *) x.
(FFunctor ff, Functor g, Functor h) =>
(g ~> h) -> ff g x -> ff h x
ffmap g x -> h x
g ~> h
t ff g x
ff) ((g ~> h) -> gg g x -> gg h x
forall (g :: * -> *) (h :: * -> *) x.
(Functor g, Functor h) =>
(g ~> h) -> gg g x -> gg h x
forall (ff :: FF) (g :: * -> *) (h :: * -> *) x.
(FFunctor ff, Functor g, Functor h) =>
(g ~> h) -> ff g x -> ff h x
ffmap g x -> h x
g ~> h
t gg g x
gg)
instance FFunctor (EnvT e) where
ffmap :: forall (g :: * -> *) (h :: * -> *) x.
(Functor g, Functor h) =>
(g ~> h) -> EnvT e g x -> EnvT e h x
ffmap g ~> h
gh (EnvT e
e g x
g) = e -> h x -> EnvT e h x
forall e (w :: * -> *) a. e -> w a -> EnvT e w a
EnvT e
e (g x -> h x
g ~> h
gh g x
g)
instance FFunctor (TracedT m) where
ffmap :: forall (g :: * -> *) (h :: * -> *) x.
(Functor g, Functor h) =>
(g ~> h) -> TracedT m g x -> TracedT m h x
ffmap g ~> h
gh (TracedT g (m -> x)
g) = h (m -> x) -> TracedT m h x
forall m (w :: * -> *) a. w (m -> a) -> TracedT m w a
TracedT (g (m -> x) -> h (m -> x)
g ~> h
gh g (m -> x)
g)
instance FFunctor (StoreT s) where
ffmap :: forall (g :: * -> *) (h :: * -> *) x.
(Functor g, Functor h) =>
(g ~> h) -> StoreT s g x -> StoreT s h x
ffmap g ~> h
gh (StoreT g (s -> x)
g s
s) = h (s -> x) -> s -> StoreT s h x
forall s (w :: * -> *) a. w (s -> a) -> s -> StoreT s w a
StoreT (g (s -> x) -> h (s -> x)
g ~> h
gh g (s -> x)
g) s
s
instance FFunctor Cofree where
ffmap :: forall (g :: * -> *) (h :: * -> *) x.
(Functor g, Functor h) =>
(g ~> h) -> Cofree g x -> Cofree h x
ffmap = (forall x. g x -> h x) -> Cofree g x -> Cofree h x
forall (f :: * -> *) (g :: * -> *) a.
Functor f =>
(forall x. f x -> g x) -> Cofree f a -> Cofree g a
hoistCofree