kan-extensions 4.2.3 → 5

raw patch · 18 files changed

+195/−426 lines, 18 filesdep ~transformersPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: transformers

API changes (from Hackage documentation)

Files

• .travis.yml +4/−4
• CHANGELOG.markdown +4/−0
• LICENSE +1/−1
• kan-extensions.cabal +4/−5
• src/Control/Comonad/Density.hs +1/−1
• src/Control/Monad/Co.hs +3/−3
• src/Control/Monad/Codensity.hs +19/−10
• src/Data/Functor/Contravariant/Coyoneda.hs +1/−1
• src/Data/Functor/Contravariant/Day.hs +1/−1
• src/Data/Functor/Contravariant/Yoneda.hs +1/−1
• src/Data/Functor/Coyoneda.hs +12/−19
• src/Data/Functor/Day.hs +1/−1
• src/Data/Functor/Day/Curried.hs +137/−0
• src/Data/Functor/Kan/Lan.hs +1/−1
• src/Data/Functor/Kan/Lift.hs +0/−145
• src/Data/Functor/Kan/Ran.hs +1/−1
• src/Data/Functor/Kan/Rift.hs +0/−210
• src/Data/Functor/Yoneda.hs +4/−22

@@ -13,12 +13,12 @@  matrix:   include:-    - env: CABALVER=1.16 GHCVER=7.4.2+    - env: CABALVER=1.18 GHCVER=7.4.2       compiler: ": #GHC 7.4.2"-      addons: {apt: {packages: [cabal-install-1.16,ghc-7.4.2,alex-3.1.4,happy-1.19.5], sources: [hvr-ghc]}}-    - env: CABALVER=1.16 GHCVER=7.6.3+      addons: {apt: {packages: [cabal-install-1.18,ghc-7.4.2,alex-3.1.4,happy-1.19.5], sources: [hvr-ghc]}}+    - env: CABALVER=1.18 GHCVER=7.6.3       compiler: ": #GHC 7.6.3"-      addons: {apt: {packages: [cabal-install-1.16,ghc-7.6.3,alex-3.1.4,happy-1.19.5], sources: [hvr-ghc]}}+      addons: {apt: {packages: [cabal-install-1.18,ghc-7.6.3,alex-3.1.4,happy-1.19.5], sources: [hvr-ghc]}}     - env: CABALVER=1.18 GHCVER=7.8.4       compiler: ": #GHC 7.8.4"       addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4,alex-3.1.4,happy-1.19.5], sources: [hvr-ghc]}}

@@ -1,3 +1,7 @@+5+-----+* Move `Data.Functor.Kan.Rift` to `Data.Functor.Day.Curried`+ 4.2.3 ----- * Builds clean on GHC 7.10

@@ -1,4 +1,4 @@-Copyright 2008-2013 Edward Kmett+Copyright 2008-2016 Edward Kmett  All rights reserved. 

@@ -1,6 +1,6 @@ name:          kan-extensions category:      Data Structures, Monads, Comonads, Functors-version:       4.2.3+version:       5 license:       BSD3 cabal-version: >= 1.6 license-file:  LICENSE@@ -9,7 +9,7 @@ stability:     provisional homepage:      http://github.com/ekmett/kan-extensions/ bug-reports:   http://github.com/ekmett/kan-extensions/issues-copyright:     Copyright (C) 2008-2013 Edward A. Kmett+copyright:     Copyright (C) 2008-2016 Edward A. Kmett synopsis:      Kan extensions, Kan lifts, various forms of the Yoneda lemma, and (co)density (co)monads description:   Kan extensions, Kan lifts, various forms of the Yoneda lemma, and (co)density (co)monads build-type:    Simple@@ -51,7 +51,7 @@     mtl           >= 2.0.1   && < 2.3,     semigroupoids >= 4       && < 6,     tagged        >= 0.7.2   && < 1,-    transformers  >= 0.2     && < 0.5+    transformers  >= 0.2     && < 0.6    exposed-modules:     Control.Comonad.Density@@ -61,10 +61,9 @@     Data.Functor.Contravariant.Yoneda     Data.Functor.Contravariant.Coyoneda     Data.Functor.Day+    Data.Functor.Day.Curried     Data.Functor.Kan.Lan-    Data.Functor.Kan.Lift     Data.Functor.Kan.Ran-    Data.Functor.Kan.Rift     Data.Functor.Yoneda     Data.Functor.Coyoneda 

