kan-extensions 3.6.2 → 3.7

raw patch · 7 files changed

+401/−363 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.markdown +5/−0
• kan-extensions.cabal +3/−3
• src/Data/Functor/Contravariant/Coyoneda.hs +77/−0
• src/Data/Functor/Contravariant/Yoneda/Reduction.hs +0/−75
• src/Data/Functor/Coyoneda.hs +292/−0
• src/Data/Functor/Yoneda.hs +24/−5
• src/Data/Functor/Yoneda/Reduction.hs +0/−280

@@ -1,3 +1,8 @@+3.7+---+* Moved all the `Yoneda` variants around again.+* Improved haddocks+ 3.6.2 ----- * Added `Data.Functor.Contravariant.Yoneda` to complete the set of Yoneda embeddings/reductions.

@@ -1,6 +1,6 @@ name:          kan-extensions category:      Data Structures, Monads, Comonads, Functors-version:       3.6.2+version:       3.7 license:       BSD3 cabal-version: >= 1.6 license-file:  LICENSE@@ -63,13 +63,13 @@     Control.Monad.Co     Control.Monad.Codensity     Data.Functor.Contravariant.Yoneda-    Data.Functor.Contravariant.Yoneda.Reduction+    Data.Functor.Contravariant.Coyoneda     Data.Functor.Kan.Lan     Data.Functor.Kan.Lift     Data.Functor.Kan.Ran     Data.Functor.Kan.Rift     Data.Functor.Yoneda-    Data.Functor.Yoneda.Reduction+    Data.Functor.Coyoneda    ghc-options: -Wall 

@@ -0,0 +1,77 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE UndecidableInstances #-}++#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702+{-# LANGUAGE Trustworthy #-}+#endif++-----------------------------------------------------------------------------+-- |+-- Copyright   :  (C) 2013 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  GADTs, TFs, MPTCs+--+-- The co-Yoneda lemma for presheafs states that @f@ is naturally isomorphic to @'Coyoneda' f@.+--+----------------------------------------------------------------------------+module Data.Functor.Contravariant.Coyoneda+  ( Coyoneda(..)+  , liftCoyoneda+  , lowerCoyoneda+  ) where++import Control.Arrow+import Data.Functor.Contravariant+import Data.Functor.Contravariant.Adjunction+import Data.Functor.Contravariant.Representable++type instance Value (Coyoneda f) = Value f++-- | A 'Contravariant' functor (aka presheaf) suitable for Yoneda reduction.+--+-- <http://ncatlab.org/nlab/show/Yoneda+reduction>+data Coyoneda f a where+  Coyoneda :: (a -> b) -> f b -> Coyoneda f a++instance Contravariant (Coyoneda f) where+  contramap f (Coyoneda g m) = Coyoneda (g.f) m+  {-# INLINE contramap #-}++instance Valued f => Valued (Coyoneda f) where+  contramapWithValue beav (Coyoneda ac fc) = Coyoneda (left ac . beav) (contramapWithValue id fc)+  {-# INLINE contramapWithValue #-}++instance Coindexed f => Coindexed (Coyoneda f) where+  coindex (Coyoneda ab fb) a = coindex fb (ab a)+  {-# INLINE coindex #-}++instance Representable f => Representable (Coyoneda f) where+  contrarep = liftCoyoneda . contrarep+  {-# INLINE contrarep #-}++instance Adjunction f g => Adjunction (Coyoneda f) (Coyoneda g) where+  leftAdjunct f = liftCoyoneda . leftAdjunct (lowerCoyoneda . f)+  {-# INLINE leftAdjunct #-}+  rightAdjunct f = liftCoyoneda . rightAdjunct (lowerCoyoneda . f)+  {-# INLINE rightAdjunct #-}++-- | Coyoneda "expansion" of a presheaf+--+-- @+-- 'liftCoyoneda' . 'lowerCoyoneda' ≡ 'id'+-- 'lowerCoyoneda' . 'liftCoyoneda' ≡ 'id'+-- @+liftCoyoneda :: f a -> Coyoneda f a+liftCoyoneda = Coyoneda id+{-# INLINE liftCoyoneda #-}++-- | Coyoneda reduction on a presheaf+lowerCoyoneda :: Contravariant f => Coyoneda f a -> f a+lowerCoyoneda (Coyoneda f m) = contramap f m+{-# INLINE lowerCoyoneda #-}

