{-# LANGUAGE CPP #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
#endif
#include "kan-extensions-common.h"

-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Functor.Yoneda
-- Copyright   :  (C) 2011-2016 Edward Kmett
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  provisional
-- Portability :  MPTCs, fundeps
--
-- The covariant form of the Yoneda lemma states that @f@ is naturally
-- isomorphic to @Yoneda f@.
--
-- This is described in a rather intuitive fashion by Dan Piponi in
--
-- <http://blog.sigfpe.com/2006/11/yoneda-lemma.html>
----------------------------------------------------------------------------

module Data.Functor.Yoneda
  ( Yoneda(..)
  , liftYoneda, lowerYoneda
  , maxF, minF, maxM, minM
  -- * as a right Kan extension
  , yonedaToRan, ranToYoneda
  ) where

import Control.Applicative
import Control.Monad (MonadPlus(..), liftM)
import Control.Monad.Fix
import Control.Monad.Free.Class
import Control.Monad.Trans.Class
import Control.Comonad
import Control.Comonad.Trans.Class
import Data.Distributive
import Data.Foldable
import Data.Functor.Adjunction
import Data.Functor.Bind
import Data.Functor.Classes
import Data.Functor.Extend
import Data.Functor.Identity
import Data.Functor.Kan.Ran
import Data.Functor.Plus
import Data.Functor.Rep
import Data.Semigroup.Foldable
import Data.Semigroup.Traversable
import Data.Traversable
import Text.Read hiding (lift)
import Prelude hiding (sequence, lookup, zipWith)

-- | @Yoneda f a@ can be viewed as the partial application of 'fmap' to its second argument.
newtype Yoneda f a = Yoneda { Yoneda f a -> forall b. (a -> b) -> f b
runYoneda :: forall b. (a -> b) -> f b }

-- | The natural isomorphism between @f@ and @'Yoneda' f@ given by the Yoneda lemma
-- is witnessed by 'liftYoneda' and 'lowerYoneda'
--
-- @
-- 'liftYoneda' . 'lowerYoneda' ≡ 'id'
-- 'lowerYoneda' . 'liftYoneda' ≡ 'id'
-- @
--
-- @
-- lowerYoneda (liftYoneda fa) =         -- definition
-- lowerYoneda (Yoneda (\f -> fmap f a)) -- definition
-- (\f -> fmap f fa) id                  -- beta reduction
-- fmap id fa                            -- functor law
-- fa
-- @
--
-- @
-- 'lift' = 'liftYoneda'
-- @
liftYoneda :: Functor f => f a -> Yoneda f a
liftYoneda :: f a -> Yoneda f a
liftYoneda f a
a = (forall b. (a -> b) -> f b) -> Yoneda f a
forall (f :: * -> *) a. (forall b. (a -> b) -> f b) -> Yoneda f a
Yoneda (\a -> b
f -> (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f f a
a)
{-# INLINE liftYoneda #-}

lowerYoneda :: Yoneda f a -> f a
lowerYoneda :: Yoneda f a -> f a
lowerYoneda (Yoneda forall b. (a -> b) -> f b
f) = (a -> a) -> f a
forall b. (a -> b) -> f b
f a -> a
forall a. a -> a
id
{-# INLINE lowerYoneda #-}

-- TODO: coerce
-- {-# RULES "lower/lift=id" liftYoneda . lowerYoneda = id #-}
-- {-# RULES "lift/lower=id" lowerYoneda . liftYoneda = id #-}

-- | @Yoneda f@ can be viewed as the right Kan extension of @f@ along the 'Identity' functor.
--
-- @
-- 'yonedaToRan' . 'ranToYoneda' ≡ 'id'
-- 'ranToYoneda' . 'yonedaToRan' ≡ 'id'
-- @
yonedaToRan :: Yoneda f a -> Ran Identity f a
yonedaToRan :: Yoneda f a -> Ran Identity f a
yonedaToRan (Yoneda forall b. (a -> b) -> f b
m) = (forall b. (a -> Identity b) -> f b) -> Ran Identity f a
forall k (g :: k -> *) (h :: k -> *) a.
(forall (b :: k). (a -> g b) -> h b) -> Ran g h a
Ran ((a -> b) -> f b
forall b. (a -> b) -> f b
m ((a -> b) -> f b)
-> ((a -> Identity b) -> a -> b) -> (a -> Identity b) -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Identity b -> b) -> (a -> Identity b) -> a -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Identity b -> b
forall a. Identity a -> a
runIdentity)
{-# INLINE yonedaToRan #-}

ranToYoneda :: Ran Identity f a -> Yoneda f a
ranToYoneda :: Ran Identity f a -> Yoneda f a
ranToYoneda (Ran forall b. (a -> Identity b) -> f b
m) = (forall b. (a -> b) -> f b) -> Yoneda f a
forall (f :: * -> *) a. (forall b. (a -> b) -> f b) -> Yoneda f a
Yoneda ((a -> Identity b) -> f b
forall b. (a -> Identity b) -> f b
m ((a -> Identity b) -> f b)
-> ((a -> b) -> a -> Identity b) -> (a -> b) -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> Identity b) -> (a -> b) -> a -> Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Identity b
forall a. a -> Identity a
Identity)
{-# INLINE ranToYoneda #-}

-- {-# RULES "yonedaToRan/ranToYoneda=id" yonedaToRan . ranToYoneda = id #-}
-- {-# RULES "ranToYoneda/yonedaToRan=id" ranToYoneda . yonedaToRan = id #-}

instance Functor (Yoneda f) where
  fmap :: (a -> b) -> Yoneda f a -> Yoneda f b
fmap a -> b
f Yoneda f a
m = (forall b. (b -> b) -> f b) -> Yoneda f b
forall (f :: * -> *) a. (forall b. (a -> b) -> f b) -> Yoneda f a
Yoneda (\b -> b
k -> Yoneda f a -> (a -> b) -> f b
forall (f :: * -> *) a. Yoneda f a -> forall b. (a -> b) -> f b
runYoneda Yoneda f a
m (b -> b
k (b -> b) -> (a -> b) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f))
  {-# INLINE fmap #-}

instance Apply f => Apply (Yoneda f) where
  Yoneda forall b. ((a -> b) -> b) -> f b
m <.> :: Yoneda f (a -> b) -> Yoneda f a -> Yoneda f b
<.> Yoneda forall b. (a -> b) -> f b
n = (forall b. (b -> b) -> f b) -> Yoneda f b
forall (f :: * -> *) a. (forall b. (a -> b) -> f b) -> Yoneda f a
Yoneda (\b -> b
f -> ((a -> b) -> a -> b) -> f (a -> b)
forall b. ((a -> b) -> b) -> f b
m (b -> b
f (b -> b) -> (a -> b) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> (a -> a) -> f a
forall b. (a -> b) -> f b
n a -> a
forall a. a -> a
id)
  {-# INLINE (<.>) #-}

instance Applicative f => Applicative (Yoneda f) where
  pure :: a -> Yoneda f a
pure a
a = (forall b. (a -> b) -> f b) -> Yoneda f a
forall (f :: * -> *) a. (forall b. (a -> b) -> f b) -> Yoneda f a
Yoneda (\a -> b
f -> b -> f b
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> b
f a
a))
  {-# INLINE pure #-}
  Yoneda forall b. ((a -> b) -> b) -> f b
m <*> :: Yoneda f (a -> b) -> Yoneda f a -> Yoneda f b
<*> Yoneda forall b. (a -> b) -> f b
n = (forall b. (b -> b) -> f b) -> Yoneda f b
forall (f :: * -> *) a. (forall b. (a -> b) -> f b) -> Yoneda f a
Yoneda (\b -> b
f -> ((a -> b) -> a -> b) -> f (a -> b)
forall b. ((a -> b) -> b) -> f b
m (b -> b
f (b -> b) -> (a -> b) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> a) -> f a
forall b. (a -> b) -> f b
n a -> a
forall a. a -> a
id)
  {-# INLINE (<*>) #-}

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

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

instance Traversable f => Traversable (Yoneda f) where
  traverse :: (a -> f b) -> Yoneda f a -> f (Yoneda f b)
traverse a -> f b
f = (f b -> Yoneda f b) -> f (f b) -> f (Yoneda f b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f b -> Yoneda f b
forall (f :: * -> *) a. Functor f => f a -> Yoneda f a
liftYoneda (f (f b) -> f (Yoneda f b))
-> (Yoneda f a -> f (f b)) -> Yoneda f a -> f (Yoneda f b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f b) -> f a -> 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 (f a -> f (f b)) -> (Yoneda f a -> f a) -> Yoneda f a -> f (f b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Yoneda f a -> f a
forall (f :: * -> *) a. Yoneda f a -> f a
lowerYoneda
  {-# INLINE traverse #-}

instance Traversable1 f => Traversable1 (Yoneda f) where
  traverse1 :: (a -> f b) -> Yoneda f a -> f (Yoneda f b)
traverse1 a -> f b
f = (f b -> Yoneda f b) -> f (f b) -> f (Yoneda f b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f b -> Yoneda f b
forall (f :: * -> *) a. Functor f => f a -> Yoneda f a
liftYoneda (f (f b) -> f (Yoneda f b))
-> (Yoneda f a -> f (f b)) -> Yoneda f a -> f (Yoneda f b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f b) -> f a -> 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 (f a -> f (f b)) -> (Yoneda f a -> f a) -> Yoneda f a -> f (f b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Yoneda f a -> f a
forall (f :: * -> *) a. Yoneda f a -> f a
lowerYoneda
  {-# INLINE traverse1 #-}

instance Distributive f => Distributive (Yoneda f) where
  collect :: (a -> Yoneda f b) -> f a -> Yoneda f (f b)
collect a -> Yoneda f b
f = f (f b) -> Yoneda f (f b)
forall (f :: * -> *) a. Functor f => f a -> Yoneda f a
liftYoneda (f (f b) -> Yoneda f (f b))
-> (f a -> f (f b)) -> f a -> Yoneda 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 (Yoneda f b -> f b
forall (f :: * -> *) a. Yoneda f a -> f a
lowerYoneda (Yoneda f b -> f b) -> (a -> Yoneda f b) -> a -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Yoneda f b
f)
  {-# INLINE collect #-}

instance Representable g => Representable (Yoneda g) where
  type Rep (Yoneda g) = Rep g
  tabulate :: (Rep (Yoneda g) -> a) -> Yoneda g a
tabulate = g a -> Yoneda g a
forall (f :: * -> *) a. Functor f => f a -> Yoneda f a
liftYoneda (g a -> Yoneda g a)
-> ((Rep g -> a) -> g a) -> (Rep g -> a) -> Yoneda g a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rep g -> a) -> g a
forall (f :: * -> *) a. Representable f => (Rep f -> a) -> f a
tabulate
  {-# INLINE tabulate #-}
  index :: Yoneda g a -> Rep (Yoneda g) -> a
index = g a -> Rep g -> a
forall (f :: * -> *) a. Representable f => f a -> Rep f -> a
index (g a -> Rep g -> a)
-> (Yoneda g a -> g a) -> Yoneda g a -> Rep g -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Yoneda g a -> g a
forall (f :: * -> *) a. Yoneda f a -> f a
lowerYoneda
  {-# INLINE index #-}

instance Adjunction f g => Adjunction (Yoneda f) (Yoneda g) where
  unit :: a -> Yoneda g (Yoneda f a)
unit = g (Yoneda f a) -> Yoneda g (Yoneda f a)
forall (f :: * -> *) a. Functor f => f a -> Yoneda f a
liftYoneda (g (Yoneda f a) -> Yoneda g (Yoneda f a))
-> (a -> g (Yoneda f a)) -> a -> Yoneda g (Yoneda f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f a -> Yoneda f a) -> g (f a) -> g (Yoneda f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f a -> Yoneda f a
forall (f :: * -> *) a. Functor f => f a -> Yoneda f a
liftYoneda (g (f a) -> g (Yoneda f a))
-> (a -> g (f a)) -> a -> g (Yoneda f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> g (f a)
forall (f :: * -> *) (u :: * -> *) a.
Adjunction f u =>
a -> u (f a)
unit
  {-# INLINE unit #-}
  counit :: Yoneda f (Yoneda g a) -> a
counit (Yoneda forall b. (Yoneda g a -> b) -> f b
m) = f (g a) -> a
forall (f :: * -> *) (u :: * -> *) a.
Adjunction f u =>
f (u a) -> a
counit ((Yoneda g a -> g a) -> f (g a)
forall b. (Yoneda g a -> b) -> f b
m Yoneda g a -> g a
forall (f :: * -> *) a. Yoneda f a -> f a
lowerYoneda)
  {-# INLINE counit #-}

instance Show1 f => Show1 (Yoneda f) where
#if LIFTED_FUNCTOR_CLASSES
  liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Yoneda f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl Int
d (Yoneda forall b. (a -> b) -> f b
f) =
    (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
"liftYoneda" Int
d ((a -> a) -> f a
forall b. (a -> b) -> f b
f a -> a
forall a. a -> a
id)
#else
  showsPrec1 d (Yoneda f) = showParen (d > 10) $
    showString "liftYoneda " . showsPrec1 11 (f id)
#endif

instance (Read1 f, Functor f) => Read1 (Yoneda f) where
#if LIFTED_FUNCTOR_CLASSES
  liftReadsPrec :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (Yoneda f a)
liftReadsPrec Int -> ReadS a
rp ReadS [a]
rl = (String -> ReadS (Yoneda f a)) -> Int -> ReadS (Yoneda f a)
forall a. (String -> ReadS a) -> Int -> ReadS a
readsData ((String -> ReadS (Yoneda f a)) -> Int -> ReadS (Yoneda f a))
-> (String -> ReadS (Yoneda f a)) -> Int -> ReadS (Yoneda f a)
forall a b. (a -> b) -> a -> b
$
    (Int -> ReadS (f a))
-> String -> (f a -> Yoneda f a) -> String -> ReadS (Yoneda 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
"liftYoneda" f a -> Yoneda f a
forall (f :: * -> *) a. Functor f => f a -> Yoneda f a
liftYoneda
#else
  readsPrec1 d = readParen (d > 10) $ \r' ->
    [ (liftYoneda f, t)
    | ("liftYoneda", s) <- lex r'
    , (f, t) <- readsPrec1 11 s
    ]
#endif

instance Show (f a) => Show (Yoneda f a) where
  showsPrec :: Int -> Yoneda f a -> ShowS
showsPrec Int
d (Yoneda forall b. (a -> b) -> f b
f) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
    String -> ShowS
showString String
"liftYoneda " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> f a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 ((a -> a) -> f a
forall b. (a -> b) -> f b
f a -> a
forall a. a -> a
id)

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

infixl 0 `on1`
on1 :: (g a -> g b -> c) -> (forall x. f x -> g x) -> f a -> f b -> c
g a -> g b -> c
(.*.) on1 :: (g a -> g b -> c) -> (forall x. f x -> g x) -> f a -> f b -> c
`on1` forall x. f x -> g x
f = \f a
x f b
y -> f a -> g a
forall x. f x -> g x
f f a
x g a -> g b -> c
.*. f b -> g b
forall x. f x -> g x
f f b
y

instance Eq1 f => Eq1 (Yoneda f) where
#if LIFTED_FUNCTOR_CLASSES
  liftEq :: (a -> b -> Bool) -> Yoneda f a -> Yoneda f b -> Bool
liftEq a -> b -> Bool
eq = (a -> b -> Bool) -> f a -> f b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eq (f a -> f b -> Bool)
-> (forall x. Yoneda f x -> f x)
-> Yoneda f a
-> Yoneda f b
-> Bool
forall (g :: * -> *) a b c (f :: * -> *).
(g a -> g b -> c) -> (forall x. f x -> g x) -> f a -> f b -> c
`on1` forall x. Yoneda f x -> f x
forall (f :: * -> *) a. Yoneda f a -> f a
lowerYoneda
  {-# INLINE liftEq #-}
#else
  eq1 = eq1 `on1` lowerYoneda
  {-# INLINE eq1 #-}
#endif

instance Ord1 f => Ord1 (Yoneda f) where
#if LIFTED_FUNCTOR_CLASSES
  liftCompare :: (a -> b -> Ordering) -> Yoneda f a -> Yoneda f b -> Ordering
liftCompare a -> b -> Ordering
cmp = (a -> b -> Ordering) -> f a -> f b -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
cmp (f a -> f b -> Ordering)
-> (forall x. Yoneda f x -> f x)
-> Yoneda f a
-> Yoneda f b
-> Ordering
forall (g :: * -> *) a b c (f :: * -> *).
(g a -> g b -> c) -> (forall x. f x -> g x) -> f a -> f b -> c
`on1` forall x. Yoneda f x -> f x
forall (f :: * -> *) a. Yoneda f a -> f a
lowerYoneda
  {-# INLINE liftCompare #-}
#else
  compare1 = compare1 `on1` lowerYoneda
  {-# INLINE compare1 #-}
#endif

instance (Eq1 f, Eq a) => Eq (Yoneda f a) where
  == :: Yoneda f a -> Yoneda f a -> Bool
(==) = Yoneda f a -> Yoneda f a -> Bool
forall (f :: * -> *) a. (Eq1 f, Eq a) => f a -> f a -> Bool
eq1
  {-# INLINE (==) #-}

instance (Ord1 f, Ord a) => Ord (Yoneda f a) where
  compare :: Yoneda f a -> Yoneda f a -> Ordering
compare = Yoneda f a -> Yoneda f a -> Ordering
forall (f :: * -> *) a. (Ord1 f, Ord a) => f a -> f a -> Ordering
compare1
  {-# INLINE compare #-}

maxF :: (Functor f, Ord (f a)) => Yoneda f a -> Yoneda f a -> Yoneda f a
Yoneda forall b. (a -> b) -> f b
f maxF :: Yoneda f a -> Yoneda f a -> Yoneda f a
`maxF` Yoneda forall b. (a -> b) -> f b
g = f a -> Yoneda f a
forall (f :: * -> *) a. Functor f => f a -> Yoneda f a
liftYoneda (f a -> Yoneda f a) -> f a -> Yoneda f a
forall a b. (a -> b) -> a -> b
$ (a -> a) -> f a
forall b. (a -> b) -> f b
f a -> a
forall a. a -> a
id f a -> f a -> f a
forall a. Ord a => a -> a -> a
`max` (a -> a) -> f a
forall b. (a -> b) -> f b
g a -> a
forall a. a -> a
id
-- {-# RULES "max/maxF" max = maxF #-}
{-# INLINE maxF #-}

minF :: (Functor f, Ord (f a)) => Yoneda f a -> Yoneda f a -> Yoneda f a
Yoneda forall b. (a -> b) -> f b
f minF :: Yoneda f a -> Yoneda f a -> Yoneda f a
`minF` Yoneda forall b. (a -> b) -> f b
g = f a -> Yoneda f a
forall (f :: * -> *) a. Functor f => f a -> Yoneda f a
liftYoneda (f a -> Yoneda f a) -> f a -> Yoneda f a
forall a b. (a -> b) -> a -> b
$ (a -> a) -> f a
forall b. (a -> b) -> f b
f a -> a
forall a. a -> a
id f a -> f a -> f a
forall a. Ord a => a -> a -> a
`max` (a -> a) -> f a
forall b. (a -> b) -> f b
g a -> a
forall a. a -> a
id
-- {-# RULES "min/minF" min = minF #-}
{-# INLINE minF #-}

maxM :: (Monad m, Ord (m a)) => Yoneda m a -> Yoneda m a -> Yoneda m a
Yoneda forall b. (a -> b) -> m b
f maxM :: Yoneda m a -> Yoneda m a -> Yoneda m a
`maxM` Yoneda forall b. (a -> b) -> m b
g = m a -> Yoneda m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> Yoneda m a) -> m a -> Yoneda m a
forall a b. (a -> b) -> a -> b
$ (a -> a) -> m a
forall b. (a -> b) -> m b
f a -> a
forall a. a -> a
id m a -> m a -> m a
forall a. Ord a => a -> a -> a
`max` (a -> a) -> m a
forall b. (a -> b) -> m b
g a -> a
forall a. a -> a
id
-- {-# RULES "max/maxM" max = maxM #-}
{-# INLINE maxM #-}

minM :: (Monad m, Ord (m a)) => Yoneda m a -> Yoneda m a -> Yoneda m a
Yoneda forall b. (a -> b) -> m b
f minM :: Yoneda m a -> Yoneda m a -> Yoneda m a
`minM` Yoneda forall b. (a -> b) -> m b
g = m a -> Yoneda m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> Yoneda m a) -> m a -> Yoneda m a
forall a b. (a -> b) -> a -> b
$ (a -> a) -> m a
forall b. (a -> b) -> m b
f a -> a
forall a. a -> a
id m a -> m a -> m a
forall a. Ord a => a -> a -> a
`min` (a -> a) -> m a
forall b. (a -> b) -> m b
g a -> a
forall a. a -> a
id
-- {-# RULES "min/minM" min = minM #-}
{-# INLINE minM #-}

instance Alt f => Alt (Yoneda f) where
  Yoneda forall b. (a -> b) -> f b
f <!> :: Yoneda f a -> Yoneda f a -> Yoneda f a
<!> Yoneda forall b. (a -> b) -> f b
g = (forall b. (a -> b) -> f b) -> Yoneda f a
forall (f :: * -> *) a. (forall b. (a -> b) -> f b) -> Yoneda f a
Yoneda (\a -> b
k -> (a -> b) -> f b
forall b. (a -> b) -> f b
f a -> b
k f b -> f b -> f b
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> (a -> b) -> f b
forall b. (a -> b) -> f b
g a -> b
k)
  {-# INLINE (<!>) #-}

instance Plus f => Plus (Yoneda f) where
  zero :: Yoneda f a
zero = (forall b. (a -> b) -> f b) -> Yoneda f a
forall (f :: * -> *) a. (forall b. (a -> b) -> f b) -> Yoneda f a
Yoneda ((forall b. (a -> b) -> f b) -> Yoneda f a)
-> (forall b. (a -> b) -> f b) -> Yoneda f a
forall a b. (a -> b) -> a -> b
$ f b -> (a -> b) -> f b
forall a b. a -> b -> a
const f b
forall (f :: * -> *) a. Plus f => f a
zero
  {-# INLINE zero #-}

instance Alternative f => Alternative (Yoneda f) where
  empty :: Yoneda f a
empty = (forall b. (a -> b) -> f b) -> Yoneda f a
forall (f :: * -> *) a. (forall b. (a -> b) -> f b) -> Yoneda f a
Yoneda ((forall b. (a -> b) -> f b) -> Yoneda f a)
-> (forall b. (a -> b) -> f b) -> Yoneda f a
forall a b. (a -> b) -> a -> b
$ f b -> (a -> b) -> f b
forall a b. a -> b -> a
const f b
forall (f :: * -> *) a. Alternative f => f a
empty
  {-# INLINE empty #-}
  Yoneda forall b. (a -> b) -> f b
f <|> :: Yoneda f a -> Yoneda f a -> Yoneda f a
<|> Yoneda forall b. (a -> b) -> f b
g = (forall b. (a -> b) -> f b) -> Yoneda f a
forall (f :: * -> *) a. (forall b. (a -> b) -> f b) -> Yoneda f a
Yoneda (\a -> b
k -> (a -> b) -> f b
forall b. (a -> b) -> f b
f a -> b
k f b -> f b -> f b
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (a -> b) -> f b
forall b. (a -> b) -> f b
g a -> b
k)
  {-# INLINE (<|>) #-}

instance Bind m => Bind (Yoneda m) where
  Yoneda forall b. (a -> b) -> m b
m >>- :: Yoneda m a -> (a -> Yoneda m b) -> Yoneda m b
>>- a -> Yoneda m b
k = (forall b. (b -> b) -> m b) -> Yoneda m b
forall (f :: * -> *) a. (forall b. (a -> b) -> f b) -> Yoneda f a
Yoneda (\b -> b
f -> (a -> a) -> m a
forall b. (a -> b) -> m b
m a -> a
forall a. a -> a
id m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
>>- \a
a -> Yoneda m b -> (b -> b) -> m b
forall (f :: * -> *) a. Yoneda f a -> forall b. (a -> b) -> f b
runYoneda (a -> Yoneda m b
k a
a) b -> b
f)
  {-# INLINE (>>-) #-}

instance Monad m => Monad (Yoneda m) where
#if __GLASGOW_HASKELL__ < 710
  return a = Yoneda (\f -> return (f a))
  {-# INLINE return #-}
#endif
  Yoneda forall b. (a -> b) -> m b
m >>= :: Yoneda m a -> (a -> Yoneda m b) -> Yoneda m b
>>= a -> Yoneda m b
k = (forall b. (b -> b) -> m b) -> Yoneda m b
forall (f :: * -> *) a. (forall b. (a -> b) -> f b) -> Yoneda f a
Yoneda (\b -> b
f -> (a -> a) -> m a
forall b. (a -> b) -> m b
m a -> a
forall a. a -> a
id m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
a -> Yoneda m b -> (b -> b) -> m b
forall (f :: * -> *) a. Yoneda f a -> forall b. (a -> b) -> f b
runYoneda (a -> Yoneda m b
k a
a) b -> b
f)
  {-# INLINE (>>=) #-}

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

instance MonadPlus m => MonadPlus (Yoneda m) where
  mzero :: Yoneda m a
mzero = (forall b. (a -> b) -> m b) -> Yoneda m a
forall (f :: * -> *) a. (forall b. (a -> b) -> f b) -> Yoneda f a
Yoneda (m b -> (a -> b) -> m b
forall a b. a -> b -> a
const m b
forall (m :: * -> *) a. MonadPlus m => m a
mzero)
  {-# INLINE mzero #-}
  Yoneda forall b. (a -> b) -> m b
f mplus :: Yoneda m a -> Yoneda m a -> Yoneda m a
`mplus` Yoneda forall b. (a -> b) -> m b
g = (forall b. (a -> b) -> m b) -> Yoneda m a
forall (f :: * -> *) a. (forall b. (a -> b) -> f b) -> Yoneda f a
Yoneda (\a -> b
k -> (a -> b) -> m b
forall b. (a -> b) -> m b
f a -> b
k m b -> m b -> m b
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` (a -> b) -> m b
forall b. (a -> b) -> m b
g a -> b
k)
  {-# INLINE mplus #-}

instance MonadTrans Yoneda where
  lift :: m a -> Yoneda m a
lift m a
a = (forall b. (a -> b) -> m b) -> Yoneda m a
forall (f :: * -> *) a. (forall b. (a -> b) -> f b) -> Yoneda f a
Yoneda (\a -> b
f -> (a -> b) -> m a -> m b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> b
f m a
a)
  {-# INLINE lift #-}

instance (Functor f, MonadFree f m) => MonadFree f (Yoneda m) where
  wrap :: f (Yoneda m a) -> Yoneda m a
wrap = m a -> Yoneda m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> Yoneda m a)
-> (f (Yoneda m a) -> m a) -> f (Yoneda m a) -> Yoneda m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (m a) -> m a
forall (f :: * -> *) (m :: * -> *) a.
MonadFree f m =>
f (m a) -> m a
wrap (f (m a) -> m a)
-> (f (Yoneda m a) -> f (m a)) -> f (Yoneda m a) -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Yoneda m a -> m a) -> f (Yoneda m a) -> f (m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Yoneda m a -> m a
forall (f :: * -> *) a. Yoneda f a -> f a
lowerYoneda
  {-# INLINE wrap #-}

instance Extend w => Extend (Yoneda w) where
  extended :: (Yoneda w a -> b) -> Yoneda w a -> Yoneda w b
extended Yoneda w a -> b
k (Yoneda forall b. (a -> b) -> w b
m) = (forall b. (b -> b) -> w b) -> Yoneda w b
forall (f :: * -> *) a. (forall b. (a -> b) -> f b) -> Yoneda f a
Yoneda (\b -> b
f -> (w a -> b) -> w a -> w b
forall (w :: * -> *) a b. Extend w => (w a -> b) -> w a -> w b
extended (b -> b
f (b -> b) -> (w a -> b) -> w a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Yoneda w a -> b
k (Yoneda w a -> b) -> (w a -> Yoneda w a) -> w a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w a -> Yoneda w a
forall (f :: * -> *) a. Functor f => f a -> Yoneda f a
liftYoneda) ((a -> a) -> w a
forall b. (a -> b) -> w b
m a -> a
forall a. a -> a
id))
  {-# INLINE extended #-}

instance Comonad w => Comonad (Yoneda w) where
  extend :: (Yoneda w a -> b) -> Yoneda w a -> Yoneda w b
extend Yoneda w a -> b
k (Yoneda forall b. (a -> b) -> w b
m) = (forall b. (b -> b) -> w b) -> Yoneda w b
forall (f :: * -> *) a. (forall b. (a -> b) -> f b) -> Yoneda f a
Yoneda (\b -> b
f -> (w a -> b) -> w a -> w b
forall (w :: * -> *) a b. Comonad w => (w a -> b) -> w a -> w b
extend (b -> b
f (b -> b) -> (w a -> b) -> w a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Yoneda w a -> b
k (Yoneda w a -> b) -> (w a -> Yoneda w a) -> w a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w a -> Yoneda w a
forall (f :: * -> *) a. Functor f => f a -> Yoneda f a
liftYoneda) ((a -> a) -> w a
forall b. (a -> b) -> w b
m a -> a
forall a. a -> a
id))
  {-# INLINE extend #-}
  extract :: Yoneda w a -> a
extract = w a -> a
forall (w :: * -> *) a. Comonad w => w a -> a
extract (w a -> a) -> (Yoneda w a -> w a) -> Yoneda w a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Yoneda w a -> w a
forall (f :: * -> *) a. Yoneda f a -> f a
lowerYoneda
  {-# INLINE extract #-}

instance ComonadTrans Yoneda where
  lower :: Yoneda w a -> w a
lower = Yoneda w a -> w a
forall (f :: * -> *) a. Yoneda f a -> f a
lowerYoneda
  {-# INLINE lower #-}