@@ -7,7 +7,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  Control.Comonad.Density--- Copyright   :  (C) 2008-2011 Edward Kmett+-- Copyright   :  (C) 2008-2016 Edward Kmett -- License     :  BSD-style (see the file LICENSE) -- -- Maintainer  :  Edward Kmett <ekmett@gmail.com>

@@ -9,7 +9,7 @@ #endif ----------------------------------------------------------------------------- -- |--- Copyright   :  (C) 2011 Edward Kmett+-- Copyright   :  (C) 2011-2016 Edward Kmett -- License     :  BSD-style (see the file LICENSE) -- -- Maintainer  :  Edward Kmett <ekmett@gmail.com>@@ -83,7 +83,7 @@  -- | -- @--- 'Co' w a ~ 'Data.Functor.KanLift.Rift' w 'Identity' a+-- 'Co' w a ~ 'Data.Functor.Kan.Rift.Rift' w 'Identity' a -- @ newtype CoT w m a = CoT { runCoT :: forall r. w (a -> m r) -> m r } @@ -101,7 +101,7 @@   mf <*> ma = mf >>= \f -> fmap f ma  instance Comonad w => Monad (CoT w m) where-  return a = CoT (`extract` a)+  return = pure   CoT k >>= f = CoT (k . extend (\wa a -> runCoT (f a) wa))  instance Comonad w => MonadTrans (CoT w) where

@@ -3,17 +3,17 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702+#if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708+#if __GLASGOW_HASKELL__ >= 708 {-# LANGUAGE DeriveDataTypeable #-} #endif  ----------------------------------------------------------------------------- -- | -- Module      :  Control.Monad.Codensity--- Copyright   :  (C) 2008-2013 Edward Kmett+-- Copyright   :  (C) 2008-2016 Edward Kmett -- License     :  BSD-style (see the file LICENSE) -- -- Maintainer  :  Edward Kmett <ekmett@gmail.com>@@ -31,7 +31,7 @@   ) where  import Control.Applicative-import Control.Monad (ap, MonadPlus(..))+import Control.Monad (MonadPlus(..)) import Control.Monad.Free import Control.Monad.IO.Class import Control.Monad.Reader.Class@@ -42,7 +42,7 @@ import Data.Functor.Kan.Ran import Data.Functor.Plus import Data.Functor.Rep-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708+#if __GLASGOW_HASKELL__ >= 708 import Data.Typeable #endif @@ -54,13 +54,13 @@ -- repeated applications of @(>>=)@. -- -- See \"Asymptotic Improvement of Computations over Free Monads\" by Janis--- Voightländer for more information about this type.+-- Voigtländer for more information about this type. -- -- <http://www.iai.uni-bonn.de/~jv/mpc08.pdf> newtype Codensity m a = Codensity   { runCodensity :: forall b. (a -> m b) -> m b   }-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708+#if __GLASGOW_HASKELL__ >= 708     deriving Typeable #endif @@ -69,17 +69,17 @@   {-# INLINE fmap #-}  instance Apply (Codensity f) where-  (<.>) = ap+  (<.>) = (<*>)   {-# INLINE (<.>) #-}  instance Applicative (Codensity f) where   pure x = Codensity (\k -> k x)   {-# INLINE pure #-}-  (<*>) = ap+  Codensity f <*> Codensity g = Codensity (\bfr -> f (\ab -> g (bfr . ab)))   {-# INLINE (<*>) #-}  instance Monad (Codensity f) where-  return x = Codensity (\k -> k x)+  return = pure   {-# INLINE return #-}   m >>= k = Codensity (\c -> runCodensity m (\a -> runCodensity (k a) c))   {-# INLINE (>>=) #-}@@ -116,11 +116,15 @@   Codensity m <|> Codensity n = Codensity (\k -> m k <|> n k)   {-# INLINE (<|>) #-} +#if __GLASGOW_HASKELL__ >= 710+instance Alternative v => MonadPlus (Codensity v)+#else instance MonadPlus v => MonadPlus (Codensity v) where   mzero = Codensity (\_ -> mzero)   {-# INLINE mzero #-}   Codensity m `mplus` Codensity n = Codensity (\k -> m k `mplus` n k)   {-# INLINE mplus #-}+#endif  -- | -- This serves as the *left*-inverse (retraction) of 'lift'.@@ -136,8 +140,13 @@ -- e.g. @'Codensity' ((->) s)) a ~ forall r. (a -> s -> r) -> s -> r@ -- could support a full complement of @'MonadState' s@ actions, while @(->) s@ -- is limited to @'MonadReader' s@ actions.+#if __GLASGOW_HASKELL__ >= 710+lowerCodensity :: Applicative f => Codensity f a -> f a+lowerCodensity a = runCodensity a pure+#else lowerCodensity :: Monad m => Codensity m a -> m a lowerCodensity a = runCodensity a return+#endif {-# INLINE lowerCodensity #-}  -- | The 'Codensity' monad of a right adjoint is isomorphic to the

