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

    {-# 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.Monoid hiding (Product)
    import Data.Profunctor.Unsafe
    import Data.Traversable
    import Prelude hiding (id,(.))

    infixr 0 :->
    type p :-> q = forall a b. p a b -> q a b

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

    -- | Lift a 'Functor' into a 'Profunctor' (forwards).
    newtype Star f d c = Star { Star f d c -> d -> f c
    runStar :: d -> f c }

    instance Functor f => Profunctor (Star f) where
      dimap :: (a -> b) -> (c -> d) -> Star f b c -> Star f a d
    dimap ab :: a -> b
    ab cd :: c -> d
    cd (Star bfc :: b -> f c
    bfc) = (a -> f d) -> Star f a d
    forall (f :: * -> *) d c. (d -> f c) -> Star f d c
    Star ((c -> d) -> f c -> f d
    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 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 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 :: (a -> b) -> Star f b c -> Star f a c
    lmap k :: a -> b
    k (Star f :: b -> f c
    f) = (a -> f c) -> Star f a c
    forall (f :: * -> *) d c. (d -> f c) -> Star f d c
    Star (b -> f c
    f (b -> f c) -> (a -> b) -> a -> f 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 :: (b -> c) -> Star f a b -> Star f a c
    rmap k :: b -> c
    k (Star f :: a -> f b
    f) = (a -> f c) -> Star f a c
    forall (f :: * -> *) d c. (d -> f c) -> Star f d c
    Star ((b -> c) -> f b -> f c
    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 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'.
      p :: Star f b c
    p .# :: Star f b c -> q a b -> Star f a c
    .# _ = 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 :: (a -> b) -> Star f a a -> Star f a b
    fmap = (a -> b) -> Star f a a -> Star f a b
    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 :: a -> Star f a a
    pure a :: a
    a = (a -> f a) -> Star f a a
    forall (f :: * -> *) d c. (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 (f :: * -> *) a. Applicative f => a -> f a
    pure a
    a
      Star ff :: a -> f (a -> b)
    ff <*> :: Star f a (a -> b) -> Star f a a -> Star f a b
    <*> Star fx :: a -> f a
    fx = (a -> f b) -> Star f a b
    forall (f :: * -> *) d c. (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 -> a -> f (a -> b)
    ff a
    a 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 ff :: a -> f a
    ff  *> :: Star f a a -> Star f a b -> Star f a b
    *> Star fx :: a -> f b
    fx = (a -> f b) -> Star f a b
    forall (f :: * -> *) d c. (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 -> a -> f a
    ff a
    a  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 ff :: a -> f a
    ff <* :: Star f a a -> Star f a b -> Star f a a
    <*  Star fx :: a -> f b
    fx = (a -> f a) -> Star f a a
    forall (f :: * -> *) d c. (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 -> a -> f a
    ff a
    a 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 :: Star f a a
    empty = (a -> f a) -> Star f a a
    forall (f :: * -> *) d c. (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
    $ \_ -> f a
    forall (f :: * -> *) a. Alternative f => f a
    empty
      Star f :: a -> f a
    f <|> :: Star f a a -> Star f a a -> Star f a a
    <|> Star g :: a -> f a
    g = (a -> f a) -> Star f a a
    forall (f :: * -> *) d c. (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 -> a -> f a
    f a
    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
    #if __GLASGOW_HASKELL__ < 710
      return a = Star $ \_ -> return a
    #endif
      Star m :: a -> f a
    m >>= :: Star f a a -> (a -> Star f a b) -> Star f a b
    >>= f :: a -> Star f a b
    f = (a -> f b) -> Star f a b
    forall (f :: * -> *) d c. (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
    $ \ e :: a
    e -> do
        a
    a <- a -> f a
    m a
    e
        Star f a b -> a -> f b
    forall (f :: * -> *) d c. Star f d c -> d -> f c
    runStar (a -> Star f a b
    f a
    a) a
    e

    instance MonadPlus f => MonadPlus (Star f a) where
      mzero :: Star f a a
    mzero = (a -> f a) -> Star f a a
    forall (f :: * -> *) d c. (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
    $ \_ -> f a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero
      Star f :: a -> f a
    f mplus :: Star f a a -> Star f a a -> Star f a a
    `mplus` Star g :: a -> f a
    g = (a -> f a) -> Star f a a
    forall (f :: * -> *) d c. (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 -> a -> f a
    f a
    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 :: f (Star f a a) -> Star f a (f a)
    distribute fs :: f (Star f a a)
    fs = (a -> f (f a)) -> Star f a (f a)
    forall (f :: * -> *) d c. (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
    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)
    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 (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 (f :: * -> *) d c. Star f d c -> d -> f c
    runStar) f (Star f a a)
    fs

    instance Monad f => Category (Star f) where
      id :: Star f a a
    id = (a -> f a) -> Star f a a
    forall (f :: * -> *) d c. (d -> f c) -> Star f d c
    Star a -> f a
    forall (m :: * -> *) a. Monad m => a -> m a
    return
      Star f :: b -> f c
    f . :: Star f b c -> Star f a b -> Star f a c
    . Star g :: a -> f b
    g = (a -> f c) -> Star f a c
    forall (f :: * -> *) d c. (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 :: (a -> b) -> Star f a b -> Star f a a
    contramap f :: a -> b
    f (Star g :: a -> f b
    g) = (a -> f a) -> Star f a a
    forall (f :: * -> *) d c. (d -> f c) -> Star f d c
    Star ((a -> b) -> f b -> f a
    forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
    contramap a -> b
    f (f b -> f a) -> (a -> f b) -> a -> f a
    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
    g)
      {-# INLINE contramap #-}

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

    -- | Lift a 'Functor' into a 'Profunctor' (backwards).
    newtype Costar f d c = Costar { Costar f d c -> f d -> c
    runCostar :: f d -> c }

    instance Functor f => Profunctor (Costar f) where
      dimap :: (a -> b) -> (c -> d) -> Costar f b c -> Costar f a d
    dimap ab :: a -> b
    ab cd :: c -> d
    cd (Costar fbc :: f b -> c
    fbc) = (f a -> d) -> Costar f a d
    forall (f :: * -> *) d c. (f d -> c) -> Costar f d c
    Costar (c -> d
    cd (c -> d) -> (f a -> c) -> f a -> d
    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 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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> b
    ab)
      {-# INLINE dimap #-}
      lmap :: (a -> b) -> Costar f b c -> Costar f a c
    lmap k :: a -> b
    k (Costar f :: f b -> c
    f) = (f a -> c) -> Costar f a c
    forall (f :: * -> *) d c. (f d -> c) -> Costar f d c
    Costar (f b -> c
    f (f b -> c) -> (f a -> f b) -> f 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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> b
    k)
      {-# INLINE lmap #-}
      rmap :: (b -> c) -> Costar f a b -> Costar f a c
    rmap k :: b -> c
    k (Costar f :: f a -> b
    f) = (f a -> c) -> Costar f a c
    forall (f :: * -> *) d c. (f d -> c) -> Costar f d c
    Costar (b -> c
    k (b -> c) -> (f a -> b) -> f 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 #-}
      #. :: q b c -> Costar f a b -> Costar f a c
    (#.) _ = (b -> b) -> a -> b
    forall a b. Coercible a b => a -> b
    coerce (\x :: 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 :: f (Costar f d a) -> Costar f d (f a)
    distribute fs :: f (Costar f d a)
    fs = (f d -> f a) -> Costar f d (f a)
    forall (f :: * -> *) d 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
    $ \gd :: f d
    gd -> (Costar f d a -> a) -> f (Costar f d a) -> f a
    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 (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 (f :: * -> *) d c. Costar f d c -> f d -> c
    runCostar) f (Costar f d a)
    fs

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

    instance Applicative (Costar f a) where
      pure :: a -> Costar f a a
    pure a :: a
    a = (f a -> a) -> Costar f a a
    forall (f :: * -> *) d 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
    $ \_ -> a
    a
      Costar ff :: f a -> a -> b
    ff <*> :: Costar f a (a -> b) -> Costar f a a -> Costar f a b
    <*> Costar fx :: f a -> a
    fx = (f a -> b) -> Costar f a b
    forall (f :: * -> *) d 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
    $ \a :: f a
    a -> f a -> a -> b
    ff f a
    a (f a -> a
    fx f a
    a)
      _ *> :: Costar f a a -> Costar f a b -> Costar f a b
    *> m :: Costar f a b
    m = Costar f a b
    m
      m :: Costar f a a
    m <* :: Costar f a a -> Costar f a b -> Costar f a a
    <* _ = Costar f a a
    m

    instance Monad (Costar f a) where
      return :: a -> Costar f a a
    return = a -> Costar f a a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
      Costar m :: f a -> a
    m >>= :: Costar f a a -> (a -> Costar f a b) -> Costar f a b
    >>= f :: a -> Costar f a b
    f = (f a -> b) -> Costar f a b
    forall (f :: * -> *) d 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
    $ \ x :: f a
    x -> Costar f a b -> f a -> b
    forall (f :: * -> *) d 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'.
    newtype WrappedArrow p a b = WrapArrow { WrappedArrow p a b -> p a b
    unwrapArrow :: p a b }

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

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

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

    instance Arrow p => Profunctor (WrappedArrow p) where
      lmap :: (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 :: (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
    ------------------------------------------------------------------------------

    newtype Forget r a b = Forget { Forget r a b -> a -> r
    runForget :: a -> r }

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

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

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

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

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