adjunctions 0.4.1 → 0.5.0

raw patch · 14 files changed

+517/−246 lines, 14 filesdep ~comonaddep ~comonad-transformersdep ~functor-applyPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: comonad, comonad-transformers, functor-apply

API changes (from Hackage documentation)

Files

• Control/Comonad/Contra/Adjoint.hs +0/−46
• Control/Comonad/Trans/Adjoint.hs +6/−3
• Control/Comonad/Trans/Density.hs +23/−21
• Control/Monad/Contra/Adjoint.hs +0/−51
• Control/Monad/Contra/Cont.hs +0/−56
• Control/Monad/Trans/Codensity.hs +29/−23
• Control/Monad/Trans/Contravariant/Adjoint.hs +60/−0
• Control/Monad/Trans/Conts.hs +81/−0
• Data/Functor/Adjunction.hs +2/−15
• Data/Functor/Contravariant/Adjunction.hs +4/−0
• Data/Functor/Contravariant/DualAdjunction.hs +0/−23
• Data/Functor/Yoneda.hs +166/−0
• Data/Functor/Yoneda/Contravariant.hs +135/−0
• adjunctions.cabal +11/−8

@@ -1,46 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses #-}--------------------------------------------------------------------------------- |--- Module      :  Control.Comonad.Contra.Adjoint--- Copyright   :  (C) 2011 Edward Kmett--- License     :  BSD-style (see the file LICENSE)------ Maintainer  :  Edward Kmett <ekmett@gmail.com>--- Stability   :  provisional--- Portability :  MPTCs------ Use a contravariant dual adjunction from Hask^op to build a 'Monad' to --- 'Comonad' transformer.-------------------------------------------------------------------------------module Control.Comonad.Contra.Adjoint-  ( Adjoint-  , runAdjoint-  , adjoint-  , AdjointT(..)-  ) where--import Prelude hiding (sequence)-import Control.Comonad-import Control.Monad (liftM)-import Data.Functor.Identity-import Data.Functor.Contravariant-import Data.Functor.Contravariant.DualAdjunction--type Adjoint f g = AdjointT f g Identity--newtype AdjointT f g m a = AdjointT { runAdjointT :: f (m (g a)) }--adjoint :: Contravariant f => f (g a) -> Adjoint f g a-adjoint = AdjointT . contramap runIdentity--runAdjoint :: Contravariant f => Adjoint f g a -> f (g a)-runAdjoint = contramap Identity . runAdjointT--instance (Contravariant f, Contravariant g, Monad m) => Functor (AdjointT f g m) where-  fmap f (AdjointT g) = AdjointT $ contramap (liftM (contramap f)) g-  -instance (DualAdjunction f g, Monad m) => Comonad (AdjointT f g m) where-  extract = rightAdjunctOp return . runAdjointT-  extend f = AdjointT . contramap (>>= leftAdjunctOp (f . AdjointT)) . runAdjointT-

