{-# 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 <ekmett@gmail.com>
-- 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 :: Coyoneda f a -> Lan Identity f a
coyonedaToLan (Coyoneda b -> a
ba f b
fb) = (Identity b -> a) -> f b -> Lan Identity f a
forall k (g :: k -> *) (b :: k) a (h :: k -> *).
(g b -> a) -> h b -> Lan g h a
Lan (b -> a
ba (b -> a) -> (Identity b -> b) -> Identity b -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity b -> b
forall a. Identity a -> a
runIdentity) f b
fb
{-# INLINE coyonedaToLan #-}

lanToCoyoneda :: Lan Identity f a -> Coyoneda f a
lanToCoyoneda :: Lan Identity f a -> Coyoneda f a
lanToCoyoneda (Lan Identity b -> a
iba f b
fb) = (b -> a) -> f b -> Coyoneda f a
forall b a (f :: * -> *). (b -> a) -> f b -> Coyoneda f a
Coyoneda (Identity b -> a
iba (Identity b -> a) -> (b -> Identity b) -> b -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Identity b
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 :: (a -> b) -> Coyoneda f a -> Coyoneda f b
fmap a -> b
f (Coyoneda b -> a
g f b
v) = (b -> b) -> f b -> Coyoneda f b
forall b a (f :: * -> *). (b -> a) -> f b -> Coyoneda f a
Coyoneda (a -> b
f (a -> b) -> (b -> a) -> b -> b
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 <.> :: Coyoneda f (a -> b) -> Coyoneda f a -> Coyoneda f b
<.> Coyoneda b -> a
nf f b
n =
    f b -> Coyoneda f b
forall (f :: * -> *) a. f a -> Coyoneda f a
liftCoyoneda (f b -> Coyoneda f b) -> f b -> Coyoneda f b
forall a b. (a -> b) -> a -> b
$ (\b
mres b
nres -> b -> a -> b
mf b
mres (b -> a
nf b
nres)) (b -> b -> b) -> f b -> f (b -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f b
m f (b -> b) -> f b -> f b
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> f b
n
  {-# INLINE (<.>) #-}
  Coyoneda b -> a
_ f b
m .> :: Coyoneda f a -> Coyoneda f b -> Coyoneda f b
.> Coyoneda b -> b
g f b
n = (b -> b) -> f b -> Coyoneda f b
forall b a (f :: * -> *). (b -> a) -> f b -> Coyoneda f a
Coyoneda b -> b
g (f b
m f b -> f b -> f b
forall (f :: * -> *) a b. Apply f => f a -> f b -> f b
.> f b
n)
  {-# INLINE (.>) #-}
  Coyoneda b -> a
f f b
m <. :: Coyoneda f a -> Coyoneda f b -> Coyoneda f a
<. Coyoneda b -> b
_ f b
n = (b -> a) -> f b -> Coyoneda f a
forall b a (f :: * -> *). (b -> a) -> f b -> Coyoneda f a
Coyoneda b -> a
f (f b
m f b -> f b -> f b
forall (f :: * -> *) a b. Apply f => f a -> f b -> f a
<. f b
n)
  {-# INLINE (<.) #-}

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

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

instance Bind m => Bind (Coyoneda m) where
  Coyoneda b -> a
f m b
v >>- :: Coyoneda m a -> (a -> Coyoneda m b) -> Coyoneda m b
>>- a -> Coyoneda m b
k = m b -> Coyoneda m b
forall (f :: * -> *) a. f a -> Coyoneda f a
liftCoyoneda (m b
v m b -> (b -> m b) -> m b
forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
>>- Coyoneda m b -> m b
forall (f :: * -> *) a. Functor f => Coyoneda f a -> f a
lowerCoyoneda (Coyoneda m b -> m b) -> (b -> Coyoneda m b) -> b -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Coyoneda m b
k (a -> Coyoneda m b) -> (b -> a) -> b -> Coyoneda m b
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
  >> :: Coyoneda m a -> Coyoneda m b -> Coyoneda m 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 >>= :: Coyoneda m a -> (a -> Coyoneda m b) -> Coyoneda m b
>>= a -> Coyoneda m b
k = m b -> Coyoneda m b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m b
v m b -> (b -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Coyoneda m b -> m b
forall (f :: * -> *) a. Monad f => Coyoneda f a -> f a
lowerM (Coyoneda m b -> m b) -> (b -> Coyoneda m b) -> b -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Coyoneda m b
k (a -> Coyoneda m b) -> (b -> a) -> b -> Coyoneda m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
f)
  {-# INLINE (>>=) #-}

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

instance MonadFix f => MonadFix (Coyoneda f) where
  mfix :: (a -> Coyoneda f a) -> Coyoneda f a
mfix a -> Coyoneda f a
f = f a -> Coyoneda f a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (f a -> Coyoneda f a) -> f a -> Coyoneda f a
forall a b. (a -> b) -> a -> b
$ (a -> f a) -> f a
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix (Coyoneda f a -> f a
forall (f :: * -> *) a. Monad f => Coyoneda f a -> f a
lowerM (Coyoneda f a -> f a) -> (a -> Coyoneda f a) -> a -> f a
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 :: Coyoneda f a
mzero = f a -> Coyoneda f a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift f a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
  {-# INLINE mzero #-}
  Coyoneda f a
m mplus :: Coyoneda f a -> Coyoneda f a -> Coyoneda f a
`mplus` Coyoneda f a
n = f a -> Coyoneda f a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (f a -> Coyoneda f a) -> f a -> Coyoneda f a
forall a b. (a -> b) -> a -> b
$ Coyoneda f a -> f a
forall (f :: * -> *) a. Monad f => Coyoneda f a -> f a
lowerM Coyoneda f a
m f a -> f a -> f a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Coyoneda f a -> f a
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 :: (Rep (Coyoneda f) -> a) -> Coyoneda f a
tabulate = f a -> Coyoneda f a
forall (f :: * -> *) a. f a -> Coyoneda f a
liftCoyoneda (f a -> Coyoneda f a)
-> ((Rep f -> a) -> f a) -> (Rep f -> a) -> Coyoneda f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rep f -> a) -> f a
forall (f :: * -> *) a. Representable f => (Rep f -> a) -> f a
tabulate
  {-# INLINE tabulate #-}
  index :: Coyoneda f a -> Rep (Coyoneda f) -> a
index = f a -> Rep f -> a
forall (f :: * -> *) a. Representable f => f a -> Rep f -> a
index (f a -> Rep f -> a)
-> (Coyoneda f a -> f a) -> Coyoneda f a -> Rep f -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coyoneda f a -> f a
forall (f :: * -> *) a. Functor f => Coyoneda f a -> f a
lowerCoyoneda
  {-# INLINE index #-}

instance Extend w => Extend (Coyoneda w) where
  extended :: (Coyoneda w a -> b) -> Coyoneda w a -> Coyoneda w b
extended Coyoneda w a -> b
k (Coyoneda b -> a
f w b
v) = (b -> b) -> w b -> Coyoneda w b
forall b a (f :: * -> *). (b -> a) -> f b -> Coyoneda f a
Coyoneda b -> b
forall a. a -> a
id (w b -> Coyoneda w b) -> w b -> Coyoneda w b
forall a b. (a -> b) -> a -> b
$ (w b -> b) -> w b -> w b
forall (w :: * -> *) a b. Extend w => (w a -> b) -> w a -> w b
extended (Coyoneda w a -> b
k (Coyoneda w a -> b) -> (w b -> Coyoneda w a) -> w b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> a) -> w b -> Coyoneda w a
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 :: (Coyoneda w a -> b) -> Coyoneda w a -> Coyoneda w b
extend Coyoneda w a -> b
k (Coyoneda b -> a
f w b
v) = (b -> b) -> w b -> Coyoneda w b
forall b a (f :: * -> *). (b -> a) -> f b -> Coyoneda f a
Coyoneda b -> b
forall a. a -> a
id (w b -> Coyoneda w b) -> w b -> Coyoneda w b
forall a b. (a -> b) -> a -> b
$ (w b -> b) -> w b -> w b
forall (w :: * -> *) a b. Comonad w => (w a -> b) -> w a -> w b
extend (Coyoneda w a -> b
k (Coyoneda w a -> b) -> (w b -> Coyoneda w a) -> w b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> a) -> w b -> Coyoneda w a
forall b a (f :: * -> *). (b -> a) -> f b -> Coyoneda f a
Coyoneda b -> a
f) w b
v
  {-# INLINE extend #-}
  extract :: Coyoneda w a -> a
extract (Coyoneda b -> a
f w b
v) = b -> a
f (w b -> b
forall (w :: * -> *) a. Comonad w => w a -> a
extract w b
v)
  {-# INLINE extract #-}

instance ComonadTrans Coyoneda where
  lower :: Coyoneda w a -> w a
lower (Coyoneda b -> a
f w b
a) = (b -> a) -> w b -> w 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 :: (a -> m) -> Coyoneda f a -> m
foldMap a -> m
f (Coyoneda b -> a
k f b
a) = (b -> m) -> f b -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (a -> m
f (a -> m) -> (b -> a) -> b -> m
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 :: (a -> m) -> Coyoneda f a -> m
foldMap1 a -> m
f (Coyoneda b -> a
k f b
a) = (b -> m) -> f b -> m
forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 (a -> m
f (a -> m) -> (b -> a) -> b -> m
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 :: (a -> f b) -> Coyoneda f a -> f (Coyoneda f b)
traverse a -> f b
f (Coyoneda b -> a
k f b
a) = (b -> b) -> f b -> Coyoneda f b
forall b a (f :: * -> *). (b -> a) -> f b -> Coyoneda f a
Coyoneda b -> b
forall a. a -> a
id (f b -> Coyoneda f b) -> f (f b) -> f (Coyoneda f b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (b -> f b) -> f b -> f (f b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (a -> f b
f (a -> f b) -> (b -> a) -> b -> f b
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 :: (a -> f b) -> Coyoneda f a -> f (Coyoneda f b)
traverse1 a -> f b
f (Coyoneda b -> a
k f b
a) = (b -> b) -> f b -> Coyoneda f b
forall b a (f :: * -> *). (b -> a) -> f b -> Coyoneda f a
Coyoneda b -> b
forall a. a -> a
id (f b -> Coyoneda f b) -> f (f b) -> f (Coyoneda f b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (b -> f b) -> f b -> f (f b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable1 t, Apply f) =>
(a -> f b) -> t a -> f (t b)
traverse1 (a -> f b
f (a -> f b) -> (b -> a) -> b -> f b
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 :: (a -> Coyoneda f b) -> f a -> Coyoneda f (f b)
collect a -> Coyoneda f b
f = f (f b) -> Coyoneda f (f b)
forall (f :: * -> *) a. f a -> Coyoneda f a
liftCoyoneda (f (f b) -> Coyoneda f (f b))
-> (f a -> f (f b)) -> f a -> Coyoneda f (f b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f b) -> f a -> f (f b)
forall (g :: * -> *) (f :: * -> *) a b.
(Distributive g, Functor f) =>
(a -> g b) -> f a -> g (f b)
collect (Coyoneda f b -> f b
forall (f :: * -> *) a. Functor f => Coyoneda f a -> f a
lowerCoyoneda (Coyoneda f b -> f b) -> (a -> Coyoneda f b) -> a -> f b
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 :: (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) =
    (Int -> f a -> ShowS) -> String -> Int -> f a -> ShowS
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith ((Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
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 ((b -> a) -> f b -> f a
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 :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (Coyoneda f a)
liftReadsPrec Int -> ReadS a
rp ReadS [a]
rl = (String -> ReadS (Coyoneda f a)) -> Int -> ReadS (Coyoneda f a)
forall a. (String -> ReadS a) -> Int -> ReadS a
readsData ((String -> ReadS (Coyoneda f a)) -> Int -> ReadS (Coyoneda f a))
-> (String -> ReadS (Coyoneda f a)) -> Int -> ReadS (Coyoneda f a)
forall a b. (a -> b) -> a -> b
$
    (Int -> ReadS (f a))
-> String
-> (f a -> Coyoneda f a)
-> String
-> ReadS (Coyoneda f a)
forall a t.
(Int -> ReadS a) -> String -> (a -> t) -> String -> ReadS t
readsUnaryWith ((Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
liftReadsPrec Int -> ReadS a
rp ReadS [a]
rl) String
"liftCoyoneda" f a -> Coyoneda f a
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 = Int -> Coyoneda f a -> ShowS
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 = ReadPrec (Coyoneda f a) -> ReadPrec (Coyoneda f a)
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec (Coyoneda f a) -> ReadPrec (Coyoneda f a))
-> ReadPrec (Coyoneda f a) -> ReadPrec (Coyoneda f a)
forall a b. (a -> b) -> a -> b
$ Int -> ReadPrec (Coyoneda f a) -> ReadPrec (Coyoneda f a)
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10 (ReadPrec (Coyoneda f a) -> ReadPrec (Coyoneda f a))
-> ReadPrec (Coyoneda f a) -> ReadPrec (Coyoneda f a)
forall a b. (a -> b) -> a -> b
$ do
    Ident String
"liftCoyoneda" <- ReadPrec Lexeme
lexP
    f a -> Coyoneda f a
forall (f :: * -> *) a. f a -> Coyoneda f a
liftCoyoneda (f a -> Coyoneda f a) -> ReadPrec (f a) -> ReadPrec (Coyoneda f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec (f a) -> ReadPrec (f a)
forall a. ReadPrec a -> ReadPrec a
step ReadPrec (f a)
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 :: (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) =
    (b -> b -> Bool) -> f b -> f b -> Bool
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 :: (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) =
    (b -> b -> Ordering) -> f b -> f b -> Ordering
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 (Functor f, Eq1 f, Eq a) => Eq (Coyoneda f a) where
  == :: Coyoneda f a -> Coyoneda f a -> Bool
(==) = Coyoneda f a -> Coyoneda f a -> Bool
forall (f :: * -> *) a. (Eq1 f, Eq a) => f a -> f a -> Bool
eq1
  {-# INLINE (==) #-}

instance (Functor f, Ord1 f, Ord a) => Ord (Coyoneda f a) where
  compare :: Coyoneda f a -> Coyoneda f a -> Ordering
compare = Coyoneda f a -> Coyoneda f a -> Ordering
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 :: a -> Coyoneda g (Coyoneda f a)
unit = g (Coyoneda f a) -> Coyoneda g (Coyoneda f a)
forall (f :: * -> *) a. f a -> Coyoneda f a
liftCoyoneda (g (Coyoneda f a) -> Coyoneda g (Coyoneda f a))
-> (a -> g (Coyoneda f a)) -> a -> Coyoneda g (Coyoneda f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f a -> Coyoneda f a) -> a -> g (Coyoneda f a)
forall (f :: * -> *) (u :: * -> *) a b.
Adjunction f u =>
(f a -> b) -> a -> u b
leftAdjunct f a -> Coyoneda f a
forall (f :: * -> *) a. f a -> Coyoneda f a
liftCoyoneda
  {-# INLINE unit #-}
  counit :: Coyoneda f (Coyoneda g a) -> a
counit = (Coyoneda g a -> g a) -> f (Coyoneda g a) -> a
forall (f :: * -> *) (u :: * -> *) a b.
Adjunction f u =>
(a -> u b) -> f a -> b
rightAdjunct Coyoneda g a -> g a
forall (f :: * -> *) a. Functor f => Coyoneda f a -> f a
lowerCoyoneda (f (Coyoneda g a) -> a)
-> (Coyoneda f (Coyoneda g a) -> f (Coyoneda g a))
-> Coyoneda f (Coyoneda g a)
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coyoneda f (Coyoneda g a) -> f (Coyoneda g a)
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 :: f a -> Coyoneda f a
liftCoyoneda = (a -> a) -> f a -> Coyoneda f a
forall b a (f :: * -> *). (b -> a) -> f b -> Coyoneda f a
Coyoneda a -> a
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 :: Coyoneda f a -> f a
lowerCoyoneda (Coyoneda b -> a
f f b
m) = (b -> a) -> f b -> f a
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 :: Coyoneda f a -> f a
lowerM (Coyoneda b -> a
f f b
m) = (b -> a) -> f b -> f a
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 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) = (b -> b) -> g b -> Coyoneda g b
forall b a (f :: * -> *). (b -> a) -> f b -> Coyoneda f a
Coyoneda b -> b
g (f b -> g b
forall a. f a -> g a
f f b
x)
{-# INLINE hoistCoyoneda #-}