{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE TypeFamilies #-}

#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
#endif
#include "kan-extensions-common.h"

-----------------------------------------------------------------------------
-- |
-- Copyright   :  (C) 2011-2016 Edward Kmett
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  Edward Kmett <[email protected]>
-- Stability   :  provisional
-- Portability :  GADTs, MPTCs, fundeps
--
-- @'Coyoneda' f@ is the "free functor" over @f@.
-- The co-Yoneda lemma for a covariant 'Functor' @f@ states that @'Coyoneda' f@
-- is naturally isomorphic to @f@.
----------------------------------------------------------------------------
module Data.Functor.Coyoneda
  ( Coyoneda(..)
  , liftCoyoneda, lowerCoyoneda, lowerM, hoistCoyoneda
  -- * as a Left Kan extension
  , coyonedaToLan, lanToCoyoneda
  ) where

import Control.Applicative as A
import Control.Monad (MonadPlus(..), liftM)
import Control.Monad.Fix
import Control.Monad.Trans.Class
import Control.Comonad
import Control.Comonad.Trans.Class
import Data.Distributive
#if !LIFTED_FUNCTOR_CLASSES
import Data.Function (on)
#endif
import Data.Functor.Adjunction
import Data.Functor.Bind
import Data.Functor.Classes
import Data.Functor.Extend
import Data.Functor.Identity
import Data.Functor.Kan.Lan
import Data.Functor.Plus
import Data.Functor.Rep
import Data.Foldable
import Data.Traversable
import Data.Semigroup.Foldable
import Data.Semigroup.Traversable
import Prelude hiding (sequence, lookup, zipWith)
import Text.Read hiding (lift)

-- | A covariant 'Functor' suitable for Yoneda reduction
--
data Coyoneda f a where
  Coyoneda :: (b -> a) -> f b -> Coyoneda f a

-- | @Coyoneda f@ is the left Kan extension of @f@ along the 'Identity' functor.
--
-- @Coyoneda f@ is always a functor, even if @f@ is not. In this case, it
-- is called the /free functor over @f@/. Note the following categorical fine
-- print: If @f@ is not a functor, @Coyoneda f@ is actually not the left Kan
-- extension of @f@ along the 'Identity' functor, but along the inclusion
-- functor from the discrete subcategory of /Hask/ which contains only identity
-- functions as morphisms to the full category /Hask/. (This is because @f@,
-- not being a proper functor, can only be interpreted as a categorical functor
-- by restricting the source category to only contain identities.)
--
-- @
-- 'coyonedaToLan' . 'lanToCoyoneda' ≡ 'id'
-- 'lanToCoyoneda' . 'coyonedaToLan' ≡ 'id'
-- @
coyonedaToLan :: Coyoneda f a -> Lan Identity f a
coyonedaToLan :: forall (f :: * -> *) a. Coyoneda f a -> Lan Identity f a
coyonedaToLan (Coyoneda b -> a
ba f b
fb) = forall {k} (g :: k -> *) (b :: k) a (h :: k -> *).
(g b -> a) -> h b -> Lan g h a
Lan (b -> a
ba forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Identity a -> a
runIdentity) f b
fb
{-# INLINE coyonedaToLan #-}

lanToCoyoneda :: Lan Identity f a -> Coyoneda f a
lanToCoyoneda :: forall (f :: * -> *) a. Lan Identity f a -> Coyoneda f a
lanToCoyoneda (Lan Identity b -> a
iba f b
fb) = forall b a (f :: * -> *). (b -> a) -> f b -> Coyoneda f a
Coyoneda (Identity b -> a
iba forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Identity a
Identity) f b
fb
{-# INLINE lanToCoyoneda #-}

-- {-# RULES "coyonedaToLan/lanToCoyoneda=id" coyonedaToLan . lanToCoyoneda = id #-}
-- {-# RULES "lanToCoyoneda/coyonedaToLan=id" lanToCoyoneda . coyonedaToLan = id #-}

instance Functor (Coyoneda f) where
  fmap :: forall a b. (a -> b) -> Coyoneda f a -> Coyoneda f b
fmap a -> b
f (Coyoneda b -> a
g f b
v) = forall b a (f :: * -> *). (b -> a) -> f b -> Coyoneda f a
Coyoneda (a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
g) f b
v
  {-# INLINE fmap #-}

instance Apply f => Apply (Coyoneda f) where
  Coyoneda b -> a -> b
mf f b
m <.> :: forall a b. Coyoneda f (a -> b) -> Coyoneda f a -> Coyoneda f b
<.> Coyoneda b -> a
nf f b
n =
    forall (f :: * -> *) a. f a -> Coyoneda f a
liftCoyoneda forall a b. (a -> b) -> a -> b
$ (\b
mres b
nres -> b -> a -> b
mf b
mres (b -> a
nf b
nres)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f b
m forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> f b
n
  {-# INLINE (<.>) #-}
  Coyoneda b -> a
_ f b
m .> :: forall a b. Coyoneda f a -> Coyoneda f b -> Coyoneda f b
.> Coyoneda b -> b
g f b
n = forall b a (f :: * -> *). (b -> a) -> f b -> Coyoneda f a
Coyoneda b -> b
g (f b
m forall (f :: * -> *) a b. Apply f => f a -> f b -> f b
.> f b
n)
  {-# INLINE (.>) #-}
  Coyoneda b -> a
f f b
m <. :: forall a b. Coyoneda f a -> Coyoneda f b -> Coyoneda f a
<. Coyoneda b -> b
_ f b
n = forall b a (f :: * -> *). (b -> a) -> f b -> Coyoneda f a
Coyoneda b -> a
f (f b
m forall (f :: * -> *) a b. Apply f => f a -> f b -> f a
<. f b
n)
  {-# INLINE (<.) #-}

instance Applicative f => Applicative (Coyoneda f) where
  pure :: forall a. a -> Coyoneda f a
pure = forall (f :: * -> *) a. f a -> Coyoneda f a
liftCoyoneda forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
  {-# INLINE pure #-}
  Coyoneda b -> a -> b
mf f b
m <*> :: forall a b. Coyoneda f (a -> b) -> Coyoneda f a -> Coyoneda f b
<*> Coyoneda b -> a
nf f b
n =
    forall (f :: * -> *) a. f a -> Coyoneda f a
liftCoyoneda forall a b. (a -> b) -> a -> b
$ (\b
mres b
nres -> b -> a -> b
mf b
mres (b -> a
nf b
nres)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f b
m forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f b
n
  {-# INLINE (<*>) #-}
  Coyoneda b -> a
_ f b
m *> :: forall a b. Coyoneda f a -> Coyoneda f b -> Coyoneda f b
*> Coyoneda b -> b
g f b
n = forall b a (f :: * -> *). (b -> a) -> f b -> Coyoneda f a
Coyoneda b -> b
g (f b
m forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> f b
n)
  {-# INLINE (*>) #-}
  Coyoneda b -> a
f f b
m <* :: forall a b. Coyoneda f a -> Coyoneda f b -> Coyoneda f a
<* Coyoneda b -> b
_ f b
n = forall b a (f :: * -> *). (b -> a) -> f b -> Coyoneda f a
Coyoneda b -> a
f (f b
m forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* f b
n)
  {-# INLINE (<*) #-}

instance Alternative f => Alternative (Coyoneda f) where
  empty :: forall a. Coyoneda f a
empty = forall (f :: * -> *) a. f a -> Coyoneda f a
liftCoyoneda forall (f :: * -> *) a. Alternative f => f a
empty
  {-# INLINE empty #-}
  Coyoneda f a
m <|> :: forall a. Coyoneda f a -> Coyoneda f a -> Coyoneda f a
<|> Coyoneda f a
n = forall (f :: * -> *) a. f a -> Coyoneda f a
liftCoyoneda forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Functor f => Coyoneda f a -> f a
lowerCoyoneda Coyoneda f a
m forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Functor f => Coyoneda f a -> f a
lowerCoyoneda Coyoneda f a
n
  {-# INLINE (<|>) #-}
  some :: forall a. Coyoneda f a -> Coyoneda f [a]
some = forall (f :: * -> *) a. f a -> Coyoneda f a
liftCoyoneda forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Alternative f => f a -> f [a]
A.some forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Functor f => Coyoneda f a -> f a
lowerCoyoneda
  {-# INLINE some #-}
  many :: forall a. Coyoneda f a -> Coyoneda f [a]
many = forall (f :: * -> *) a. f a -> Coyoneda f a
liftCoyoneda forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Alternative f => f a -> f [a]
A.many forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Functor f => Coyoneda f a -> f a
lowerCoyoneda
  {-# INLINE many #-}

{-
-- These are slightly optimized versions of the *default*
-- `some` and `many` definitions for `Coyoneda`. I don't
-- know if it's worth the clutter to expose them.
someDefault (Coyoneda vf vb) = liftCoyoneda some_v
  where
    many_v = some_v <|> pure []
    some_v = (:) . vf <$> vb <*> many_v
{-# INLINE someDefault #-}

manyDefault (Coyoneda vf vb) = liftCoyoneda many_v
  where
    many_v = some_v <|> pure []
    some_v = (:) . vf <$> vb <*> many_v
{-# INLINE many #-}
-}

instance Alt f => Alt (Coyoneda f) where
  Coyoneda f a
m <!> :: forall a. Coyoneda f a -> Coyoneda f a -> Coyoneda f a
<!> Coyoneda f a
n = forall (f :: * -> *) a. f a -> Coyoneda f a
liftCoyoneda forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Functor f => Coyoneda f a -> f a
lowerCoyoneda Coyoneda f a
m forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> forall (f :: * -> *) a. Functor f => Coyoneda f a -> f a
lowerCoyoneda Coyoneda f a
n
  {-# INLINE (<!>) #-}

instance Plus f => Plus (Coyoneda f) where
  zero :: forall a. Coyoneda f a
zero = forall (f :: * -> *) a. f a -> Coyoneda f a
liftCoyoneda forall (f :: * -> *) a. Plus f => f a
zero
  {-# INLINE zero #-}

instance Bind m => Bind (Coyoneda m) where
  Coyoneda b -> a
f m b
v >>- :: forall a b. Coyoneda m a -> (a -> Coyoneda m b) -> Coyoneda m b
>>- a -> Coyoneda m b
k = forall (f :: * -> *) a. f a -> Coyoneda f a
liftCoyoneda (m b
v forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
>>- forall (f :: * -> *) a. Functor f => Coyoneda f a -> f a
lowerCoyoneda forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Coyoneda m b
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
f)
  {-# INLINE (>>-) #-}

instance Monad m => Monad (Coyoneda m) where
#if __GLASGOW_HASKELL__ < 710
  -- pre-AMP
  return = Coyoneda id . return
  {-# INLINE return #-}

  Coyoneda _ m >> Coyoneda g n = Coyoneda g (m >> n)
  {-# INLINE (>>) #-}
#else
  -- post-AMP
  >> :: forall a b. Coyoneda m a -> Coyoneda m b -> Coyoneda m b
(>>) = forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)
  {-# INLINE (>>) #-}
#endif
  Coyoneda b -> a
f m b
v >>= :: forall a b. Coyoneda m a -> (a -> Coyoneda m b) -> Coyoneda m b
>>= a -> Coyoneda m b
k = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m b
v forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (f :: * -> *) a. Monad f => Coyoneda f a -> f a
lowerM forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Coyoneda m b
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
f)
  {-# INLINE (>>=) #-}

instance MonadTrans Coyoneda where
  lift :: forall (m :: * -> *) a. Monad m => m a -> Coyoneda m a
lift = forall b a (f :: * -> *). (b -> a) -> f b -> Coyoneda f a
Coyoneda forall a. a -> a
id
  {-# INLINE lift #-}

instance MonadFix f => MonadFix (Coyoneda f) where
  mfix :: forall a. (a -> Coyoneda f a) -> Coyoneda f a
mfix a -> Coyoneda f a
f = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix (forall (f :: * -> *) a. Monad f => Coyoneda f a -> f a
lowerM forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Coyoneda f a
f)
  {-# INLINE mfix #-}

instance MonadPlus f => MonadPlus (Coyoneda f) where
  mzero :: forall a. Coyoneda f a
mzero = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *) a. MonadPlus m => m a
mzero
  {-# INLINE mzero #-}
  Coyoneda f a
m mplus :: forall a. Coyoneda f a -> Coyoneda f a -> Coyoneda f a
`mplus` Coyoneda f a
n = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Monad f => Coyoneda f a -> f a
lowerM Coyoneda f a
m forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` forall (f :: * -> *) a. Monad f => Coyoneda f a -> f a
lowerM Coyoneda f a
n
  {-# INLINE mplus #-}

instance Representable f => Representable (Coyoneda f) where
  type Rep (Coyoneda f) = Rep f
  tabulate :: forall a. (Rep (Coyoneda f) -> a) -> Coyoneda f a
tabulate = forall (f :: * -> *) a. f a -> Coyoneda f a
liftCoyoneda forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Representable f => (Rep f -> a) -> f a
tabulate
  {-# INLINE tabulate #-}
  index :: forall a. Coyoneda f a -> Rep (Coyoneda f) -> a
index = forall (f :: * -> *) a. Representable f => f a -> Rep f -> a
index forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Functor f => Coyoneda f a -> f a
lowerCoyoneda
  {-# INLINE index #-}

instance Extend w => Extend (Coyoneda w) where
  extended :: forall a b. (Coyoneda w a -> b) -> Coyoneda w a -> Coyoneda w b
extended Coyoneda w a -> b
k (Coyoneda b -> a
f w b
v) = forall b a (f :: * -> *). (b -> a) -> f b -> Coyoneda f a
Coyoneda forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall (w :: * -> *) a b. Extend w => (w a -> b) -> w a -> w b
extended (Coyoneda w a -> b
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a (f :: * -> *). (b -> a) -> f b -> Coyoneda f a
Coyoneda b -> a
f) w b
v
  {-# INLINE extended #-}

instance Comonad w => Comonad (Coyoneda w) where
  extend :: forall a b. (Coyoneda w a -> b) -> Coyoneda w a -> Coyoneda w b
extend Coyoneda w a -> b
k (Coyoneda b -> a
f w b
v) = forall b a (f :: * -> *). (b -> a) -> f b -> Coyoneda f a
Coyoneda forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall (w :: * -> *) a b. Comonad w => (w a -> b) -> w a -> w b
extend (Coyoneda w a -> b
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a (f :: * -> *). (b -> a) -> f b -> Coyoneda f a
Coyoneda b -> a
f) w b
v
  {-# INLINE extend #-}
  extract :: forall a. Coyoneda w a -> a
extract (Coyoneda b -> a
f w b
v) = b -> a
f (forall (w :: * -> *) a. Comonad w => w a -> a
extract w b
v)
  {-# INLINE extract #-}

instance ComonadTrans Coyoneda where
  lower :: forall (w :: * -> *) a. Comonad w => Coyoneda w a -> w a
lower (Coyoneda b -> a
f w b
a) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> a
f w b
a
  {-# INLINE lower #-}

instance Foldable f => Foldable (Coyoneda f) where
  foldMap :: forall m a. Monoid m => (a -> m) -> Coyoneda f a -> m
foldMap a -> m
f (Coyoneda b -> a
k f b
a) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (a -> m
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
k) f b
a
  {-# INLINE foldMap #-}

instance Foldable1 f => Foldable1 (Coyoneda f) where
  foldMap1 :: forall m a. Semigroup m => (a -> m) -> Coyoneda f a -> m
foldMap1 a -> m
f (Coyoneda b -> a
k f b
a) = forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 (a -> m
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
k) f b
a
  {-# INLINE foldMap1 #-}

instance Traversable f => Traversable (Coyoneda f) where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Coyoneda f a -> f (Coyoneda f b)
traverse a -> f b
f (Coyoneda b -> a
k f b
a) = forall b a (f :: * -> *). (b -> a) -> f b -> Coyoneda f a
Coyoneda forall a. a -> a
id forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (a -> f b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
k) f b
a
  {-# INLINE traverse #-}

instance Traversable1 f => Traversable1 (Coyoneda f) where
  traverse1 :: forall (f :: * -> *) a b.
Apply f =>
(a -> f b) -> Coyoneda f a -> f (Coyoneda f b)
traverse1 a -> f b
f (Coyoneda b -> a
k f b
a) = forall b a (f :: * -> *). (b -> a) -> f b -> Coyoneda f a
Coyoneda forall a. a -> a
id forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable1 t, Apply f) =>
(a -> f b) -> t a -> f (t b)
traverse1 (a -> f b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
k) f b
a
  {-# INLINE traverse1 #-}

instance Distributive f => Distributive (Coyoneda f) where
  collect :: forall (f :: * -> *) a b.
Functor f =>
(a -> Coyoneda f b) -> f a -> Coyoneda f (f b)
collect a -> Coyoneda f b
f = forall (f :: * -> *) a. f a -> Coyoneda f a
liftCoyoneda forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (g :: * -> *) (f :: * -> *) a b.
(Distributive g, Functor f) =>
(a -> g b) -> f a -> g (f b)
collect (forall (f :: * -> *) a. Functor f => Coyoneda f a -> f a
lowerCoyoneda forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Coyoneda f b
f)
  {-# INLINE collect #-}

instance (Functor f, Show1 f) => Show1 (Coyoneda f) where
#if LIFTED_FUNCTOR_CLASSES
  liftShowsPrec :: forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> Coyoneda f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl Int
d (Coyoneda b -> a
f f b
a) =
    forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith (forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl) String
"liftCoyoneda" Int
d (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> a
f f b
a)
  {-# INLINE liftShowsPrec #-}
#else
  showsPrec1 d (Coyoneda f a) = showParen (d > 10) $
    showString "liftCoyoneda " . showsPrec1 11 (fmap f a)
  {-# INLINE showsPrec1 #-}
#endif

instance (Read1 f) => Read1 (Coyoneda f) where
#if LIFTED_FUNCTOR_CLASSES
  liftReadsPrec :: forall a.
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (Coyoneda f a)
liftReadsPrec Int -> ReadS a
rp ReadS [a]
rl = forall a. (String -> ReadS a) -> Int -> ReadS a
readsData forall a b. (a -> b) -> a -> b
$
    forall a t.
(Int -> ReadS a) -> String -> (a -> t) -> String -> ReadS t
readsUnaryWith (forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
liftReadsPrec Int -> ReadS a
rp ReadS [a]
rl) String
"liftCoyoneda" forall (f :: * -> *) a. f a -> Coyoneda f a
liftCoyoneda
  {-# INLINE liftReadsPrec #-}
#else
  readsPrec1 d = readParen (d > 10) $ \r' ->
    [ (liftCoyoneda f, t)
    | ("liftCoyoneda", s) <- lex r'
    , (f, t) <- readsPrec1 11 s
    ]
  {-# INLINE readsPrec1 #-}
#endif

instance (Functor f, Show1 f, Show a) => Show (Coyoneda f a) where
  showsPrec :: Int -> Coyoneda f a -> ShowS
showsPrec = forall (f :: * -> *) a. (Show1 f, Show a) => Int -> f a -> ShowS
showsPrec1
  {-# INLINE showsPrec #-}

instance Read (f a) => Read (Coyoneda f a) where
#ifdef __GLASGOW_HASKELL__
  readPrec :: ReadPrec (Coyoneda f a)
readPrec = forall a. ReadPrec a -> ReadPrec a
parens forall a b. (a -> b) -> a -> b
$ forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10 forall a b. (a -> b) -> a -> b
$ do
    Ident String
"liftCoyoneda" <- ReadPrec Lexeme
lexP
    forall (f :: * -> *) a. f a -> Coyoneda f a
liftCoyoneda forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ReadPrec a -> ReadPrec a
step forall a. Read a => ReadPrec a
readPrec
  {-# INLINE readPrec #-}
#else
  readsPrec d = readParen (d > 10) $ \r' ->
    [ (liftCoyoneda f, t)
    | ("liftCoyoneda", s) <- lex r'
    , (f, t) <- readsPrec 11 s
    ]
  {-# INLINE readsPrec #-}
#endif

#if LIFTED_FUNCTOR_CLASSES
instance Eq1 f => Eq1 (Coyoneda f) where
  liftEq :: forall a b.
(a -> b -> Bool) -> Coyoneda f a -> Coyoneda f b -> Bool
liftEq a -> b -> Bool
eq (Coyoneda b -> a
f f b
xs) (Coyoneda b -> b
g f b
ys) =
    forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq (\b
x b
y -> a -> b -> Bool
eq (b -> a
f b
x) (b -> b
g b
y)) f b
xs f b
ys
  {-# INLINE liftEq #-}
#else
instance (Functor f, Eq1 f) => Eq1 (Coyoneda f) where
  eq1 = eq1 `on` lowerCoyoneda
  {-# INLINE eq1 #-}
#endif

#if LIFTED_FUNCTOR_CLASSES
instance Ord1 f => Ord1 (Coyoneda f) where
  liftCompare :: forall a b.
(a -> b -> Ordering) -> Coyoneda f a -> Coyoneda f b -> Ordering
liftCompare a -> b -> Ordering
cmp (Coyoneda b -> a
f f b
xs) (Coyoneda b -> b
g f b
ys) =
    forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare (\b
x b
y -> a -> b -> Ordering
cmp (b -> a
f b
x) (b -> b
g b
y)) f b
xs f b
ys
  {-# INLINE liftCompare #-}
#else
instance (Functor f, Ord1 f) => Ord1 (Coyoneda f) where
  compare1 = compare1 `on` lowerCoyoneda
  {-# INLINE compare1 #-}
#endif

instance ( Eq1 f, Eq a
#if !LIFTED_FUNCTOR_CLASSES
         , Functor f
#endif
         ) => Eq (Coyoneda f a) where
  == :: Coyoneda f a -> Coyoneda f a -> Bool
(==) = forall (f :: * -> *) a. (Eq1 f, Eq a) => f a -> f a -> Bool
eq1
  {-# INLINE (==) #-}

instance ( Ord1 f, Ord a
#if !LIFTED_FUNCTOR_CLASSES
         , Functor f
#endif
         ) => Ord (Coyoneda f a) where
  compare :: Coyoneda f a -> Coyoneda f a -> Ordering
compare = forall (f :: * -> *) a. (Ord1 f, Ord a) => f a -> f a -> Ordering
compare1
  {-# INLINE compare #-}

instance Adjunction f g => Adjunction (Coyoneda f) (Coyoneda g) where
  unit :: forall a. a -> Coyoneda g (Coyoneda f a)
unit = forall (f :: * -> *) a. f a -> Coyoneda f a
liftCoyoneda forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (u :: * -> *) a b.
Adjunction f u =>
(f a -> b) -> a -> u b
leftAdjunct forall (f :: * -> *) a. f a -> Coyoneda f a
liftCoyoneda
  {-# INLINE unit #-}
  counit :: forall a. Coyoneda f (Coyoneda g a) -> a
counit = forall (f :: * -> *) (u :: * -> *) a b.
Adjunction f u =>
(a -> u b) -> f a -> b
rightAdjunct forall (f :: * -> *) a. Functor f => Coyoneda f a -> f a
lowerCoyoneda forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Functor f => Coyoneda f a -> f a
lowerCoyoneda
  {-# INLINE counit #-}

-- | Yoneda \"expansion\"
--
-- @
-- 'liftCoyoneda' . 'lowerCoyoneda' ≡ 'id'
-- 'lowerCoyoneda' . 'liftCoyoneda' ≡ 'id'
-- @
--
-- @
-- lowerCoyoneda (liftCoyoneda fa) = -- by definition
-- lowerCoyoneda (Coyoneda id fa)  = -- by definition
-- fmap id fa                      = -- functor law
-- fa
-- @
--
-- @
-- 'lift' = 'liftCoyoneda'
-- @
liftCoyoneda :: f a -> Coyoneda f a
liftCoyoneda :: forall (f :: * -> *) a. f a -> Coyoneda f a
liftCoyoneda = forall b a (f :: * -> *). (b -> a) -> f b -> Coyoneda f a
Coyoneda forall a. a -> a
id
{-# INLINE liftCoyoneda #-}

-- | Yoneda reduction lets us walk under the existential and apply 'fmap'.
--
-- Mnemonically, \"Yoneda reduction\" sounds like and works a bit like β-reduction.
--
-- <http://ncatlab.org/nlab/show/Yoneda+reduction>
--
-- You can view 'Coyoneda' as just the arguments to 'fmap' tupled up.
--
-- @
-- 'lower' = 'lowerM' = 'lowerCoyoneda'
-- @
lowerCoyoneda :: Functor f => Coyoneda f a -> f a
lowerCoyoneda :: forall (f :: * -> *) a. Functor f => Coyoneda f a -> f a
lowerCoyoneda (Coyoneda b -> a
f f b
m) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> a
f f b
m
{-# INLINE lowerCoyoneda #-}

-- | Yoneda reduction given a 'Monad' lets us walk under the existential and apply 'liftM'.
--
-- You can view 'Coyoneda' as just the arguments to 'liftM' tupled up.
--
-- @
-- 'lower' = 'lowerM' = 'lowerCoyoneda'
-- @
lowerM :: Monad f => Coyoneda f a -> f a
lowerM :: forall (f :: * -> *) a. Monad f => Coyoneda f a -> f a
lowerM (Coyoneda b -> a
f f b
m) = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM b -> a
f f b
m
{-# INLINE lowerM #-}

-- | Lift a natural transformation from @f@ to @g@ to a natural transformation
-- from @Coyoneda f@ to @Coyoneda g@.
hoistCoyoneda :: (forall a. f a -> g a) -> (Coyoneda f b -> Coyoneda g b)
hoistCoyoneda :: forall (f :: * -> *) (g :: * -> *) b.
(forall a. f a -> g a) -> Coyoneda f b -> Coyoneda g b
hoistCoyoneda forall a. f a -> g a
f (Coyoneda b -> b
g f b
x) = forall b a (f :: * -> *). (b -> a) -> f b -> Coyoneda f a
Coyoneda b -> b
g (forall a. f a -> g a
f f b
x)
{-# INLINE hoistCoyoneda #-}