    {-# LANGUAGE CPP #-}
    {-# LANGUAGE PolyKinds #-}
    {-# LANGUAGE RankNTypes #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE TypeOperators #-}

    {-# LANGUAGE Trustworthy #-}

    -----------------------------------------------------------------------------
    -- |
    -- Copyright   :  (C) 2011-2015 Edward Kmett,
    -- License     :  BSD-style (see the file LICENSE)
    --
    -- Maintainer  :  Edward Kmett <ekmett@gmail.com>
    -- Stability   :  provisional
    -- Portability :  portable
    --
    -- For a good explanation of profunctors in Haskell see Dan Piponi's article:
    --
    -- <http://blog.sigfpe.com/2011/07/profunctors-in-haskell.html>
    --
    -- For more information on strength and costrength, see:
    --
    -- <http://comonad.com/reader/2008/deriving-strength-from-laziness/>
    ----------------------------------------------------------------------------
    module Data.Profunctor.Types
      ( Profunctor(dimap, lmap, rmap)
      , Star(..)
      , Costar(..)
      , WrappedArrow(..)
      , Forget(..)
      , (:->)
      ) where

    import Control.Applicative hiding (WrappedArrow(..))
    import Control.Arrow
    import Control.Category
    import Control.Comonad
    import Control.Monad (MonadPlus(..), (>=>))
    import Data.Coerce (Coercible, coerce)
    import Data.Distributive
    import Data.Foldable
    import Data.Functor.Contravariant
    import Data.Profunctor.Unsafe
    import Data.Traversable
    import Prelude hiding (id,(.))

    #if !(MIN_VERSION_base(4,11,0))
    import Data.Semigroup (Semigroup(..))
    #endif

    infixr 0 :->

    -- | (':->') has a polymorphic kind since @5.6@.

    -- (:->) :: forall k1 k2. (k1 -> k2 -> Type) -> (k1 -> k2 -> Type) -> Type
    type p :-> q = forall a b. p a b -> q a b

    ------------------------------------------------------------------------------
    -- Star
    ------------------------------------------------------------------------------

    -- | Lift a 'Functor' into a 'Profunctor' (forwards).
    --
    -- 'Star' has a polymorphic kind since @5.6@.

    -- Star :: (k -> Type) -> (Type -> k -> Type)
    newtype Star f d c = Star { forall {k} (f :: k -> *) d (c :: k). Star f d c -> d -> f c
    runStar :: d -> f c }

    instance Functor f => Profunctor (Star f) where
      dimap :: forall a b c d. (a -> b) -> (c -> d) -> Star f b c -> Star f a d
    dimap a -> b
    ab c -> d
    cd (Star b -> f c
    bfc) = (a -> f d) -> Star f a d
    forall {k} (f :: k -> *) d (c :: k). (d -> f c) -> Star f d c
    Star ((c -> d) -> f c -> f d
    forall a b. (a -> b) -> f a -> f b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap c -> d
    cd (f c -> f d) -> (a -> f c) -> a -> f d
    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
    . b -> f c
    bfc (b -> f c) -> (a -> b) -> a -> f c
    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
    . a -> b
    ab)
      {-# INLINE dimap #-}
      lmap :: forall a b c. (a -> b) -> Star f b c -> Star f a c
    lmap a -> b
    k (Star b -> f c
    f) = (a -> f c) -> Star f a c
    forall {k} (f :: k -> *) d (c :: k). (d -> f c) -> Star f d c
    Star (b -> f c
    f (b -> f c) -> (a -> b) -> a -> f c
    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
    . a -> b
    k)
      {-# INLINE lmap #-}
      rmap :: forall b c a. (b -> c) -> Star f a b -> Star f a c
    rmap b -> c
    k (Star a -> f b
    f) = (a -> f c) -> Star f a c
    forall {k} (f :: k -> *) d (c :: k). (d -> f c) -> Star f d c
    Star ((b -> c) -> f b -> f c
    forall a b. (a -> b) -> f a -> f b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap b -> c
    k (f b -> f c) -> (a -> f b) -> a -> f c
    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
    . a -> f b
    f)
      {-# INLINE rmap #-}
      -- We cannot safely overload (#.) because we didn't write the 'Functor'.
      Star f b c
    p .# :: forall a b c (q :: * -> * -> *).
    Coercible b a =>
    Star f b c -> q a b -> Star f a c
    .# q a b
    _ = Star f b c -> Star f a c
    forall a b. Coercible a b => a -> b
    coerce Star f b c
    p
      {-# INLINE (.#) #-}

    instance Functor f => Functor (Star f a) where
      fmap :: forall a b. (a -> b) -> Star f a a -> Star f a b
    fmap = (a -> b) -> Star f a a -> Star f a b
    forall b c a. (b -> c) -> Star f a b -> Star f a c
    forall (p :: * -> * -> *) b c a.
    Profunctor p =>
    (b -> c) -> p a b -> p a c
    rmap
      {-# INLINE fmap #-}

    instance Applicative f => Applicative (Star f a) where
      pure :: forall a. a -> Star f a a
    pure a
    a = (a -> f a) -> Star f a a
    forall {k} (f :: k -> *) d (c :: k). (d -> f c) -> Star f d c
    Star ((a -> f a) -> Star f a a) -> (a -> f a) -> Star f a a
    forall a b. (a -> b) -> a -> b
    $ \a
    _ -> a -> f a
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure a
    a
      Star a -> f (a -> b)
    ff <*> :: forall a b. Star f a (a -> b) -> Star f a a -> Star f a b
    <*> Star a -> f a
    fx = (a -> f b) -> Star f a b
    forall {k} (f :: k -> *) d (c :: k). (d -> f c) -> Star f d c
    Star ((a -> f b) -> Star f a b) -> (a -> f b) -> Star f a b
    forall a b. (a -> b) -> a -> b
    $ \a
    a -> a -> f (a -> b)
    ff a
    a f (a -> b) -> f a -> f b
    forall a b. f (a -> b) -> f a -> f b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> a -> f a
    fx a
    a
      Star a -> f a
    ff  *> :: forall a b. Star f a a -> Star f a b -> Star f a b
    *> Star a -> f b
    fx = (a -> f b) -> Star f a b
    forall {k} (f :: k -> *) d (c :: k). (d -> f c) -> Star f d c
    Star ((a -> f b) -> Star f a b) -> (a -> f b) -> Star f a b
    forall a b. (a -> b) -> a -> b
    $ \a
    a -> a -> f a
    ff a
    a  f a -> f b -> f b
    forall a b. f a -> f b -> f b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> a -> f b
    fx a
    a
      Star a -> f a
    ff <* :: forall a b. Star f a a -> Star f a b -> Star f a a
    <*  Star a -> f b
    fx = (a -> f a) -> Star f a a
    forall {k} (f :: k -> *) d (c :: k). (d -> f c) -> Star f d c
    Star ((a -> f a) -> Star f a a) -> (a -> f a) -> Star f a a
    forall a b. (a -> b) -> a -> b
    $ \a
    a -> a -> f a
    ff a
    a f a -> f b -> f a
    forall a b. f a -> f b -> f a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <*  a -> f b
    fx a
    a

    instance Alternative f => Alternative (Star f a) where
      empty :: forall a. Star f a a
    empty = (a -> f a) -> Star f a a
    forall {k} (f :: k -> *) d (c :: k). (d -> f c) -> Star f d c
    Star ((a -> f a) -> Star f a a) -> (a -> f a) -> Star f a a
    forall a b. (a -> b) -> a -> b
    $ \a
    _ -> f a
    forall a. f a
    forall (f :: * -> *) a. Alternative f => f a
    empty
      Star a -> f a
    f <|> :: forall a. Star f a a -> Star f a a -> Star f a a
    <|> Star a -> f a
    g = (a -> f a) -> Star f a a
    forall {k} (f :: k -> *) d (c :: k). (d -> f c) -> Star f d c
    Star ((a -> f a) -> Star f a a) -> (a -> f a) -> Star f a a
    forall a b. (a -> b) -> a -> b
    $ \a
    a -> a -> f a
    f a
    a f a -> f a -> f a
    forall a. f a -> f a -> f a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> a -> f a
    g a
    a

    instance Monad f => Monad (Star f a) where
      Star a -> f a
    m >>= :: forall a b. Star f a a -> (a -> Star f a b) -> Star f a b
    >>= a -> Star f a b
    f = (a -> f b) -> Star f a b
    forall {k} (f :: k -> *) d (c :: k). (d -> f c) -> Star f d c
    Star ((a -> f b) -> Star f a b) -> (a -> f b) -> Star f a b
    forall a b. (a -> b) -> a -> b
    $ \ a
    e -> do
        a <- a -> f a
    m a
    e
        runStar (f a) e

    instance MonadPlus f => MonadPlus (Star f a) where
      mzero :: forall a. Star f a a
    mzero = (a -> f a) -> Star f a a
    forall {k} (f :: k -> *) d (c :: k). (d -> f c) -> Star f d c
    Star ((a -> f a) -> Star f a a) -> (a -> f a) -> Star f a a
    forall a b. (a -> b) -> a -> b
    $ \a
    _ -> f a
    forall a. f a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero
      Star a -> f a
    f mplus :: forall a. Star f a a -> Star f a a -> Star f a a
    `mplus` Star a -> f a
    g = (a -> f a) -> Star f a a
    forall {k} (f :: k -> *) d (c :: k). (d -> f c) -> Star f d c
    Star ((a -> f a) -> Star f a a) -> (a -> f a) -> Star f a a
    forall a b. (a -> b) -> a -> b
    $ \a
    a -> a -> f a
    f a
    a f a -> f a -> f a
    forall a. f a -> f a -> f a
    forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
    `mplus` a -> f a
    g a
    a

    instance Distributive f => Distributive (Star f a) where
      distribute :: forall (f :: * -> *) a.
    Functor f =>
    f (Star f a a) -> Star f a (f a)
    distribute f (Star f a a)
    fs = (a -> f (f a)) -> Star f a (f a)
    forall {k} (f :: k -> *) d (c :: k). (d -> f c) -> Star f d c
    Star ((a -> f (f a)) -> Star f a (f a))
    -> (a -> f (f a)) -> Star f a (f a)
    forall a b. (a -> b) -> a -> b
    $ \a
    a -> (Star f a a -> f a) -> f (Star f a a) -> f (f a)
    forall (g :: * -> *) (f :: * -> *) a b.
    (Distributive g, Functor f) =>
    (a -> g b) -> f a -> g (f b)
    forall (f :: * -> *) a b. Functor f => (a -> f b) -> f a -> f (f b)
    collect (((a -> f a) -> a -> f a
    forall a b. (a -> b) -> a -> b
    $ a
    a) ((a -> f a) -> f a)
    -> (Star f a a -> a -> f a) -> Star f a a -> f a
    forall a b c (q :: * -> * -> *).
    Coercible b a =>
    (b -> c) -> q a b -> a -> c
    forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
    (Profunctor p, Coercible b a) =>
    p b c -> q a b -> p a c
    .# Star f a a -> a -> f a
    forall {k} (f :: k -> *) d (c :: k). Star f d c -> d -> f c
    runStar) f (Star f a a)
    fs

    instance Monad f => Category (Star f) where
      id :: forall a. Star f a a
    id = (a -> f a) -> Star f a a
    forall {k} (f :: k -> *) d (c :: k). (d -> f c) -> Star f d c
    Star a -> f a
    forall a. a -> f a
    forall (m :: * -> *) a. Monad m => a -> m a
    return
      Star b -> f c
    f . :: forall b c a. Star f b c -> Star f a b -> Star f a c
    . Star a -> f b
    g = (a -> f c) -> Star f a c
    forall {k} (f :: k -> *) d (c :: k). (d -> f c) -> Star f d c
    Star ((a -> f c) -> Star f a c) -> (a -> f c) -> Star f a c
    forall a b. (a -> b) -> a -> b
    $ a -> f b
    g (a -> f b) -> (b -> f c) -> a -> f c
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=> b -> f c
    f

    instance Contravariant f => Contravariant (Star f a) where
      contramap :: forall a' a. (a' -> a) -> Star f a a -> Star f a a'
    contramap a' -> a
    f (Star a -> f a
    g) = (a -> f a') -> Star f a a'
    forall {k} (f :: k -> *) d (c :: k). (d -> f c) -> Star f d c
    Star ((a' -> a) -> f a -> f a'
    forall a' a. (a' -> a) -> f a -> f a'
    forall (f :: * -> *) a' a.
    Contravariant f =>
    (a' -> a) -> f a -> f a'
    contramap a' -> a
    f (f a -> f a') -> (a -> f a) -> a -> f 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
    . a -> f a
    g)
      {-# INLINE contramap #-}

    ------------------------------------------------------------------------------
    -- Costar
    ------------------------------------------------------------------------------

    -- | Lift a 'Functor' into a 'Profunctor' (backwards).
    --
    -- 'Costar' has a polymorphic kind since @5.6@.

    -- Costar :: (k -> Type) -> k -> Type -> Type
    newtype Costar f d c = Costar { forall {k} (f :: k -> *) (d :: k) c. Costar f d c -> f d -> c
    runCostar :: f d -> c }

    instance Functor f => Profunctor (Costar f) where
      dimap :: forall a b c d.
    (a -> b) -> (c -> d) -> Costar f b c -> Costar f a d
    dimap a -> b
    ab c -> d
    cd (Costar f b -> c
    fbc) = (f a -> d) -> Costar f a d
    forall {k} (f :: k -> *) (d :: k) c. (f d -> c) -> Costar f d c
    Costar (c -> d
    cd (c -> d) -> (f a -> c) -> f a -> d
    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
    . f b -> c
    fbc (f b -> c) -> (f a -> f b) -> f a -> c
    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
    . (a -> b) -> f a -> f b
    forall a b. (a -> b) -> f a -> f b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> b
    ab)
      {-# INLINE dimap #-}
      lmap :: forall a b c. (a -> b) -> Costar f b c -> Costar f a c
    lmap a -> b
    k (Costar f b -> c
    f) = (f a -> c) -> Costar f a c
    forall {k} (f :: k -> *) (d :: k) c. (f d -> c) -> Costar f d c
    Costar (f b -> c
    f (f b -> c) -> (f a -> f b) -> f a -> c
    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
    . (a -> b) -> f a -> f b
    forall a b. (a -> b) -> f a -> f b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> b
    k)
      {-# INLINE lmap #-}
      rmap :: forall b c a. (b -> c) -> Costar f a b -> Costar f a c
    rmap b -> c
    k (Costar f a -> b
    f) = (f a -> c) -> Costar f a c
    forall {k} (f :: k -> *) (d :: k) c. (f d -> c) -> Costar f d c
    Costar (b -> c
    k (b -> c) -> (f a -> b) -> f a -> c
    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
    . f a -> b
    f)
      {-# INLINE rmap #-}
      #. :: forall a b c (q :: * -> * -> *).
    Coercible c b =>
    q b c -> Costar f a b -> Costar f a c
    (#.) q b c
    _ = (b -> b) -> a -> b
    forall a b. Coercible a b => a -> b
    coerce (\b
    x -> b
    x :: b) :: forall a b. Coercible b a => a -> b
      {-# INLINE (#.) #-}
      -- We cannot overload (.#) because we didn't write the 'Functor'.

    instance Distributive (Costar f d) where
      distribute :: forall (f :: * -> *) a.
    Functor f =>
    f (Costar f d a) -> Costar f d (f a)
    distribute f (Costar f d a)
    fs = (f d -> f a) -> Costar f d (f a)
    forall {k} (f :: k -> *) (d :: k) c. (f d -> c) -> Costar f d c
    Costar ((f d -> f a) -> Costar f d (f a))
    -> (f d -> f a) -> Costar f d (f a)
    forall a b. (a -> b) -> a -> b
    $ \f d
    gd -> (Costar f d a -> a) -> f (Costar f d a) -> f a
    forall a b. (a -> b) -> f a -> f b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (((f d -> a) -> f d -> a
    forall a b. (a -> b) -> a -> b
    $ f d
    gd) ((f d -> a) -> a)
    -> (Costar f d a -> f d -> a) -> Costar f d a -> a
    forall a b c (q :: * -> * -> *).
    Coercible b a =>
    (b -> c) -> q a b -> a -> c
    forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
    (Profunctor p, Coercible b a) =>
    p b c -> q a b -> p a c
    .# Costar f d a -> f d -> a
    forall {k} (f :: k -> *) (d :: k) c. Costar f d c -> f d -> c
    runCostar) f (Costar f d a)
    fs

    instance Functor (Costar f a) where
      fmap :: forall a b. (a -> b) -> Costar f a a -> Costar f a b
    fmap a -> b
    k (Costar f a -> a
    f) = (f a -> b) -> Costar f a b
    forall {k} (f :: k -> *) (d :: k) c. (f d -> c) -> Costar f d c
    Costar (a -> b
    k (a -> b) -> (f a -> a) -> f a -> b
    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
    . f a -> a
    f)
      {-# INLINE fmap #-}
      a
    a <$ :: forall a b. a -> Costar f a b -> Costar f a a
    <$ Costar f a b
    _ = (f a -> a) -> Costar f a a
    forall {k} (f :: k -> *) (d :: k) c. (f d -> c) -> Costar f d c
    Costar ((f a -> a) -> Costar f a a) -> (f a -> a) -> Costar f a a
    forall a b. (a -> b) -> a -> b
    $ \f a
    _ -> a
    a
      {-# INLINE (<$) #-}

    instance Applicative (Costar f a) where
      pure :: forall a. a -> Costar f a a
    pure a
    a = (f a -> a) -> Costar f a a
    forall {k} (f :: k -> *) (d :: k) c. (f d -> c) -> Costar f d c
    Costar ((f a -> a) -> Costar f a a) -> (f a -> a) -> Costar f a a
    forall a b. (a -> b) -> a -> b
    $ \f a
    _ -> a
    a
      Costar f a -> a -> b
    ff <*> :: forall a b. Costar f a (a -> b) -> Costar f a a -> Costar f a b
    <*> Costar f a -> a
    fx = (f a -> b) -> Costar f a b
    forall {k} (f :: k -> *) (d :: k) c. (f d -> c) -> Costar f d c
    Costar ((f a -> b) -> Costar f a b) -> (f a -> b) -> Costar f a b
    forall a b. (a -> b) -> a -> b
    $ \f a
    a -> f a -> a -> b
    ff f a
    a (f a -> a
    fx f a
    a)
      Costar f a a
    _ *> :: forall a b. Costar f a a -> Costar f a b -> Costar f a b
    *> Costar f a b
    m = Costar f a b
    m
      Costar f a a
    m <* :: forall a b. Costar f a a -> Costar f a b -> Costar f a a
    <* Costar f a b
    _ = Costar f a a
    m

    instance Monad (Costar f a) where
      return :: forall a. a -> Costar f a a
    return = a -> Costar f a a
    forall a. a -> Costar f a a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
      Costar f a -> a
    m >>= :: forall a b. Costar f a a -> (a -> Costar f a b) -> Costar f a b
    >>= a -> Costar f a b
    f = (f a -> b) -> Costar f a b
    forall {k} (f :: k -> *) (d :: k) c. (f d -> c) -> Costar f d c
    Costar ((f a -> b) -> Costar f a b) -> (f a -> b) -> Costar f a b
    forall a b. (a -> b) -> a -> b
    $ \ f a
    x -> Costar f a b -> f a -> b
    forall {k} (f :: k -> *) (d :: k) c. Costar f d c -> f d -> c
    runCostar (a -> Costar f a b
    f (f a -> a
    m f a
    x)) f a
    x

    ------------------------------------------------------------------------------
    -- Wrapped Profunctors
    ------------------------------------------------------------------------------

    -- | Wrap an arrow for use as a 'Profunctor'.
    --
    -- 'WrappedArrow' has a polymorphic kind since @5.6@.

    -- WrappedArrow :: (k1 -> k2 -> Type) -> (k1 -> k2 -> Type)
    newtype WrappedArrow p a b = WrapArrow { forall {k} {k} (p :: k -> k -> *) (a :: k) (b :: k).
    WrappedArrow p a b -> p a b
    unwrapArrow :: p a b }

    instance Category p => Category (WrappedArrow p) where
      WrapArrow p b c
    f . :: forall (b :: k) (c :: k) (a :: k).
    WrappedArrow p b c -> WrappedArrow p a b -> WrappedArrow p a c
    . WrapArrow p a b
    g = p a c -> WrappedArrow p a c
    forall {k} {k} (p :: k -> k -> *) (a :: k) (b :: k).
    p a b -> WrappedArrow p a b
    WrapArrow (p b c
    f p b c -> p a b -> p a c
    forall (b :: k) (c :: k) (a :: k). p b c -> p a b -> p a c
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . p a b
    g)
      {-# INLINE (.) #-}
      id :: forall (a :: k). WrappedArrow p a a
    id = p a a -> WrappedArrow p a a
    forall {k} {k} (p :: k -> k -> *) (a :: k) (b :: k).
    p a b -> WrappedArrow p a b
    WrapArrow p a a
    forall (a :: k). p a a
    forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
    id
      {-# INLINE id #-}

    instance Arrow p => Arrow (WrappedArrow p) where
      arr :: forall b c. (b -> c) -> WrappedArrow p b c
    arr = p b c -> WrappedArrow p b c
    forall {k} {k} (p :: k -> k -> *) (a :: k) (b :: k).
    p a b -> WrappedArrow p a b
    WrapArrow (p b c -> WrappedArrow p b c)
    -> ((b -> c) -> p b c) -> (b -> c) -> WrappedArrow p b c
    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
    . (b -> c) -> p b c
    forall b c. (b -> c) -> p b c
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
    arr
      {-# INLINE arr #-}
      first :: forall b c d. WrappedArrow p b c -> WrappedArrow p (b, d) (c, d)
    first = p (b, d) (c, d) -> WrappedArrow p (b, d) (c, d)
    forall {k} {k} (p :: k -> k -> *) (a :: k) (b :: k).
    p a b -> WrappedArrow p a b
    WrapArrow (p (b, d) (c, d) -> WrappedArrow p (b, d) (c, d))
    -> (WrappedArrow p b c -> p (b, d) (c, d))
    -> WrappedArrow p b c
    -> WrappedArrow p (b, d) (c, d)
    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
    . p b c -> p (b, d) (c, d)
    forall b c d. p b c -> p (b, d) (c, d)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first (p b c -> p (b, d) (c, d))
    -> (WrappedArrow p b c -> p b c)
    -> WrappedArrow p b c
    -> p (b, d) (c, d)
    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
    . WrappedArrow p b c -> p b c
    forall {k} {k} (p :: k -> k -> *) (a :: k) (b :: k).
    WrappedArrow p a b -> p a b
    unwrapArrow
      {-# INLINE first #-}
      second :: forall b c d. WrappedArrow p b c -> WrappedArrow p (d, b) (d, c)
    second = p (d, b) (d, c) -> WrappedArrow p (d, b) (d, c)
    forall {k} {k} (p :: k -> k -> *) (a :: k) (b :: k).
    p a b -> WrappedArrow p a b
    WrapArrow (p (d, b) (d, c) -> WrappedArrow p (d, b) (d, c))
    -> (WrappedArrow p b c -> p (d, b) (d, c))
    -> WrappedArrow p b c
    -> WrappedArrow p (d, b) (d, c)
    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
    . p b c -> p (d, b) (d, c)
    forall b c d. p b c -> p (d, b) (d, c)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (d, b) (d, c)
    second (p b c -> p (d, b) (d, c))
    -> (WrappedArrow p b c -> p b c)
    -> WrappedArrow p b c
    -> p (d, b) (d, c)
    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
    . WrappedArrow p b c -> p b c
    forall {k} {k} (p :: k -> k -> *) (a :: k) (b :: k).
    WrappedArrow p a b -> p a b
    unwrapArrow
      {-# INLINE second #-}
      WrapArrow p b c
    a *** :: forall b c b' c'.
    WrappedArrow p b c
    -> WrappedArrow p b' c' -> WrappedArrow p (b, b') (c, c')
    *** WrapArrow p b' c'
    b = p (b, b') (c, c') -> WrappedArrow p (b, b') (c, c')
    forall {k} {k} (p :: k -> k -> *) (a :: k) (b :: k).
    p a b -> WrappedArrow p a b
    WrapArrow (p b c
    a p b c -> p b' c' -> p (b, b') (c, c')
    forall b c b' c'. p b c -> p b' c' -> p (b, b') (c, c')
    forall (a :: * -> * -> *) b c b' c'.
    Arrow a =>
    a b c -> a b' c' -> a (b, b') (c, c')
    *** p b' c'
    b)
      {-# INLINE (***) #-}
      WrapArrow p b c
    a &&& :: forall b c c'.
    WrappedArrow p b c
    -> WrappedArrow p b c' -> WrappedArrow p b (c, c')
    &&& WrapArrow p b c'
    b = p b (c, c') -> WrappedArrow p b (c, c')
    forall {k} {k} (p :: k -> k -> *) (a :: k) (b :: k).
    p a b -> WrappedArrow p a b
    WrapArrow (p b c
    a p b c -> p b c' -> p b (c, c')
    forall b c c'. p b c -> p b c' -> p b (c, c')
    forall (a :: * -> * -> *) b c c'.
    Arrow a =>
    a b c -> a b c' -> a b (c, c')
    &&& p b c'
    b)
      {-# INLINE (&&&) #-}

    instance ArrowZero p => ArrowZero (WrappedArrow p) where
      zeroArrow :: forall b c. WrappedArrow p b c
    zeroArrow = p b c -> WrappedArrow p b c
    forall {k} {k} (p :: k -> k -> *) (a :: k) (b :: k).
    p a b -> WrappedArrow p a b
    WrapArrow p b c
    forall b c. p b c
    forall (a :: * -> * -> *) b c. ArrowZero a => a b c
    zeroArrow
      {-# INLINE zeroArrow #-}

    instance ArrowChoice p => ArrowChoice (WrappedArrow p) where
      left :: forall b c d.
    WrappedArrow p b c -> WrappedArrow p (Either b d) (Either c d)
    left = p (Either b d) (Either c d)
    -> WrappedArrow p (Either b d) (Either c d)
    forall {k} {k} (p :: k -> k -> *) (a :: k) (b :: k).
    p a b -> WrappedArrow p a b
    WrapArrow (p (Either b d) (Either c d)
     -> WrappedArrow p (Either b d) (Either c d))
    -> (WrappedArrow p b c -> p (Either b d) (Either c d))
    -> WrappedArrow p b c
    -> WrappedArrow p (Either b d) (Either c d)
    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
    . p b c -> p (Either b d) (Either c d)
    forall b c d. p b c -> p (Either b d) (Either c d)
    forall (a :: * -> * -> *) b c d.
    ArrowChoice a =>
    a b c -> a (Either b d) (Either c d)
    left (p b c -> p (Either b d) (Either c d))
    -> (WrappedArrow p b c -> p b c)
    -> WrappedArrow p b c
    -> p (Either b d) (Either c d)
    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
    . WrappedArrow p b c -> p b c
    forall {k} {k} (p :: k -> k -> *) (a :: k) (b :: k).
    WrappedArrow p a b -> p a b
    unwrapArrow
      {-# INLINE left #-}
      right :: forall b c d.
    WrappedArrow p b c -> WrappedArrow p (Either d b) (Either d c)
    right = p (Either d b) (Either d c)
    -> WrappedArrow p (Either d b) (Either d c)
    forall {k} {k} (p :: k -> k -> *) (a :: k) (b :: k).
    p a b -> WrappedArrow p a b
    WrapArrow (p (Either d b) (Either d c)
     -> WrappedArrow p (Either d b) (Either d c))
    -> (WrappedArrow p b c -> p (Either d b) (Either d c))
    -> WrappedArrow p b c
    -> WrappedArrow p (Either d b) (Either d c)
    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
    . p b c -> p (Either d b) (Either d c)
    forall b c d. p b c -> p (Either d b) (Either d c)
    forall (a :: * -> * -> *) b c d.
    ArrowChoice a =>
    a b c -> a (Either d b) (Either d c)
    right (p b c -> p (Either d b) (Either d c))
    -> (WrappedArrow p b c -> p b c)
    -> WrappedArrow p b c
    -> p (Either d b) (Either d c)
    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
    . WrappedArrow p b c -> p b c
    forall {k} {k} (p :: k -> k -> *) (a :: k) (b :: k).
    WrappedArrow p a b -> p a b
    unwrapArrow
      {-# INLINE right #-}
      WrapArrow p b c
    a +++ :: forall b c b' c'.
    WrappedArrow p b c
    -> WrappedArrow p b' c'
    -> WrappedArrow p (Either b b') (Either c c')
    +++ WrapArrow p b' c'
    b = p (Either b b') (Either c c')
    -> WrappedArrow p (Either b b') (Either c c')
    forall {k} {k} (p :: k -> k -> *) (a :: k) (b :: k).
    p a b -> WrappedArrow p a b
    WrapArrow (p b c
    a p b c -> p b' c' -> p (Either b b') (Either c c')
    forall b c b' c'. p b c -> p b' c' -> p (Either b b') (Either c c')
    forall (a :: * -> * -> *) b c b' c'.
    ArrowChoice a =>
    a b c -> a b' c' -> a (Either b b') (Either c c')
    +++ p b' c'
    b)
      {-# INLINE (+++) #-}
      WrapArrow p b d
    a ||| :: forall b d c.
    WrappedArrow p b d
    -> WrappedArrow p c d -> WrappedArrow p (Either b c) d
    ||| WrapArrow p c d
    b = p (Either b c) d -> WrappedArrow p (Either b c) d
    forall {k} {k} (p :: k -> k -> *) (a :: k) (b :: k).
    p a b -> WrappedArrow p a b
    WrapArrow (p b d
    a p b d -> p c d -> p (Either b c) d
    forall b d c. p b d -> p c d -> p (Either b c) d
    forall (a :: * -> * -> *) b d c.
    ArrowChoice a =>
    a b d -> a c d -> a (Either b c) d
    ||| p c d
    b)
      {-# INLINE (|||) #-}

    instance ArrowApply p => ArrowApply (WrappedArrow p) where
      app :: forall b c. WrappedArrow p (WrappedArrow p b c, b) c
    app = p (WrappedArrow p b c, b) c
    -> WrappedArrow p (WrappedArrow p b c, b) c
    forall {k} {k} (p :: k -> k -> *) (a :: k) (b :: k).
    p a b -> WrappedArrow p a b
    WrapArrow (p (WrappedArrow p b c, b) c
     -> WrappedArrow p (WrappedArrow p b c, b) c)
    -> p (WrappedArrow p b c, b) c
    -> WrappedArrow p (WrappedArrow p b c, b) c
    forall a b. (a -> b) -> a -> b
    $ p (p b c, b) c
    forall b c. p (p b c, b) c
    forall (a :: * -> * -> *) b c. ArrowApply a => a (a b c, b) c
    app p (p b c, b) c
    -> p (WrappedArrow p b c, b) (p b c, b)
    -> p (WrappedArrow p b c, b) c
    forall b c a. p b c -> p a b -> p a c
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . ((WrappedArrow p b c, b) -> (p b c, b))
    -> p (WrappedArrow p b c, b) (p b c, b)
    forall b c. (b -> c) -> p b c
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
    arr ((WrappedArrow p b c -> p b c)
    -> (WrappedArrow p b c, b) -> (p b c, b)
    forall b c d. (b -> c) -> (b, d) -> (c, d)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first WrappedArrow p b c -> p b c
    forall {k} {k} (p :: k -> k -> *) (a :: k) (b :: k).
    WrappedArrow p a b -> p a b
    unwrapArrow)
      {-# INLINE app #-}

    instance ArrowLoop p => ArrowLoop (WrappedArrow p) where
      loop :: forall b d c. WrappedArrow p (b, d) (c, d) -> WrappedArrow p b c
    loop = p b c -> WrappedArrow p b c
    forall {k} {k} (p :: k -> k -> *) (a :: k) (b :: k).
    p a b -> WrappedArrow p a b
    WrapArrow (p b c -> WrappedArrow p b c)
    -> (WrappedArrow p (b, d) (c, d) -> p b c)
    -> WrappedArrow p (b, d) (c, d)
    -> WrappedArrow p b c
    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
    . p (b, d) (c, d) -> p b c
    forall b d c. p (b, d) (c, d) -> p b c
    forall (a :: * -> * -> *) b d c.
    ArrowLoop a =>
    a (b, d) (c, d) -> a b c
    loop (p (b, d) (c, d) -> p b c)
    -> (WrappedArrow p (b, d) (c, d) -> p (b, d) (c, d))
    -> WrappedArrow p (b, d) (c, d)
    -> p b c
    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
    . WrappedArrow p (b, d) (c, d) -> p (b, d) (c, d)
    forall {k} {k} (p :: k -> k -> *) (a :: k) (b :: k).
    WrappedArrow p a b -> p a b
    unwrapArrow
      {-# INLINE loop #-}

    instance Arrow p => Profunctor (WrappedArrow p) where
      lmap :: forall a b c. (a -> b) -> WrappedArrow p b c -> WrappedArrow p a c
    lmap = (a -> b) -> WrappedArrow p b c -> WrappedArrow p a c
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    (b -> c) -> a c d -> a b d
    (^>>)
      {-# INLINE lmap #-}
      rmap :: forall b c a. (b -> c) -> WrappedArrow p a b -> WrappedArrow p a c
    rmap = (b -> c) -> WrappedArrow p a b -> WrappedArrow p a c
    forall (a :: * -> * -> *) c d b.
    Arrow a =>
    (c -> d) -> a b c -> a b d
    (^<<)
      {-# INLINE rmap #-}
      -- We cannot safely overload (#.) or (.#) because we didn't write the 'Arrow'.

    ------------------------------------------------------------------------------
    -- Forget
    ------------------------------------------------------------------------------

    -- | 'Forget' has a polymorphic kind since @5.6@.

    -- Forget :: Type -> Type -> k -> Type
    newtype Forget r a b = Forget { forall {k} r a (b :: k). Forget r a b -> a -> r
    runForget :: a -> r }

    instance Profunctor (Forget r) where
      dimap :: forall a b c d.
    (a -> b) -> (c -> d) -> Forget r b c -> Forget r a d
    dimap a -> b
    f c -> d
    _ (Forget b -> r
    k) = (a -> r) -> Forget r a d
    forall {k} r a (b :: k). (a -> r) -> Forget r a b
    Forget (b -> r
    k (b -> r) -> (a -> b) -> a -> r
    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
    . a -> b
    f)
      {-# INLINE dimap #-}
      lmap :: forall a b c. (a -> b) -> Forget r b c -> Forget r a c
    lmap a -> b
    f (Forget b -> r
    k) = (a -> r) -> Forget r a c
    forall {k} r a (b :: k). (a -> r) -> Forget r a b
    Forget (b -> r
    k (b -> r) -> (a -> b) -> a -> r
    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
    . a -> b
    f)
      {-# INLINE lmap #-}
      rmap :: forall b c a. (b -> c) -> Forget r a b -> Forget r a c
    rmap b -> c
    _ (Forget a -> r
    k) = (a -> r) -> Forget r a c
    forall {k} r a (b :: k). (a -> r) -> Forget r a b
    Forget a -> r
    k
      {-# INLINE rmap #-}

    instance Functor (Forget r a) where
      fmap :: forall a b. (a -> b) -> Forget r a a -> Forget r a b
    fmap a -> b
    _ (Forget a -> r
    k) = (a -> r) -> Forget r a b
    forall {k} r a (b :: k). (a -> r) -> Forget r a b
    Forget a -> r
    k
      {-# INLINE fmap #-}

    instance Foldable (Forget r a) where
      foldMap :: forall m a. Monoid m => (a -> m) -> Forget r a a -> m
    foldMap a -> m
    _ Forget r a a
    _ = m
    forall a. Monoid a => a
    mempty
      {-# INLINE foldMap #-}

    instance Traversable (Forget r a) where
      traverse :: forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Forget r a a -> f (Forget r a b)
    traverse a -> f b
    _ (Forget a -> r
    k) = Forget r a b -> f (Forget r a b)
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ((a -> r) -> Forget r a b
    forall {k} r a (b :: k). (a -> r) -> Forget r a b
    Forget a -> r
    k)
      {-# INLINE traverse #-}

    instance Contravariant (Forget r a) where
      contramap :: forall a' a. (a' -> a) -> Forget r a a -> Forget r a a'
    contramap a' -> a
    _ (Forget a -> r
    k) = (a -> r) -> Forget r a a'
    forall {k} r a (b :: k). (a -> r) -> Forget r a b
    Forget a -> r
    k
      {-# INLINE contramap #-}

    -- | Via @Semigroup r => (a -> r)@
    --
    -- @since 5.6.2
    instance Semigroup r => Semigroup (Forget r a b) where
      Forget a -> r
    f <> :: Forget r a b -> Forget r a b -> Forget r a b
    <> Forget a -> r
    g = (a -> r) -> Forget r a b
    forall {k} r a (b :: k). (a -> r) -> Forget r a b
    Forget (a -> r
    f (a -> r) -> (a -> r) -> a -> r
    forall a. Semigroup a => a -> a -> a
    <> a -> r
    g)
      {-# INLINE (<>) #-}

    -- | Via @Monoid r => (a -> r)@
    --
    -- @since 5.6.2
    instance Monoid r => Monoid (Forget r a b) where
      mempty :: Forget r a b
    mempty = (a -> r) -> Forget r a b
    forall {k} r a (b :: k). (a -> r) -> Forget r a b
    Forget a -> r
    forall a. Monoid a => a
    mempty
      {-# INLINE mempty #-}
    #if !(MIN_VERSION_base(4,11,0))
      mappend (Forget f) (Forget g) = Forget (mappend f g)
      {-# INLINE mappend #-}
    #endif