@@ -1,75 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE UndecidableInstances #-}-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702-{-# LANGUAGE Trustworthy #-}-#endif--------------------------------------------------------------------------------- |--- Copyright   :  (C) 2013 Edward Kmett--- License     :  BSD-style (see the file LICENSE)------ Maintainer  :  Edward Kmett <ekmett@gmail.com>--- Stability   :  provisional--- Portability :  GADTs, TFs, MPTCs------ Yoneda Reduction of presheafs------ <http://ncatlab.org/nlab/show/Yoneda+reduction>---------------------------------------------------------------------------------module Data.Functor.Contravariant.Yoneda.Reduction-  ( Yoneda(..)-  , liftYoneda-  , lowerYoneda-  ) where--import Control.Arrow-import Data.Functor.Contravariant-import Data.Functor.Contravariant.Adjunction-import Data.Functor.Contravariant.Representable--type instance Value (Yoneda f) = Value f---- | A 'Contravariant' functor (aka presheaf) suitable for Yoneda reduction.-data Yoneda f a where-  Yoneda :: (a -> b) -> f b -> Yoneda f a--instance Contravariant (Yoneda f) where-  contramap f (Yoneda g m) = Yoneda (g.f) m-  {-# INLINE contramap #-}--instance Valued f => Valued (Yoneda f) where-  contramapWithValue beav (Yoneda ac fc) = Yoneda (left ac . beav) (contramapWithValue id fc)-  {-# INLINE contramapWithValue #-}--instance Coindexed f => Coindexed (Yoneda f) where-  coindex (Yoneda ab fb) a = coindex fb (ab a)-  {-# INLINE coindex #-}--instance Representable f => Representable (Yoneda f) where-  contrarep = liftYoneda . contrarep-  {-# INLINE contrarep #-}--instance Adjunction f g => Adjunction (Yoneda f) (Yoneda g) where-  leftAdjunct f = liftYoneda . leftAdjunct (lowerYoneda . f)-  {-# INLINE leftAdjunct #-}-  rightAdjunct f = liftYoneda . rightAdjunct (lowerYoneda . f)-  {-# INLINE rightAdjunct #-}---- | Yoneda "expansion" of a presheaf------ @--- 'liftYoneda' . 'lowerYoneda' ≡ 'id'--- 'lowerYoneda' . 'liftYoneda' ≡ 'id'--- @-liftYoneda :: f a -> Yoneda f a-liftYoneda = Yoneda id-{-# INLINE liftYoneda #-}---- | Yoneda reduction on a presheaf-lowerYoneda :: Contravariant f => Yoneda f a -> f a-lowerYoneda (Yoneda f m) = contramap f m-{-# INLINE lowerYoneda #-}