@@ -10,7 +10,7 @@  ----------------------------------------------------------------------------- -- |--- Copyright   :  (C) 2013 Edward Kmett+-- Copyright   :  (C) 2013-2016 Edward Kmett -- License     :  BSD-style (see the file LICENSE) -- -- Maintainer  :  Edward Kmett <ekmett@gmail.com>

@@ -13,7 +13,7 @@ #endif ----------------------------------------------------------------------------- -- |--- Copyright   :  (C) 2013-2014 Edward Kmett, Gershom Bazerman and Derek Elkins+-- Copyright   :  (C) 2013-2016 Edward Kmett, Gershom Bazerman and Derek Elkins -- License     :  BSD-style (see the file LICENSE) -- -- Maintainer  :  Edward Kmett <ekmett@gmail.com>

@@ -9,7 +9,7 @@ #endif ----------------------------------------------------------------------------- -- |--- Copyright   :  (C) 2013 Edward Kmett+-- Copyright   :  (C) 2013-2016 Edward Kmett -- License     :  BSD-style (see the file LICENSE) -- -- Maintainer  :  Edward Kmett <ekmett@gmail.com>

@@ -11,7 +11,7 @@  ----------------------------------------------------------------------------- -- |--- Copyright   :  (C) 2011-2013 Edward Kmett+-- Copyright   :  (C) 2011-2016 Edward Kmett -- License     :  BSD-style (see the file LICENSE) -- -- Maintainer  :  Edward Kmett <ekmett@gmail.com>@@ -26,8 +26,6 @@   , liftCoyoneda, lowerCoyoneda, lowerM   -- * as a Left Kan extension   , coyonedaToLan, lanToCoyoneda-  -- * as a Left Kan lift-  , coyonedaToLift, liftToCoyoneda   ) where  import Control.Applicative@@ -43,7 +41,6 @@ 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.Rep import Data.Foldable@@ -60,6 +57,15 @@  -- | @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'@@ -73,21 +79,6 @@ -- {-# 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 #-}@@ -121,8 +112,10 @@   {-# INLINE (>>-) #-}  instance Monad m => Monad (Coyoneda m) where+#if __GLASGOW_HASKELL__ < 710   return = Coyoneda id . return   {-# INLINE return #-}+#endif   Coyoneda f v >>= k = lift (v >>= lowerM . k . f)   {-# INLINE (>>=) #-} 

