    {-# LANGUAGE CPP #-}
    {-# LANGUAGE PolyKinds    #-}
    {-# LANGUAGE TypeFamilies #-}
    {-# LANGUAGE UndecidableInstances #-}
    {-# OPTIONS_GHC -Wno-orphans #-}
    module Barbies.Internal.FunctorT
      ( FunctorT(..)
      , gtmapDefault
      , CanDeriveFunctorT
      )

    where

    import Barbies.Generics.Functor (GFunctor(..))

    import Control.Applicative.Backwards(Backwards (..))
    import Control.Applicative.Lift(Lift, mapLift )

    #if MIN_VERSION_transformers(0,5,3)
    import Control.Monad.Trans.Accum(AccumT, mapAccumT)
    #endif
    import Control.Monad.Trans.Except(ExceptT, mapExceptT)
    import Control.Monad.Trans.Identity(IdentityT, mapIdentityT)
    import Control.Monad.Trans.Maybe(MaybeT, mapMaybeT)
    import Control.Monad.Trans.RWS.Lazy as Lazy (RWST, mapRWST)
    import Control.Monad.Trans.RWS.Strict as Strict (RWST, mapRWST)
    import Control.Monad.Trans.Reader(ReaderT, mapReaderT)
    import Control.Monad.Trans.State.Lazy as Lazy (StateT, mapStateT)
    import Control.Monad.Trans.State.Strict as Strict (StateT, mapStateT)
    import Control.Monad.Trans.Writer.Lazy as Lazy (WriterT, mapWriterT)
    import Control.Monad.Trans.Writer.Strict as Strict (WriterT, mapWriterT)

    import Data.Functor.Compose   (Compose (..))
    import Data.Functor.Product   (Product (..))
    import Data.Functor.Reverse   (Reverse (..))
    import Data.Functor.Sum       (Sum (..))
    import Data.Generics.GenericN
    import Data.Proxy             (Proxy (..))
    import Data.Kind              (Type)

    -- | Functor from indexed-types to indexed-types. Instances of 'FunctorT' should
    --   satisfy the following laws:
    --
    -- @
    -- 'tmap' 'id' = 'id'
    -- 'tmap' f . 'tmap' g = 'tmap' (f . g)
    -- @
    --
    -- There is a default 'tmap' implementation for 'Generic' types, so
    -- instances can derived automatically.
    class FunctorT (t :: (k -> Type) -> k' -> Type) where
      tmap :: (forall a . f a -> g a) -> t f x -> t g x

      default tmap
        :: forall f g x
        .  CanDeriveFunctorT t f g x
        => (forall a . f a -> g a)
        -> t f x
        -> t g x
      tmap = (forall (a :: k). f a -> g a) -> t f x -> t g x
    forall {k} {k} (t :: (k -> *) -> k -> *) (f :: k -> *)
           (g :: k -> *) (x :: k).
    CanDeriveFunctorT t f g x =>
    (forall (a :: k). f a -> g a) -> t f x -> t g x
    gtmapDefault

    -- | @'CanDeriveFunctorT' T f g x@ is in practice a predicate about @T@ only.
    --   Intuitively, it says that the following holds, for any arbitrary @f@:
    --
    --     * There is an instance of @'Generic' (T f)@.
    --
    --     * @T f x@ can contain fields of type @t f y@ as long as there exists a
    --       @'FunctorT' t@ instance. In particular, recursive usages of @T f y@
    --       are allowed.
    --
    --     * @T f x@ can also contain usages of @t f y@ under a @'Functor' h@.
    --       For example, one could use @'Maybe' (T f y)@ when defining @T f y@.
    type CanDeriveFunctorT t f g x
      = ( GenericP 1 (t f x)
        , GenericP 1 (t g x)
        , GFunctor 1 f g (RepP 1 (t f x)) (RepP 1 (t g x))
        )

    -- | Default implementation of 'tmap' based on 'Generic'.
    gtmapDefault
      :: CanDeriveFunctorT t f g x
      => (forall a . f a -> g a)
      -> t f x
      -> t g x
    gtmapDefault :: forall {k} {k} (t :: (k -> *) -> k -> *) (f :: k -> *)
           (g :: k -> *) (x :: k).
    CanDeriveFunctorT t f g x =>
    (forall (a :: k). f a -> g a) -> t f x -> t g x
    gtmapDefault forall (a :: k). f a -> g a
    f
      = Proxy 1 -> RepP 1 (t g x) Any -> t g x
    forall (n :: Nat) a x. GenericP n a => Proxy n -> RepP n a x -> a
    forall x. Proxy 1 -> RepP 1 (t g x) x -> t g x
    toP (forall (t :: Nat). Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @1) (Zip
       (Rep (FilterIndex 1 (Indexed t 2) (Param 1 g) x)) (Rep (t g x)) Any
     -> t g x)
    -> (t f x
        -> Zip
             (Rep (FilterIndex 1 (Indexed t 2) (Param 1 g) x))
             (Rep (t g x))
             Any)
    -> t f x
    -> t g x
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Proxy 1
    -> (forall (a :: k). f a -> g a)
    -> Zip
         (Rep (FilterIndex 1 (Indexed t 2) (Param 1 f) x)) (Rep (t f x)) Any
    -> Zip
         (Rep (FilterIndex 1 (Indexed t 2) (Param 1 g) x)) (Rep (t g x)) Any
    forall x.
    Proxy 1
    -> (forall (a :: k). f a -> g a)
    -> Zip
         (Rep (FilterIndex 1 (Indexed t 2) (Param 1 f) x)) (Rep (t f x)) x
    -> Zip
         (Rep (FilterIndex 1 (Indexed t 2) (Param 1 g) x)) (Rep (t g x)) x
    forall {k} {k1} (n :: Nat) (f :: k -> *) (g :: k -> *)
           (repbf :: k1 -> *) (repbg :: k1 -> *) (x :: k1).
    GFunctor n f g repbf repbg =>
    Proxy n -> (forall (a :: k). f a -> g a) -> repbf x -> repbg x
    gmap (forall (t :: Nat). Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @1) f a -> g a
    forall (a :: k). f a -> g a
    f (Zip
       (Rep (FilterIndex 1 (Indexed t 2) (Param 1 f) x)) (Rep (t f x)) Any
     -> Zip
          (Rep (FilterIndex 1 (Indexed t 2) (Param 1 g) x))
          (Rep (t g x))
          Any)
    -> (t f x
        -> Zip
             (Rep (FilterIndex 1 (Indexed t 2) (Param 1 f) x))
             (Rep (t f x))
             Any)
    -> t f x
    -> Zip
         (Rep (FilterIndex 1 (Indexed t 2) (Param 1 g) x)) (Rep (t g x)) Any
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Proxy 1 -> t f x -> RepP 1 (t f x) Any
    forall (n :: Nat) a x. GenericP n a => Proxy n -> a -> RepP n a x
    forall x. Proxy 1 -> t f x -> RepP 1 (t f x) x
    fromP (forall (t :: Nat). Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @1)
    {-# INLINE gtmapDefault #-}

    -- ------------------------------------------------------------
    -- Generic derivation: Special cases for FunctorT
    -- -----------------------------------------------------------

    type P = Param

    instance
      ( FunctorT t
      ) => GFunctor 1 f g (Rec (t (P 1 f) x) (t f x))
                          (Rec (t (P 1 g) x) (t g x))
      where
      gmap :: forall (x :: k1).
    Proxy 1
    -> (forall (a :: k). f a -> g a)
    -> Rec (t (P 1 f) x) (t f x) x
    -> Rec (t (P 1 g) x) (t g x) x
    gmap Proxy 1
    _ forall (a :: k). f a -> g a
    h (Rec (K1 t f x
    tf)) = K1 R (t g x) x -> Rec (t (P 1 g) x) (t g x) x
    forall {k} p a (x :: k). K1 R a x -> Rec p a x
    Rec (t g x -> K1 R (t g x) x
    forall k i c (p :: k). c -> K1 i c p
    K1 ((forall (a :: k). f a -> g a) -> t f x -> t g x
    forall k k' (t :: (k -> *) -> k' -> *) (f :: k -> *) (g :: k -> *)
           (x :: k').
    FunctorT t =>
    (forall (a :: k). f a -> g a) -> t f x -> t g x
    forall (f :: k -> *) (g :: k -> *) (x :: k').
    (forall (a :: k). f a -> g a) -> t f x -> t g x
    tmap f a -> g a
    forall (a :: k). f a -> g a
    h t f x
    tf))
      {-# INLINE gmap #-}

    instance
      ( Functor h
      , FunctorT t
      ) => GFunctor 1 f g (Rec (h (t (P 1 f) x)) (h (t f x)))
                          (Rec (h (t (P 1 g) x)) (h (t g x)))
      where
      gmap :: forall (x :: k1).
    Proxy 1
    -> (forall (a :: k). f a -> g a)
    -> Rec (h (t (P 1 f) x)) (h (t f x)) x
    -> Rec (h (t (P 1 g) x)) (h (t g x)) x
    gmap Proxy 1
    _ forall (a :: k). f a -> g a
    h (Rec (K1 h (t f x)
    htf)) = K1 R (h (t g x)) x -> Rec (h (t (P 1 g) x)) (h (t g x)) x
    forall {k} p a (x :: k). K1 R a x -> Rec p a x
    Rec (h (t g x) -> K1 R (h (t g x)) x
    forall k i c (p :: k). c -> K1 i c p
    K1 ((t f x -> t g x) -> h (t f x) -> h (t g x)
    forall a b. (a -> b) -> h a -> h b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((forall (a :: k). f a -> g a) -> t f x -> t g x
    forall k k' (t :: (k -> *) -> k' -> *) (f :: k -> *) (g :: k -> *)
           (x :: k').
    FunctorT t =>
    (forall (a :: k). f a -> g a) -> t f x -> t g x
    forall (f :: k -> *) (g :: k -> *) (x :: k').
    (forall (a :: k). f a -> g a) -> t f x -> t g x
    tmap f a -> g a
    forall (a :: k). f a -> g a
    h) h (t f x)
    htf))
      {-# INLINE gmap #-}

    -- This is the same as the previous instance, but for nested (normal-flavoured)
    -- functors.
    instance
      ( Functor h
      , Functor m
      , FunctorT t
      ) => GFunctor 1 f g (Rec (m (h (t (P 1 f) x))) (m (h (t f x))))
                          (Rec (m (h (t (P 1 g) x))) (m (h (t g x))))
      where
      gmap :: forall (x :: k1).
    Proxy 1
    -> (forall (a :: k). f a -> g a)
    -> Rec (m (h (t (P 1 f) x))) (m (h (t f x))) x
    -> Rec (m (h (t (P 1 g) x))) (m (h (t g x))) x
    gmap Proxy 1
    _ forall (a :: k). f a -> g a
    h (Rec (K1 m (h (t f x))
    mhtf)) = K1 R (m (h (t g x))) x
    -> Rec (m (h (t (P 1 g) x))) (m (h (t g x))) x
    forall {k} p a (x :: k). K1 R a x -> Rec p a x
    Rec (m (h (t g x)) -> K1 R (m (h (t g x))) x
    forall k i c (p :: k). c -> K1 i c p
    K1 ((h (t f x) -> h (t g x)) -> m (h (t f x)) -> m (h (t g x))
    forall a b. (a -> b) -> m a -> m b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((t f x -> t g x) -> h (t f x) -> h (t g x)
    forall a b. (a -> b) -> h a -> h b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((forall (a :: k). f a -> g a) -> t f x -> t g x
    forall k k' (t :: (k -> *) -> k' -> *) (f :: k -> *) (g :: k -> *)
           (x :: k').
    FunctorT t =>
    (forall (a :: k). f a -> g a) -> t f x -> t g x
    forall (f :: k -> *) (g :: k -> *) (x :: k').
    (forall (a :: k). f a -> g a) -> t f x -> t g x
    tmap f a -> g a
    forall (a :: k). f a -> g a
    h)) m (h (t f x))
    mhtf))
      {-# INLINE gmap #-}

    -- --------------------------------
    -- Instances for base types
    -- --------------------------------

    instance Functor f => FunctorT (Compose f) where
      tmap :: forall (f :: k' -> *) (g :: k' -> *) (x :: k').
    (forall (a :: k'). f a -> g a) -> Compose f f x -> Compose f g x
    tmap forall (a :: k'). f a -> g a
    h (Compose f (f x)
    fga)
        = f (g x) -> Compose f g x
    forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
    f (g a) -> Compose f g a
    Compose ((f x -> g x) -> f (f x) -> f (g x)
    forall a b. (a -> b) -> f a -> f b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap f x -> g x
    forall (a :: k'). f a -> g a
    h f (f x)
    fga)
      {-# INLINE tmap #-}

    instance FunctorT (Product f) where
      tmap :: forall (f :: k' -> *) (g :: k' -> *) (x :: k').
    (forall (a :: k'). f a -> g a) -> Product f f x -> Product f g x
    tmap forall (a :: k'). f a -> g a
    h (Pair f x
    fa f x
    ga) = f x -> g x -> Product f g x
    forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
    f a -> g a -> Product f g a
    Pair f x
    fa (f x -> g x
    forall (a :: k'). f a -> g a
    h f x
    ga)
      {-# INLINE tmap #-}

    instance FunctorT (Sum f) where
      tmap :: forall (f :: k' -> *) (g :: k' -> *) (x :: k').
    (forall (a :: k'). f a -> g a) -> Sum f f x -> Sum f g x
    tmap forall (a :: k'). f a -> g a
    h = \case
        InL f x
    fa -> f x -> Sum f g x
    forall {k} (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
    InL f x
    fa
        InR f x
    ga -> g x -> Sum f g x
    forall {k} (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
    InR (f x -> g x
    forall (a :: k'). f a -> g a
    h f x
    ga)
      {-# INLINE tmap #-}

    -- --------------------------------
    -- Instances for transformers types
    -- --------------------------------

    #if MIN_VERSION_transformers(0,5,3)
    instance FunctorT (AccumT w) where
      tmap :: forall (f :: * -> *) (g :: * -> *) x.
    (forall a. f a -> g a) -> AccumT w f x -> AccumT w g x
    tmap forall a. f a -> g a
    h = (f (x, w) -> g (x, w)) -> AccumT w f x -> AccumT w g x
    forall (m :: * -> *) a w (n :: * -> *) b.
    (m (a, w) -> n (b, w)) -> AccumT w m a -> AccumT w n b
    mapAccumT f (x, w) -> g (x, w)
    forall a. f a -> g a
    h
      {-# INLINE tmap #-}
    #endif

    instance FunctorT Backwards where
      tmap :: forall (f :: k' -> *) (g :: k' -> *) (x :: k').
    (forall (a :: k'). f a -> g a) -> Backwards f x -> Backwards g x
    tmap forall (a :: k'). f a -> g a
    h (Backwards f x
    fa)
        = g x -> Backwards g x
    forall {k} (f :: k -> *) (a :: k). f a -> Backwards f a
    Backwards (f x -> g x
    forall (a :: k'). f a -> g a
    h f x
    fa)
      {-# INLINE tmap #-}

    instance FunctorT Reverse where
      tmap :: forall (f :: k' -> *) (g :: k' -> *) (x :: k').
    (forall (a :: k'). f a -> g a) -> Reverse f x -> Reverse g x
    tmap forall (a :: k'). f a -> g a
    h (Reverse f x
    fa) = g x -> Reverse g x
    forall {k} (f :: k -> *) (a :: k). f a -> Reverse f a
    Reverse (f x -> g x
    forall (a :: k'). f a -> g a
    h f x
    fa)
      {-# INLINE tmap #-}

    instance FunctorT Lift where
      tmap :: forall (f :: * -> *) (g :: * -> *) x.
    (forall a. f a -> g a) -> Lift f x -> Lift g x
    tmap forall a. f a -> g a
    h = (f x -> g x) -> Lift f x -> Lift g x
    forall (f :: * -> *) a (g :: * -> *).
    (f a -> g a) -> Lift f a -> Lift g a
    mapLift f x -> g x
    forall a. f a -> g a
    h
      {-# INLINE tmap #-}

    instance FunctorT (ExceptT e) where
      tmap :: forall (f :: * -> *) (g :: * -> *) x.
    (forall a. f a -> g a) -> ExceptT e f x -> ExceptT e g x
    tmap forall a. f a -> g a
    h = (f (Either e x) -> g (Either e x))
    -> ExceptT e f x -> ExceptT e g x
    forall (m :: * -> *) e a (n :: * -> *) e' b.
    (m (Either e a) -> n (Either e' b))
    -> ExceptT e m a -> ExceptT e' n b
    mapExceptT f (Either e x) -> g (Either e x)
    forall a. f a -> g a
    h
      {-# INLINE tmap #-}

    instance FunctorT IdentityT where
      tmap :: forall (f :: k' -> *) (g :: k' -> *) (x :: k').
    (forall (a :: k'). f a -> g a) -> IdentityT f x -> IdentityT g x
    tmap forall (a :: k'). f a -> g a
    h = (f x -> g x) -> IdentityT f x -> IdentityT g x
    forall {k1} {k2} (m :: k1 -> *) (a :: k1) (n :: k2 -> *) (b :: k2).
    (m a -> n b) -> IdentityT m a -> IdentityT n b
    mapIdentityT f x -> g x
    forall (a :: k'). f a -> g a
    h
      {-# INLINE tmap #-}

    instance FunctorT MaybeT where
      tmap :: forall (f :: * -> *) (g :: * -> *) x.
    (forall a. f a -> g a) -> MaybeT f x -> MaybeT g x
    tmap forall a. f a -> g a
    h = (f (Maybe x) -> g (Maybe x)) -> MaybeT f x -> MaybeT g x
    forall (m :: * -> *) a (n :: * -> *) b.
    (m (Maybe a) -> n (Maybe b)) -> MaybeT m a -> MaybeT n b
    mapMaybeT f (Maybe x) -> g (Maybe x)
    forall a. f a -> g a
    h
      {-# INLINE tmap #-}

    instance FunctorT (Lazy.RWST r w s) where
      tmap :: forall (f :: * -> *) (g :: * -> *) x.
    (forall a. f a -> g a) -> RWST r w s f x -> RWST r w s g x
    tmap forall a. f a -> g a
    h = (f (x, s, w) -> g (x, s, w)) -> RWST r w s f x -> RWST r w s g x
    forall (m :: * -> *) a s w (n :: * -> *) b w' r.
    (m (a, s, w) -> n (b, s, w')) -> RWST r w s m a -> RWST r w' s n b
    Lazy.mapRWST f (x, s, w) -> g (x, s, w)
    forall a. f a -> g a
    h
      {-# INLINE tmap #-}

    instance FunctorT (Strict.RWST r w s) where
      tmap :: forall (f :: * -> *) (g :: * -> *) x.
    (forall a. f a -> g a) -> RWST r w s f x -> RWST r w s g x
    tmap forall a. f a -> g a
    h = (f (x, s, w) -> g (x, s, w)) -> RWST r w s f x -> RWST r w s g x
    forall (m :: * -> *) a s w (n :: * -> *) b w' r.
    (m (a, s, w) -> n (b, s, w')) -> RWST r w s m a -> RWST r w' s n b
    Strict.mapRWST f (x, s, w) -> g (x, s, w)
    forall a. f a -> g a
    h
      {-# INLINE tmap #-}

    instance FunctorT (ReaderT r) where
      tmap :: forall (f :: * -> *) (g :: * -> *) x.
    (forall a. f a -> g a) -> ReaderT r f x -> ReaderT r g x
    tmap forall a. f a -> g a
    h = (f x -> g x) -> ReaderT r f x -> ReaderT r g x
    forall (m :: * -> *) a (n :: * -> *) b r.
    (m a -> n b) -> ReaderT r m a -> ReaderT r n b
    mapReaderT f x -> g x
    forall a. f a -> g a
    h
      {-# INLINE tmap #-}

    instance FunctorT (Lazy.StateT s) where
      tmap :: forall (f :: * -> *) (g :: * -> *) x.
    (forall a. f a -> g a) -> StateT s f x -> StateT s g x
    tmap forall a. f a -> g a
    h = (f (x, s) -> g (x, s)) -> StateT s f x -> StateT s g x
    forall (m :: * -> *) a s (n :: * -> *) b.
    (m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
    Lazy.mapStateT f (x, s) -> g (x, s)
    forall a. f a -> g a
    h
      {-# INLINE tmap #-}

    instance FunctorT (Strict.StateT s) where
      tmap :: forall (f :: * -> *) (g :: * -> *) x.
    (forall a. f a -> g a) -> StateT s f x -> StateT s g x
    tmap forall a. f a -> g a
    h = (f (x, s) -> g (x, s)) -> StateT s f x -> StateT s g x
    forall (m :: * -> *) a s (n :: * -> *) b.
    (m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
    Strict.mapStateT f (x, s) -> g (x, s)
    forall a. f a -> g a
    h
      {-# INLINE tmap #-}

    instance FunctorT (Lazy.WriterT w) where
      tmap :: forall (f :: * -> *) (g :: * -> *) x.
    (forall a. f a -> g a) -> WriterT w f x -> WriterT w g x
    tmap forall a. f a -> g a
    h = (f (x, w) -> g (x, w)) -> WriterT w f x -> WriterT w g x
    forall (m :: * -> *) a w (n :: * -> *) b w'.
    (m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b
    Lazy.mapWriterT f (x, w) -> g (x, w)
    forall a. f a -> g a
    h
      {-# INLINE tmap #-}

    instance FunctorT (Strict.WriterT w) where
      tmap :: forall (f :: * -> *) (g :: * -> *) x.
    (forall a. f a -> g a) -> WriterT w f x -> WriterT w g x
    tmap forall a. f a -> g a
    h = (f (x, w) -> g (x, w)) -> WriterT w f x -> WriterT w g x
    forall (m :: * -> *) a w (n :: * -> *) b w'.
    (m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b
    Strict.mapWriterT f (x, w) -> g (x, w)
    forall a. f a -> g a
    h
      {-# INLINE tmap #-}