@@ -0,0 +1,292 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE TypeFamilies #-}++#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702+{-# LANGUAGE Trustworthy #-}+#endif++-----------------------------------------------------------------------------+-- |+-- Copyright   :  (C) 2011-2013 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  GADTs, MPTCs, fundeps+--+-- 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+  -- * as a Left Kan extension+  , coyonedaToLan, lanToCoyoneda+  -- * as a Left Kan lift+  , coyonedaToLift, liftToCoyoneda+  ) where++import Control.Applicative+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+import Data.Function (on)+import Data.Functor.Adjunction+import Data.Functor.Bind+import Data.Functor.Extend+import Data.Functor.Identity+import Data.Functor.Kan.Lan+import Data.Functor.Kan.Lift+import Data.Functor.Plus+import Data.Functor.Representable+import Data.Key+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.+--+-- @+-- 'coyonedaToLan' . 'lanToCoyoneda' ≡ 'id'+-- 'lanToCoyoneda' . 'coyonedaToLan' ≡ 'id'+-- @+coyonedaToLan :: Coyoneda f a -> Lan Identity f a+coyonedaToLan (Coyoneda ba fb) = Lan (ba . runIdentity) fb++lanToCoyoneda :: Lan Identity f a -> Coyoneda f a+lanToCoyoneda (Lan iba fb) = Coyoneda (iba . Identity) fb++{-# RULES "coyonedaToLan/lanToCoyoneda=id" coyonedaToLan . lanToCoyoneda = id #-}+{-# RULES "lanToCoyoneda/coyonedaToLan=id" lanToCoyoneda . coyonedaToLan = id #-}++-- | @'Coyoneda' f@ is the left Kan lift of @f@ along the 'Identity' functor.+--+-- @+-- 'coyonedaToLift' . 'liftToCoyoneda' ≡ 'id'+-- 'liftToCoyoneda' . 'coyonedaToLift' ≡ 'id'+-- @+coyonedaToLift :: Coyoneda f a -> Lift Identity f a+coyonedaToLift (Coyoneda ba fb) = Lift $ \ f2iz -> ba <$> runIdentity (f2iz fb)++liftToCoyoneda :: Functor f => Lift Identity f a -> Coyoneda f a+liftToCoyoneda (Lift m) = Coyoneda id (m Identity)++{-# RULES "coyonedaToLift/liftToCoyoneda=id" coyonedaToLift . liftToCoyoneda = id #-}+{-# RULES "liftToCoyoneda/coyonedaToLift=id" liftToCoyoneda . coyonedaToLift = id #-}++instance Functor (Coyoneda f) where+  fmap f (Coyoneda g v) = Coyoneda (f . g) v+  {-# INLINE fmap #-}++type instance Key (Coyoneda f) = Key f++instance Keyed f => Keyed (Coyoneda f) where+  mapWithKey f (Coyoneda k a) = Coyoneda id $ mapWithKey (\x -> f x . k) a+  {-# INLINE mapWithKey #-}++instance Apply f => Apply (Coyoneda f) where+  m <.> n = liftCoyoneda $ lowerCoyoneda m <.> lowerCoyoneda n+  {-# INLINE (<.>) #-}++instance Applicative f => Applicative (Coyoneda f) where+  pure = liftCoyoneda . pure+  {-# INLINE pure #-}+  m <*> n = liftCoyoneda $ lowerCoyoneda m <*> lowerCoyoneda n+  {-# INLINE (<*>) #-}++instance Zip f => Zip (Coyoneda f) where+  zipWith f m n = liftCoyoneda $ zipWith f (lowerCoyoneda m) (lowerCoyoneda n)+  {-# INLINE zipWith #-}++instance ZipWithKey f => ZipWithKey (Coyoneda f) where+  zipWithKey f m n = liftCoyoneda $ zipWithKey f (lowerCoyoneda m) (lowerCoyoneda n)+  {-# INLINE zipWithKey #-}++instance Alternative f => Alternative (Coyoneda f) where+  empty = liftCoyoneda empty+  {-# INLINE empty #-}+  m <|> n = liftCoyoneda $ lowerCoyoneda m <|> lowerCoyoneda n+  {-# INLINE (<|>) #-}++instance Alt f => Alt (Coyoneda f) where+  m <!> n = liftCoyoneda $ lowerCoyoneda m <!> lowerCoyoneda n+  {-# INLINE (<!>) #-}++instance Plus f => Plus (Coyoneda f) where+  zero = liftCoyoneda zero+  {-# INLINE zero #-}++instance Bind m => Bind (Coyoneda m) where+  Coyoneda f v >>- k = liftCoyoneda (v >>- lowerCoyoneda . k . f)+  {-# INLINE (>>-) #-}++instance Monad m => Monad (Coyoneda m) where+  return = Coyoneda id . return+  {-# INLINE return #-}+  Coyoneda f v >>= k = lift (v >>= lowerM . k . f)+  {-# INLINE (>>=) #-}++instance MonadTrans Coyoneda where+  lift = Coyoneda id+  {-# INLINE lift #-}++instance MonadFix f => MonadFix (Coyoneda f) where+  mfix f = lift $ mfix (lowerM . f)+  {-# INLINE mfix #-}++instance MonadPlus f => MonadPlus (Coyoneda f) where+  mzero = lift mzero+  {-# INLINE mzero #-}+  m `mplus` n = lift $ lowerM m `mplus` lowerM n+  {-# INLINE mplus #-}++instance (Functor f, Lookup f) => Lookup (Coyoneda f) where+  lookup k f = lookup k (lowerCoyoneda f)+  {-# INLINE lookup #-}++instance (Functor f, Indexable f) => Indexable (Coyoneda f) where+  index = index . lowerCoyoneda+  {-# INLINE index #-}++instance Representable f => Representable (Coyoneda f) where+  tabulate = liftCoyoneda . tabulate+  {-# INLINE tabulate #-}++instance Extend w => Extend (Coyoneda w) where+  extended k (Coyoneda f v) = Coyoneda id $ extended (k . Coyoneda f) v+  {-# INLINE extended #-}++instance Comonad w => Comonad (Coyoneda w) where+  extend k (Coyoneda f v) = Coyoneda id $ extend (k . Coyoneda f) v+  {-# INLINE extend #-}+  extract (Coyoneda f v) = f (extract v)+  {-# INLINE extract #-}++instance ComonadTrans Coyoneda where+  lower (Coyoneda f a) = fmap f a+  {-# INLINE lower #-}++instance Foldable f => Foldable (Coyoneda f) where+  foldMap f (Coyoneda k a) = foldMap (f . k) a+  {-# INLINE foldMap #-}++instance FoldableWithKey f => FoldableWithKey (Coyoneda f) where+  foldMapWithKey f (Coyoneda k a) = foldMapWithKey (\x -> f x . k) a+  {-# INLINE foldMapWithKey #-}++instance Foldable1 f => Foldable1 (Coyoneda f) where+  foldMap1 f (Coyoneda k a) = foldMap1 (f . k) a+  {-# INLINE foldMap1 #-}++instance FoldableWithKey1 f => FoldableWithKey1 (Coyoneda f) where+  foldMapWithKey1 f (Coyoneda k a) = foldMapWithKey1 (\x -> f x . k) a+  {-# INLINE foldMapWithKey1 #-}++instance Traversable f => Traversable (Coyoneda f) where+  traverse f (Coyoneda k a) = Coyoneda id <$> traverse (f . k) a+  {-# INLINE traverse #-}++instance Traversable1 f => Traversable1 (Coyoneda f) where+  traverse1 f (Coyoneda k a) = Coyoneda id <$> traverse1 (f . k) a+  {-# INLINE traverse1 #-}++instance TraversableWithKey f => TraversableWithKey (Coyoneda f) where+  traverseWithKey f (Coyoneda k a) = Coyoneda id <$> traverseWithKey (\x -> f x . k) a+  {-# INLINE traverseWithKey #-}++instance TraversableWithKey1 f => TraversableWithKey1 (Coyoneda f) where+  traverseWithKey1 f (Coyoneda k a) = Coyoneda id <$> traverseWithKey1 (\x -> f x . k) a+  {-# INLINE traverseWithKey1 #-}++instance Distributive f => Distributive (Coyoneda f) where+  collect f = liftCoyoneda . collect (lowerCoyoneda . f)+  {-# INLINE collect #-}++instance (Functor f, Show (f a)) => Show (Coyoneda f a) where+  showsPrec d (Coyoneda f a) = showParen (d > 10) $+    showString "liftCoyoneda " . showsPrec 11 (fmap f a)+  {-# INLINE showsPrec #-}++#ifdef __GLASGOW_HASKELL__+instance (Functor f, Read (f a)) => Read (Coyoneda f a) where+  readPrec = parens $ prec 10 $ do+    Ident "liftCoyoneda" <- lexP+    liftCoyoneda <$> step readPrec+  {-# INLINE readPrec #-}+#endif++instance (Functor f, Eq (f a)) => Eq (Coyoneda f a) where+  (==) = (==) `on` lowerCoyoneda+  {-# INLINE (==) #-}++instance (Functor f, Ord (f a)) => Ord (Coyoneda f a) where+  compare = compare `on` lowerCoyoneda+  {-# INLINE compare #-}++instance Adjunction f g => Adjunction (Coyoneda f) (Coyoneda g) where+  unit = liftCoyoneda . fmap liftCoyoneda . unit+  {-# INLINE unit #-}+  counit = counit . fmap lowerCoyoneda . 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 = Coyoneda 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 m) = fmap f 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 m) = liftM f m+{-# INLINE lowerM #-}