@@ -6,7 +6,7 @@ {-# LANGUAGE RankNTypes #-} ----------------------------------------------------------------------------- -- |--- Copyright   :  (C) 2014 Edward Kmett+-- Copyright   :  (C) 2014-2016 Edward Kmett -- License     :  BSD-style (see the file LICENSE) -- -- Maintainer  :  Edward Kmett <ekmett@gmail.com>

@@ -0,0 +1,137 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE GADTs #-}++#if __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL__ < 710+{-# LANGUAGE Trustworthy #-}+#endif+-------------------------------------------------------------------------------------------+-- |+-- Copyright 	: 2013-2016 Edward Kmett and Dan Doel+-- License	: BSD+--+-- Maintainer	: Edward Kmett <ekmett@gmail.com>+-- Stability	: experimental+-- Portability	: rank N types+--+-- @'Day' f -| 'Curried' f@+--+-- @'Day' f ~ 'Compose' f@ when f preserves colimits / is a left adjoint. (Due in part to the+-- strength of all functors in Hask.)+--+-- So by the uniqueness of adjoints, when f is a left adjoint, @'Curried' f ~ 'Rift' f@+-------------------------------------------------------------------------------------------+module Data.Functor.Day.Curried+  (+  -- * Right Kan lifts+    Curried(..)+  , toCurried, fromCurried, applied, unapplied+  , adjointToCurried, curriedToAdjoint+  , composedAdjointToCurried, curriedToComposedAdjoint+  , liftCurried, lowerCurried, rap+  ) where++#if __GLASGOW_HASKELL__ < 710+import Control.Applicative+#endif+import Data.Functor.Adjunction+import Data.Functor.Day+import Data.Functor.Identity++newtype Curried g h a =+  Curried { runCurried :: forall r. g (a -> r) -> h r }++instance Functor g => Functor (Curried g h) where+  fmap f (Curried g) = Curried (g . fmap (.f))+  {-# INLINE fmap #-}++instance (Functor g, g ~ h) => Applicative (Curried g h) where+  pure a = Curried (fmap ($a))+  {-# INLINE pure #-}+  Curried mf <*> Curried ma = Curried (ma . mf . fmap (.))+  {-# INLINE (<*>) #-}++-- | The natural isomorphism between @f@ and @Curried f f@.+-- @+-- 'lowerCurried' '.' 'liftCurried' ≡ 'id'+-- 'liftCurried' '.' 'lowerCurried' ≡ 'id'+-- @+--+-- @+-- 'lowerCurried' ('liftCurried' x)     -- definition+-- 'lowerCurried' ('Curried' ('<*>' x))   -- definition+-- ('<*>' x) ('pure' 'id')          -- beta reduction+-- 'pure' 'id' '<*>' x              -- Applicative identity law+-- x+-- @+liftCurried :: Applicative f => f a -> Curried f f a+liftCurried fa = Curried (<*> fa)+{-# INLINE liftCurried #-}++-- | Lower 'Curried' by applying 'pure' 'id' to the continuation.+--+-- See 'liftCurried'.+lowerCurried :: Applicative f => Curried f g a -> g a+lowerCurried (Curried f) = f (pure id)+{-# INLINE lowerCurried #-}++-- | Indexed applicative composition of right Kan lifts.+rap :: Functor f => Curried f g (a -> b) -> Curried g h a -> Curried f h b+rap (Curried mf) (Curried ma) = Curried (ma . mf . fmap (.))+{-# INLINE rap #-}++-- | This is the counit of the @Day f -| Curried f@ adjunction+applied :: Functor f => Day f (Curried f g) a -> g a+applied (Day fb (Curried fg) bca) = fg (bca <$> fb)+{-# INLINE applied #-}++-- | This is the unit of the @Day f -| Curried f@ adjunction+unapplied :: Functor f => g a -> Curried f (Day f g) a+unapplied ga = Curried $ \ fab -> Day fab ga id+{-# INLINE unapplied #-}++-- | The universal property of 'Curried'+toCurried :: (Functor g, Functor k) => (forall x. Day g k x -> h x) -> k a -> Curried g h a+toCurried h ka = Curried $ \gar -> h (Day gar ka id)+{-# INLINE toCurried #-}++-- |+-- @+-- 'toCurried' . 'fromCurried' ≡ 'id'+-- 'fromCurried' . 'toCurried' ≡ 'id'+-- @+fromCurried :: Functor f => (forall a. k a -> Curried f h a) -> Day f k b -> h b+fromCurried f (Day fc kd cdb) = runCurried (f kd) (cdb <$> fc)+{-# INLINE fromCurried #-}++-- | @Curried f Identity a@ is isomorphic to the right adjoint to @f@ if one exists.+--+-- @+-- 'adjointToCurried' . 'curriedToAdjoint' ≡ 'id'+-- 'curriedToAdjoint' . 'adjointToCurried' ≡ 'id'+-- @+adjointToCurried :: Adjunction f u => u a -> Curried f Identity a+adjointToCurried ua = Curried (Identity . rightAdjunct (<$> ua))+{-# INLINE adjointToCurried #-}++-- | @Curried f Identity a@ is isomorphic to the right adjoint to @f@ if one exists.+curriedToAdjoint :: Adjunction f u => Curried f Identity a -> u a+curriedToAdjoint (Curried m) = leftAdjunct (runIdentity . m) id+{-# INLINE curriedToAdjoint #-}++-- | @Curried f h a@ is isomorphic to the post-composition of the right adjoint of @f@ onto @h@ if such a right adjoint exists.+--+-- @+-- 'curriedToComposedAdjoint' . 'composedAdjointToCurried' ≡ 'id'+-- 'composedAdjointToCurried' . 'curriedToComposedAdjoint' ≡ 'id'+-- @++curriedToComposedAdjoint :: Adjunction f u => Curried f h a -> u (h a)+curriedToComposedAdjoint (Curried m) = leftAdjunct m id+{-# INLINE curriedToComposedAdjoint #-}++-- | @Curried f h a@ is isomorphic to the post-composition of the right adjoint of @f@ onto @h@ if such a right adjoint exists.+composedAdjointToCurried :: (Functor h, Adjunction f u) => u (h a) -> Curried f h a+composedAdjointToCurried uha = Curried $ rightAdjunct (\b -> fmap b <$> uha)+{-# INLINE composedAdjointToCurried #-}+

@@ -6,7 +6,7 @@ #endif ------------------------------------------------------------------------------------------- -- |--- Copyright 	: 2008-2013 Edward Kmett+-- Copyright 	: 2008-2016 Edward Kmett -- License	: BSD -- -- Maintainer	: Edward Kmett <ekmett@gmail.com>

@@ -1,145 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE GADTs #-}--#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702-{-# LANGUAGE Trustworthy #-}-#endif----------------------------------------------------------------------------------------------- |--- Copyright 	: 2013 Edward Kmett and Dan Doel--- License	: BSD------ Maintainer	: Edward Kmett <ekmett@gmail.com>--- Stability	: experimental--- Portability	: rank N types------ Left Kan lifts for functors over Hask, wherever they exist.------ <http://ncatlab.org/nlab/show/Kan+lift>---------------------------------------------------------------------------------------------module Data.Functor.Kan.Lift-  (-  -- * Left Kan lifts-    Lift(..)-  , toLift, fromLift, glift-  , composeLift, decomposeLift-  , adjointToLift, liftToAdjoint-  , liftToComposedAdjoint, composedAdjointToLift-  , repToLift, liftToRep-  , liftToComposedRep, composedRepToLift-  ) where--import Data.Functor.Adjunction-import Data.Functor.Composition-import Data.Functor.Compose-import Data.Functor.Identity-import Data.Functor.Rep---- * Left Kan Lift---- |--- > f => g . Lift g f--- > (forall z. f => g . z) -> Lift g f => z -- couniversal------ Here we use the universal property directly as how we extract from our definition of 'Lift'.-newtype Lift g f a = Lift { runLift :: forall z. Functor z => (forall x. f x -> g (z x)) -> z a }--instance Functor (Lift g h) where-  fmap f (Lift g) = Lift (\x -> fmap f (g x))-  {-# INLINE fmap #-}---- |------ @f => g ('Lift' g f a)@-glift :: Adjunction l g => k a -> g (Lift g k a)-glift = leftAdjunct (\lka -> Lift (\k2gz -> rightAdjunct k2gz lka))-{-# INLINE glift #-}---- | The universal property of 'Lift'-toLift :: Functor z => (forall a. f a -> g (z a)) -> Lift g f b -> z b-toLift f l =  runLift l f-{-# INLINE toLift #-}---- | When the adjunction exists------ @--- 'fromLift' . 'toLift' ≡ 'id'--- 'toLift' . 'fromLift' ≡ 'id'--- @-fromLift :: Adjunction l u => (forall a. Lift u f a -> z a) -> f b -> u (z b)-fromLift f = fmap f . glift-{-# INLINE fromLift #-}---- |------ @--- 'composeLift' . 'decomposeLift' = 'id'--- 'decomposeLift' . 'composeLift' = 'id'--- @-composeLift :: (Composition compose, Functor f, Functor g) => Lift f (Lift g h) a -> Lift (compose g f) h a-composeLift (Lift m) = Lift $ \h -> m $ decompose . toLift (fmap Compose . decompose . h)-{-# INLINE composeLift #-}--decomposeLift :: (Composition compose, Adjunction l g) => Lift (compose g f) h a -> Lift f (Lift g h) a-decomposeLift (Lift m) = Lift $ \h -> m (compose . fmap h . glift)-{-# INLINE decomposeLift #-}---- | @Lift u Identity a@ is isomorphic to the left adjoint to @u@ if one exists.------ @--- 'adjointToLift' . 'liftToAdjoint' ≡ 'id'--- 'liftToAdjoint' . 'adjointToLift' ≡ 'id'--- @-adjointToLift :: Adjunction f u => f a -> Lift u Identity a-adjointToLift fa = Lift $ \k -> rightAdjunct (k . Identity) fa-{-# INLINE adjointToLift #-}----- | @Lift u Identity a@ is isomorphic to the left adjoint to @u@ if one exists.-liftToAdjoint :: Adjunction f u => Lift u Identity a -> f a-liftToAdjoint = toLift (unit . runIdentity)-{-# INLINE liftToAdjoint #-}---- |------ @--- 'repToLift' . 'liftToRep' ≡ 'id'--- 'liftToRep' . 'repToLift' ≡ 'id'--- @-repToLift :: Representable u => Rep u -> a -> Lift u Identity a-repToLift e a = Lift $ \k -> index (k (Identity a)) e-{-# INLINE repToLift #-}--liftToRep :: Representable u => Lift u Identity a -> (Rep u, a)-liftToRep (Lift m) = m $ \(Identity a) -> tabulate $ \e -> (e, a)-{-# INLINE liftToRep #-}---- | @Lift u h a@ is isomorphic to the post-composition of the left adjoint of @u@ onto @h@ if such a left adjoint exists.------ @--- 'liftToComposedAdjoint' . 'composedAdjointToLift' ≡ 'id'--- 'composedAdjointToLift' . 'liftToComposedAdjoint' ≡ 'id'--- @-liftToComposedAdjoint :: (Adjunction f u, Functor h) => Lift u h a -> f (h a)-liftToComposedAdjoint (Lift m) = decompose $ m (leftAdjunct Compose)-{-# INLINE liftToComposedAdjoint #-}---- | @Lift u h a@ is isomorphic to the post-composition of the left adjoint of @u@ onto @h@ if such a left adjoint exists.-composedAdjointToLift :: Adjunction f u => f (h a) -> Lift u h a-composedAdjointToLift = rightAdjunct glift-{-# INLINE composedAdjointToLift #-}---- |------ @--- 'liftToComposedRep' . 'composedRepToLift' ≡ 'id'--- 'composedRepToLift' . 'liftToComposedRep' ≡ 'id'--- @-liftToComposedRep :: (Functor h, Representable u) => Lift u h a -> (Rep u, h a)-liftToComposedRep (Lift m) = decompose $ m $ \h -> tabulate $ \e -> Compose (e, h)-{-# INLINE liftToComposedRep #-}--composedRepToLift :: Representable u => Rep u -> h a -> Lift u h a-composedRepToLift e ha = Lift $ \h2uz -> index (h2uz ha) e-{-# INLINE composedRepToLift #-}

@@ -5,7 +5,7 @@ #endif ------------------------------------------------------------------------------------------- -- |--- Copyright 	: 2008-2013 Edward Kmett+-- Copyright 	: 2008-2016 Edward Kmett -- License	: BSD -- -- Maintainer	: Edward Kmett <ekmett@gmail.com>

@@ -1,210 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE GADTs #-}--#if __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL__ < 710-{-# LANGUAGE Trustworthy #-}-#endif----------------------------------------------------------------------------------------------- |--- Copyright 	: 2013 Edward Kmett and Dan Doel--- License	: BSD------ Maintainer	: Edward Kmett <ekmett@gmail.com>--- Stability	: experimental--- Portability	: rank N types------ Right and Left Kan lifts for functors over Hask, where they exist.------ <http://ncatlab.org/nlab/show/Kan+lift>---------------------------------------------------------------------------------------------module Data.Functor.Kan.Rift-  (-  -- * Right Kan lifts-    Rift(..)-  , toRift, fromRift, grift-  , composeRift, decomposeRift-  , adjointToRift, riftToAdjoint-  , composedAdjointToRift, riftToComposedAdjoint-  , liftRift, lowerRift, rap-  ) where--#if __GLASGOW_HASKELL__ < 710-import Control.Applicative-#endif-import Data.Functor.Adjunction-import Data.Functor.Composition-import Data.Functor.Identity---- * Right Kan Lift---- |------ @g . 'Rift' g f => f@------ This could alternately be defined directly from the (co)universal propertly--- in which case, we'd get 'toRift' = 'UniversalRift', but then the usage would--- suffer.------ @--- data 'UniversalRift' g f a = forall z. 'Functor' z =>---      'UniversalRift' (forall x. g (z x) -> f x) (z a)--- @------ We can witness the isomorphism between Rift and UniversalRift using:------ @--- riftIso1 :: Functor g => UniversalRift g f a -> Rift g f a--- riftIso1 (UniversalRift h z) = Rift $ \\g -> h $ fmap (\\k -> k \<$\> z) g--- @------ @--- riftIso2 :: Rift g f a -> UniversalRift g f a--- riftIso2 (Rift e) = UniversalRift e id--- @------ @--- riftIso1 (riftIso2 (Rift h)) =--- riftIso1 (UniversalRift h id) =          -- by definition--- Rift $ \\g -> h $ fmap (\\k -> k \<$\> id) g -- by definition--- Rift $ \\g -> h $ fmap id g               -- \<$\> = (.) and (.id)--- Rift $ \\g -> h g                         -- by functor law--- Rift h                                   -- eta reduction--- @------ The other direction is left as an exercise for the reader.------ There are several monads that we can form from @Rift@.------ When @g@ is corepresentable (e.g. is a right adjoint) then there exists @x@ such that @g ~ (->) x@, then it follows that------ @--- Rift g g a ~--- forall r. (x -> a -> r) -> x -> r ~--- forall r. (a -> x -> r) -> x -> r ~--- forall r. (a -> g r) -> g r ~--- Codensity g r--- @------ When @f@ is a left adjoint, so that @f -| g@ then------ @--- Rift f f a ~--- forall r. f (a -> r) -> f r ~--- forall r. (a -> r) -> g (f r) ~--- forall r. (a -> r) -> Adjoint f g r ~--- Yoneda (Adjoint f g r)--- @------ An alternative way to view that is to note that whenever @f@ is a left adjoint then @f -| 'Rift' f 'Identity'@, and since @'Rift' f f@ is isomorphic to @'Rift' f 'Identity' (f a)@, this is the 'Monad' formed by the adjunction.------ @'Rift' 'Identity' m@ can be a 'Monad' for any 'Monad' @m@, as it is isomorphic to @'Yoneda' m@.--newtype Rift g h a =-  Rift { runRift :: forall r. g (a -> r) -> h r }--instance Functor g => Functor (Rift g h) where-  fmap f (Rift g) = Rift (g . fmap (.f))-  {-# INLINE fmap #-}--instance (Functor g, g ~ h) => Applicative (Rift g h) where-  pure a = Rift (fmap ($a))-  {-# INLINE pure #-}-  Rift mf <*> Rift ma = Rift (ma . mf . fmap (.))-  {-# INLINE (<*>) #-}---- | The natural isomorphism between @f@ and @Rift f f@.--- @--- 'lowerRift' '.' 'liftRift' ≡ 'id'--- 'liftRift' '.' 'lowerRift' ≡ 'id'--- @------ @--- 'lowerRift' ('liftRift' x)     -- definition--- 'lowerRift' ('Rift' ('<*>' x))   -- definition--- ('<*>' x) ('pure' 'id')          -- beta reduction--- 'pure' 'id' '<*>' x              -- Applicative identity law--- x--- @-liftRift :: Applicative f => f a -> Rift f f a-liftRift fa = Rift (<*> fa)-{-# INLINE liftRift #-}---- | Lower 'Rift' by applying 'pure' 'id' to the continuation.------ See 'liftRift'.-lowerRift :: Applicative f => Rift f g a -> g a-lowerRift (Rift f) = f (pure id)-{-# INLINE lowerRift #-}---- | Indexed applicative composition of right Kan lifts.-rap :: Functor f => Rift f g (a -> b) -> Rift g h a -> Rift f h b-rap (Rift mf) (Rift ma) = Rift (ma . mf . fmap (.))-{-# INLINE rap #-}--grift :: Adjunction f u => f (Rift f k a) -> k a-grift = rightAdjunct (\r -> leftAdjunct (runRift r) id)-{-# INLINE grift #-}---- | The universal property of 'Rift'-toRift :: (Functor g, Functor k) => (forall x. g (k x) -> h x) -> k a -> Rift g h a-toRift h z = Rift $ \g -> h $ fmap (<$> z) g-{-# INLINE toRift #-}---- |--- When @f -| u@, then @f -| Rift f Identity@ and------ @--- 'toRift' . 'fromRift' ≡ 'id'--- 'fromRift' . 'toRift' ≡ 'id'--- @-fromRift :: Adjunction f u => (forall a. k a -> Rift f h a) -> f (k b) -> h b-fromRift f = grift . fmap f-{-# INLINE fromRift #-}---- | @Rift f Identity a@ is isomorphic to the right adjoint to @f@ if one exists.------ @--- 'adjointToRift' . 'riftToAdjoint' ≡ 'id'--- 'riftToAdjoint' . 'adjointToRift' ≡ 'id'--- @-adjointToRift :: Adjunction f u => u a -> Rift f Identity a-adjointToRift ua = Rift (Identity . rightAdjunct (<$> ua))-{-# INLINE adjointToRift #-}---- | @Rift f Identity a@ is isomorphic to the right adjoint to @f@ if one exists.-riftToAdjoint :: Adjunction f u => Rift f Identity a -> u a-riftToAdjoint (Rift m) = leftAdjunct (runIdentity . m) id-{-# INLINE riftToAdjoint #-}---- |------ @--- 'composeRift' . 'decomposeRift' ≡ 'id'--- 'decomposeRift' . 'composeRift' ≡ 'id'--- @-composeRift :: (Composition compose, Adjunction g u) => Rift f (Rift g h) a -> Rift (compose g f) h a-composeRift (Rift f) = Rift (grift . fmap f . decompose)-{-# INLINE composeRift #-}--decomposeRift :: (Composition compose, Functor f, Functor g) => Rift (compose g f) h a -> Rift f (Rift g h) a-decomposeRift (Rift f) = Rift $ \far -> Rift (f . compose . fmap (\rs -> fmap (rs.) far))-{-# INLINE decomposeRift #-}----- | @Rift f h a@ is isomorphic to the post-composition of the right adjoint of @f@ onto @h@ if such a right adjoint exists.------ @--- 'riftToComposedAdjoint' . 'composedAdjointToRift' ≡ 'id'--- 'composedAdjointToRift' . 'riftToComposedAdjoint' ≡ 'id'--- @--riftToComposedAdjoint :: Adjunction f u => Rift f h a -> u (h a)-riftToComposedAdjoint (Rift m) = leftAdjunct m id-{-# INLINE riftToComposedAdjoint #-}---- | @Rift f h a@ is isomorphic to the post-composition of the right adjoint of @f@ onto @h@ if such a right adjoint exists.-composedAdjointToRift :: (Functor h, Adjunction f u) => u (h a) -> Rift f h a-composedAdjointToRift uha = Rift $ rightAdjunct (\b -> fmap b <$> uha)-{-# INLINE composedAdjointToRift #-}-

@@ -12,7 +12,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  Data.Functor.Yoneda--- Copyright   :  (C) 2011-2013 Edward Kmett+-- Copyright   :  (C) 2011-2016 Edward Kmett -- License     :  BSD-style (see the file LICENSE) -- -- Maintainer  :  Edward Kmett <ekmett@gmail.com>@@ -33,8 +33,6 @@   , maxF, minF, maxM, minM   -- * as a right Kan extension   , yonedaToRan, ranToYoneda-  -- * as a right Kan lift-  , yonedaToRift, riftToYoneda   ) where  import Control.Applicative@@ -52,7 +50,6 @@ import Data.Functor.Extend import Data.Functor.Identity import Data.Functor.Kan.Ran-import Data.Functor.Kan.Rift import Data.Functor.Plus import Data.Functor.Rep import Data.Semigroup.Foldable@@ -90,7 +87,7 @@ lowerYoneda (Yoneda f) = f id  -- {-# RULES "lower/lift=id" liftYoneda . lowerYoneda = id #-}---{-# RULES "lift/lower=id" lowerYoneda . liftYoneda = id #-}+-- {-# RULES "lift/lower=id" lowerYoneda . liftYoneda = id #-}  -- | @Yoneda f@ can be viewed as the right Kan extension of @f@ along the 'Identity' functor. --@@ -107,23 +104,6 @@ -- {-# RULES "yonedaToRan/ranToYoneda=id" yonedaToRan . ranToYoneda = id #-} -- {-# RULES "ranToYoneda/yonedaToRan=id" ranToYoneda . yonedaToRan = id #-} --- | @Yoneda f@ can be viewed as the right Kan lift of @f@ along the 'Identity' functor.------ @--- 'yonedaToRift' . 'riftToYoneda' ≡ 'id'--- 'riftToYoneda' . 'yonedaToRift' ≡ 'id'--- @-yonedaToRift :: Yoneda f a -> Rift Identity f a-yonedaToRift m = Rift (runYoneda m . runIdentity)-{-# INLINE yonedaToRift #-}--riftToYoneda :: Rift Identity f a -> Yoneda f a-riftToYoneda m = Yoneda (runRift m . Identity)-{-# INLINE riftToYoneda #-}---- {-# RULES "yonedaToRift/riftToYoneda=id" yonedaToRift . riftToYoneda = id #-}--- {-# RULES "riftToYoneda/yonedaToRift=id" riftToYoneda . yonedaToRift = id #-}- instance Functor (Yoneda f) where   fmap f m = Yoneda (\k -> runYoneda m (k . f)) @@ -211,7 +191,9 @@   Yoneda m >>- k = Yoneda (\f -> m id >>- \a -> runYoneda (k a) f)  instance Monad m => Monad (Yoneda m) where+#if __GLASGOW_HASKELL__ < 710   return a = Yoneda (\f -> return (f a))+#endif   Yoneda m >>= k = Yoneda (\f -> m id >>= \a -> runYoneda (k a) f)  instance MonadFix m => MonadFix (Yoneda m) where