{-# LANGUAGE DerivingVia           #-}
{-# OPTIONS_HADDOCK hide, not-home #-}

module Data.HFunctor.Internal (
    HFunctor(..)
  , HBifunctor(..)
  , WrappedHBifunctor(..)
  , sumSum, prodProd
  , generalize, absorb
  , NDL, ndlSingleton, fromNDL
  ) where

import           Control.Applicative.Backwards
import           Control.Applicative.Free
import           Control.Applicative.Lift
import           Control.Applicative.ListF
import           Control.Applicative.Step
import           Control.Comonad.Trans.Env
import           Control.Monad.Freer.Church
import           Control.Monad.Trans.Compose
import           Control.Monad.Trans.Identity
import           Control.Monad.Trans.Maybe
import           Control.Monad.Trans.Reader
import           Control.Natural
import           Control.Natural.IsoF
import           Data.Bifunctor
import           Data.Bifunctor.Joker
import           Data.Coerce
import           Data.Foldable
import           Data.Functor.Bind
import           Data.Functor.Contravariant.Night    (Night(..))
import           Data.Functor.Coyoneda
import           Data.Functor.Day                    (Day(..))
import           Data.Functor.Identity
import           Data.Functor.Product
import           Data.Functor.Reverse
import           Data.Functor.Sum
import           Data.Functor.These
import           Data.Functor.Yoneda
import           Data.Kind
import           Data.List.NonEmpty                  (NonEmpty(..))
import           Data.Proxy
import           Data.Tagged
import           Data.Vinyl.CoRec
import           Data.Vinyl.Core                     (Rec)
import           Data.Vinyl.Recursive
import           GHC.Generics
import qualified Control.Alternative.Free            as Alt
import qualified Control.Applicative.Free.Fast       as FAF
import qualified Control.Applicative.Free.Final      as FA
import qualified Control.Monad.Free.Church           as MC
import qualified Data.Functor.Contravariant.Coyoneda as CCY
import qualified Data.Functor.Contravariant.Day      as CD
import qualified Data.Functor.Contravariant.Night    as N
import qualified Data.Functor.Day                    as D
import qualified Data.Functor.Invariant.Day          as ID
import qualified Data.Functor.Invariant.Night        as IN
import qualified Data.SOP                            as SOP
import qualified Data.SOP.NP                         as SOP
import qualified Data.SOP.NS                         as SOP

-- | An 'HFunctor' can be thought of a unary "functor transformer" ---
-- a basic functor combinator.  It takes a functor as input and returns
-- a functor as output.
--
-- It "enhances" a functor with extra structure (sort of like how a monad
-- transformer enhances a 'Monad' with extra structure).
--
-- As a uniform inteface, we can "swap the underlying functor" (also
-- sometimes called "hoisting").  This is what 'hmap' does: it lets us swap
-- out the @f@ in a @t f@ for a @t g@.
--
-- For example, the free monad 'Free' takes a 'Functor' and returns a new
-- 'Functor'.  In the process, it provides a monadic structure over @f@.
-- 'hmap' lets us turn a @'Free' f@ into a @'Free' g@: a monad built over
-- @f@ can be turned into a monad built over @g@.
--
-- For the ability to move in and out of the enhanced functor, see
-- 'Data.HFunctor.Inject' and 'Data.HFunctor.Interpret.Interpret'.
--
-- This class is similar to 'Control.Monad.Morph.MFunctor' from
-- "Control.Monad.Morph", but instances must work without a 'Monad' constraint.
--
-- This class is also found in the /hschema/ library with the same name.
class HFunctor t where
    -- | If we can turn an @f@ into a @g@, then we can turn a @t f@ into
    -- a @t g@.
    --
    -- It must be the case that
    --
    -- @
    -- 'hmap' 'id' == id
    -- @
    --
    -- Essentially, @t f@ adds some "extra structure" to @f@.  'hmap'
    -- must swap out the functor, /without affecting the added structure/.
    --
    -- For example, @'ListF' f a@ is essentially a list of @f a@s.  If we
    -- 'hmap' to swap out the @f a@s for @g a@s, then we must ensure that
    -- the "added structure" (here, the number of items in the list, and
    -- the ordering of those items) remains the same.  So, 'hmap' must
    -- preserve the number of items in the list, and must maintain the
    -- ordering.
    --
    -- The law @'hmap' 'id' == id@ is a way of formalizing this property.
    hmap :: f ~> g -> t f ~> t g

    {-# MINIMAL hmap #-}

-- | A 'HBifunctor' is like an 'HFunctor', but it enhances /two/ different
-- functors instead of just one.
--
-- Usually, it enhaces them "together" in some sort of combining way.
--
-- This typeclass provides a uniform instance for "swapping out" or
-- "hoisting" the enhanced functors.   We can hoist the first one with
-- 'hleft', the second one with 'hright', or both at the same time with
-- 'hbimap'.
--
-- For example, the @f :*: g@ type gives us "both @f@ and @g@":
--
-- @
-- data (f ':*:' g) a = f a :*: g a
-- @
--
-- It combines both @f@ and @g@ into a unified structure --- here, it does
-- it by providing both @f@ and @g@.
--
-- The single law is:
--
-- @
-- 'hbimap' 'id' id == id
-- @
--
-- This ensures that 'hleft', 'hright', and 'hbimap' do not affect the
-- structure that @t@ adds on top of the underlying functors.
class HBifunctor (t :: (k -> Type) -> (k -> Type) -> k -> Type) where
    -- | Swap out the first transformed functor.
    hleft  :: f ~> j -> t f g ~> t j g
    hleft f ~> j
f t f g x
x = forall k (t :: (k -> *) -> (k -> *) -> k -> *) (f :: k -> *)
       (j :: k -> *) (g :: k -> *) (l :: k -> *).
HBifunctor t =>
(f ~> j) -> (g ~> l) -> t f g ~> t j l
hbimap f ~> j
f forall a. a -> a
id t f g x
x

    -- | Swap out the second transformed functor.
    hright :: g ~> l -> t f g ~> t f l
    hright g ~> l
f t f g x
x = forall k (t :: (k -> *) -> (k -> *) -> k -> *) (f :: k -> *)
       (j :: k -> *) (g :: k -> *) (l :: k -> *).
HBifunctor t =>
(f ~> j) -> (g ~> l) -> t f g ~> t j l
hbimap forall a. a -> a
id g ~> l
f t f g x
x

    -- | Swap out both transformed functors at the same time.
    hbimap :: f ~> j -> g ~> l -> t f g ~> t j l
    hbimap f ~> j
f g ~> l
g = forall k (t :: (k -> *) -> (k -> *) -> k -> *) (f :: k -> *)
       (j :: k -> *) (g :: k -> *).
HBifunctor t =>
(f ~> j) -> t f g ~> t j g
hleft f ~> j
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (t :: (k -> *) -> (k -> *) -> k -> *) (g :: k -> *)
       (l :: k -> *) (f :: k -> *).
HBifunctor t =>
(g ~> l) -> t f g ~> t f l
hright g ~> l
g

    {-# MINIMAL hleft, hright | hbimap #-}

-- | Useful newtype to allow us to derive an 'HFunctor' instance from any
-- instance of 'HBifunctor', using -XDerivingVia.
--
-- For example, because we have @instance 'HBifunctor' 'Day'@, we can
-- write:
--
-- @
-- deriving via ('WrappedHBifunctor' 'Day' f) instance 'HFunctor' ('Day' f)
-- @
--
-- to give us an automatic 'HFunctor' instance and save us some work.
newtype WrappedHBifunctor t (f :: k -> Type) (g :: k -> Type) (a :: k)
    = WrapHBifunctor { forall k (t :: (k -> *) -> (k -> *) -> k -> *) (f :: k -> *)
       (g :: k -> *) (a :: k).
WrappedHBifunctor t f g a -> t f g a
unwrapHBifunctor :: t f g a }
  deriving forall a b.
a -> WrappedHBifunctor t f g b -> WrappedHBifunctor t f g a
forall a b.
(a -> b) -> WrappedHBifunctor t f g a -> WrappedHBifunctor t f g b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (t :: (* -> *) -> (* -> *) -> * -> *) (f :: * -> *)
       (g :: * -> *) a b.
Functor (t f g) =>
a -> WrappedHBifunctor t f g b -> WrappedHBifunctor t f g a
forall (t :: (* -> *) -> (* -> *) -> * -> *) (f :: * -> *)
       (g :: * -> *) a b.
Functor (t f g) =>
(a -> b) -> WrappedHBifunctor t f g a -> WrappedHBifunctor t f g b
<$ :: forall a b.
a -> WrappedHBifunctor t f g b -> WrappedHBifunctor t f g a
$c<$ :: forall (t :: (* -> *) -> (* -> *) -> * -> *) (f :: * -> *)
       (g :: * -> *) a b.
Functor (t f g) =>
a -> WrappedHBifunctor t f g b -> WrappedHBifunctor t f g a
fmap :: forall a b.
(a -> b) -> WrappedHBifunctor t f g a -> WrappedHBifunctor t f g b
$cfmap :: forall (t :: (* -> *) -> (* -> *) -> * -> *) (f :: * -> *)
       (g :: * -> *) a b.
Functor (t f g) =>
(a -> b) -> WrappedHBifunctor t f g a -> WrappedHBifunctor t f g b
Functor

-- | Isomorphism between different varieities of ':+:'.
sumSum :: (f :+: g) <~> Sum f g
sumSum :: forall {k} (f :: k -> *) (g :: k -> *). (f :+: g) <~> Sum f g
sumSum = forall {k} (f :: k -> *) (g :: k -> *).
(f ~> g) -> (g ~> f) -> f <~> g
isoF forall {k} {f :: k -> *} {g :: k -> *} {a :: k}.
(:+:) f g a -> Sum f g a
to_ forall {k} {f :: k -> *} {g :: k -> *} {p :: k}.
Sum f g p -> (:+:) f g p
from_
  where
    to_ :: (:+:) f g a -> Sum f g a
to_   (L1 f a
x)  = forall {k} (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
InL f a
x
    to_   (R1 g a
y)  = forall {k} (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
InR g a
y
    from_ :: Sum f g p -> (:+:) f g p
from_ (InL f p
x) = forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 f p
x
    from_ (InR g p
y) = forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 g p
y

-- | Isomorphism between different varieities of ':*:'.
prodProd :: (f :*: g) <~> Product f g
prodProd :: forall {k} (f :: k -> *) (g :: k -> *). (f :*: g) <~> Product f g
prodProd = forall {k} (f :: k -> *) (g :: k -> *).
(f ~> g) -> (g ~> f) -> f <~> g
isoF forall {k} {f :: k -> *} {g :: k -> *} {a :: k}.
(:*:) f g a -> Product f g a
to_ forall {k} {f :: k -> *} {g :: k -> *} {p :: k}.
Product f g p -> (:*:) f g p
from_
  where
    to_ :: (:*:) f g a -> Product f g a
to_   (f a
x :*: g a
y)  = forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair f a
x g a
y
    from_ :: Product f g p -> (:*:) f g p
from_ (Pair f p
x g p
y) = f p
x forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: g p
y

-- | Turn 'Identity' into any @'Applicative' f@.  Can be useful as an
-- argument to 'hmap', 'hbimap', or 'Data.HFunctor.Interpret.interpret'.
--
-- It is a more general form of 'Control.Monad.Morph.generalize' from
-- /mmorph/.
generalize :: Applicative f => Identity ~> f
generalize :: forall (f :: * -> *). Applicative f => Identity ~> f
generalize (Identity x
x) = forall (f :: * -> *) a. Applicative f => a -> f a
pure x
x

-- | Natural transformation from any functor @f@ into 'Proxy'.  Can be
-- useful for "zeroing out" a functor with 'hmap' or 'hbimap' or
-- 'Data.HFunctor.Interpret.interpret'.
absorb :: f ~> Proxy
absorb :: forall {k} (f :: k -> *). f ~> Proxy
absorb f x
_ = forall {k} (t :: k). Proxy t
Proxy

-- | Internal type, used to not require dlist-1.0
newtype NDL a = NDL ([a] -> NonEmpty a)

ndlSingleton :: a -> NDL a
ndlSingleton :: forall a. a -> NDL a
ndlSingleton a
x = forall a. ([a] -> NonEmpty a) -> NDL a
NDL (a
xforall a. a -> [a] -> NonEmpty a
:|)

fromNDL :: NDL a -> NonEmpty a
fromNDL :: forall a. NDL a -> NonEmpty a
fromNDL (NDL [a] -> NonEmpty a
f) = [a] -> NonEmpty a
f []

instance Semigroup (NDL a) where
    NDL [a] -> NonEmpty a
x <> :: NDL a -> NDL a -> NDL a
<> NDL [a] -> NonEmpty a
y = forall a. ([a] -> NonEmpty a) -> NDL a
NDL ([a] -> NonEmpty a
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> NonEmpty a
y)

instance HFunctor Coyoneda where
    hmap :: forall (f :: * -> *) (g :: * -> *).
(f ~> g) -> Coyoneda f ~> Coyoneda g
hmap f ~> g
f Coyoneda f x
x = forall (f :: * -> *) (g :: * -> *) b.
(forall a. f a -> g a) -> Coyoneda f b -> Coyoneda g b
hoistCoyoneda f ~> g
f Coyoneda f x
x

-- | @since 0.3.0.0
instance HFunctor CCY.Coyoneda where
    hmap :: forall (f :: * -> *) (g :: * -> *).
(f ~> g) -> Coyoneda f ~> Coyoneda g
hmap f ~> g
f (CCY.Coyoneda x -> b
g f b
x) = forall a b (f :: * -> *). (a -> b) -> f b -> Coyoneda f a
CCY.Coyoneda x -> b
g (f ~> g
f f b
x)

instance HFunctor Ap where
    hmap :: forall (f :: * -> *) (g :: * -> *). (f ~> g) -> Ap f ~> Ap g
hmap f ~> g
f Ap f x
x = forall (f :: * -> *) (g :: * -> *) b.
(forall a. f a -> g a) -> Ap f b -> Ap g b
hoistAp f ~> g
f Ap f x
x

instance HFunctor ListF where
    hmap :: forall (f :: k -> *) (g :: k -> *). (f ~> g) -> ListF f ~> ListF g
hmap f ~> g
f (ListF [f x]
xs) = forall {k} (f :: k -> *) (a :: k). [f a] -> ListF f a
ListF (forall a b. (a -> b) -> [a] -> [b]
map f ~> g
f [f x]
xs)

instance HFunctor NonEmptyF where
    hmap :: forall (f :: k -> *) (g :: k -> *).
(f ~> g) -> NonEmptyF f ~> NonEmptyF g
hmap f ~> g
f (NonEmptyF NonEmpty (f x)
xs) = forall {k} (f :: k -> *) (a :: k). NonEmpty (f a) -> NonEmptyF f a
NonEmptyF (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f ~> g
f NonEmpty (f x)
xs)

instance HFunctor MaybeF where
    hmap :: forall (f :: k -> *) (g :: k -> *).
(f ~> g) -> MaybeF f ~> MaybeF g
hmap f ~> g
f (MaybeF Maybe (f x)
xs) = forall {k} (f :: k -> *) (a :: k). Maybe (f a) -> MaybeF f a
MaybeF (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f ~> g
f Maybe (f x)
xs)

instance HFunctor (MapF k) where
    hmap :: forall (f :: k -> *) (g :: k -> *).
(f ~> g) -> MapF k f ~> MapF k g
hmap f ~> g
f (MapF Map k (f x)
xs) = forall {k} k1 (f :: k -> *) (a :: k). Map k1 (f a) -> MapF k1 f a
MapF (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f ~> g
f Map k (f x)
xs)

instance HFunctor (NEMapF k) where
    hmap :: forall (f :: k -> *) (g :: k -> *).
(f ~> g) -> NEMapF k f ~> NEMapF k g
hmap f ~> g
f (NEMapF NEMap k (f x)
xs) = forall {k} k1 (f :: k -> *) (a :: k).
NEMap k1 (f a) -> NEMapF k1 f a
NEMapF (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f ~> g
f NEMap k (f x)
xs)

instance HFunctor Alt.Alt where
    hmap :: forall (f :: * -> *) (g :: * -> *). (f ~> g) -> Alt f ~> Alt g
hmap f ~> g
f Alt f x
x = forall (f :: * -> *) (g :: * -> *) b.
(forall a. f a -> g a) -> Alt f b -> Alt g b
Alt.hoistAlt f ~> g
f Alt f x
x

-- | @since 0.3.6.0
instance HFunctor Alt.AltF where
    hmap :: forall (f :: * -> *) (g :: * -> *). (f ~> g) -> AltF f ~> AltF g
hmap f ~> g
f = \case
      Alt.Ap f a1
x Alt f (a1 -> x)
xs -> forall (f :: * -> *) a1 a. f a1 -> Alt f (a1 -> a) -> AltF f a
Alt.Ap (f ~> g
f f a1
x) (forall {k} {k} (t :: (k -> *) -> k -> *) (f :: k -> *)
       (g :: k -> *).
HFunctor t =>
(f ~> g) -> t f ~> t g
hmap f ~> g
f Alt f (a1 -> x)
xs)
      Alt.Pure x
x  -> forall a (f :: * -> *). a -> AltF f a
Alt.Pure x
x

instance HFunctor Step where
    hmap :: forall (f :: k -> *) (g :: k -> *). (f ~> g) -> Step f ~> Step g
hmap f ~> g
f (Step Natural
n f x
x) = forall {k} (f :: k -> *) (a :: k). Natural -> f a -> Step f a
Step Natural
n (f ~> g
f f x
x)

instance HFunctor Steps where
    hmap :: forall (f :: k -> *) (g :: k -> *). (f ~> g) -> Steps f ~> Steps g
hmap f ~> g
f (Steps NEMap Natural (f x)
xs) = forall {k} (f :: k -> *) (a :: k). NEMap Natural (f a) -> Steps f a
Steps (f ~> g
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NEMap Natural (f x)
xs)

instance HFunctor Flagged where
    hmap :: forall (f :: k -> *) (g :: k -> *).
(f ~> g) -> Flagged f ~> Flagged g
hmap f ~> g
f (Flagged Bool
b f x
x) = forall {k} (f :: k -> *) (a :: k). Bool -> f a -> Flagged f a
Flagged Bool
b (f ~> g
f f x
x)

instance HFunctor Free where
    hmap :: forall (f :: * -> *) (g :: * -> *). (f ~> g) -> Free f ~> Free g
hmap f ~> g
f Free f x
x = forall (f :: * -> *) (g :: * -> *). (f ~> g) -> Free f ~> Free g
hoistFree f ~> g
f Free f x
x

instance HFunctor Free1 where
    hmap :: forall (f :: * -> *) (g :: * -> *). (f ~> g) -> Free1 f ~> Free1 g
hmap f ~> g
f Free1 f x
x = forall (f :: * -> *) (g :: * -> *). (f ~> g) -> Free1 f ~> Free1 g
hoistFree1 f ~> g
f Free1 f x
x

-- | Note that there is no 'Data.HFunctor.Interpret.Interpret' or
-- 'Data.HFunctor.Bind' instance, because 'Data.HFunctor.inject' requires
-- @'Functor' f@.
instance HFunctor MC.F where
    hmap :: forall (f :: * -> *) (g :: * -> *). (f ~> g) -> F f ~> F g
hmap f ~> g
f F f x
x = forall (f :: * -> *) (g :: * -> *) a.
(forall x. f x -> g x) -> F f a -> F g a
MC.hoistF f ~> g
f F f x
x

-- | Note that there is no 'Data.HFunctor.Interpret.Interpret' or
-- 'Data.HFunctor.Bind' instance, because 'Data.HFunctor.inject' requires
-- @'Functor' f@.
instance HFunctor MaybeT where
    hmap :: forall (f :: * -> *) (g :: * -> *).
(f ~> g) -> MaybeT f ~> MaybeT g
hmap f ~> g
f MaybeT f x
x = forall (m :: * -> *) a (n :: * -> *) b.
(m (Maybe a) -> n (Maybe b)) -> MaybeT m a -> MaybeT n b
mapMaybeT f ~> g
f MaybeT f x
x

instance HFunctor Yoneda where
    hmap :: forall (f :: * -> *) (g :: * -> *).
(f ~> g) -> Yoneda f ~> Yoneda g
hmap f ~> g
f Yoneda f x
x = forall (f :: * -> *) a. (forall b. (a -> b) -> f b) -> Yoneda f a
Yoneda forall a b. (a -> b) -> a -> b
$ f ~> g
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Yoneda f a -> forall b. (a -> b) -> f b
runYoneda Yoneda f x
x

instance HFunctor FA.Ap where
    hmap :: forall (f :: * -> *) (g :: * -> *). (f ~> g) -> Ap f ~> Ap g
hmap f ~> g
f Ap f x
x = forall (f :: * -> *) (g :: * -> *) b.
(forall a. f a -> g a) -> Ap f b -> Ap g b
FA.hoistAp f ~> g
f Ap f x
x

instance HFunctor FAF.Ap where
    hmap :: forall (f :: * -> *) (g :: * -> *). (f ~> g) -> Ap f ~> Ap g
hmap f ~> g
f Ap f x
x = forall (f :: * -> *) (g :: * -> *) a.
(forall x. f x -> g x) -> Ap f a -> Ap g a
FAF.hoistAp f ~> g
f Ap f x
x

instance HFunctor IdentityT where
    hmap :: forall (f :: k -> *) (g :: k -> *).
(f ~> g) -> IdentityT f ~> IdentityT g
hmap f ~> g
f IdentityT f x
x = forall {k1} {k2} (m :: k1 -> *) (a :: k1) (n :: k2 -> *) (b :: k2).
(m a -> n b) -> IdentityT m a -> IdentityT n b
mapIdentityT f ~> g
f IdentityT f x
x

instance HFunctor Lift where
    hmap :: forall (f :: * -> *) (g :: * -> *). (f ~> g) -> Lift f ~> Lift g
hmap f ~> g
f Lift f x
x = forall (f :: * -> *) a (g :: * -> *).
(f a -> g a) -> Lift f a -> Lift g a
mapLift f ~> g
f Lift f x
x

instance HFunctor MaybeApply where
    hmap :: forall (f :: * -> *) (g :: * -> *).
(f ~> g) -> MaybeApply f ~> MaybeApply g
hmap f ~> g
f (MaybeApply Either (f x) x
x) = forall (f :: * -> *) a. Either (f a) a -> MaybeApply f a
MaybeApply (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first f ~> g
f Either (f x) x
x)

instance HFunctor Backwards where
    hmap :: forall (f :: k -> *) (g :: k -> *).
(f ~> g) -> Backwards f ~> Backwards g
hmap f ~> g
f (Backwards f x
x) = forall {k} (f :: k -> *) (a :: k). f a -> Backwards f a
Backwards (f ~> g
f f x
x)

instance HFunctor WrappedApplicative where
    hmap :: forall (f :: * -> *) (g :: * -> *).
(f ~> g) -> WrappedApplicative f ~> WrappedApplicative g
hmap f ~> g
f (WrapApplicative f x
x) = forall (f :: * -> *) a. f a -> WrappedApplicative f a
WrapApplicative (f ~> g
f f x
x)

instance HFunctor (ReaderT r) where
    hmap :: forall (f :: * -> *) (g :: * -> *).
(f ~> g) -> ReaderT r f ~> ReaderT r g
hmap f ~> g
f ReaderT r f x
x = forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT f ~> g
f ReaderT r f x
x

instance HFunctor Tagged where
    hmap :: forall (f :: k -> *) (g :: k -> *).
(f ~> g) -> Tagged f ~> Tagged g
hmap f ~> g
_ Tagged f x
x = coerce :: forall a b. Coercible a b => a -> b
coerce Tagged f x
x

instance HFunctor Reverse where
    hmap :: forall (f :: k -> *) (g :: k -> *).
(f ~> g) -> Reverse f ~> Reverse g
hmap f ~> g
f (Reverse f x
x) = forall {k} (f :: k -> *) (a :: k). f a -> Reverse f a
Reverse (f ~> g
f f x
x)

instance (HFunctor s, HFunctor t) => HFunctor (ComposeT s t) where
    hmap :: forall (f :: * -> *) (g :: * -> *).
(f ~> g) -> ComposeT s t f ~> ComposeT s t g
hmap f ~> g
f (ComposeT s (t f) x
x) = forall (f :: (* -> *) -> * -> *) (g :: (* -> *) -> * -> *)
       (m :: * -> *) a.
f (g m) a -> ComposeT f g m a
ComposeT forall a b. (a -> b) -> a -> b
$ forall {k} {k} (t :: (k -> *) -> k -> *) (f :: k -> *)
       (g :: k -> *).
HFunctor t =>
(f ~> g) -> t f ~> t g
hmap (forall {k} {k} (t :: (k -> *) -> k -> *) (f :: k -> *)
       (g :: k -> *).
HFunctor t =>
(f ~> g) -> t f ~> t g
hmap f ~> g
f) s (t f) x
x

instance Functor f => HFunctor ((:.:) f) where
    hmap :: forall (f :: k -> *) (g :: k -> *).
(f ~> g) -> (f :.: f) ~> (f :.: g)
hmap f ~> g
f (Comp1 f (f x)
x) = forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
f (g p) -> (:.:) f g p
Comp1 (f ~> g
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (f x)
x)

instance HFunctor (M1 i c) where
    hmap :: forall (f :: k -> *) (g :: k -> *).
(f ~> g) -> M1 i c f ~> M1 i c g
hmap f ~> g
f (M1 f x
x) = forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f ~> g
f f x
x)

instance HFunctor Void2 where
    hmap :: forall (f :: k -> *) (g :: k -> *). (f ~> g) -> Void2 f ~> Void2 g
hmap f ~> g
_ Void2 f x
x = coerce :: forall a b. Coercible a b => a -> b
coerce Void2 f x
x

instance HFunctor (EnvT e) where
    hmap :: forall (f :: * -> *) (g :: * -> *).
(f ~> g) -> EnvT e f ~> EnvT e g
hmap f ~> g
f (EnvT e
e f x
x) = forall e (w :: * -> *) a. e -> w a -> EnvT e w a
EnvT e
e (f ~> g
f f x
x)

instance HFunctor Rec where
    hmap :: forall (f :: k -> *) (g :: k -> *). (f ~> g) -> Rec f ~> Rec g
hmap f ~> g
f Rec f x
x = forall {u} (f :: u -> *) (g :: u -> *) (rs :: [u]).
(forall (x :: u). f x -> g x) -> Rec f rs -> Rec g rs
rmap f ~> g
f Rec f x
x

instance HFunctor CoRec where
    hmap :: forall (f :: k -> *) (g :: k -> *). (f ~> g) -> CoRec f ~> CoRec g
hmap f ~> g
f (CoRec f a1
x) = forall {k} (a1 :: k) (b :: [k]) (a :: k -> *).
RElem a1 b (RIndex a1 b) =>
a a1 -> CoRec a b
CoRec (f ~> g
f f a1
x)

-- | @since 0.3.0.0
instance HFunctor SOP.NP where
    hmap :: forall (f :: k -> *) (g :: k -> *). (f ~> g) -> NP f ~> NP g
hmap f ~> g
f = forall {k} (r :: [k] -> *) (f :: k -> *) (xs :: [k]).
r '[]
-> (forall (y :: k) (ys :: [k]). f y -> r ys -> r (y : ys))
-> NP f xs
-> r xs
SOP.cata_NP forall {k} (a :: k -> *). NP a '[]
SOP.Nil (forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
(SOP.:*) forall b c a. (b -> c) -> (a -> b) -> a -> c
. f ~> g
f)

-- | @since 0.3.0.0
instance HFunctor SOP.NS where
    hmap :: forall (f :: k -> *) (g :: k -> *). (f ~> g) -> NS f ~> NS g
hmap f ~> g
f = forall {k} (r :: [k] -> *) (f :: k -> *) (xs :: [k]).
(forall (y :: k) (ys :: [k]). f y -> r (y : ys))
-> (forall (y :: k) (ys :: [k]). r ys -> r (y : ys))
-> NS f xs
-> r xs
SOP.cata_NS (forall {k} (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
SOP.Z forall b c a. (b -> c) -> (a -> b) -> a -> c
. f ~> g
f) forall {k} (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
SOP.S

instance HFunctor (Joker f) where
    hmap :: forall (f :: k -> *) (g :: k -> *).
(f ~> g) -> Joker f f ~> Joker f g
hmap f ~> g
_ Joker f f x
x = coerce :: forall a b. Coercible a b => a -> b
coerce Joker f f x
x

instance HFunctor (Void3 f) where
    hmap :: forall (f :: k -> *) (g :: k -> *).
(f ~> g) -> Void3 f f ~> Void3 f g
hmap f ~> g
_ = \case {}

instance HFunctor (Comp f) where
    hmap :: forall (f :: k -> *) (g :: k -> *).
(f ~> g) -> Comp f f ~> Comp f g
hmap f ~> g
f (f x
x :>>= x -> f x
h) = f x
x forall {k} (f :: * -> *) (g :: k -> *) (a :: k) x.
f x -> (x -> g a) -> Comp f g a
:>>= (f ~> g
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> f x
h)

instance HBifunctor (:*:) where
    hleft :: forall (f :: k -> *) (j :: k -> *) (g :: k -> *).
(f ~> j) -> (f :*: g) ~> (j :*: g)
hleft  f ~> j
f (f x
x :*: g x
y) = f ~> j
f f x
x forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*:   g x
y
    hright :: forall (g :: k -> *) (l :: k -> *) (f :: k -> *).
(g ~> l) -> (f :*: g) ~> (f :*: l)
hright g ~> l
g (f x
x :*: g x
y) =   f x
x forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: g ~> l
g g x
y
    hbimap :: forall (f :: k -> *) (j :: k -> *) (g :: k -> *) (l :: k -> *).
(f ~> j) -> (g ~> l) -> (f :*: g) ~> (j :*: l)
hbimap f ~> j
f g ~> l
g (f x
x :*: g x
y) = f ~> j
f f x
x forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: g ~> l
g g x
y

instance HBifunctor Product where
    hleft :: forall (f :: k -> *) (j :: k -> *) (g :: k -> *).
(f ~> j) -> Product f g ~> Product j g
hleft  f ~> j
f (Pair f x
x g x
y)   = forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair (f ~> j
f f x
x)    g x
y
    hright :: forall (g :: k -> *) (l :: k -> *) (f :: k -> *).
(g ~> l) -> Product f g ~> Product f l
hright g ~> l
g (Pair f x
x g x
y)   = forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair    f x
x  (g ~> l
g g x
y)
    hbimap :: forall (f :: k -> *) (j :: k -> *) (g :: k -> *) (l :: k -> *).
(f ~> j) -> (g ~> l) -> Product f g ~> Product j l
hbimap f ~> j
f g ~> l
g (Pair f x
x g x
y) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair (f ~> j
f f x
x) (g ~> l
g g x
y)

instance HBifunctor Day where
    hleft :: forall (f :: * -> *) (j :: * -> *) (g :: * -> *).
(f ~> j) -> Day f g ~> Day j g
hleft f ~> j
f Day f g x
x = forall (f :: * -> *) (g :: * -> *) (h :: * -> *) a.
(forall x. f x -> g x) -> Day f h a -> Day g h a
D.trans1 f ~> j
f Day f g x
x
    hright :: forall (g :: * -> *) (l :: * -> *) (f :: * -> *).
(g ~> l) -> Day f g ~> Day f l
hright g ~> l
f Day f g x
x = forall (g :: * -> *) (h :: * -> *) (f :: * -> *) a.
(forall x. g x -> h x) -> Day f g a -> Day f h a
D.trans2 g ~> l
f Day f g x
x
    hbimap :: forall (f :: * -> *) (j :: * -> *) (g :: * -> *) (l :: * -> *).
(f ~> j) -> (g ~> l) -> Day f g ~> Day j l
hbimap f ~> j
f g ~> l
g (Day f b
x g c
y b -> c -> x
z) = forall (f :: * -> *) (g :: * -> *) a b c.
f b -> g c -> (b -> c -> a) -> Day f g a
Day (f ~> j
f f b
x) (g ~> l
g g c
y) b -> c -> x
z

-- | @since 0.3.0.0
instance HBifunctor CD.Day where
    hleft :: forall (f :: * -> *) (j :: * -> *) (g :: * -> *).
(f ~> j) -> Day f g ~> Day j g
hleft f ~> j
f Day f g x
x = forall (f :: * -> *) (g :: * -> *) (h :: * -> *) a.
(forall x. f x -> g x) -> Day f h a -> Day g h a
CD.trans1 f ~> j
f Day f g x
x
    hright :: forall (g :: * -> *) (l :: * -> *) (f :: * -> *).
(g ~> l) -> Day f g ~> Day f l
hright g ~> l
f Day f g x
x = forall (g :: * -> *) (h :: * -> *) (f :: * -> *) a.
(forall x. g x -> h x) -> Day f g a -> Day f h a
CD.trans2 g ~> l
f Day f g x
x
    hbimap :: forall (f :: * -> *) (j :: * -> *) (g :: * -> *) (l :: * -> *).
(f ~> j) -> (g ~> l) -> Day f g ~> Day j l
hbimap f ~> j
f g ~> l
g (CD.Day f b
x g c
y x -> (b, c)
z) = forall (f :: * -> *) (g :: * -> *) a b c.
f b -> g c -> (a -> (b, c)) -> Day f g a
CD.Day (f ~> j
f f b
x) (g ~> l
g g c
y) x -> (b, c)
z

-- | @since 0.3.4.0
instance HBifunctor ID.Day where
    hbimap :: forall (f :: * -> *) (j :: * -> *) (g :: * -> *) (l :: * -> *).
(f ~> j) -> (g ~> l) -> Day f g ~> Day j l
hbimap f ~> j
f g ~> l
g (ID.Day f b
x g c
y b -> c -> x
h x -> (b, c)
j) = forall (f :: * -> *) (g :: * -> *) a b c.
f b -> g c -> (b -> c -> a) -> (a -> (b, c)) -> Day f g a
ID.Day (f ~> j
f f b
x) (g ~> l
g g c
y) b -> c -> x
h x -> (b, c)
j

instance HBifunctor IN.Night where
    hbimap :: forall (f :: * -> *) (j :: * -> *) (g :: * -> *) (l :: * -> *).
(f ~> j) -> (g ~> l) -> Night f g ~> Night j l
hbimap f ~> j
f g ~> l
g (IN.Night f b1
x g c1
y b1 -> x
h c1 -> x
j x -> Either b1 c1
k) = forall (a :: * -> *) b1 (b :: * -> *) c1 c.
a b1
-> b c1
-> (b1 -> c)
-> (c1 -> c)
-> (c -> Either b1 c1)
-> Night a b c
IN.Night (f ~> j
f f b1
x) (g ~> l
g g c1
y) b1 -> x
h c1 -> x
j x -> Either b1 c1
k

-- | @since 0.3.0.0
instance HBifunctor Night where
    hleft :: forall (f :: * -> *) (j :: * -> *) (g :: * -> *).
(f ~> j) -> Night f g ~> Night j g
hleft f ~> j
f Night f g x
x = forall (f :: * -> *) (j :: * -> *) (g :: * -> *).
(f ~> j) -> Night f g ~> Night j g
N.trans1 f ~> j
f Night f g x
x
    hright :: forall (g :: * -> *) (l :: * -> *) (f :: * -> *).
(g ~> l) -> Night f g ~> Night f l
hright g ~> l
f Night f g x
x = forall (g :: * -> *) (l :: * -> *) (f :: * -> *).
(g ~> l) -> Night f g ~> Night f l
N.trans2 g ~> l
f Night f g x
x
    hbimap :: forall (f :: * -> *) (j :: * -> *) (g :: * -> *) (l :: * -> *).
(f ~> j) -> (g ~> l) -> Night f g ~> Night j l
hbimap f ~> j
f g ~> l
g (Night f b1
x g c1
y x -> Either b1 c1
z) = forall (a :: * -> *) b1 (b :: * -> *) c1 c.
a b1 -> b c1 -> (c -> Either b1 c1) -> Night a b c
Night (f ~> j
f f b1
x) (g ~> l
g g c1
y) x -> Either b1 c1
z

instance HBifunctor (:+:) where
    hleft :: forall (f :: k -> *) (j :: k -> *) (g :: k -> *).
(f ~> j) -> (f :+: g) ~> (j :+: g)
hleft f ~> j
f = \case
      L1 f x
x -> forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (f ~> j
f f x
x)
      R1 g x
y -> forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 g x
y

    hright :: forall (g :: k -> *) (l :: k -> *) (f :: k -> *).
(g ~> l) -> (f :+: g) ~> (f :+: l)
hright g ~> l
g = \case
      L1 f x
x -> forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 f x
x
      R1 g x
y -> forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (g ~> l
g g x
y)

    hbimap :: forall (f :: k -> *) (j :: k -> *) (g :: k -> *) (l :: k -> *).
(f ~> j) -> (g ~> l) -> (f :+: g) ~> (j :+: l)
hbimap f ~> j
f g ~> l
g = \case
      L1 f x
x -> forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (f ~> j
f f x
x)
      R1 g x
y -> forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (g ~> l
g g x
y)

instance HBifunctor Sum where
    hleft :: forall (f :: k -> *) (j :: k -> *) (g :: k -> *).
(f ~> j) -> Sum f g ~> Sum j g
hleft f ~> j
f = \case
      InL f x
x -> forall {k} (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
InL (f ~> j
f f x
x)
      InR g x
y -> forall {k} (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
InR g x
y

    hright :: forall (g :: k -> *) (l :: k -> *) (f :: k -> *).
(g ~> l) -> Sum f g ~> Sum f l
hright g ~> l
g = \case
      InL f x
x -> forall {k} (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
InL f x
x
      InR g x
y -> forall {k} (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
InR (g ~> l
g g x
y)

    hbimap :: forall (f :: k -> *) (j :: k -> *) (g :: k -> *) (l :: k -> *).
(f ~> j) -> (g ~> l) -> Sum f g ~> Sum j l
hbimap f ~> j
f g ~> l
g = \case
      InL f x
x -> forall {k} (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
InL (f ~> j
f f x
x)
      InR g x
y -> forall {k} (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
InR (g ~> l
g g x
y)

instance HBifunctor These1 where
    hbimap :: forall (f :: * -> *) (j :: * -> *) (g :: * -> *) (l :: * -> *).
(f ~> j) -> (g ~> l) -> These1 f g ~> These1 j l
hbimap f ~> j
f g ~> l
g = \case
      This1  f x
x   -> forall (f :: * -> *) (g :: * -> *) a. f a -> These1 f g a
This1  (f ~> j
f f x
x)
      That1    g x
y -> forall (f :: * -> *) (g :: * -> *) a. g a -> These1 f g a
That1        (g ~> l
g g x
y)
      These1 f x
x g x
y -> forall (f :: * -> *) (g :: * -> *) a. f a -> g a -> These1 f g a
These1 (f ~> j
f f x
x) (g ~> l
g g x
y)

instance HBifunctor Joker where
    hleft :: forall (f :: k -> *) (j :: k -> *) (g :: k -> *).
(f ~> j) -> Joker f g ~> Joker j g
hleft  f ~> j
f   (Joker f x
x) = forall {k} {k1} (g :: k -> *) (a :: k1) (b :: k).
g b -> Joker g a b
Joker (f ~> j
f f x
x)
    hright :: forall (g :: k -> *) (l :: k -> *) (f :: k -> *).
(g ~> l) -> Joker f g ~> Joker f l
hright   g ~> l
_           = coerce :: forall a b. Coercible a b => a -> b
coerce
    hbimap :: forall (f :: k -> *) (j :: k -> *) (g :: k -> *) (l :: k -> *).
(f ~> j) -> (g ~> l) -> Joker f g ~> Joker j l
hbimap f ~> j
f g ~> l
_ (Joker f x
x) = forall {k} {k1} (g :: k -> *) (a :: k1) (b :: k).
g b -> Joker g a b
Joker (f ~> j
f f x
x)

instance HBifunctor Void3 where
    hleft :: forall (f :: k -> *) (j :: k -> *) (g :: k -> *).
(f ~> j) -> Void3 f g ~> Void3 j g
hleft  f ~> j
_   = coerce :: forall a b. Coercible a b => a -> b
coerce
    hright :: forall (g :: k -> *) (l :: k -> *) (f :: k -> *).
(g ~> l) -> Void3 f g ~> Void3 f l
hright   g ~> l
_ = coerce :: forall a b. Coercible a b => a -> b
coerce
    hbimap :: forall (f :: k -> *) (j :: k -> *) (g :: k -> *) (l :: k -> *).
(f ~> j) -> (g ~> l) -> Void3 f g ~> Void3 j l
hbimap f ~> j
_ g ~> l
_ = coerce :: forall a b. Coercible a b => a -> b
coerce

instance HBifunctor Comp where
    hleft :: forall (f :: * -> *) (j :: * -> *) (g :: * -> *).
(f ~> j) -> Comp f g ~> Comp j g
hleft  f ~> j
f   (f x
x :>>= x -> g x
h) = f ~> j
f f x
x forall {k} (f :: * -> *) (g :: k -> *) (a :: k) x.
f x -> (x -> g a) -> Comp f g a
:>>= x -> g x
h
    hright :: forall (g :: * -> *) (l :: * -> *) (f :: * -> *).
(g ~> l) -> Comp f g ~> Comp f l
hright   g ~> l
g (f x
x :>>= x -> g x
h) =   f x
x forall {k} (f :: * -> *) (g :: k -> *) (a :: k) x.
f x -> (x -> g a) -> Comp f g a
:>>= (g ~> l
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> g x
h)
    hbimap :: forall (f :: * -> *) (j :: * -> *) (g :: * -> *) (l :: * -> *).
(f ~> j) -> (g ~> l) -> Comp f g ~> Comp j l
hbimap f ~> j
f g ~> l
g (f x
x :>>= x -> g x
h) = f ~> j
f f x
x forall {k} (f :: * -> *) (g :: k -> *) (a :: k) x.
f x -> (x -> g a) -> Comp f g a
:>>= (g ~> l
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> g x
h)

instance HBifunctor t => HFunctor (WrappedHBifunctor t f) where
    hmap :: forall (f :: k -> *) (g :: k -> *).
(f ~> g) -> WrappedHBifunctor t f f ~> WrappedHBifunctor t f g
hmap f ~> g
f = forall k (t :: (k -> *) -> (k -> *) -> k -> *) (f :: k -> *)
       (g :: k -> *) (a :: k).
t f g a -> WrappedHBifunctor t f g a
WrapHBifunctor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (t :: (k -> *) -> (k -> *) -> k -> *) (g :: k -> *)
       (l :: k -> *) (f :: k -> *).
HBifunctor t =>
(g ~> l) -> t f g ~> t f l
hright f ~> g
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (t :: (k -> *) -> (k -> *) -> k -> *) (f :: k -> *)
       (g :: k -> *) (a :: k).
WrappedHBifunctor t f g a -> t f g a
unwrapHBifunctor

deriving via (WrappedHBifunctor Day f)      instance HFunctor (Day f)
deriving via (WrappedHBifunctor ID.Day f)   instance HFunctor (ID.Day f)
deriving via (WrappedHBifunctor IN.Night f) instance HFunctor (IN.Night f)
deriving via (WrappedHBifunctor (:*:) f)    instance HFunctor ((:*:) f)
deriving via (WrappedHBifunctor (:+:) f)    instance HFunctor ((:+:) f)
deriving via (WrappedHBifunctor Product f)  instance HFunctor (Product f)
deriving via (WrappedHBifunctor Sum f)      instance HFunctor (Sum f)
deriving via (WrappedHBifunctor These1 f)   instance HFunctor (These1 f)