@@ -22,9 +22,8 @@ -- Stability   :  provisional -- Portability :  MPTCs, fundeps ----- The co-Yoneda lemma states that------ @f a@ is isomorphic to @(forall r. (a -> r) -> f a)@+-- 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 --@@ -76,8 +75,28 @@   {-# INLINE specByM' #-} #endif +-- | @Yoneda f a@ can be viewed as the partial application of 'fmap' to its second argument. newtype Yoneda f a = Yoneda { 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 a = Yoneda (\f -> fmap f a) @@ -87,7 +106,7 @@ {-# RULES "lower/lift=id" liftYoneda . lowerYoneda = id #-} {-# RULES "lift/lower=id" lowerYoneda . liftYoneda = id #-} --- | @Yoneda f@ is the right Kan extension of @f@ along the 'Identity' functor.+-- | @Yoneda f@ can be viewed as the right Kan extension of @f@ along the 'Identity' functor. -- -- @ -- 'yonedaToRan' . 'ranToYoneda' ≡ 'id'@@ -102,7 +121,7 @@ {-# RULES "yonedaToRan/ranToYoneda=id" yonedaToRan . ranToYoneda = id #-} {-# RULES "ranToYoneda/yonedaToRan=id" ranToYoneda . yonedaToRan = id #-} --- | @Yoneda f@ is the right Kan lift of @f@ along the 'Identity' functor.+-- | @Yoneda f@ can be viewed as the right Kan lift of @f@ along the 'Identity' functor. -- -- @ -- 'yonedaToRift' . 'riftToYoneda' ≡ 'id'

@@ -1,280 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE TypeFamilies #-}--#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702-{-# LANGUAGE Trustworthy #-}-#endif---------------------------------------------------------------------------------- |--- Copyright   :  (C) 2011-2013 Edward Kmett--- License     :  BSD-style (see the file LICENSE)------ Maintainer  :  Edward Kmett <ekmett@gmail.com>--- Stability   :  provisional--- Portability :  GADTs, MPTCs, fundeps------ Yoneda Reduction:------ <http://ncatlab.org/nlab/show/Yoneda+reduction>------ @'Yoneda' f@ is isomorphic to @'Lan' f 'Identity'@------------------------------------------------------------------------------module Data.Functor.Yoneda.Reduction-  ( Yoneda(..)-  , liftYoneda, lowerYoneda, lowerM-  -- * as a Left Kan extension-  , yonedaToLan, lanToYoneda-  -- * as a Left Kan lift-  , yonedaToLift, liftToYoneda-  ) where--import Control.Applicative-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-import Data.Function (on)-import Data.Functor.Adjunction-import Data.Functor.Bind-import Data.Functor.Extend-import Data.Functor.Identity-import Data.Functor.Kan.Lan-import Data.Functor.Kan.Lift-import Data.Functor.Plus-import Data.Functor.Representable-import Data.Key-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 form suitable for Yoneda reduction-data Yoneda f a where-  Yoneda :: (b -> a) -> f b -> Yoneda f a---- | @Yoneda f@ is the left Kan extension of @f@ along the 'Identity' functor.------ @--- 'yonedaToLan' . 'lanToYoneda' ≡ 'id'--- 'lanToYoneda' . 'yonedaToLan' ≡ 'id'--- @-yonedaToLan :: Yoneda f a -> Lan Identity f a-yonedaToLan (Yoneda ba fb) = Lan (ba . runIdentity) fb--lanToYoneda :: Lan Identity f a -> Yoneda f a-lanToYoneda (Lan iba fb) = Yoneda (iba . Identity) fb--{-# RULES "yonedaToLan/lanToYoneda=id" yonedaToLan . lanToYoneda = id #-}-{-# RULES "lanToYoneda/yonedaToLan=id" lanToYoneda . yonedaToLan = id #-}---- | @Yoneda f@ is the left Kan lift of @f@ along the 'Identity' functor.------ @--- 'yonedaToLift' . 'liftToYoneda' ≡ 'id'--- 'liftToYoneda' . 'yonedaToLift' ≡ 'id'--- @-yonedaToLift :: Yoneda f a -> Lift Identity f a-yonedaToLift (Yoneda ba fb) = Lift $ \ f2iz -> ba <$> runIdentity (f2iz fb)--liftToYoneda :: Functor f => Lift Identity f a -> Yoneda f a-liftToYoneda (Lift m) = Yoneda id (m Identity)--{-# RULES "yonedaToLift/liftToYoneda=id" yonedaToLift . liftToYoneda = id #-}-{-# RULES "liftToYoneda/yonedaToLift=id" liftToYoneda . yonedaToLift = id #-}--instance Functor (Yoneda f) where-  fmap f (Yoneda g v) = Yoneda (f . g) v-  {-# INLINE fmap #-}--type instance Key (Yoneda f) = Key f--instance Keyed f => Keyed (Yoneda f) where-  mapWithKey f (Yoneda k a) = Yoneda id $ mapWithKey (\x -> f x . k) a-  {-# INLINE mapWithKey #-}--instance Apply f => Apply (Yoneda f) where-  m <.> n = liftYoneda $ lowerYoneda m <.> lowerYoneda n-  {-# INLINE (<.>) #-}--instance Applicative f => Applicative (Yoneda f) where-  pure = liftYoneda . pure-  {-# INLINE pure #-}-  m <*> n = liftYoneda $ lowerYoneda m <*> lowerYoneda n-  {-# INLINE (<*>) #-}--instance Zip f => Zip (Yoneda f) where-  zipWith f m n = liftYoneda $ zipWith f (lowerYoneda m) (lowerYoneda n)-  {-# INLINE zipWith #-}--instance ZipWithKey f => ZipWithKey (Yoneda f) where-  zipWithKey f m n = liftYoneda $ zipWithKey f (lowerYoneda m) (lowerYoneda n)-  {-# INLINE zipWithKey #-}--instance Alternative f => Alternative (Yoneda f) where-  empty = liftYoneda empty-  {-# INLINE empty #-}-  m <|> n = liftYoneda $ lowerYoneda m <|> lowerYoneda n-  {-# INLINE (<|>) #-}--instance Alt f => Alt (Yoneda f) where-  m <!> n = liftYoneda $ lowerYoneda m <!> lowerYoneda n-  {-# INLINE (<!>) #-}--instance Plus f => Plus (Yoneda f) where-  zero = liftYoneda zero-  {-# INLINE zero #-}--instance Bind m => Bind (Yoneda m) where-  Yoneda f v >>- k = liftYoneda (v >>- lowerYoneda . k . f)-  {-# INLINE (>>-) #-}--instance Monad m => Monad (Yoneda m) where-  return = Yoneda id . return-  {-# INLINE return #-}-  Yoneda f v >>= k = lift (v >>= lowerM . k . f)-  {-# INLINE (>>=) #-}--instance MonadTrans Yoneda where-  lift = Yoneda id-  {-# INLINE lift #-}--instance MonadFix f => MonadFix (Yoneda f) where-  mfix f = lift $ mfix (lowerM . f)-  {-# INLINE mfix #-}--instance MonadPlus f => MonadPlus (Yoneda f) where-  mzero = lift mzero-  {-# INLINE mzero #-}-  m `mplus` n = lift $ lowerM m `mplus` lowerM n-  {-# INLINE mplus #-}--instance (Functor f, Lookup f) => Lookup (Yoneda f) where-  lookup k f = lookup k (lowerYoneda f)-  {-# INLINE lookup #-}--instance (Functor f, Indexable f) => Indexable (Yoneda f) where-  index = index . lowerYoneda-  {-# INLINE index #-}--instance Representable f => Representable (Yoneda f) where-  tabulate = liftYoneda . tabulate-  {-# INLINE tabulate #-}--instance Extend w => Extend (Yoneda w) where-  extended k (Yoneda f v) = Yoneda id $ extended (k . Yoneda f) v-  {-# INLINE extended #-}--instance Comonad w => Comonad (Yoneda w) where-  extend k (Yoneda f v) = Yoneda id $ extend (k . Yoneda f) v-  {-# INLINE extend #-}-  extract (Yoneda f v) = f (extract v)-  {-# INLINE extract #-}--instance ComonadTrans Yoneda where-  lower (Yoneda f a) = fmap f a-  {-# INLINE lower #-}--instance Foldable f => Foldable (Yoneda f) where-  foldMap f (Yoneda k a) = foldMap (f . k) a-  {-# INLINE foldMap #-}--instance FoldableWithKey f => FoldableWithKey (Yoneda f) where-  foldMapWithKey f (Yoneda k a) = foldMapWithKey (\x -> f x . k) a-  {-# INLINE foldMapWithKey #-}--instance Foldable1 f => Foldable1 (Yoneda f) where-  foldMap1 f (Yoneda k a) = foldMap1 (f . k) a-  {-# INLINE foldMap1 #-}--instance FoldableWithKey1 f => FoldableWithKey1 (Yoneda f) where-  foldMapWithKey1 f (Yoneda k a) = foldMapWithKey1 (\x -> f x . k) a-  {-# INLINE foldMapWithKey1 #-}--instance Traversable f => Traversable (Yoneda f) where-  traverse f (Yoneda k a) = Yoneda id <$> traverse (f . k) a-  {-# INLINE traverse #-}--instance Traversable1 f => Traversable1 (Yoneda f) where-  traverse1 f (Yoneda k a) = Yoneda id <$> traverse1 (f . k) a-  {-# INLINE traverse1 #-}--instance TraversableWithKey f => TraversableWithKey (Yoneda f) where-  traverseWithKey f (Yoneda k a) = Yoneda id <$> traverseWithKey (\x -> f x . k) a-  {-# INLINE traverseWithKey #-}--instance TraversableWithKey1 f => TraversableWithKey1 (Yoneda f) where-  traverseWithKey1 f (Yoneda k a) = Yoneda id <$> traverseWithKey1 (\x -> f x . k) a-  {-# INLINE traverseWithKey1 #-}--instance Distributive f => Distributive (Yoneda f) where-  collect f = liftYoneda . collect (lowerYoneda . f)-  {-# INLINE collect #-}--instance (Functor f, Show (f a)) => Show (Yoneda f a) where-  showsPrec d (Yoneda f a) = showParen (d > 10) $-    showString "liftYoneda " . showsPrec 11 (fmap f a)-  {-# INLINE showsPrec #-}--#ifdef __GLASGOW_HASKELL__-instance (Functor f, Read (f a)) => Read (Yoneda f a) where-  readPrec = parens $ prec 10 $ do-    Ident "liftYoneda" <- lexP-    liftYoneda <$> step readPrec-  {-# INLINE readPrec #-}-#endif--instance (Functor f, Eq (f a)) => Eq (Yoneda f a) where-  (==) = (==) `on` lowerYoneda-  {-# INLINE (==) #-}--instance (Functor f, Ord (f a)) => Ord (Yoneda f a) where-  compare = compare `on` lowerYoneda-  {-# INLINE compare #-}--instance Adjunction f g => Adjunction (Yoneda f) (Yoneda g) where-  unit = liftYoneda . fmap liftYoneda . unit-  {-# INLINE unit #-}-  counit = counit . fmap lowerYoneda . lowerYoneda-  {-# INLINE counit #-}---- | Yoneda "expansion"------ @--- 'liftYoneda' . 'lowerYoneda' ≡ 'id'--- 'lowerYoneda' . 'liftYoneda' ≡ 'id'--- @--------- @--- 'lift' = 'liftYoneda'--- @-liftYoneda :: f a -> Yoneda f a-liftYoneda = Yoneda id-{-# INLINE liftYoneda #-}---- | Yoneda reduction------ @--- 'lower' = 'lowerM' = 'lowerYoneda'--- @-lowerYoneda :: Functor f => Yoneda f a -> f a-lowerYoneda (Yoneda f m) = fmap f m-{-# INLINE lowerYoneda #-}---- | Yoneda reduction given a 'Monad'.------ @--- 'lower' = 'lowerM' = 'lowerYoneda'--- @-lowerM :: Monad f => Yoneda f a -> f a-lowerM (Yoneda f m) = liftM f m-{-# INLINE lowerM #-}