[new stuff ekmett@gmail.com**20090505003700 Ignore-this: 801a14d5a566a19e54fc197784a9af61 ] { addfile ./doc/html/monad-ran/Control-Functor-Pointed.html hunk ./doc/html/monad-ran/Control-Functor-Pointed.html 1 + + +Control.Functor.Pointed
monad-ran-0.0.7: Fast implementations of monads and monad transformers using right Kan extensionsSource codeContentsIndex
Control.Functor.Pointed
Portabilityportable
Stabilityexperimental
MaintainerEdward Kmett <ekmett@gmail.com>
Description
Documentation
class Functor f => Pointed f whereSource
Methods
point :: a -> f aSource
show/hide Instances
Produced by Haddock version 2.3.0
addfile ./doc/html/monad-ran/Control-Monad-CPS-Maybe.html hunk ./doc/html/monad-ran/Control-Monad-CPS-Maybe.html 1 + + +Control.Monad.CPS.Maybe
monad-ran-0.0.7: Fast implementations of monads and monad transformers using right Kan extensionsSource codeContentsIndex
Control.Monad.CPS.Maybe
Documentation
newtype Maybe' a Source
Constructors
Maybe'
getMaybe' :: forall o. (a -> o) -> o -> o
show/hide Instances
maybe' :: a -> (b -> a) -> Maybe' b -> aSource
Produced by Haddock version 2.3.0
addfile ./doc/html/monad-ran/Control-Monad-Codensity.html hunk ./doc/html/monad-ran/Control-Monad-Codensity.html 1 + + +Control.Monad.Codensity
monad-ran-0.0.7: Fast implementations of monads and monad transformers using right Kan extensionsSource codeContentsIndex
Control.Monad.Codensity
Contents
The codensity monad of a functor +
Synopsis
data Codensity f a = Codensity {
getCodensity :: forall b. (a -> f b) -> f b
}
lowerCodensity :: Monad m => Codensity m a -> m a
lowerCodensityApp :: Applicative f => Codensity f a -> f a
lowerCodensityPointed :: Applicative f => Codensity f a -> f a
The codensity monad of a functor +
data Codensity f a Source
The Codensity monad of a functor/monad generated by a functor +
Constructors
Codensity
getCodensity :: forall b. (a -> f b) -> f b
show/hide Instances
lowerCodensity :: Monad m => Codensity m a -> m aSource
lowerCodensityApp :: Applicative f => Codensity f a -> f aSource
lowerCodensityPointed :: Applicative f => Codensity f a -> f aSource
Produced by Haddock version 2.3.0
hunk ./doc/html/monad-ran/Control-Monad-Ran.html 22 ->monad-ran-0.0.6: Implementations of common monads and monad transformers as right Kan extensionsmonad-ran-0.0.7: Fast implementations of monads and monad transformers using right Kan extensions
Contents
The Yoneda Lemma +
The codensity monad of a functor +
A right Kan extension monad transformer +
Representing monads as right Kan extensions +
DocumentationSynopsis
data Yoneda f a = Yoneda {
getYoneda :: forall b. (a -> b) -> f b
}
data Codensity f a = Codensity {
getCodensity :: forall b. (a -> f b) -> f b
}
data Ran m a = Ran {
getRan :: forall b. (a -> G m b) -> H m b
}
class (Monad (Ran f), Monad f, RanIso f) => RMonad f
liftRan :: RanIso f => f a -> Ran f a
lowerRan :: RanIso f => Ran f a -> f a
The Yoneda Lemma +MonadRWS r w s f => MonadRWS r w s (Yoneda f)MonadError e f => MonadError e (Yoneda f)MonadReader r f => MonadReader r (Yoneda f)MonadState s f => MonadState s (Yoneda f)MonadWriter w f => MonadWriter w (Yoneda f)MonadFix m => MonadFix (Yoneda m)MonadPlus f => MonadPlus (Yoneda f)Monad f => RMonadAlternative f => AlternativeMonadIO f => MonadIO (Yoneda f)Pointed f => Pointed (Yoneda f)RanIso (Yoneda f)The codensity monad of a functor +The Codensity monad of a functor/monad generated by a functor +MonadRWS r w s m => MonadRWS r w s (Codensity m)MonadError e m => MonadError e (Codensity m)MonadReader r m => MonadReader r (Codensity m)MonadState s m => MonadState s (Codensity m)MonadWriter w m => MonadWriter w (Codensity m)MonadPlus m => MonadPlus (Codensity m)RMonadMonadIO m => MonadIO (Codensity m)PointedRanIso (Codensity f)A right Kan extension monad transformer +A right Kan extension transformer for a monad +show/hide Instances
class Monad f => RMonad f whereSourceMonadRWS r w s f => MonadRWS r w s (Ran (Yoneda f))
MonadRWS r w s m => MonadRWS r w s (Ran (Codensity m))
MonadError e f => MonadError e (Ran (Yoneda f))
Error e => MonadError e (Ran (Either e))Associated TypesMonadError e m => MonadError e (Ran (Codensity m))
MonadReader r f => MonadReader r (Ran (Yoneda f))
MonadReader r m => MonadReader r (Ran (Codensity m))
type G f :: * -> *SourceMonadState s f => MonadState s (Ran (Yoneda f))
MonadState s m => MonadState s (Ran (Codensity m))MonadWriter w f => MonadWriter w (Ran (Yoneda f))
MonadWriter w m => MonadWriter w (Ran (Codensity m))
type H f :: * -> *SourceMonad (Ran IO)
Error e => Monad (Ran (Either e))
Monad (Ran STM)Monad (Ran (ST s))MethodsMonad (Ran Maybe)
Monad (Ran Identity)
(Codensity f))
Monad f => Monad (Ran (Yoneda f))
toRan :: f a -> Monad ( f aSource
RanIso f => Functor (Ran f)MonadFix m => MonadFix (Ran (Yoneda m)) (Either e))
MonadFix m => MonadFix (Ran (Codensity m))
fromRan :: Error e => MonadPlus ( f a -> f aSource
MonadPlus (Ran Maybe)
MonadPlus f => MonadPlus (Ran (Yoneda f))MonadPlus f => MonadPlus (Ran (Codensity f))show/hide InstancesApplicative (Ran IO)
RMonad m => RMonad (StateT s m)RMonad m => RMonad (ReaderT e m)Representing monads as right Kan extensions +(RMonad m, Error b) => RMonad (ErrorT b m)
monad-ran-0.0.7: Fast implementations of monads and monad transformers using right Kan extensionsControl.Monad.Codensity, Control.Monad.Codensity, fromRanGGgetCodensityControl.Monad.Codensity, getCodensitygetMaybe'Control.Monad.RanControl.Monad.CPS.MaybeControl.Monad.Yoneda, toRanrunYonedaControl.Monad.RanControl.Monad.YonedaControl.Monad.Yoneda, Control.Monad.Yoneda, monad-ran-0.0.6: Implementations of common monads and monad transformers as right Kan extensionsmonad-ran-0.0.7: Fast implementations of monads and monad transformers using right Kan extensionsmonad-ran-0.0.6: Implementations of common monads and monad transformers as right Kan extensionsmonad-ran-0.0.7: Fast implementations of monads and monad transformers using right Kan extensionsmonad-ran-0.0.6: Implementations of common monads and monad transformers as right Kan extensionsmonad-ran-0.0.7: Fast implementations of monads and monad transformers using right Kan extensions. +>Fast implementations of monads and monad transformers using right Kan extensions hunk ./doc/html/monad-ran/index.html 66 ->MonadFunctorControl.Functor.Pointed
class (Monad (Ran f), Monad f, RanIso f) => RMonad f Source
toRan :: RMonad f => f a -> liftRan :: RanIso f => f a -> fromRan :: RMonad f => lowerRan :: RanIso f => + +Control.Monad.Yoneda
monad-ran-0.0.7: Fast implementations of monads and monad transformers using right Kan extensionsSource codeContentsIndex
Control.Monad.Yoneda
Contents
The Yoneda Lemma +
Synopsis
data Yoneda f a = Yoneda {
getYoneda :: forall b. (a -> b) -> f b
}
runYoneda :: Yoneda f a -> f a
The Yoneda Lemma +
data Yoneda f a Source
Constructors
Yoneda
getYoneda :: forall b. (a -> b) -> f b
show/hide Instances
runYoneda :: Yoneda f a -> f aSource
Produced by Haddock version 2.3.0
hunk ./doc/html/monad-ran/doc-index.html 7 ->monad-ran-0.0.6: Implementations of common monads and monad transformers as right Kan extensions (Index)monad-ran-0.0.7: Fast implementations of monads and monad transformers using right Kan extensions (Index)monad-ran-0.0.6: Implementations of common monads and monad transformers as right Kan extensions		liftRanControl.Monad.Ran
lowerCodensityControl.Monad.Codensity
lowerCodensityAppControl.Monad.Codensity
lowerCodensityPointedControl.Monad.Codensity
lowerRanControl.Monad.Ran
Maybe'
1 (Type/Class)Control.Monad.CPS.Maybe
2 (Data Constructor)Control.Monad.CPS.Maybe
maybe'Control.Monad.CPS.Maybe
pointControl.Functor.Pointed
PointedControl.Functor.Pointed
show/hideMonad
+ + + +Control/Functor/Pointed.hs + + + +
-------------------------------------------------------------------------------------------
+-- | 
+-- Module       : Control.Functor.Pointed
+-- Copyright    : 2008 Edward Kmett
+-- License      : BSD
+--
+-- Maintainer   : Edward Kmett <ekmett@gmail.com>
+-- Stability    : experimental
+-- Portability  : portable
+--
+-------------------------------------------------------------------------------------------
+
+module Control.Functor.Pointed 
+    ( Pointed(..)
+    ) where
+
+import Control.Monad.Identity
+import Control.Monad.Reader
+import qualified Control.Monad.Writer.Lazy as LW
+import qualified Control.Monad.Writer.Strict as SW
+import qualified Control.Monad.State.Lazy as LS
+import qualified Control.Monad.State.Strict as SS
+import qualified Control.Monad.RWS.Lazy as LR
+import qualified Control.Monad.RWS.Strict as SR
+import Control.Monad.Error
+import Control.Monad.Cont
+import Control.Monad.List
+import Data.Monoid
+
+-- return
+class Functor f => Pointed f where
+    point :: a -> f a
+
+instance Pointed Maybe where point = Just
+instance Pointed [] where point = return
+
+instance Pointed (Cont r) where point = return
+instance Monad m => Pointed (ContT r m) where point = return
+
+instance Pointed Identity where point = Identity
+
+instance Pointed (Either a) where point = Right
+instance (Error e, Monad m) => Pointed (ErrorT e m) where point = return
+
+instance Pointed (Reader r) where point = return
+instance Monad m => Pointed (ReaderT r m) where point = return
+instance Pointed ((->)r) where point = return
+
+instance Pointed (SS.State w) where point = return
+instance Pointed (LS.State w) where point = return
+instance Monad m => Pointed (SS.StateT w m) where point = return
+instance Monad m => Pointed (LS.StateT w m) where point = return
+
+instance Monoid w => Pointed (SW.Writer w) where point = return
+instance Monoid w => Pointed (LW.Writer w) where point = return
+instance (Monoid w, Monad m) => Pointed (SW.WriterT w m) where point = return
+instance (Monoid w, Monad m) => Pointed (LW.WriterT w m) where point = return
+
+instance Monoid w => Pointed (SR.RWS r w s) where point = return
+instance Monoid w => Pointed (LR.RWS r w s) where point = return
+instance (Monoid w, Monad m) => Pointed (SR.RWST r w s m) where point = return
+instance (Monoid w, Monad m) => Pointed (LR.RWST r w s m) where point = return
+
+instance Monad m => Pointed (ListT m) where point = return
+
+ addfile ./doc/html/monad-ran/src/Control-Monad-CPS-Maybe.html hunk ./doc/html/monad-ran/src/Control-Monad-CPS-Maybe.html 1 + + + + +Control/Monad/CPS/Maybe.hs + + + +
{-# LANGUAGE Rank2Types #-}
+
+module Control.Monad.CPS.Maybe
+    ( Maybe'(..)
+    , maybe'
+    ) where
+
+newtype Maybe' a = Maybe' { getMaybe' :: forall o. (a -> o) -> o -> o } 
+
+instance Functor Maybe' where
+    fmap f (Maybe' m) = Maybe' (\k -> m (k . f))
+
+instance Monad Maybe' where
+    return a = Maybe' (\k _ -> k a)
+    Maybe' g >>= f = Maybe' (\k z -> g (\a -> getMaybe' (f a) k z) z)
+    
+maybe' :: a -> (b -> a) -> Maybe' b -> a
+maybe' a b (Maybe' m) = m b a
+
+ addfile ./doc/html/monad-ran/src/Control-Monad-Codensity.html hunk ./doc/html/monad-ran/src/Control-Monad-Codensity.html 1 + + + + +Control/Monad/Codensity.hs + + + +
{-# LANGUAGE Rank2Types, MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, UndecidableInstances #-}
+-- Finding the right Kan extension
+
+module Control.Monad.Codensity
+    ( -- * The codensity monad of a functor
+      Codensity(..)
+    , lowerCodensity
+    , lowerCodensityApp
+    , lowerCodensityPointed
+    ) where
+
+import Data.Monoid
+import Data.Maybe (maybe)
+import Control.Applicative
+import Control.Monad
+import Control.Monad.Trans
+import Control.Monad.Identity
+import Control.Monad.Cont.Class
+import Control.Monad.State.Class
+import Control.Monad.Error.Class
+import Control.Monad.Reader.Class
+import Control.Monad.Writer.Class
+import Control.Monad.RWS.Class
+import Control.Functor.Pointed
+
+-- | The Codensity monad of a functor/monad generated by a functor
+
+data Codensity f a = Codensity { getCodensity :: forall b. (a -> f b) -> f b }
+
+instance Functor (Codensity k) where
+    fmap f m = Codensity (\k -> getCodensity m (k . f))
+
+instance Pointed (Codensity f) where
+    point x = Codensity (\k -> k x)
+
+instance Applicative (Codensity f) where
+    pure x = Codensity (\k -> k x)
+    Codensity f <*> Codensity x = Codensity (\k -> f (\f' -> x (k . f')))
+
+instance Monad (Codensity f) where
+    return x = Codensity (\k -> k x)
+    Codensity m >>= k = Codensity 
+        (\c -> m (\a -> getCodensity (k a) c))
+
+instance MonadIO m => MonadIO (Codensity m) where
+    liftIO = lift . liftIO
+
+instance MonadPlus m => MonadPlus (Codensity m) where
+    mzero = Codensity (const mzero)
+    a `mplus` b = lift (lowerCodensity a `mplus` lowerCodensity b)
+
+instance MonadReader r m => MonadReader r (Codensity m) where
+    ask = lift ask
+    local f m = Codensity (\c -> do r <- ask; local f (getCodensity m (local (const r) . c)))
+
+instance MonadWriter w m => MonadWriter w (Codensity m) where
+    tell = lift . tell
+    listen = lift . listen . lowerCodensity
+    pass = lift . pass . lowerCodensity
+
+instance MonadState s m => MonadState s (Codensity m) where
+    get = lift get
+    put = lift . put
+
+instance MonadRWS r w s m => MonadRWS r w s (Codensity m)
+
+-- instance MonadFix f => MonadFix (Codensity f) where
+--    mfix f = lift . mfix (lowerCodensity . f)
+
+instance MonadError e m => MonadError e (Codensity m) where
+    throwError = lift . throwError
+--    Codensity f `catchError` h = catchError . run
+
+instance MonadTrans Codensity where
+    lift m = Codensity (m >>=)
+
+lowerCodensity :: Monad m => Codensity m a -> m a
+lowerCodensity = flip getCodensity return
+
+lowerCodensityApp :: Applicative f => Codensity f a -> f a
+lowerCodensityApp = flip getCodensity pure
+
+lowerCodensityPointed :: Applicative f => Codensity f a -> f a
+lowerCodensityPointed = flip getCodensity pure
+
+
+ hunk ./doc/html/monad-ran/src/Control-Monad-Ran.html 9 -
-- Finding the right Kan extension
-
-module Control.Monad.Ran 
-    ( Yoneda(..)
-    , Codensity(..)
-    , Ran(..)
-    , RMonad
-    , G
-    , H
-    , toRan
-    , fromRan
-    ) where
-
-import Data.Monoid
-import Control.Applicative
-import Control.Monad
-import Control.Monad.Identity
-import Control.Monad.Cont
-import Control.Monad.State
-import Control.Monad.Error
-import Control.Monad.Reader
-import Control.Monad.Writer
-import Control.Monad.RWS
-
-data Yoneda f a = Yoneda { getYoneda :: forall b. (a -> b) -> f b } 
-
-instance Functor (Yoneda f) where
-    fmap f m = Yoneda (\k -> getYoneda m (k . f))
-
-instance Applicative f => Applicative (Yoneda f) where
-    pure a = Yoneda (\f -> pure (f a))
-    m <*> n = Yoneda (\f -> getYoneda m (f .) <*> getYoneda n id)
-
-instance Monad f => Monad (Yoneda f) where
-    return a = Yoneda (\f -> return (f a))
-    m >>= k = Yoneda (\f -> getYoneda m id >>= \a -> getYoneda (k a) f)
-
-instance MonadTrans Yoneda where
-    lift m = Yoneda (\f -> liftM f m)
-
-data Codensity f a = Codensity { getCodensity :: forall b. (a -> f b) -> f b }
+
{-# LANGUAGE RankNTypes, FlexibleInstances, FlexibleContexts, TypeFamilies, MultiParamTypeClasses, MagicHash, UnboxedTuples, UndecidableInstances  #-}
+-- Finding the right Kan extension
+
+module Control.Monad.Ran 
+    ( 
+      -- * The Yoneda Lemma
+      Yoneda(..)
+      -- * The codensity monad of a functor
+    , Codensity(..)
+      -- * A right Kan extension monad transformer
+    , Ran(..)
+      -- * Representing monads as right Kan extensions
+    , RMonad
+    , G
+    , H
+    , liftRan
+    , lowerRan
+    ) where
+
+import Data.Monoid
+import Data.Maybe (maybe)
+import Control.Applicative
+import Control.Functor.Pointed
+import Control.Monad
+import Control.Monad.Yoneda
+import Control.Monad.Codensity
+import Control.Monad.Identity
+import Control.Monad.Cont
+import Control.Monad.State
+import Control.Monad.Error
+import Control.Monad.Reader
+import Control.Monad.Writer
+import Control.Monad.RWS
+
+import GHC.Prim
+import GHC.IOBase hiding (liftIO)
+import GHC.Conc
+import GHC.ST
+
+-- | A right Kan extension transformer for a monad
+data Ran m a = Ran { getRan :: forall b. (a -> G m b) -> H m b } 
hunk ./doc/html/monad-ran/src/Control-Monad-Ran.html 51
-instance Functor (Codensity k) where
-    fmap f m = Codensity (\k -> getCodensity m (k . f))
-
-instance Applicative (Codensity f) where
-    pure = return
-    (<*>) = ap
-
-instance Monad (Codensity f) where
-    return x = Codensity (\k -> k x)
-    m >>= k = Codensity (\c -> getCodensity m (\a -> getCodensity (k a) c))
-
-instance MonadTrans Codensity where
-    lift m = Codensity (m >>=)
-
-runCodensity :: Monad m => Codensity m a -> m a
-runCodensity = flip getCodensity return
-
-runCodensityApp :: Applicative f => Codensity f a -> f a
-runCodensityApp = flip getCodensity pure
-
--- .. Pointed
-
-data Ran m a = Ran { getRan :: forall b. (a -> G m b) -> H m b } 
+class RanIso f where
+    type G f    :: * -> *
+    type H f    :: * -> *
+    liftRan       :: f a -> Ran f a
+    lowerRan      :: Ran f a -> f a
+
+instance RanIso f => Functor (Ran f) where
+    fmap f m = Ran (\k -> getRan m (k . f))
+
+returnCodensity :: (RanIso m, G m ~ H m) => a -> Ran m a
+returnCodensity a = Ran (\k -> k a)
+
+bindCodensity :: (RanIso m, G m ~ H m) => Ran m a -> (a -> Ran m b) -> Ran m b
+bindCodensity (Ran m) k = Ran (\c -> m (\a -> getRan (k a) c))
+
+apCodensity :: (RanIso m, G m ~ H m) => Ran m (a -> b) -> Ran m a -> Ran m b
+apCodensity (Ran f) (Ran x) = Ran (\k -> f (\f' -> x (k . f')))
+
+class (Monad (Ran f), Monad f, RanIso f) => RMonad f 
+instance (Monad (Ran f), Monad f, RanIso f) => RMonad f
+
+class (Applicative (Ran f), Applicative f, RanIso f) => RApplicative f 
+instance (Applicative (Ran f), Applicative f, RanIso f) => RApplicative f
hunk ./doc/html/monad-ran/src/Control-Monad-Ran.html 75
-class Monad f => RMonad f where
-    type G f    :: * -> *
-    type H f    :: * -> *
-    toRan      :: f a -> Ran f a
-    fromRan    :: Ran f a -> f a
-
---class RMonadTrans t where
---    liftR :: RMonad m => RanT m a -> RanT (t m) a
-
--- utility bifunctors for definitions below
-type Hom = (->)
-type (:->) = ReaderT
-
-data ErrorH b r  = ErrorH { getErrorH :: (b -> r) -> r } 
-data ErrorTH b m r = ErrorTH { getErrorTH :: (b -> G m r) -> H m r }
-
--- Yoneda Identity
--- forall o. (a -> o) -> o
-instance RMonad Identity where
-    type G Identity = Identity
-    type H Identity = Identity
-    toRan m = Ran (m >>=)
-    fromRan = flip getRan Identity
-
--- Yoneda Endo
--- forall o. (a -> o) -> o -> o
-instance RMonad Maybe where
-    type G Maybe = Identity
-    type H Maybe = Endo
-    toRan (Just x) = Ran (\k -> Endo (\_ -> runIdentity (k x)))
-    toRan Nothing = Ran (\_ -> Endo id)
-    fromRan (Ran f) = appEndo (f (Identity . Just)) Nothing
-
--- Yoneda (ErrorH b)
--- forall o. (a -> o) -> (b -> o) -> o
-instance Error b => RMonad (Either b) where
-    type G (Either b) = Identity
-    type H (Either b) = ErrorH b
+-- The codensity monad as a right Kan extension of a functor along itself
+-- Many state-like monads can be CPS transformed into a codensity monad.
+instance RanIso (Codensity f) where
+    type G (Codensity f) = f
+    type H (Codensity f) = f
+    liftRan (Codensity f) = Ran f
+    lowerRan (Ran f) = Codensity f
+
+ranCodensity :: Ran (Codensity f) a -> Codensity f a
+ranCodensity = lowerRan
+
+codensityRan :: Codensity f a -> Ran (Codensity f) a
+codensityRan = liftRan
+
+liftRanCodensity :: Monad f => f a -> Ran (Codensity f) a
+liftRanCodensity f = Ran (f >>=)
+
+lowerRanCodensity :: Monad f => Ran (Codensity f) a -> f a 
+lowerRanCodensity (Ran f) = f return
+
+instance Pointed (Ran (Codensity f)) where
+    point = returnCodensity
+
+instance Applicative (Ran (Codensity f)) where
+    pure = returnCodensity
+    (<*>) = apCodensity
+
+instance Monad (Ran (Codensity f)) where
+    return = returnCodensity
+    (>>=) = bindCodensity
+
+instance MonadPlus f => Alternative (Ran (Codensity f)) where
+    empty = liftRan mzero
+    m <|> n = liftRan (lowerRan m `mplus` lowerRan n)
+    
+instance MonadPlus f => MonadPlus (Ran (Codensity f)) where
+    mzero = liftRan mzero
+    m `mplus` n = liftRan (lowerRan m `mplus` lowerRan n)
hunk ./doc/html/monad-ran/src/Control-Monad-Ran.html 114
--- Yoneda (ErrorTH b m)
--- forall o. (a -> G m o) -> (b -> G m o) -> H m o
-instance (RMonad m, Error b) => RMonad (ErrorT b m) where
-   type G (ErrorT b m) = G m 
-   type H (ErrorT b m) = ErrorTH b m
-
--- Yoneda f
--- forall o. (a -> o) -> f o 
-instance Monad f => RMonad (Yoneda f) where
-    type G (Yoneda f) = Identity
-    type H (Yoneda f) = f
+instance MonadIO f => MonadIO (Ran (Codensity f)) where
+    liftIO f = Ran (liftIO f >>=)
+
+instance MonadState s m => MonadState s (Ran (Codensity m)) where
+    get = Ran (get >>=)
+    put s = Ran (put s >>=)
+
+instance MonadWriter w m => MonadWriter w (Ran (Codensity m)) where
+    tell w = Ran (tell w >>=) 
+    listen = liftRanCodensity . listen . lowerRanCodensity
+    pass = liftRanCodensity . pass . lowerRanCodensity
hunk ./doc/html/monad-ran/src/Control-Monad-Ran.html 126
--- Codensity f
--- forall o. (a -> f o) -> f o 
-instance RMonad (Codensity f) where
-    type G (Codensity f) = f
-    type H (Codensity f) = f
-
--- Yoneda (Reader r)
--- forall o. (a -> o) -> r -> o
-instance RMonad (Reader e) where
-    type G (Reader e) = Identity
-    type H (Reader e) = Hom e
-
--- embedded as CPS'd State to avoid superfluous 'mappend mempty' calls
--- specialized Codensity (Reader w)
--- forall o. (a -> w -> o) -> w -> o
-instance Monoid w => RMonad (Writer w) where
-    type G (Writer w) = Hom w
-    type H (Writer w) = Hom w
-    -- forall o. (a -> w -> o) -> o
-    -- type H (Writer w) = Identity
-
--- Codensity (Reader s)
--- forall o. (a -> s -> o) -> s -> o
-instance RMonad (State s) where
-    type G (State s) = Hom s
-    type H (State s) = Hom s
-
--- Codensity (Const r)
--- (a -> r) -> r
-instance RMonad (Cont r) where
-    type G (Cont r) = Const r
-    type H (Cont r) = Const r
-
--- forall o. (a -> G m o) -> r -> H m o 
-instance RMonad m => RMonad (ReaderT e m) where
-    type G (ReaderT e m) = G m
-    type H (ReaderT e m) = e :-> H m
-
--- forall o. (a -> w -> G m o) -> H m o
-instance (Monoid w, RMonad m) => RMonad (WriterT w m) where
-    type G (WriterT w m) = w :-> G m
-    type H (WriterT w m) = H m
-
--- forall o. (a -> s -> G m o) -> s -> H m o 
-instance RMonad m => RMonad (StateT s m) where
-    type G (StateT s m) = s :-> G m
-    type H (StateT s m) = s :-> H m
-
--- (a -> G m r) -> H m r
-data ConstT r f a = ConstT { getConstT :: f r } 
-instance RMonad m => RMonad (ContT r m) where
-    type G (ContT r m) = ConstT r (G m)
-    type H (ContT r m) = ConstT r (H m)
+instance MonadReader r m => MonadReader r (Ran (Codensity m)) where
+    ask = Ran (ask >>=)
+    local f = liftRanCodensity . local f . lowerRanCodensity
+
+instance MonadRWS r w s m => MonadRWS r w s (Ran (Codensity m))
+    
+instance MonadFix m => MonadFix (Ran (Codensity m)) where
+    mfix f = liftRanCodensity $ mfix (lowerRanCodensity . f)
+
+instance MonadError e m => MonadError e (Ran (Codensity m)) where
+    throwError e = Ran (throwError e >>=)
+    m `catchError` h = liftRanCodensity (lowerRanCodensity m `catchError` (lowerRanCodensity . h))
+
+-- TODO: the other instances for Ran (Codensity f)
+-- MonadIO, MonadState, etc.
+
+-- Yoneda Identity a ~ Codensity Identity a ~ forall o. (a -> o) -> o
+instance RanIso Identity where
+    type G Identity = Identity
+    type H Identity = Identity
+    liftRan m = Ran (m >>=)
+    lowerRan = flip getRan Identity
+
+instance Pointed (Ran Identity) where
+    point = returnCodensity
+
+instance Applicative (Ran Identity) where
+    pure = returnCodensity
+    (<*>) = apCodensity
+
+instance Monad (Ran Identity) where
+    return = returnCodensity
+    (>>=) = bindCodensity
+
+newtype World w a = World { runWorld :: State# w -> a } 
+
+-- homegrown STret with flopped arguments
+data STret' s a = STret' a (State# s)
+
+liftRanWorld :: (G m ~ World w, H m ~ World w) => (State# w -> (# State# w, a #)) -> Ran m a
+liftRanWorld f = Ran (\k -> World (\w -> case f w of (# w', a #) -> runWorld (k a) w'))
+
+-- viewpatterned to eliminate named temporaries:
+-- liftRanWorld f = Ran (\k -> World (\(f -> (# w, (runWorld . k -> j) #)) -> j w))
+
+lowerRanWorld :: (G m ~ World w, H m ~ World w) => Ran m a -> State# w -> (# State# w, a #)
+lowerRanWorld (Ran r) w = case runWorld (r (World . STret')) w of 
+    STret' b w'' -> (# w'', b #)
+
+-- Represent IO as the codensity of the RealWorld
+instance RanIso IO where
+    type G IO = World RealWorld
+    type H IO = World RealWorld
+    liftRan (IO s) = liftRanWorld s
+    lowerRan s = IO (lowerRanWorld s)
+
+instance Applicative (Ran IO) where
+    pure = returnCodensity
+    (<*>) = apCodensity
+
+instance Monad (Ran IO) where
+    return = returnCodensity
+    (>>=) = bindCodensity
+
+instance MonadIO (Ran IO) where
+    liftIO = liftRan
+
+-- Represent ST s as the codensity of the world s
+instance RanIso (ST s) where
+    type G (ST s) = World s
+    type H (ST s) = World s
+    liftRan (ST s) = liftRanWorld s
+    lowerRan r = ST (lowerRanWorld r)
+
+instance Applicative (Ran (ST s)) where
+    pure = returnCodensity
+    (<*>) = apCodensity
+
+instance Monad (Ran (ST s)) where
+    return = returnCodensity
+    (>>=) = bindCodensity
+
+-- todo make a MonadST class
+
+-- Represent STM as the codensity of the RealWorld
+instance RanIso STM where
+    type G STM = World RealWorld
+    type H STM = World RealWorld
+    liftRan (STM s) = liftRanWorld s
+    lowerRan r = STM (lowerRanWorld r)
+
+instance Applicative (Ran STM) where
+    pure = returnCodensity
+    (<*>) = apCodensity
+
+instance Monad (Ran STM) where
+    return = returnCodensity
+    (>>=) = bindCodensity
+
+-- TODO: make a MonadSTM class
+
+-- Yoneda Endo a ~ forall o. (a -> o) -> o -> o ~ forall o. (a -> Identity o) -> Endo o
+-- note Endo is not a Hask Functor and Maybe is not a Codensity monad, so this is trickier
+instance RanIso Maybe where
+    type G Maybe = Identity
+    type H Maybe = Endo
+    liftRan = maybe mzero return
+    lowerRan f = appEndo (getRan f (Identity . return)) mzero
+
+instance Monad (Ran Maybe) where
+    return x = Ran (\k -> Endo (\_ -> runIdentity (k x)))
+    Ran g >>= f = Ran (\k -> Endo (\z -> appEndo (g (\a -> Identity (appEndo (getRan (f a) k) z))) z))
+    fail _ = mzero
+
+instance Applicative (Ran Maybe) where
+    pure x = Ran (\k -> Endo (\_ -> runIdentity (k x)))
+    Ran f <*> Ran g = Ran (\k -> Endo (\z -> appEndo (f (\f' -> Identity (appEndo (g (k . f')) z))) z))
+
+instance MonadPlus (Ran Maybe) where
+    mzero = Ran (\_ -> Endo id)
+    Ran m `mplus` Ran n = Ran (\k -> Endo (\z -> appEndo (m k) (appEndo (n k) z)))
+
+-- as per Maybe, this Monoid turns a semigroup into a monoid
+instance Monoid a => Monoid (Ran Maybe a) where
+    mempty = mzero
+    Ran a `mappend` Ran b = Ran (\k -> Endo (\z -> appEndo (a (\a' -> Identity (appEndo (b (k . mappend a')) z))) z))
+
+type (:->) = ReaderT
+
+data ErrorH e o  = ErrorH { getErrorH :: (e -> o) -> o } 
+data ErrorTH e m o = ErrorTH { getErrorTH :: (e -> G m o) -> H m o }
+
+
+-- Yoneda (ErrorH e) ~ forall o. (a -> o) -> (e -> o) -> o ~ forall o. (a -> Identity o) -> (e -> o) -> o ~ forall o. (a -> Identity o) -> ErrorH e o
+instance Error e => RanIso (Either e) where
+    type G (Either e) = Identity
+    type H (Either e) = ErrorH e
+    liftRan (Right a) = Ran (\k -> ErrorH (\_ -> runIdentity (k a)))
+    liftRan (Left x)  = Ran (\_ -> ErrorH (\e -> e x))
+    lowerRan          = eitherRan Left Right
+
+eitherRan :: (e -> b) -> (a -> b) -> Ran (Either e) a -> b
+eitherRan f g (Ran m) = getErrorH (m (Identity . g)) f
+
+instance Error e => Monad (Ran (Either e)) where
+    return x = Ran (\k -> ErrorH (\_ -> runIdentity (k x)))
+    fail = throwError . strMsg
+    Ran g >>= f = Ran (\k -> ErrorH (\z -> getErrorH (g (\a -> Identity (getErrorH (getRan (f a) k) z))) z))
+
+instance Error e => MonadError e (Ran (Either e)) where
+    throwError x = Ran (\_ -> ErrorH (\e -> e x))
+--  catchError f h = Ran (\k -> ErrorH (\e -> getErrorH (getRan f k) e))
+--  catchError :: Ran (Either e) a -> (e -> Ran (Either e) a -> Ran (Either e) a
+    Ran m `catchError` h = Ran (\k -> ErrorH (\z -> getErrorH (m k) (\e -> getErrorH (getRan (h e) k) z)))
+
+instance Error e => MonadPlus (Ran (Either e)) where
+    mzero = throwError noMsg
+    Ran m `mplus` Ran n = Ran (\k -> ErrorH (\z -> getErrorH (m k) (\_ -> getErrorH (n k) z)))
+        
+{-
+-- Yoneda (ErrorTH b m)
+-- forall o. (a -> G m o) -> (b -> G m o) -> H m o
+-- forall o. (a -> G m o) -> H m ((b -> G m o) -> o) ?
+instance (RMonad m, Error b) => RMonad (ErrorT b m) where
+    type G (ErrorT b m) = G m 
+    type H (ErrorT b m) = ErrorTH b m
+
+
+-- Codensity f
+-- forall o. (a -> f o) -> f o 
+instance RMonad (Codensity f) where
+    type G (Codensity f) = f
+    type H (Codensity f) = f
+    liftRan (Codensity f) = Ran f
+    lowerRan (Ran f) = Codensity f
+
+-- Yoneda (Reader r)
+-- forall o. (a -> o) -> r -> o
+instance RMonad (Reader e) where
+    type G (Reader e) = Identity
+    type H (Reader e) = Reader e
+    liftRan m = Ran (\f -> liftM (runIdentity . f) m)
+    lowerRan (Ran f) = f Identity
+
+-- embedded as CPS'd State to avoid superfluous 'mappend mempty' calls
+-- specialized Codensity (Reader w)
+-- forall o. (a -> w -> o) -> w -> o
+instance Monoid w => RMonad (Writer w) where
+    type G (Writer w) = (->) w
+    type H (Writer w) = (->) w
+    liftRan (Writer (a,w'))  = Ran (\f w -> f a (w `mappend` w'))
+    lowerRan (Ran f) = Writer (f (,) mempty)
+    -- forall o. (a -> w -> o) -> o
+    -- type H (Writer w) = Identity
+
+-- Codensity (Reader s)
+-- forall o. (a -> s -> o) -> s -> o
+instance RMonad (State s) where
+    type G (State s) = (->) s
+    type H (State s) = (->) s
+    liftRan (State g)  = Ran (\f -> uncurry f . g)
+    lowerRan (Ran f)  = State (f (,))
+
+-- Codensity (Const r)
+-- (a -> r) -> r
+instance RMonad (Cont r) where
+    type G (Cont r) = Const r
+    type H (Cont r) = Const r
+
+-- forall o. (a -> G m o) -> r -> H m o 
+instance RMonad m => RMonad (ReaderT e m) where
+    type G (ReaderT e m) = G m
+    type H (ReaderT e m) = e :-> H m
+
+-- forall o. (a -> w -> G m o) -> H m o
+-- forall o. (a -> G m (w -> o)) -> H m (w -> o) ?
+instance (Monoid w, RMonad m) => RMonad (WriterT w m) where
+    type G (WriterT w m) = w :-> G m
+    type H (WriterT w m) = H m
+
+-- forall o. (a -> s -> G m o) -> s -> H m o 
+-- forall o. (a -> G m (s -> o)) -> H m (s -> o) ?
+instance RMonad m => RMonad (StateT s m) where
+    type G (StateT s m) = s :-> G m
+    type H (StateT s m) = s :-> H m
+
+-- (a -> G m r) -> H m r
+data ConstT r f a = ConstT { getConstT :: f r } 
+instance RMonad m => RMonad (ContT r m) where
+    type G (ContT r m) = ConstT r (G m)
+    type H (ContT r m) = ConstT r (H m)
+-}
+
+
+
+-- Yoneda lemma as a right Kan extension along the identity functor
+instance RanIso (Yoneda f) where
+    type G (Yoneda f) = Identity
+    type H (Yoneda f) = f
+    liftRan (Yoneda f) = Ran (\b -> f (runIdentity . b))
+    lowerRan (Ran f) = Yoneda (\b -> f (Identity . b))
+
+ranYoneda :: Ran (Yoneda f) a -> Yoneda f a
+ranYoneda = lowerRan
+
+yonedaRan :: Yoneda f a -> Ran (Yoneda f) a
+yonedaRan = liftRan
+
+instance Pointed f => Pointed (Ran (Yoneda f)) where
+    point = liftRan . point
+
+instance Applicative f => Applicative (Ran (Yoneda f)) where
+    pure = liftRan . pure
+    m <*> n = liftRan (lowerRan m <*> lowerRan n)
+
+instance Alternative f => Alternative (Ran (Yoneda f)) where
+    empty = liftRan empty
+    m <|> n = liftRan (lowerRan m <|> lowerRan n) 
+
+instance Monad f => Monad (Ran (Yoneda f)) where
+    return = liftRan . return
+    m >>= k = liftRan (lowerRan m >>= lowerRan . k)
+
+instance MonadPlus f => MonadPlus (Ran (Yoneda f)) where
+    mzero = liftRan mzero
+    m `mplus` n = liftRan (lowerRan m `mplus` lowerRan n)
+
+instance MonadReader r f => MonadReader r (Ran (Yoneda f)) where
+    ask = liftRan ask
+    local f = liftRan . local f . lowerRan
+
+instance MonadWriter w f => MonadWriter w (Ran (Yoneda f)) where
+    tell = liftRan . tell
+    listen = liftRan . listen . lowerRan
+    pass = liftRan . pass . lowerRan
+
+instance MonadState s f => MonadState s (Ran (Yoneda f)) where
+    get = liftRan get
+    put = liftRan . put
+
+instance MonadIO f => MonadIO (Ran (Yoneda f)) where
+    liftIO = liftRan . liftIO
+
+instance MonadRWS r w s f => MonadRWS r w s (Ran (Yoneda f))
+
+instance MonadError e f => MonadError e (Ran (Yoneda f)) where
+    throwError = liftRan . throwError
+    Ran f `catchError` h = Ran (\k -> f k `catchError` \e -> getRan (h e) k)
+
+instance MonadFix m => MonadFix (Ran (Yoneda m)) where
+    mfix f = Ran (\k -> liftM (runIdentity . k) $ mfix (\a -> getRan (f a) Identity))
addfile ./doc/html/monad-ran/src/Control-Monad-Yoneda.html
hunk ./doc/html/monad-ran/src/Control-Monad-Yoneda.html 1
+
+
+
+
+Control/Monad/Yoneda.hs
+
+
+
+
{-# LANGUAGE Rank2Types, MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, UndecidableInstances #-}
+-- Finding the right Kan extension
+
+module Control.Monad.Yoneda
+    ( -- * The Yoneda Lemma
+      Yoneda(..)
+    , runYoneda
+    ) where
+
+import Data.Monoid
+import Data.Maybe (maybe)
+import Control.Applicative
+import Control.Functor.Pointed
+import Control.Monad
+import Control.Monad.Trans
+import Control.Monad.Fix
+import Control.Monad.Cont.Class
+import Control.Monad.State.Class
+import Control.Monad.Error.Class
+import Control.Monad.Reader.Class
+import Control.Monad.Writer.Class
+import Control.Monad.RWS.Class
+
+data Yoneda f a = Yoneda { getYoneda :: forall b. (a -> b) -> f b } 
+
+instance Functor (Yoneda f) where
+    fmap f m = Yoneda (\k -> getYoneda m (k . f))
+
+instance Pointed f => Pointed (Yoneda f) where
+    point a = Yoneda (\f -> point (f a))
+
+instance Applicative f => Applicative (Yoneda f) where
+    pure a = Yoneda (\f -> pure (f a))
+    m <*> n = Yoneda (\f -> getYoneda m (f .) <*> getYoneda n id)
+
+instance Alternative f => Alternative (Yoneda f) where
+    empty = Yoneda (const empty)
+    Yoneda m <|> Yoneda n = Yoneda (\f -> m f <|> n f)
+
+instance Monad f => Monad (Yoneda f) where
+    return a = Yoneda (\f -> return (f a))
+    m >>= k = Yoneda (\f -> getYoneda m id >>= \a -> getYoneda (k a) f)
+
+instance MonadPlus f => MonadPlus (Yoneda f) where
+    mzero = Yoneda (const mzero)
+    Yoneda m `mplus` Yoneda n = Yoneda (\f -> m f `mplus` n f)
+
+instance MonadTrans Yoneda where
+    lift m = Yoneda (\f -> liftM f m)
+
+instance MonadReader r f => MonadReader r (Yoneda f) where
+    ask = lift ask
+    local f = lift . local f . runYoneda 
+
+instance MonadWriter w f => MonadWriter w (Yoneda f) where
+    tell = lift . tell
+    listen = lift . listen . runYoneda
+    pass = lift . pass . runYoneda
+
+instance MonadState s f => MonadState s (Yoneda f) where
+    get = lift get
+    put = lift . put
+
+instance MonadIO f => MonadIO (Yoneda f) where
+    liftIO = lift . liftIO
+
+instance MonadRWS r w s f => MonadRWS r w s (Yoneda f)
+
+instance MonadError e f => MonadError e (Yoneda f) where
+    throwError = lift . throwError
+
+instance MonadFix m => MonadFix (Yoneda m)
+    
+runYoneda :: Yoneda f a -> f a 
+runYoneda (Yoneda f) = f id
+
+

+
}
show/hideCPS
Control.Monad.CPS.Maybe
Control.Monad.Codensity
Control.Monad.Yoneda