    {-# LANGUAGE CPP #-}
    {-# LANGUAGE Rank2Types #-}
    {-# LANGUAGE TypeFamilies #-}
    {-# LANGUAGE TypeOperators #-}
    #if __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL__ <= 708
    {-# LANGUAGE Trustworthy #-}
    #endif
    -----------------------------------------------------------------------------
    -- |
    -- Copyright   :  (C) 2013-2015 Edward Kmett and Dan Doel
    -- License     :  BSD-style (see the file LICENSE)
    --
    -- Maintainer  :  Edward Kmett <ekmett@gmail.com>
    -- Stability   :  provisional
    -- Portability :  Rank2Types, TFs
    --
    ----------------------------------------------------------------------------
    module Data.Profunctor.Ran
      ( Ran(..)
      , decomposeRan
      , precomposeRan
      , curryRan
      , uncurryRan
      , Codensity(..)
      , decomposeCodensity
      ) where

    import Control.Category
    import Data.Profunctor
    import Data.Profunctor.Composition
    import Data.Profunctor.Monad
    import Data.Profunctor.Unsafe
    import Prelude hiding (id,(.))

    --------------------------------------------------------------------------------
    -- * Ran
    --------------------------------------------------------------------------------

    -- | This represents the right Kan extension of a 'Profunctor' @q@ along a 'Profunctor' @p@ in a limited version of the 2-category of Profunctors where the only object is the category Hask, 1-morphisms are profunctors composed and compose with Profunctor composition, and 2-morphisms are just natural transformations.
    newtype Ran p q a b = Ran { runRan :: forall x. p x a -> q x b }

    instance ProfunctorFunctor (Ran p) where
      promap f (Ran g) = Ran (f . g)

    instance Category p => ProfunctorComonad (Ran p) where
      proextract (Ran f) = f id
      produplicate (Ran f) = Ran $ \ p -> Ran $ \q -> f (p . q)

    instance (Profunctor p, Profunctor q) => Profunctor (Ran p q) where
      dimap ca bd f = Ran (rmap bd . runRan f . rmap ca)
      {-# INLINE dimap #-}
      lmap ca f = Ran (runRan f . rmap ca)
      {-# INLINE lmap #-}
      rmap bd f = Ran (rmap bd . runRan f)
      {-# INLINE rmap #-}
      bd #. f = Ran (\p -> bd #. runRan f p)
      {-# INLINE ( #. ) #-}
      f .# ca = Ran (\p -> runRan f (ca #. p))
      {-# INLINE (.#) #-}

    instance Profunctor q => Functor (Ran p q a) where
      fmap bd f = Ran (rmap bd . runRan f)
      {-# INLINE fmap #-}

    -- | @'Ran' p p@ forms a 'Monad' in the 'Profunctor' 2-category, which is isomorphic to a Haskell 'Category' instance.
    instance p ~ q => Category (Ran p q) where
      id = Ran id
      {-# INLINE id #-}
      Ran f . Ran g = Ran (f . g)
      {-# INLINE (.) #-}

    -- | The 2-morphism that defines a right Kan extension.
    --
    -- Note: When @q@ is left adjoint to @'Ran' q (->)@ then 'decomposeRan' is the 'counit' of the adjunction.
    decomposeRan :: Procompose (Ran q p) q :-> p
    decomposeRan (Procompose (Ran qp) q) = qp q
    {-# INLINE decomposeRan #-}

    precomposeRan :: Profunctor q => Procompose q (Ran p (->)) :-> Ran p q
    precomposeRan (Procompose p pf) = Ran (\pxa -> runRan pf pxa `lmap` p)
    {-# INLINE precomposeRan #-}

    curryRan :: (Procompose p q :-> r) -> p :-> Ran q r
    curryRan f p = Ran $ \q -> f (Procompose p q)
    {-# INLINE curryRan #-}

    uncurryRan :: (p :-> Ran q r) -> Procompose p q :-> r
    uncurryRan f (Procompose p q) = runRan (f p) q
    {-# INLINE uncurryRan #-}

    --------------------------------------------------------------------------------
    -- * Codensity
    --------------------------------------------------------------------------------

    -- | This represents the right Kan extension of a 'Profunctor' @p@ along itself. This provides a generalization of the \"difference list\" trick to profunctors.
    newtype Codensity p a b = Codensity { runCodensity :: forall x. p x a -> p x b }

    instance Profunctor p => Profunctor (Codensity p) where
      dimap ca bd f = Codensity (rmap bd . runCodensity f . rmap ca)
      {-# INLINE dimap #-}
      lmap ca f = Codensity (runCodensity f . rmap ca)
      {-# INLINE lmap #-}
      rmap bd f = Codensity (rmap bd . runCodensity f)
      {-# INLINE rmap #-}
      bd #. f = Codensity (\p -> bd #. runCodensity f p)
      {-# INLINE ( #. ) #-}
      f .# ca = Codensity (\p -> runCodensity f (ca #. p))
      {-# INLINE (.#) #-}

    instance Profunctor p => Functor (Codensity p a) where
      fmap bd f = Codensity (rmap bd . runCodensity f)
      {-# INLINE fmap #-}

    instance Category (Codensity p) where
      id = Codensity id
      {-# INLINE id #-}
      Codensity f . Codensity g = Codensity (f . g)
      {-# INLINE (.) #-}

    decomposeCodensity :: Procompose (Codensity p) p a b -> p a b
    decomposeCodensity (Procompose (Codensity pp) p) = pp p
    {-# INLINE decomposeCodensity #-}