@@ -36,13 +36,16 @@ runAdjoint :: Functor f => Adjoint f g a -> f (g a) runAdjoint = fmap runIdentity . runAdjointT -instance (Adjunction f g, Functor m) => Functor (AdjointT f g m) where+instance (Adjunction f g, Functor w) => Functor (AdjointT f g w) where   fmap f (AdjointT g) = AdjointT $ fmap (fmap (fmap f)) g   b <$ (AdjointT g) = AdjointT $ fmap (fmap (b <$)) g -instance (Adjunction f g, Comonad m) => Comonad (AdjointT f g m) where-  extract = rightAdjunct extract . runAdjointT++instance (Adjunction f g, Extend w) => Extend (AdjointT f g w) where   extend f (AdjointT m) = AdjointT $ fmap (extend $ leftAdjunct (f . AdjointT)) m++instance (Adjunction f g, Comonad w) => Comonad (AdjointT f g w) where+  extract = rightAdjunct extract . runAdjointT    {- instance (Adjunction f g, Monad m) => Applicative (AdjointT f g m) where

@@ -1,7 +1,7 @@ {-# LANGUAGE MultiParamTypeClasses, GADTs #-} ----------------------------------------------------------------------------- -- |--- Module      :  Control.Comonad.Density+-- Module      :  Control.Comonad.Trans.Density -- Copyright   :  (C) 2008-2011 Edward Kmett -- License     :  BSD-style (see the file LICENSE) --@@ -9,40 +9,42 @@ -- Stability   :  experimental -- Portability :  non-portable (GADTs, MPTCs) ----- The density comonad for a functor. aka the comonad cogenerated by a functor--- The ''density'' term dates back to Dubuc''s 1974 thesis. The term +-- The densityT comonad for a functor. aka the comonad cogenerated by a functor+-- The ''densityT'' term dates back to Dubuc''s 1974 thesis. The term  -- ''monad genererated by a functor'' dates back to 1972 in Street''s  -- ''Formal Theory of Monads''. ---------------------------------------------------------------------------- module Control.Comonad.Trans.Density-  ( Density(..)-  , liftDensity-  , densityToAdjunction, adjunctionToDensity+  ( DensityT(..)+  , liftDensityT+  , densityTToAdjunction, adjunctionToDensityT   ) where  import Control.Comonad import Control.Comonad.Trans.Class import Data.Functor.Adjunction -data Density k a where-  Density :: (k b -> a) -> k b -> Density k a+data DensityT k a where+  DensityT :: (k b -> a) -> k b -> DensityT k a -instance Functor (Density f) where-  fmap f (Density g h) = Density (f . g) h+instance Functor (DensityT f) where+  fmap f (DensityT g h) = DensityT (f . g) h -instance Comonad (Density f) where-  extract (Density f a) = f a-  duplicate (Density f ws) = Density (Density f) ws+instance Extend (DensityT f) where+  duplicate (DensityT f ws) = DensityT (DensityT f) ws -instance ComonadTrans Density where-  lower (Density f c) = extend f c+instance Comonad (DensityT f) where+  extract (DensityT f a) = f a++instance ComonadTrans DensityT where+  lower (DensityT f c) = extend f c    -- | The natural isomorphism between a comonad w and the comonad generated by w (forwards).-liftDensity :: Comonad w => w a -> Density w a-liftDensity = Density extract +liftDensityT :: Comonad w => w a -> DensityT w a+liftDensityT = DensityT extract  -densityToAdjunction :: Adjunction f g => Density f a -> f (g a)-densityToAdjunction (Density f v) = fmap (leftAdjunct f) v+densityTToAdjunction :: Adjunction f g => DensityT f a -> f (g a)+densityTToAdjunction (DensityT f v) = fmap (leftAdjunct f) v -adjunctionToDensity :: Adjunction f g => f (g a) -> Density f a-adjunctionToDensity = Density counit+adjunctionToDensityT :: Adjunction f g => f (g a) -> DensityT f a+adjunctionToDensityT = DensityT counit

@@ -1,51 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses #-}--------------------------------------------------------------------------------- |--- Module      :  Control.Monad.Contra.Adjoint--- Copyright   :  (C) 2011 Edward Kmett--- License     :  BSD-style (see the file LICENSE)------ Maintainer  :  Edward Kmett <ekmett@gmail.com>--- Stability   :  provisional--- Portability :  MPTCs, fundeps------ Use a contravariant adjunction to Hask^op to build a 'Comonad' to --- 'Monad' transformer.-------------------------------------------------------------------------------module Control.Monad.Contra.Adjoint-  ( Adjoint-  , runAdjoint-  , adjoint-  , AdjointT(..)-  ) where--import Prelude hiding (sequence)-import Control.Applicative-import Control.Comonad-import Control.Monad (ap)-import Data.Functor.Identity-import Data.Functor.Contravariant-import Data.Functor.Contravariant.Adjunction--type Adjoint f g = AdjointT f g Identity--newtype AdjointT f g w a = AdjointT { runAdjointT :: g (w (f a)) }--adjoint :: Contravariant g => g (f a) -> Adjoint f g a-adjoint = AdjointT . contramap runIdentity--runAdjoint :: Contravariant g => Adjoint f g a -> g (f a)-runAdjoint = contramap Identity . runAdjointT--instance (Adjunction f g, Functor w) => Functor (AdjointT f g w) where-  fmap f (AdjointT g) = AdjointT $ contramap (fmap (contramap f)) g-  -instance (Adjunction f g, Comonad w) => Applicative (AdjointT f g w) where-  pure = AdjointT . leftAdjunct extract-  (<*>) = ap--instance (Adjunction f g, Comonad w) => Monad (AdjointT f g w) where-  return = AdjointT . leftAdjunct extract-  AdjointT m >>= f = AdjointT $ contramap (extend (rightAdjunct (runAdjointT . f))) m-

@@ -1,56 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses #-}--------------------------------------------------------------------------------- |--- Module      :  Control.Monad.Contra.Cont--- Copyright   :  (C) 2011 Edward Kmett--- License     :  BSD-style (see the file LICENSE)------ Maintainer  :  Edward Kmett <ekmett@gmail.com>--- Stability   :  provisional--- Portability :  MPTCs, fundeps------ > ContT r ~ AdjointT (Op r) (Op r)-------------------------------------------------------------------------------module Control.Monad.Contra.Cont-  ( Cont-  , runCont-  , cont-  , ContT(..)-  , callCC-  ) where--import Prelude hiding (sequence)-import Control.Applicative-import Control.Comonad-import Control.Monad (ap)-import Data.Functor.Apply-import Data.Functor.Identity--type Cont r = ContT r Identity--newtype ContT r w a = ContT { runContT :: w (a -> r) -> r }--cont :: ((a -> r) -> r) -> Cont r a-cont f = ContT $ f . runIdentity--runCont :: Cont r a -> (a -> r) -> r-runCont (ContT k) = k . Identity--instance Functor w => Functor (ContT r w) where-  fmap f (ContT k) = ContT $ k . fmap (. f)--instance Comonad w => FunctorApply (ContT r w) where-  (<.>) = ap-  -instance Comonad w => Applicative (ContT r w) where-  pure x = ContT $ \wk -> extract wk x-  (<*>) = ap--instance Comonad w => Monad (ContT r w) where-  return = pure-  ContT k >>= f = ContT $ k . extend (\wa a -> runContT (f a) wa)--callCC :: Comonad w => ((a -> ContT r w b) -> ContT r w a) -> ContT r w a-callCC f = ContT $ \wc -> runContT (f (\a -> ContT $ \_ -> extract wc a)) wc-

@@ -11,10 +11,10 @@ -- ---------------------------------------------------------------------------- module Control.Monad.Trans.Codensity-  ( Codensity(..)-  , lowerCodensity-  , codensityToAdjunction-  , adjunctionToCodensity+  ( CodensityT(..)+  , lowerCodensityT+  , codensityTToAdjunction+  , adjunctionToCodensityT   ) where  import Control.Applicative@@ -23,35 +23,41 @@ import Data.Functor.Apply import Control.Monad.Trans.Class -newtype Codensity m a = Codensity { runCodensity :: forall b. (a -> m b) -> m b }+{-+type Codensity = CodensityT Identity+codensity :: (forall b. (a -> b) -> b) -> Codensity a+runCodensity :: Codensity a -> (a -> b) -> a+-} -instance Functor (Codensity k) where-  fmap f m = Codensity (\k -> runCodensity m (k . f))+newtype CodensityT m a = CodensityT { runCodensityT :: forall b. (a -> m b) -> m b } -instance FunctorApply (Codensity f) where+instance Functor (CodensityT k) where+  fmap f (CodensityT m) = CodensityT (\k -> m (k . f))++instance Apply (CodensityT f) where   (<.>) = ap -instance Applicative (Codensity f) where-  pure x = Codensity (\k -> k x)+instance Applicative (CodensityT f) where+  pure x = CodensityT (\k -> k x)   (<*>) = ap -instance Monad (Codensity f) where-  return x = Codensity (\k -> k x)-  m >>= k = Codensity (\c -> runCodensity m (\a -> runCodensity (k a) c))+instance Monad (CodensityT f) where+  return x = CodensityT (\k -> k x)+  m >>= k = CodensityT (\c -> runCodensityT m (\a -> runCodensityT (k a) c))  {--instance MonadIO m => MonadIO (Codensity m) where-  liftIO = liftCodensity . liftIO +instance MonadIO m => MonadIO (CodensityT m) where+  liftIO = liftCodensityT . liftIO  -} -instance MonadTrans Codensity where-  lift m = Codensity (m >>=)+instance MonadTrans CodensityT where+  lift m = CodensityT (m >>=) -lowerCodensity :: Monad m => Codensity m a -> m a-lowerCodensity a = runCodensity a return+lowerCodensityT :: Monad m => CodensityT m a -> m a+lowerCodensityT a = runCodensityT a return -codensityToAdjunction :: Adjunction f g => Codensity g a -> g (f a)-codensityToAdjunction r = runCodensity r unit+codensityTToAdjunction :: Adjunction f g => CodensityT g a -> g (f a)+codensityTToAdjunction r = runCodensityT r unit -adjunctionToCodensity :: Adjunction f g => g (f a) -> Codensity g a-adjunctionToCodensity f = Codensity (\a -> fmap (rightAdjunct a) f)+adjunctionToCodensityT :: Adjunction f g => g (f a) -> CodensityT g a+adjunctionToCodensityT f = CodensityT (\a -> fmap (rightAdjunct a) f)

@@ -0,0 +1,60 @@+{-# LANGUAGE MultiParamTypeClasses #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Monad.Trans.Contravariant.Adjoint+-- Copyright   :  (C) 2011 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  MPTCs, fundeps+--+-- Uses a contravariant adjunction:+--+-- f -| g : Hask^op -> Hask+--+-- to build a 'Comonad' to 'Monad' transformer. Sadly, the dual construction, +-- which builds a 'Comonad' out of a 'Monad', is uninhabited, because any +-- 'Adjunction' of the form+-- +-- > f -| g : Hask -> Hask^op+-- +-- would trivially admit unsafePerformIO.+-- +----------------------------------------------------------------------------++module Control.Monad.Trans.Contravariant.Adjoint+  ( Adjoint+  , runAdjoint+  , adjoint+  , AdjointT(..)+  ) where++import Prelude hiding (sequence)+import Control.Applicative+import Control.Comonad+import Control.Monad (ap)+import Data.Functor.Identity+import Data.Functor.Contravariant+import Data.Functor.Contravariant.Adjunction++type Adjoint f g = AdjointT f g Identity++newtype AdjointT f g w a = AdjointT { runAdjointT :: g (w (f a)) }++adjoint :: Contravariant g => g (f a) -> Adjoint f g a+adjoint = AdjointT . contramap runIdentity++runAdjoint :: Contravariant g => Adjoint f g a -> g (f a)+runAdjoint = contramap Identity . runAdjointT++instance (Adjunction f g, Functor w) => Functor (AdjointT f g w) where+  fmap f (AdjointT g) = AdjointT $ contramap (fmap (contramap f)) g+  +instance (Adjunction f g, Comonad w) => Applicative (AdjointT f g w) where+  pure = AdjointT . leftAdjunct extract+  (<*>) = ap++instance (Adjunction f g, Comonad w) => Monad (AdjointT f g w) where+  return = AdjointT . leftAdjunct extract+  AdjointT m >>= f = AdjointT $ contramap (extend (rightAdjunct (runAdjointT . f))) m

@@ -0,0 +1,81 @@+{-# LANGUAGE MultiParamTypeClasses #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Monad.Trans.Conts+-- Copyright   :  (C) 2011 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  MPTCs, fundeps+--+-- > Cont r ~ Contravariant.Adjoint (Op r) (Op r)+-- > Conts r ~ Contravariant.AdjointT (Op r) (Op r)+-- > ContsT r w m ~ Contravariant.AdjointT (Op (m r)) (Op (m r)) w+----------------------------------------------------------------------------++module Control.Monad.Trans.Conts+  ( +  -- * Continuation passing style+    Cont+  , cont+  , runCont+  -- * Multiple-continuation passing style+  , Conts+  , runConts+  , conts+  -- * Multiple-continuation passing style transformer+  , ContsT(..)+  , callCC+  ) where++import Prelude hiding (sequence)+import Control.Applicative+import Control.Comonad+import Control.Monad.Trans.Class+import Control.Monad (ap)+import Data.Functor.Apply+import Data.Functor.Identity++type Cont r = ContsT r Identity Identity++cont :: ((a -> r) -> r) -> Cont r a+cont f = ContsT $ \ (Identity k) -> Identity $ f $ runIdentity . k++runCont :: Cont r a -> (a -> r) -> r+runCont (ContsT k) f = runIdentity $ k $ Identity (Identity . f)++type Conts r w = ContsT r w Identity++conts :: Functor w => (w (a -> r) -> r) -> Conts r w a+conts k = ContsT $ Identity . k . fmap (runIdentity .)++runConts :: Functor w => Conts r w a -> w (a -> r) -> r+runConts (ContsT k) = runIdentity . k . fmap (Identity .)++newtype ContsT r w m a = ContsT { runContsT :: w (a -> m r) -> m r }++instance Functor w => Functor (ContsT r w m) where+  fmap f (ContsT k) = ContsT $ k . fmap (. f)++instance Comonad w => Apply (ContsT r w m) where+  (<.>) = ap+  +instance Comonad w => Applicative (ContsT r w m) where+  pure x = ContsT $ \f -> extract f x+  (<*>) = ap++instance Comonad w => Monad (ContsT r w m) where+  return = pure+  ContsT k >>= f = ContsT $ k . extend (\wa a -> runContsT (f a) wa)++callCC :: Comonad w => ((a -> ContsT r w m b) -> ContsT r w m a) -> ContsT r w m a+callCC f = ContsT $ \wamr -> runContsT (f (\a -> ContsT $ \_ -> extract wamr a)) wamr++{-+callCCs :: Comonad w => (w (a -> ContsT r w m b) -> ContsT r w m a) -> ContsT r w m a+callCCs f = +-}++instance Comonad w => MonadTrans (ContsT r w) where+  lift m = ContsT $ extract . fmap (m >>=) 

@@ -26,9 +26,8 @@  import Data.Functor.Identity import Data.Functor.Compose-import qualified Data.Functor.Contravariant.Adjunction as C-import qualified Data.Functor.Contravariant.DualAdjunction as C-import qualified Data.Functor.Contravariant.Compose as C+-- import qualified Data.Functor.Contravariant.Adjunction as C+-- import qualified Data.Functor.Contravariant.Compose as C  -- | An adjunction between Hask and Hask. --@@ -64,18 +63,6 @@ instance (Adjunction f g, Adjunction f' g') => Adjunction (Compose f' f) (Compose g g') where   unit = Compose . leftAdjunct (leftAdjunct Compose)    counit = rightAdjunct (rightAdjunct getCompose) . getCompose--instance (C.Adjunction f g, C.DualAdjunction f' g') => Adjunction (C.Compose f' f) (C.Compose g g') where-  unit = C.Compose . C.leftAdjunct (C.leftAdjunctOp C.Compose)-  counit = C.rightAdjunctOp (C.rightAdjunct C.getCompose) . C.getCompose---- instance (C.DualAdjunction f g, C.Adjunction f' g') => Adjunction (C.Compose g g') (C.Compose f' f) where--- --- This would require me to make separate compositions for contravariant adjunctions and contravariant dual-adjunctions,--- but you can always just flip the arguments and get the opposite adjunction. This works because for f -| g : Hask -> Hask:------ class Adjunction f g => DualAdjunction g f--- instance Adjunction f g => DualAdjunction g f  data Representation f x = Representation   { rep :: forall a. (x -> a) -> f a

@@ -14,6 +14,10 @@ -- -- > rightAdjunct unit = id -- > leftAdjunct counit = id+--+-- Any adjunction from Hask to Hask^op would indirectly+-- permit unsafePerformIO, and therefore does not exist.+ class (Contravariant f, Contravariant g) => Adjunction f g | f -> g, g -> f where   unit :: a -> g (f a) -- monad in Hask   counit :: a -> f (g a) -- comonad in Hask^op

@@ -1,23 +0,0 @@-{-# LANGUAGE Rank2Types, MultiParamTypeClasses, FunctionalDependencies, UndecidableInstances #-}-module Data.Functor.Contravariant.DualAdjunction -  ( DualAdjunction(..)-  ) where--import Data.Functor.Contravariant---- | An adjunction from Hask to Hask^op--- --- >  Hask (f a) b ~ Op a (g b)------ > rightAdjunct unit = id--- > leftAdjunct counit = id-class (Contravariant f, Contravariant g) => DualAdjunction f g | f -> g, g -> f where-  unitOp :: g (f a) -> a-  counitOp :: f (g a) -> a-  leftAdjunctOp :: (f a -> b) -> g b -> a-  rightAdjunctOp :: (g b -> a) -> f a -> b--  unitOp = leftAdjunctOp id-  counitOp = rightAdjunctOp id-  leftAdjunctOp f = unitOp . contramap f-  rightAdjunctOp f = counitOp . contramap f

@@ -0,0 +1,166 @@+{-# LANGUAGE CPP, Rank2Types, FlexibleContexts, MultiParamTypeClasses, UndecidableInstances #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Functor.Yoneda+-- Copyright   :  (C) 2011 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  MPTCs, fundeps+--+----------------------------------------------------------------------------++module Data.Functor.Yoneda+  ( Yoneda+  , yoneda+  , runYoneda+  , liftYoneda+  , lowerYoneda+  , YonedaT(..)+  , liftYonedaT+  , lowerYonedaT+  , maxF, minF, maxM, minM+  ) where++import Prelude hiding (sequence)+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.Foldable+import Data.Function (on)+import Data.Functor.Apply+import Data.Functor.Plus+import Data.Functor.Identity+import Data.Functor.Adjunction+import Data.Traversable+import Text.Read hiding (lift)++type Yoneda = YonedaT Identity ++yoneda :: (forall b. (a -> b) -> b) -> Yoneda a+yoneda f = YonedaT (Identity . f)+{-# INLINE yoneda #-}++runYoneda :: Yoneda a -> (a -> b) -> b+runYoneda (YonedaT f) = runIdentity . f+{-# INLINE runYoneda #-}++liftYoneda :: a -> Yoneda a+liftYoneda a = YonedaT (\f -> Identity (f a))+{-# INLINE liftYoneda #-}++lowerYoneda :: Yoneda a -> a+lowerYoneda m = runIdentity (runYonedaT m id)+{-# INLINE lowerYoneda #-}++newtype YonedaT f a = YonedaT { runYonedaT :: forall b. (a -> b) -> f b } ++liftYonedaT :: Functor f => f a -> YonedaT f a +liftYonedaT a = YonedaT (\f -> fmap f a)++lowerYonedaT :: YonedaT f a -> f a +lowerYonedaT (YonedaT f) = f id++{-# RULES "lower/lift=id" liftYonedaT . lowerYonedaT = id #-}+{-# RULES "lift/lower=id" lowerYonedaT . liftYonedaT = id #-}++instance Functor (YonedaT f) where+  fmap f m = YonedaT (\k -> runYonedaT m (k . f))++instance Apply f => Apply (YonedaT f) where+  YonedaT m <.> YonedaT n = YonedaT (\f -> m (f .) <.> n id)+  +instance Applicative f => Applicative (YonedaT f) where+  pure a = YonedaT (\f -> pure (f a))+  YonedaT m <*> YonedaT n = YonedaT (\f -> m (f .) <*> n id)++instance Foldable f => Foldable (YonedaT f) where+  foldMap f = foldMap f . lowerYonedaT++-- a traversable isntance with a function in it!+instance Traversable f => Traversable (YonedaT f) where+  traverse f = fmap liftYonedaT . traverse f . lowerYonedaT++instance Distributive f => Distributive (YonedaT f) where+  collect f = liftYonedaT . collect (lowerYonedaT . f)++instance Adjunction f g => Adjunction (YonedaT f) (YonedaT g) where+  unit = liftYonedaT . fmap liftYonedaT . unit+  counit (YonedaT m) = counit (m lowerYonedaT)++-- instance Show1 f => Show1 (YonedaT f) where+instance Show (f a) => Show (YonedaT f a) where+  showsPrec d (YonedaT f) = showParen (d > 10) $+    showString "liftYonedaT " . showsPrec 11 (f id)++-- instance Read1 f => Read1 (YonedaT f) where+#ifdef __GLASGOW_HASKELL__+instance (Functor f, Read (f a)) => Read (YonedaT f a) where+  readPrec = parens $ prec 10 $ do+     Ident "liftYonedaT" <- lexP+     liftYonedaT <$> step readPrec+#endif++instance Eq (f a) => Eq (YonedaT f a) where+  (==) = (==) `on` lowerYonedaT++instance Ord (f a) => Ord (YonedaT f a) where+  compare = compare `on` lowerYonedaT++maxF :: (Functor f, Ord (f a)) => YonedaT f a -> YonedaT f a -> YonedaT f a+YonedaT f `maxF` YonedaT g = liftYonedaT $ f id `max` g id+-- {-# RULES "max/maxF" max = maxF #-}+{-# INLINE maxF #-}++minF :: (Functor f, Ord (f a)) => YonedaT f a -> YonedaT f a -> YonedaT f a+YonedaT f `minF` YonedaT g = liftYonedaT $ f id `max` g id+-- {-# RULES "min/minF" min = minF #-}+{-# INLINE minF #-}++maxM :: (Monad m, Ord (m a)) => YonedaT m a -> YonedaT m a -> YonedaT m a+YonedaT f `maxM` YonedaT g = lift $ f id `max` g id+-- {-# RULES "max/maxM" max = maxM #-}+{-# INLINE maxM #-}++minM :: (Monad m, Ord (m a)) => YonedaT m a -> YonedaT m a -> YonedaT m a+YonedaT f `minM` YonedaT g = lift $ f id `min` g id+-- {-# RULES "min/minM" min = minM #-}+{-# INLINE minM #-}++instance Alt f => Alt (YonedaT f) where+  YonedaT f <!> YonedaT g = YonedaT (\k -> f k <!> g k)++instance Plus f => Plus (YonedaT f) where+  zero = YonedaT $ const zero++instance Alternative f => Alternative (YonedaT f) where+  empty = YonedaT $ const empty+  YonedaT f <|> YonedaT g = YonedaT (\k -> f k <|> g k)+  +instance Monad m => Monad (YonedaT m) where+  return a = YonedaT (\f -> return (f a))+  YonedaT m >>= k = YonedaT (\f -> m id >>= \a -> runYonedaT (k a) f)++instance MonadFix m => MonadFix (YonedaT m) where+  mfix f = lift $ mfix (lowerYonedaT . f)++instance MonadPlus m => MonadPlus (YonedaT m) where+  mzero = YonedaT (const mzero)+  YonedaT f `mplus` YonedaT g = YonedaT (\k -> f k `mplus` g k)++instance MonadTrans YonedaT where+  lift a = YonedaT (\f -> liftM f a)++instance Extend w => Extend (YonedaT w) where+  extend k (YonedaT m) = YonedaT (\f -> extend (f . k . liftYonedaT) (m id))++instance Comonad w => Comonad (YonedaT w) where+  extract = extract . lowerYonedaT ++instance ComonadTrans YonedaT where+  lower = lowerYonedaT 

@@ -0,0 +1,135 @@+{-# LANGUAGE CPP, GADTs, FlexibleContexts, MultiParamTypeClasses, UndecidableInstances #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Functor.Yoneda.Contravariant+-- Copyright   :  (C) 2011 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  GADTs, MPTCs, fundeps+--+----------------------------------------------------------------------------+module Data.Functor.Yoneda.Contravariant+  ( Yoneda+  , yoneda+  , liftYoneda+  , lowerYoneda+  , liftYonedaT+  , lowerYonedaT+  , lowerM+  , YonedaT(..)+  ) 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.Foldable+import Data.Function (on)+import Data.Functor.Apply+import Data.Functor.Plus+import Data.Functor.Identity+import Data.Functor.Adjunction+import Data.Traversable+import Prelude hiding (sequence)+import Text.Read hiding (lift)++type Yoneda = YonedaT Identity++-- | The contravariant Yoneda lemma applied to a covariant functor+data YonedaT f a where+  YonedaT :: (b -> a) -> f b -> YonedaT f a++yoneda :: (b -> a) -> b -> Yoneda a+yoneda f = YonedaT f . Identity++liftYoneda :: a -> Yoneda a +liftYoneda = YonedaT id . Identity++lowerYoneda :: Yoneda a -> a+lowerYoneda (YonedaT f (Identity a)) = f a++liftYonedaT :: f a -> YonedaT f a +liftYonedaT = YonedaT id++lowerYonedaT :: Functor f => YonedaT f a -> f a+lowerYonedaT (YonedaT f m) = fmap f m++lowerM :: Monad f => YonedaT f a -> f a +lowerM (YonedaT f m) = liftM f m+++instance Functor (YonedaT f) where+  fmap f (YonedaT g v) = YonedaT (f . g) v++instance Applicative f => Applicative (YonedaT f) where+  pure = liftYonedaT . pure+  m <*> n = liftYonedaT $ lowerYonedaT m <*> lowerYonedaT n++instance Alternative f => Alternative (YonedaT f) where+  empty = liftYonedaT empty +  m <|> n = liftYonedaT $ lowerYonedaT m <|> lowerYonedaT n++instance Alt f => Alt (YonedaT f) where+  m <!> n = liftYonedaT $ lowerYonedaT m <!> lowerYonedaT n++instance Plus f => Plus (YonedaT f) where+  zero = liftYonedaT zero++instance Monad m => Monad (YonedaT m) where+  return = YonedaT id . return+  YonedaT f v >>= k = lift (v >>= lowerM . k . f)++instance MonadTrans YonedaT where+  lift = YonedaT id++instance MonadFix f => MonadFix (YonedaT f) where+  mfix f = lift $ mfix (lowerM . f)++instance MonadPlus f => MonadPlus (YonedaT f) where+  mzero = lift mzero+  m `mplus` n = lift $ lowerM m `mplus` lowerM n++instance Extend w => Extend (YonedaT w) where+  extend k (YonedaT f v) = YonedaT id $ extend (k . YonedaT f) v++instance Comonad w => Comonad (YonedaT w) where+  extract (YonedaT f v) = f (extract v)++instance ComonadTrans YonedaT where+  lower (YonedaT f a) = fmap f a++instance (Foldable f, Functor f) => Foldable (YonedaT f) where+  foldMap f (YonedaT k a) = foldMap (f . k) a++instance Traversable f => Traversable (YonedaT f) where+  traverse f (YonedaT k a) = YonedaT id <$> traverse (f . k) a++instance Distributive f => Distributive (YonedaT f) where+  collect f = liftYonedaT . collect (lowerYonedaT . f)++instance (Functor f, Show (f a)) => Show (YonedaT f a) where+  showsPrec d (YonedaT f a) = showParen (d > 10) $+    showString "liftYonedaT " . showsPrec 11 (fmap f a)++#ifdef __GLASGOW_HASKELL__+instance (Functor f, Read (f a)) => Read (YonedaT f a) where+  readPrec = parens $ prec 10 $ do+    Ident "liftYonedaT" <- lexP+    liftYonedaT <$> step readPrec+#endif++instance (Functor f, Eq (f a)) => Eq (YonedaT f a) where+  (==) = (==) `on` lowerYonedaT++instance (Functor f, Ord (f a)) => Ord (YonedaT f a) where+  compare = compare `on` lowerYonedaT++instance Adjunction f g => Adjunction (YonedaT f) (YonedaT g) where+  unit = liftYonedaT . fmap liftYonedaT . unit+  counit = counit . fmap lowerYonedaT . lowerYonedaT+

@@ -1,6 +1,6 @@ name:          adjunctions category:      Data Structures, Adjunctions-version:       0.4.1+version:       0.5.0 license:       BSD3 cabal-version: >= 1.6 license-file:  LICENSE@@ -21,23 +21,26 @@   build-depends:      base >= 4 && < 4.4,     contravariant >= 0.1.2 && < 0.2,-    comonad >= 0.7 && < 0.8,+    comonad >= 0.9 && < 0.10,     distributive >= 0.1 && < 0.2,-    functor-apply >= 0.7.4.1 && < 0.8,-    comonad-transformers >= 0.7 && < 0.8,+    functor-apply >= 0.10 && < 0.11,+    comonad-transformers >= 0.10 && < 0.11,     transformers >= 0.2.0 && < 0.3    exposed-modules:-    Control.Comonad.Contra.Adjoint     Control.Comonad.Trans.Adjoint     Control.Comonad.Trans.Density-    Control.Monad.Contra.Cont-    Control.Monad.Contra.Adjoint     Control.Monad.Trans.Adjoint     Control.Monad.Trans.Codensity+    Control.Monad.Trans.Conts+    Control.Monad.Trans.Contravariant.Adjoint     Data.Functor.Adjunction     Data.Functor.Contravariant.Adjunction-    Data.Functor.Contravariant.DualAdjunction     Data.Functor.Zap+    Data.Functor.Yoneda+    Data.Functor.Yoneda.Contravariant    ghc-options: -Wall ++--    Control.Monad.Trans.Yoneda+