{-# 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
( Yoneda(..)
, liftYoneda, lowerYoneda
, maxF, minF, maxM, minM
, 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)
newtype Yoneda f a = Yoneda { Yoneda f a -> forall b. (a -> b) -> f b
runYoneda :: forall b. (a -> b) -> f b }
liftYoneda :: Functor f => f a -> Yoneda f a
liftYoneda :: f a -> Yoneda f a
liftYoneda a :: 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 (\f :: 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 f :: 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 #-}
yonedaToRan :: Yoneda f a -> Ran Identity f a
yonedaToRan :: Yoneda f a -> Ran Identity f a
yonedaToRan (Yoneda m :: 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 m :: 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 #-}
instance Functor (Yoneda f) where
fmap :: (a -> b) -> Yoneda f a -> Yoneda f b
fmap f :: a -> b
f m :: 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 (\k :: 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 m :: forall b. ((a -> b) -> b) -> f b
m <.> :: Yoneda f (a -> b) -> Yoneda f a -> Yoneda f b
<.> Yoneda n :: 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 (\f :: 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
a = (forall b. (a -> b) -> f b) -> Yoneda f a
forall (f :: * -> *) a. (forall b. (a -> b) -> f b) -> Yoneda f a
Yoneda (\f :: a -> b
f -> b -> f b
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> b
f a
a))
{-# INLINE pure #-}
Yoneda m :: forall b. ((a -> b) -> b) -> f b
m <*> :: Yoneda f (a -> b) -> Yoneda f a -> Yoneda f b
<*> Yoneda n :: 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 (\f :: 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 f :: 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 f :: 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 f :: 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 f :: 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 f :: 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 m :: 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 sp :: Int -> a -> ShowS
sp sl :: [a] -> ShowS
sl d :: Int
d (Yoneda f :: 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) "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 rp :: Int -> ReadS a
rp rl :: 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) "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 d :: Int
d (Yoneda f :: forall b. (a -> b) -> f b
f) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
String -> ShowS
showString "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 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 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 "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` f :: forall x. f x -> g x
f = \x :: f a
x y :: 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 eq :: 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 cmp :: 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 f :: forall b. (a -> b) -> f b
f maxF :: Yoneda f a -> Yoneda f a -> Yoneda f a
`maxF` Yoneda g :: 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
{-# INLINE maxF #-}
minF :: (Functor f, Ord (f a)) => Yoneda f a -> Yoneda f a -> Yoneda f a
Yoneda f :: forall b. (a -> b) -> f b
f minF :: Yoneda f a -> Yoneda f a -> Yoneda f a
`minF` Yoneda g :: 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
{-# INLINE minF #-}
maxM :: (Monad m, Ord (m a)) => Yoneda m a -> Yoneda m a -> Yoneda m a
Yoneda f :: forall b. (a -> b) -> m b
f maxM :: Yoneda m a -> Yoneda m a -> Yoneda m a
`maxM` Yoneda g :: 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
{-# INLINE maxM #-}
minM :: (Monad m, Ord (m a)) => Yoneda m a -> Yoneda m a -> Yoneda m a
Yoneda f :: forall b. (a -> b) -> m b
f minM :: Yoneda m a -> Yoneda m a -> Yoneda m a
`minM` Yoneda g :: 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
{-# INLINE minM #-}
instance Alt f => Alt (Yoneda f) where
Yoneda f :: forall b. (a -> b) -> f b
f <!> :: Yoneda f a -> Yoneda f a -> Yoneda f a
<!> Yoneda g :: 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 (\k :: 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 f :: forall b. (a -> b) -> f b
f <|> :: Yoneda f a -> Yoneda f a -> Yoneda f a
<|> Yoneda g :: 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 (\k :: 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 m :: forall b. (a -> b) -> m b
m >>- :: Yoneda m a -> (a -> Yoneda m b) -> Yoneda m b
>>- k :: 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 (\f :: 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
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 m :: forall b. (a -> b) -> m b
m >>= :: Yoneda m a -> (a -> Yoneda m b) -> Yoneda m b
>>= k :: 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 (\f :: 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
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 f :: 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 f :: forall b. (a -> b) -> m b
f mplus :: Yoneda m a -> Yoneda m a -> Yoneda m a
`mplus` Yoneda g :: 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 (\k :: 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 a :: 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 (\f :: 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 k :: Yoneda w a -> b
k (Yoneda m :: 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 (\f :: 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 k :: Yoneda w a -> b
k (Yoneda m :: 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 (\f :: 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 #-}