packages feed

adjunctions 2.5 → 3.0

raw patch · 13 files changed

+460/−457 lines, 13 filesdep ~comonaddep ~comonad-transformersdep ~keysPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: comonad, comonad-transformers, keys, representable-functors, semigroupoids

API changes (from Hackage documentation)

Files

− Control/Comonad/Trans/Adjoint.hs 
@@ -1,57 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}--------------------------------------------------------------------------------- |--- Module      :  Control.Comonad.Trans.Adjoint--- Copyright   :  (C) 2011 Edward Kmett--- License     :  BSD-style (see the file LICENSE)------ Maintainer  :  Edward Kmett <ekmett@gmail.com>--- Stability   :  provisional--- Portability :  MPTCs, fundeps----------------------------------------------------------------------------------module Control.Comonad.Trans.Adjoint-  ( Adjoint-  , runAdjoint-  , adjoint-  , AdjointT(..)-  ) where--import Prelude hiding (sequence)-import Control.Applicative-import Control.Comonad-import Control.Comonad.Trans.Class-import Data.Functor.Adjunction-import Data.Functor.Identity-import Data.Distributive--type Adjoint f g = AdjointT f g Identity--newtype AdjointT f g w a = AdjointT { runAdjointT :: f (w (g a)) }--adjoint :: Functor f => f (g a) -> Adjoint f g a-adjoint = AdjointT . fmap Identity--runAdjoint :: Functor f => Adjoint f g a -> f (g a)-runAdjoint = fmap runIdentity . runAdjointT--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, 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-  pure = AdjointT . leftAdjunct return-  (<*>) = ap--}-    -instance (Adjunction f g, Distributive g) => ComonadTrans (AdjointT f g) where-  lower = counit . fmap distribute . runAdjointT
− Control/Monad/Trans/Adjoint.hs 
@@ -1,53 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}--------------------------------------------------------------------------------- |--- Module      :  Control.Monad.Trans.Adjoint--- Copyright   :  (C) 2011 Edward Kmett--- License     :  BSD-style (see the file LICENSE)------ Maintainer  :  Edward Kmett <ekmett@gmail.com>--- Stability   :  provisional--- Portability :  MPTCs, fundeps----------------------------------------------------------------------------------module Control.Monad.Trans.Adjoint-  ( Adjoint-  , runAdjoint-  , adjoint-  , AdjointT(..)-  ) where--import Prelude hiding (sequence)-import Control.Applicative-import Control.Monad (ap, liftM)-import Control.Monad.Trans.Class-import Data.Traversable-import Data.Functor.Adjunction-import Data.Functor.Identity--type Adjoint f g = AdjointT f g Identity--newtype AdjointT f g m a = AdjointT { runAdjointT :: g (m (f a)) }--adjoint :: Functor g => g (f a) -> Adjoint f g a-adjoint = AdjointT . fmap Identity--runAdjoint :: Functor g => Adjoint f g a -> g (f a)-runAdjoint = fmap runIdentity . runAdjointT--instance (Adjunction f g, Monad m) => Functor (AdjointT f g m) where-  fmap f (AdjointT g) = AdjointT $ fmap (liftM (fmap f)) g-  b <$ (AdjointT g) = AdjointT $ fmap (liftM (b <$)) g-  -instance (Adjunction f g, Monad m) => Applicative (AdjointT f g m) where-  pure = AdjointT . leftAdjunct return-  (<*>) = ap--instance (Adjunction f g, Monad m) => Monad (AdjointT f g m) where-  return = AdjointT . leftAdjunct return-  AdjointT m >>= f = AdjointT $ fmap (>>= rightAdjunct (runAdjointT . f)) m-    --- | Exploiting this instance requires that we have the missing Traversables for Identity, (,)e and IdentityT-instance (Adjunction f g, Traversable f) => MonadTrans (AdjointT f g) where-  lift = AdjointT . fmap sequence . unit
− Control/Monad/Trans/Contravariant/Adjoint.hs 
@@ -1,60 +0,0 @@-{-# 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
− Control/Monad/Trans/Conts.hs 
@@ -1,81 +0,0 @@-{-# 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 >>=)
− Data/Functor/Adjunction.hs 
@@ -1,152 +0,0 @@-{-# LANGUAGE Rank2Types-           , MultiParamTypeClasses-           , FunctionalDependencies-           , UndecidableInstances #-}------------------------------------------------------------------------------------------------ |--- Module	: Data.Functor.Adjunction--- Copyright 	: 2008-2011 Edward Kmett--- License	: BSD------ Maintainer	: Edward Kmett <ekmett@gmail.com>--- Stability	: experimental--- Portability	: rank 2 types, MPTCs, fundeps------------------------------------------------------------------------------------------------module Data.Functor.Adjunction -  ( Adjunction(..)-  , tabulateAdjunction-  , indexAdjunction-  , zipR, unzipR-  , unabsurdL, absurdL-  , cozipL, uncozipL-  , extractL, duplicateL-  , splitL, unsplitL -  ) where--import Control.Applicative-import Control.Arrow ((&&&), (|||))-import Control.Monad.Instances ()-import Control.Monad.Trans.Identity-import Control.Monad.Trans.Reader-import Control.Monad.Trans.Writer-import Control.Comonad.Trans.Env-import Control.Comonad.Trans.Traced--import Data.Functor.Identity-import Data.Functor.Compose-import Data.Functor.Representable-import Data.Void---- | An adjunction between Hask and Hask.------ Minimal definition: both 'unit' and 'counit' or both 'leftAdjunct' --- and 'rightAdjunct', subject to the constraints imposed by the --- default definitions that the following laws should hold.------ > unit = leftAdjunct id--- > counit = rightAdjunct id--- > leftAdjunct f = fmap f . unit--- > rightAdjunct f = counit . fmap f------ Any implementation is required to ensure that 'leftAdjunct' and --- 'rightAdjunct' witness an isomorphism from @Nat (f a, b)@ to --- @Nat (a, g b)@------ > rightAdjunct unit = id--- > leftAdjunct counit = id -class (Functor f, Representable u) => -      Adjunction f u | f -> u, u -> f where-  unit         :: a -> u (f a)-  counit       :: f (u a) -> a-  leftAdjunct  :: (f a -> b) -> a -> u b-  rightAdjunct :: (a -> u b) -> f a -> b--  unit           = leftAdjunct id-  counit         = rightAdjunct id-  leftAdjunct f  = fmap f . unit-  rightAdjunct f = counit . fmap f---- | Every right adjoint is representable by its left adjoint --- applied to a unit element--- --- Use this definition and the primitives in --- Data.Functor.Representable to meet the requirements of the --- superclasses of Representable.-tabulateAdjunction :: Adjunction f u => (f () -> b) -> u b-tabulateAdjunction f = leftAdjunct f ()---- | This definition admits a default definition for the --- 'index' method of 'Index", one of the superclasses of --- Representable.-indexAdjunction :: Adjunction f u => u b -> f a -> b-indexAdjunction = rightAdjunct . const--splitL :: Adjunction f u => f a -> (a, f ())-splitL = rightAdjunct (flip leftAdjunct () . (,))--unsplitL :: Functor f => a -> f () -> f a-unsplitL = (<$)--extractL :: Adjunction f u => f a -> a-extractL = fst . splitL--duplicateL :: Adjunction f u => f a -> f (f a)-duplicateL as = as <$ as---- | A right adjoint functor admits an intrinsic --- notion of zipping-zipR :: Adjunction f u => (u a, u b) -> u (a, b)-zipR = leftAdjunct (rightAdjunct fst &&& rightAdjunct snd)---- | Every functor in Haskell permits unzipping-unzipR :: Functor u => u (a, b) -> (u a, u b)-unzipR = fmap fst &&& fmap snd--absurdL :: Void -> f Void-absurdL = absurd---- | A left adjoint must be inhabited, or we can derive bottom. -unabsurdL :: Adjunction f u => f Void -> Void-unabsurdL = rightAdjunct absurd---- | And a left adjoint must be inhabited by exactly one element-cozipL :: Adjunction f u => f (Either a b) -> Either (f a) (f b)-cozipL = rightAdjunct (leftAdjunct Left ||| leftAdjunct Right)---- | Every functor in Haskell permits 'uncozipping'-uncozipL :: Functor f => Either (f a) (f b) -> f (Either a b)-uncozipL = fmap Left ||| fmap Right---- Requires deprecated Impredicative types--- limitR :: Adjunction f u => (forall a. u a) -> u (forall a. a)--- limitR = leftAdjunct (rightAdjunct (\(x :: forall a. a) -> x))--instance Adjunction ((,) e) ((->) e) where-  leftAdjunct f a e      = f (e, a)-  rightAdjunct f ~(e, a) = f a e--instance Adjunction Identity Identity where-  leftAdjunct f  = Identity . f . Identity-  rightAdjunct f = runIdentity . f . runIdentity--instance Adjunction f g => -         Adjunction (IdentityT f) (IdentityT g) where-  unit   = IdentityT . leftAdjunct IdentityT-  counit = rightAdjunct runIdentityT . runIdentityT--instance Adjunction w m => -         Adjunction (EnvT e w) (ReaderT e m) where-  unit              = ReaderT . flip fmap EnvT . flip leftAdjunct-  counit (EnvT e w) = rightAdjunct (flip runReaderT e) w--instance Adjunction m w => -         Adjunction (WriterT s m) (TracedT s w) where-  unit   = TracedT . leftAdjunct (\ma s -> WriterT (fmap (\a -> (a, s)) ma)) -  counit = rightAdjunct (\(t, s) -> ($s) <$> runTracedT t) . runWriterT--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
− Data/Functor/Contravariant/Adjunction.hs 
@@ -1,48 +0,0 @@-{-# LANGUAGE Rank2Types, MultiParamTypeClasses, FunctionalDependencies, UndecidableInstances #-}-module Data.Functor.Contravariant.Adjunction -  ( Adjunction(..)-  , corepAdjunction-  , coindexAdjunction-  ) where--import Control.Monad.Instances ()-import Data.Functor.Contravariant-import Data.Functor.Corepresentable---- | An adjunction from Hask^op to Hask--- --- > Op (f a) b ~ Hask a (g b)------ > 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, Corepresentable 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-  leftAdjunct  :: (b -> f a) -> a -> g b -  rightAdjunct :: (a -> g b) -> b -> f a--  unit = leftAdjunct id -  counit = rightAdjunct id-  leftAdjunct f = contramap f . unit -  rightAdjunct f = contramap f . counit---- | This adjunction gives rise to the Cont monad-instance Adjunction (Op r) (Op r) where-  unit a = Op (\k -> getOp k a)-  counit = unit---- | This gives rise to the Cont Bool monad-instance Adjunction Predicate Predicate where-  unit a = Predicate (\k -> getPredicate k a)-  counit = unit---- | Represent a contravariant functor that has a left adjoint-corepAdjunction :: Adjunction f g => (a -> f ()) -> g a-corepAdjunction = flip leftAdjunct () --coindexAdjunction :: Adjunction f g => g a -> a -> f ()-coindexAdjunction = rightAdjunct . const
adjunctions.cabal view
@@ -1,6 +1,6 @@ name:          adjunctions category:      Data Structures, Adjunctions-version:       2.5+version:       3.0 license:       BSD3 cabal-version: >= 1.6 license-file:  LICENSE@@ -20,6 +20,8 @@   location: git://github.com/ekmett/adjunctions.git  library+  hs-source-dirs: src+   other-extensions:     CPP     FunctionalDependencies@@ -34,14 +36,14 @@     transformers           >= 0.2     && < 0.4,     mtl                    >= 2.0.1   && < 2.2,     containers             >= 0.3     && < 0.6,-    comonad                >= 1.1.1.5 && < 1.2,+    comonad                == 3.0.*,     contravariant          >= 0.2.0.1 && < 0.3,     distributive           >= 0.2.2   && < 0.3,-    semigroupoids          >= 1.3.1.2 && < 1.4,+    semigroupoids          == 3.0.*,     void                   >= 0.5.5.1 && < 0.6,-    keys                   >= 2.2     && < 2.3,-    comonad-transformers   >= 2.1.1.1 && < 2.2,-    representable-functors >= 2.5     && < 2.6+    keys                   == 3.0.*,+    comonad-transformers   == 3.0.*,+    representable-functors == 3.0.*    exposed-modules:     Data.Functor.Adjunction
+ src/Control/Comonad/Trans/Adjoint.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Comonad.Trans.Adjoint+-- Copyright   :  (C) 2011 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  MPTCs, fundeps+--+----------------------------------------------------------------------------++module Control.Comonad.Trans.Adjoint+  ( Adjoint+  , runAdjoint+  , adjoint+  , AdjointT(..)+  ) where++import Prelude hiding (sequence)+import Control.Applicative+import Control.Comonad+import Control.Comonad.Trans.Class+import Data.Functor.Adjunction+import Data.Functor.Extend+import Data.Functor.Identity+import Data.Distributive++type Adjoint f g = AdjointT f g Identity++newtype AdjointT f g w a = AdjointT { runAdjointT :: f (w (g a)) }++adjoint :: Functor f => f (g a) -> Adjoint f g a+adjoint = AdjointT . fmap Identity++runAdjoint :: Functor f => Adjoint f g a -> f (g a)+runAdjoint = fmap runIdentity . runAdjointT++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, Extend w) => Extend (AdjointT f g w) where+  extended f (AdjointT m) = AdjointT $ fmap (extended $ leftAdjunct (f . AdjointT)) m++instance (Adjunction f g, Comonad w) => Comonad (AdjointT f g w) where+  extend f (AdjointT m) = AdjointT $ fmap (extend $ leftAdjunct (f . AdjointT)) m+  extract = rightAdjunct extract . runAdjointT+  +{-+instance (Adjunction f g, Monad m) => Applicative (AdjointT f g m) where+  pure = AdjointT . leftAdjunct return+  (<*>) = ap+-}+    +instance (Adjunction f g, Distributive g) => ComonadTrans (AdjointT f g) where+  lower = counit . fmap distribute . runAdjointT
+ src/Control/Monad/Trans/Adjoint.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Monad.Trans.Adjoint+-- Copyright   :  (C) 2011 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  MPTCs, fundeps+--+----------------------------------------------------------------------------++module Control.Monad.Trans.Adjoint+  ( Adjoint+  , runAdjoint+  , adjoint+  , AdjointT(..)+  ) where++import Prelude hiding (sequence)+import Control.Applicative+import Control.Monad (ap, liftM)+import Control.Monad.Trans.Class+import Data.Traversable+import Data.Functor.Adjunction+import Data.Functor.Identity++type Adjoint f g = AdjointT f g Identity++newtype AdjointT f g m a = AdjointT { runAdjointT :: g (m (f a)) }++adjoint :: Functor g => g (f a) -> Adjoint f g a+adjoint = AdjointT . fmap Identity++runAdjoint :: Functor g => Adjoint f g a -> g (f a)+runAdjoint = fmap runIdentity . runAdjointT++instance (Adjunction f g, Monad m) => Functor (AdjointT f g m) where+  fmap f (AdjointT g) = AdjointT $ fmap (liftM (fmap f)) g+  b <$ (AdjointT g) = AdjointT $ fmap (liftM (b <$)) g+  +instance (Adjunction f g, Monad m) => Applicative (AdjointT f g m) where+  pure = AdjointT . leftAdjunct return+  (<*>) = ap++instance (Adjunction f g, Monad m) => Monad (AdjointT f g m) where+  return = AdjointT . leftAdjunct return+  AdjointT m >>= f = AdjointT $ fmap (>>= rightAdjunct (runAdjointT . f)) m+    +-- | Exploiting this instance requires that we have the missing Traversables for Identity, (,)e and IdentityT+instance (Adjunction f g, Traversable f) => MonadTrans (AdjointT f g) where+  lift = AdjointT . fmap sequence . unit
+ src/Control/Monad/Trans/Contravariant/Adjoint.hs view
@@ -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
+ src/Control/Monad/Trans/Conts.hs view
@@ -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 >>=)
+ src/Data/Functor/Adjunction.hs view
@@ -0,0 +1,152 @@+{-# LANGUAGE Rank2Types+           , MultiParamTypeClasses+           , FunctionalDependencies+           , UndecidableInstances #-}++-------------------------------------------------------------------------------------------+-- |+-- Module	: Data.Functor.Adjunction+-- Copyright 	: 2008-2011 Edward Kmett+-- License	: BSD+--+-- Maintainer	: Edward Kmett <ekmett@gmail.com>+-- Stability	: experimental+-- Portability	: rank 2 types, MPTCs, fundeps+--+-------------------------------------------------------------------------------------------+module Data.Functor.Adjunction +  ( Adjunction(..)+  , tabulateAdjunction+  , indexAdjunction+  , zipR, unzipR+  , unabsurdL, absurdL+  , cozipL, uncozipL+  , extractL, duplicateL+  , splitL, unsplitL +  ) where++import Control.Applicative+import Control.Arrow ((&&&), (|||))+import Control.Monad.Instances ()+import Control.Monad.Trans.Identity+import Control.Monad.Trans.Reader+import Control.Monad.Trans.Writer+import Control.Comonad.Trans.Env+import Control.Comonad.Trans.Traced++import Data.Functor.Identity+import Data.Functor.Compose+import Data.Functor.Representable+import Data.Void++-- | An adjunction between Hask and Hask.+--+-- Minimal definition: both 'unit' and 'counit' or both 'leftAdjunct' +-- and 'rightAdjunct', subject to the constraints imposed by the +-- default definitions that the following laws should hold.+--+-- > unit = leftAdjunct id+-- > counit = rightAdjunct id+-- > leftAdjunct f = fmap f . unit+-- > rightAdjunct f = counit . fmap f+--+-- Any implementation is required to ensure that 'leftAdjunct' and +-- 'rightAdjunct' witness an isomorphism from @Nat (f a, b)@ to +-- @Nat (a, g b)@+--+-- > rightAdjunct unit = id+-- > leftAdjunct counit = id +class (Functor f, Representable u) => +      Adjunction f u | f -> u, u -> f where+  unit         :: a -> u (f a)+  counit       :: f (u a) -> a+  leftAdjunct  :: (f a -> b) -> a -> u b+  rightAdjunct :: (a -> u b) -> f a -> b++  unit           = leftAdjunct id+  counit         = rightAdjunct id+  leftAdjunct f  = fmap f . unit+  rightAdjunct f = counit . fmap f++-- | Every right adjoint is representable by its left adjoint +-- applied to a unit element+-- +-- Use this definition and the primitives in +-- Data.Functor.Representable to meet the requirements of the +-- superclasses of Representable.+tabulateAdjunction :: Adjunction f u => (f () -> b) -> u b+tabulateAdjunction f = leftAdjunct f ()++-- | This definition admits a default definition for the +-- 'index' method of 'Index", one of the superclasses of +-- Representable.+indexAdjunction :: Adjunction f u => u b -> f a -> b+indexAdjunction = rightAdjunct . const++splitL :: Adjunction f u => f a -> (a, f ())+splitL = rightAdjunct (flip leftAdjunct () . (,))++unsplitL :: Functor f => a -> f () -> f a+unsplitL = (<$)++extractL :: Adjunction f u => f a -> a+extractL = fst . splitL++duplicateL :: Adjunction f u => f a -> f (f a)+duplicateL as = as <$ as++-- | A right adjoint functor admits an intrinsic +-- notion of zipping+zipR :: Adjunction f u => (u a, u b) -> u (a, b)+zipR = leftAdjunct (rightAdjunct fst &&& rightAdjunct snd)++-- | Every functor in Haskell permits unzipping+unzipR :: Functor u => u (a, b) -> (u a, u b)+unzipR = fmap fst &&& fmap snd++absurdL :: Void -> f Void+absurdL = absurd++-- | A left adjoint must be inhabited, or we can derive bottom. +unabsurdL :: Adjunction f u => f Void -> Void+unabsurdL = rightAdjunct absurd++-- | And a left adjoint must be inhabited by exactly one element+cozipL :: Adjunction f u => f (Either a b) -> Either (f a) (f b)+cozipL = rightAdjunct (leftAdjunct Left ||| leftAdjunct Right)++-- | Every functor in Haskell permits 'uncozipping'+uncozipL :: Functor f => Either (f a) (f b) -> f (Either a b)+uncozipL = fmap Left ||| fmap Right++-- Requires deprecated Impredicative types+-- limitR :: Adjunction f u => (forall a. u a) -> u (forall a. a)+-- limitR = leftAdjunct (rightAdjunct (\(x :: forall a. a) -> x))++instance Adjunction ((,) e) ((->) e) where+  leftAdjunct f a e      = f (e, a)+  rightAdjunct f ~(e, a) = f a e++instance Adjunction Identity Identity where+  leftAdjunct f  = Identity . f . Identity+  rightAdjunct f = runIdentity . f . runIdentity++instance Adjunction f g => +         Adjunction (IdentityT f) (IdentityT g) where+  unit   = IdentityT . leftAdjunct IdentityT+  counit = rightAdjunct runIdentityT . runIdentityT++instance Adjunction w m => +         Adjunction (EnvT e w) (ReaderT e m) where+  unit              = ReaderT . flip fmap EnvT . flip leftAdjunct+  counit (EnvT e w) = rightAdjunct (flip runReaderT e) w++instance Adjunction m w => +         Adjunction (WriterT s m) (TracedT s w) where+  unit   = TracedT . leftAdjunct (\ma s -> WriterT (fmap (\a -> (a, s)) ma)) +  counit = rightAdjunct (\(t, s) -> ($s) <$> runTracedT t) . runWriterT++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
+ src/Data/Functor/Contravariant/Adjunction.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE Rank2Types, MultiParamTypeClasses, FunctionalDependencies, UndecidableInstances #-}+module Data.Functor.Contravariant.Adjunction +  ( Adjunction(..)+  , corepAdjunction+  , coindexAdjunction+  ) where++import Control.Monad.Instances ()+import Data.Functor.Contravariant+import Data.Functor.Corepresentable++-- | An adjunction from Hask^op to Hask+-- +-- > Op (f a) b ~ Hask a (g b)+--+-- > 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, Corepresentable 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+  leftAdjunct  :: (b -> f a) -> a -> g b +  rightAdjunct :: (a -> g b) -> b -> f a++  unit = leftAdjunct id +  counit = rightAdjunct id+  leftAdjunct f = contramap f . unit +  rightAdjunct f = contramap f . counit++-- | This adjunction gives rise to the Cont monad+instance Adjunction (Op r) (Op r) where+  unit a = Op (\k -> getOp k a)+  counit = unit++-- | This gives rise to the Cont Bool monad+instance Adjunction Predicate Predicate where+  unit a = Predicate (\k -> getPredicate k a)+  counit = unit++-- | Represent a contravariant functor that has a left adjoint+corepAdjunction :: Adjunction f g => (a -> f ()) -> g a+corepAdjunction = flip leftAdjunct () ++coindexAdjunction :: Adjunction f g => g a -> a -> f ()+coindexAdjunction = rightAdjunct . const