[auto
ekmett@gmail.com**20090505062100
Ignore-this: b66a54d8122302aa0b5822c9e132e566
] {
hunk ./doc/html/monad-ran/Control-Functor-Pointed.html 325
+> (Reader e))
+
hunk ./doc/html/monad-ran/src/Control-Monad-Ran.html 26
- , returnRanCodensity
- , bindRanCodensity
- , apRanCodensity
- , ranCodensity
- , codensityRan
- , liftRanCodensity
- , lowerRanCodensity
- , liftRanWorld
- , lowerRanWorld
- ) 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
-
-import Text.Read hiding (get)
-import Text.Show
-
-
-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))
-
-returnRanCodensity :: (RanIso m, G m ~ H m) => a -> Ran m a
-returnRanCodensity a = Ran (\k -> k a)
-
-bindRanCodensity :: (RanIso m, G m ~ H m) => Ran m a -> (a -> Ran m b) -> Ran m b
-bindRanCodensity (Ran m) k = Ran (\c -> m (\a -> getRan (k a) c))
-
-apRanCodensity :: (RanIso m, G m ~ H m) => Ran m (a -> b) -> Ran m a -> Ran m b
-apRanCodensity (Ran f) (Ran x) = Ran (\k -> f (\f' -> x (\x' -> k (f' x'))))
+
+ , RanTrans
+ , liftRanT
+ , outRan
+ , inRan
+
+ , returnRanCodensity
+ , bindRanCodensity
+ , apRanCodensity
+ , ranCodensity
+ , codensityRan
+ , liftRanCodensity
+ , lowerRanCodensity
+
+ , liftRanWorld
+ , lowerRanWorld
+ ) 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
+
+import Text.Read hiding (get)
+import Text.Show
+
+
+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
+
+class RanTrans t where
+ liftRanT :: (RanIso m, RanIso (t m)) => Ran m a -> Ran (t m) a
+ outRan :: (RanIso m, RanIso (t m)) => Ran (t m) a -> t (Ran m) a
+ inRan :: (RanIso m, RanIso (t m)) => t (Ran m) a -> Ran (t m) a
hunk ./doc/html/monad-ran/src/Control-Monad-Ran.html 81
-liftRanCodensity :: (RanIso m, G m ~ H m, Monad (G m)) => G m a -> Ran m a
-liftRanCodensity f = Ran (f >>=)
+instance RanIso f => Functor (Ran f) where
+ fmap f m = Ran (\k -> getRan m (k . f))
hunk ./doc/html/monad-ran/src/Control-Monad-Ran.html 84
-lowerRanCodensity :: (RanIso m, G m ~ H m, Monad (G m)) => Ran m a -> G m a
-lowerRanCodensity (Ran f) = f return
-
-mfixRanCodensity :: (RanIso m, G m ~ H m, MonadFix (G m)) => (a -> Ran m a) -> Ran m a
-mfixRanCodensity f = liftRanCodensity $ mfix (lowerRanCodensity . f)
-
-mfixRan :: (RanIso m, MonadFix m) => (a -> Ran m a) -> Ran m a
-mfixRan f = liftRan $ mfix (lowerRan . 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
-
-
-
-instance RanIso (Codensity f) where
- type G (Codensity f) = f
- type H (Codensity f) = f
- liftRan = codensityRan
- lowerRan = ranCodensity
+
+
+returnRanCodensity :: (RanIso m, G m ~ H m) => a -> Ran m a
+returnRanCodensity a = Ran (\k -> k a)
+
+bindRanCodensity :: (RanIso m, G m ~ H m) => Ran m a -> (a -> Ran m b) -> Ran m b
+bindRanCodensity (Ran m) k = Ran (\c -> m (\a -> getRan (k a) c))
+
+apRanCodensity :: (RanIso m, G m ~ H m) => Ran m (a -> b) -> Ran m a -> Ran m b
+apRanCodensity (Ran f) (Ran x) = Ran (\k -> f (\f' -> x (\x' -> k (f' x'))))
+
+liftRanCodensity :: (RanIso m, G m ~ H m, Monad (G m)) => G m a -> Ran m a
+liftRanCodensity f = Ran (f >>=)
+
+lowerRanCodensity :: (RanIso m, G m ~ H m, Monad (G m)) => Ran m a -> G m a
+lowerRanCodensity (Ran f) = f return
+
+mfixRanCodensity :: (RanIso m, G m ~ H m, MonadFix (G m)) => (a -> Ran m a) -> Ran m a
+mfixRanCodensity f = liftRanCodensity $ mfix (lowerRanCodensity . f)
+
+mfixRan :: (RanIso m, MonadFix m) => (a -> Ran m a) -> Ran m a
+mfixRan f = liftRan $ mfix (lowerRan . f)
hunk ./doc/html/monad-ran/src/Control-Monad-Ran.html 107
-ranCodensity :: Ran (Codensity f) a -> Codensity f a
-ranCodensity (Ran f) = Codensity f
+class (Monad (Ran f), Monad f, RanIso f) => RMonad f
+instance (Monad (Ran f), Monad f, RanIso f) => RMonad f
hunk ./doc/html/monad-ran/src/Control-Monad-Ran.html 110
-codensityRan :: Codensity f a -> Ran (Codensity f) a
-codensityRan (Codensity f) = Ran 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 113
-instance Pointed (Ran (Codensity f)) where
- point = returnRanCodensity
-
-instance Applicative (Ran (Codensity f)) where
- pure = returnRanCodensity
- (<*>) = apRanCodensity
-
-instance Monad (Ran (Codensity f)) where
- return = returnRanCodensity
- (>>=) = bindRanCodensity
+
+
+instance RanIso (Codensity f) where
+ type G (Codensity f) = f
+ type H (Codensity f) = f
+ liftRan = codensityRan
+ lowerRan = ranCodensity
+
+ranCodensity :: Ran (Codensity f) a -> Codensity f a
+ranCodensity (Ran f) = Codensity f
hunk ./doc/html/monad-ran/src/Control-Monad-Ran.html 124
-instance Alternative (Codensity f) => Alternative (Ran (Codensity f)) where
- empty = liftRan empty
- m <|> n = liftRan (lowerRan m <|> lowerRan n)
-
-
-
-instance MonadPlus f => MonadPlus (Ran (Codensity f)) where
- mzero = liftRan mzero
- m `mplus` n = liftRan (lowerRan m `mplus` lowerRan n)
+codensityRan :: Codensity f a -> Ran (Codensity f) a
+codensityRan (Codensity f) = Ran f
+
+instance Pointed (Ran (Codensity f)) where
+ point = returnRanCodensity
+
+instance Applicative (Ran (Codensity f)) where
+ pure = returnRanCodensity
+ (<*>) = apRanCodensity
+
+instance Monad (Ran (Codensity f)) where
+ return = returnRanCodensity
+ (>>=) = bindRanCodensity
hunk ./doc/html/monad-ran/src/Control-Monad-Ran.html 138
-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
-
-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 Alternative (Codensity f) => Alternative (Ran (Codensity f)) where
+ empty = liftRan empty
+ m <|> n = liftRan (lowerRan m <|> lowerRan n)
+
+
+
+instance MonadPlus f => MonadPlus (Ran (Codensity f)) where
+ mzero = liftRan mzero
+ m `mplus` n = liftRan (lowerRan m `mplus` lowerRan n)
+
+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 >>=)
hunk ./doc/html/monad-ran/src/Control-Monad-Ran.html 159
-instance MonadError e m => MonadError e (Ran (Codensity m)) where
- throwError e = Ran (throwError e >>=)
- m `catchError` h = liftRanCodensity (lowerRanCodensity m `catchError` (lowerRanCodensity . h))
-
-
-
-
-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 = returnRanCodensity
-
-instance Applicative (Ran Identity) where
- pure = returnRanCodensity
- (<*>) = apRanCodensity
+instance MonadWriter w m => MonadWriter w (Ran (Codensity m)) where
+ tell w = Ran (tell w >>=)
+ listen = liftRanCodensity . listen . lowerRanCodensity
+ pass = liftRanCodensity . pass . lowerRanCodensity
+
+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))
+
+
hunk ./doc/html/monad-ran/src/Control-Monad-Ran.html 179
-instance Monad (Ran Identity) where
- return = returnRanCodensity
- (>>=) = bindRanCodensity
-
-instance Eq a => Eq (Ran Identity a) where
- Ran f == Ran g = runIdentity (f Identity) == runIdentity (g Identity)
+
+instance RanIso Identity where
+ type G Identity = Identity
+ type H Identity = Identity
+ liftRan m = Ran (m >>=)
+ lowerRan = flip getRan Identity
hunk ./doc/html/monad-ran/src/Control-Monad-Ran.html 186
-instance Ord a => Ord (Ran Identity a) where
- Ran f `compare` Ran g = runIdentity (f Identity) `compare` runIdentity (g Identity)
+instance Pointed (Ran Identity) where
+ point = returnRanCodensity
hunk ./doc/html/monad-ran/src/Control-Monad-Ran.html 189
-instance Show a => Show (Ran Identity a) where
- showsPrec d (Ran f) = showParen (d > 10) $
- showString "return " . showsPrec 11 (runIdentity (f Identity))
-
-instance Read a => Read (Ran Identity a) where
- readPrec = parens $ prec 10 $ do
- Ident "return" <- lexP
- m <- step readPrec
- return (return m)
-
-
-
-instance RanIso (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 (,))
-
-instance Pointed (Ran (State s)) where
- point = returnRanCodensity
-
-instance Applicative (Ran (State s)) where
- pure = returnRanCodensity
- (<*>) = apRanCodensity
-
-instance Monad (Ran (State s)) where
- return = returnRanCodensity
- (>>=) = bindRanCodensity
-
-instance MonadState s (Ran (State s)) where
- get = Ran (\k s -> k s s)
- put s = Ran (\k _ -> k () s)
-
-
-
-instance Monoid w => RanIso (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)
-
-instance Monoid w => Pointed (Ran (Writer w)) where
- point = returnRanCodensity
-
-instance Monoid w => Applicative (Ran (Writer w)) where
- pure = returnRanCodensity
- (<*>) = apRanCodensity
-
-instance Monoid w => Monad (Ran (Writer w)) where
- return = returnRanCodensity
- (>>=) = bindRanCodensity
-
-instance Monoid w => MonadWriter w (Ran (Writer w)) where
- tell w' = Ran (\f w -> f () (w `mappend` w'))
- listen (Ran f) = Ran (\g -> f (\a w -> g (a,w) w))
- pass (Ran f) = Ran (\g -> f (\(a,p) w -> g a (p w)))
-
-newtype World w a = World { runWorld :: State# w -> a }
-
-
-data STret' s a = STret' a (State# s)
+instance Applicative (Ran Identity) where
+ pure = returnRanCodensity
+ (<*>) = apRanCodensity
+
+instance Monad (Ran Identity) where
+ return = returnRanCodensity
+ (>>=) = bindRanCodensity
+
+instance Eq a => Eq (Ran Identity a) where
+ Ran f == Ran g = runIdentity (f Identity) == runIdentity (g Identity)
+
+instance Ord a => Ord (Ran Identity a) where
+ Ran f `compare` Ran g = runIdentity (f Identity) `compare` runIdentity (g Identity)
+
+instance Show a => Show (Ran Identity a) where
+ showsPrec d (Ran f) = showParen (d > 10) $
+ showString "return " . showsPrec 11 (runIdentity (f Identity))
+
+instance Read a => Read (Ran Identity a) where
+ readPrec = parens $ prec 10 $ do
+ Ident "return" <- lexP
+ m <- step readPrec
+ return (return m)
+
+
+
+instance RanIso (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 (,))
+
+instance Pointed (Ran (State s)) where
+ point = returnRanCodensity
+
+instance Applicative (Ran (State s)) where
+ pure = returnRanCodensity
+ (<*>) = apRanCodensity
+
+instance Monad (Ran (State s)) where
+ return = returnRanCodensity
+ (>>=) = bindRanCodensity
+
+instance MonadState s (Ran (State s)) where
+ get = Ran (\k s -> k s s)
+ put s = Ran (\k _ -> k () s)
+
+
+
+instance Monoid w => RanIso (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)
+
+instance Monoid w => Pointed (Ran (Writer w)) where
+ point = returnRanCodensity
+
+instance Monoid w => Applicative (Ran (Writer w)) where
+ pure = returnRanCodensity
+ (<*>) = apRanCodensity
hunk ./doc/html/monad-ran/src/Control-Monad-Ran.html 251
-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'))
-
-
-
-
-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 #)
-
-
-instance RanIso IO where
- type G IO = World RealWorld
- type H IO = World RealWorld
- liftRan (IO a) = liftRanWorld a
- lowerRan a = IO (lowerRanWorld a)
-
-instance Applicative (Ran IO) where
- pure = returnRanCodensity
- (<*>) = apRanCodensity
-
-instance Monad (Ran IO) where
- return = returnRanCodensity
- (>>=) = bindRanCodensity
-
-instance MonadIO (Ran IO) where
- liftIO = liftRan
-
-instance MonadPlus (Ran IO) where
- mzero = liftIO mzero
- m `mplus` n = m `catchError` const n
-
-instance MonadError IOError (Ran IO) where
- throwError = liftIO . ioError
- catchError m h = liftRan (lowerRan m `catch` (lowerRan . h))
-
-instance MonadFix (Ran IO) where
- mfix = mfixRan
-
-
-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 = returnRanCodensity
- (<*>) = apRanCodensity
-
-instance Monad (Ran (ST s)) where
- return = returnRanCodensity
- (>>=) = bindRanCodensity
-
-instance MonadFix (Ran (ST s)) where
- mfix f = liftRan $ fixST (lowerRan . f)
-
-
-
-
-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 Monoid w => Monad (Ran (Writer w)) where
+ return = returnRanCodensity
+ (>>=) = bindRanCodensity
+
+instance Monoid w => MonadWriter w (Ran (Writer w)) where
+ tell w' = Ran (\f w -> f () (w `mappend` w'))
+ listen (Ran f) = Ran (\g -> f (\a w -> g (a,w) w))
+ pass (Ran f) = Ran (\g -> f (\(a,p) w -> g a (p w)))
+
+newtype World w a = World { runWorld :: State# w -> a }
+
+
+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'))
+
+
+data STret' s a = STret' a (State# s)
+
+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 #)
+
+
+instance RanIso IO where
+ type G IO = World RealWorld
+ type H IO = World RealWorld
+ liftRan (IO a) = liftRanWorld a
+ lowerRan a = IO (lowerRanWorld a)
+
+instance Applicative (Ran IO) where
+ pure = returnRanCodensity
+ (<*>) = apRanCodensity
+
+instance Monad (Ran IO) where
+ return = returnRanCodensity
+ (>>=) = bindRanCodensity
+
+instance MonadIO (Ran IO) where
+ liftIO = liftRan
+
+instance MonadPlus (Ran IO) where
+ mzero = liftIO mzero
+ m `mplus` n = m `catchError` const n
+
+instance MonadError IOError (Ran IO) where
+ throwError = liftIO . ioError
+ catchError m h = liftRan (lowerRan m `catch` (lowerRan . h))
+
+instance MonadFix (Ran IO) where
+ mfix = mfixRan
+
+
+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 = returnRanCodensity
+ (<*>) = apRanCodensity
+
+instance Monad (Ran (ST s)) where
+ return = returnRanCodensity
+ (>>=) = bindRanCodensity
hunk ./doc/html/monad-ran/src/Control-Monad-Ran.html 317
-instance Applicative (Ran STM) where
- pure = returnRanCodensity
- (<*>) = apRanCodensity
-
-instance Monad (Ran STM) where
- return = returnRanCodensity
- (>>=) = bindRanCodensity
-
-
-
-
-
-
-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)))
+instance MonadFix (Ran (ST s)) where
+ mfix f = liftRan $ fixST (lowerRan . f)
+
+
+
+
+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 = returnRanCodensity
+ (<*>) = apRanCodensity
+
+instance Monad (Ran STM) where
+ return = returnRanCodensity
+ (>>=) = bindRanCodensity
+
+
+
+
+
+
+
+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))
hunk ./doc/html/monad-ran/src/Control-Monad-Ran.html 349
-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))
-
-instance MonadFix (Ran Maybe) where
- mfix f = m where
- m = f (unJust m)
- unJust (Ran r) = appEndo (r Identity) (error "mfix (Ran Maybe): Nothing")
+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
hunk ./doc/html/monad-ran/src/Control-Monad-Ran.html 358
-instance Eq a => Eq (Ran Maybe a) where
- f == g = lowerRan f == lowerRan g
-
-instance Ord a => Ord (Ran Maybe a) where
- f `compare` g = lowerRan f `compare` lowerRan g
-
-instance Show a => Show (Ran Maybe a) where
- showsPrec d f = showParen (d > 10) $
- showString "liftRan " . showsPrec 11 (lowerRan f)
-
-instance Read a => Read (Ran Maybe a) where
- readPrec = parens $ prec 10 $ do
- Ident "liftRan " <- lexP
- m <- step readPrec
- return (liftRan m)
+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)
hunk ./doc/html/monad-ran/src/Control-Monad-Ran.html 374
-type (:->) = ReaderT
-
-data ErrorH e o = ErrorH { getErrorH :: (e -> o) -> o }
+instance MonadReader r f => MonadReader r (Ran (Yoneda f)) where
+ ask = liftRan ask
+ local f = liftRan . local f . lowerRan
hunk ./doc/html/monad-ran/src/Control-Monad-Ran.html 378
-
-instance 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))
-
-
- 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)))
-
-instance Error e => MonadFix (Ran (Either e)) where
- mfix f = m where
- m = f (fromRight m)
- fromRight (Ran r) = getErrorH (r Identity) (\_ -> error "mfix (Ran (Either e)): empty mfix argument")
-
-instance (Eq a, Eq b) => Eq (Ran (Either a) b) where
- f == g = lowerRan f == lowerRan g
+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))
+
+
+
+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
hunk ./doc/html/monad-ran/src/Control-Monad-Ran.html 412
-instance (Ord a, Ord b) => Ord (Ran (Either a) b) where
- f `compare` g = lowerRan f `compare` lowerRan g
-
-instance (Show a, Show b) => Show (Ran (Either a) b) where
- showsPrec d f = showParen (d > 10) $
- showString "liftRan " . showsPrec 11 (lowerRan f)
-
-instance (Read a, Read b) => Read (Ran (Either a) b) where
- readPrec = parens $ prec 10 $ do
- Ident "liftRan " <- lexP
- m <- step readPrec
- return (liftRan m)
-
-
-
-instance RanIso ((->)e) where
- type G ((->) e) = Identity
- type H ((->) e) = (->) e
- liftRan m = Ran (\f -> liftM (runIdentity . f) m)
- lowerRan (Ran f) = f Identity
-
-instance Pointed (Ran ((->)e)) where
- point = return
-
-instance Applicative (Ran ((->)e)) where
- pure = return
- Ran f <*> Ran g = Ran (\k r -> runIdentity (k (f Identity r (g Identity r))))
-
-instance Monad (Ran ((->)e)) where
- return a = Ran (\f _ -> runIdentity (f a))
- Ran f >>= h = Ran (\k r -> getRan (h (f Identity r)) k r)
-
-instance MonadReader e (Ran ((->)e)) where
- ask = Ran (\k r -> runIdentity (k r))
- local f (Ran m) = Ran (\k r -> m k (f r))
-
-instance Monoid m => Monoid (Ran ((->)e) m) where
- mempty = return mempty
- Ran a `mappend` Ran b = Ran (\k r -> runIdentity (k (a Identity r `mappend` b Identity r)))
-
-
-
-
-
-
+instance (Ord a, Ord b) => Ord (Ran (Either a) b) where
+ f `compare` g = lowerRan f `compare` lowerRan g
+
+instance (Show a, Show b) => Show (Ran (Either a) b) where
+ showsPrec d f = showParen (d > 10) $
+ showString "liftRan " . showsPrec 11 (lowerRan f)
+
+instance (Read a, Read b) => Read (Ran (Either a) b) where
+ readPrec = parens $ prec 10 $ do
+ Ident "liftRan " <- lexP
+ m <- step readPrec
+ return (liftRan m)
hunk ./doc/html/monad-ran/src/Control-Monad-Ran.html 497
-
-
-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 RanIso ((->)e) where
+ type G ((->) e) = Identity
+ type H ((->) e) = (->) e
+ liftRan m = Ran (\f -> liftM (runIdentity . f) m)
+ lowerRan (Ran f) = f Identity
+
+instance Pointed (Ran ((->)e)) where
+ point = return
+
+instance Applicative (Ran ((->)e)) where
+ pure = return
+ Ran f <*> Ran g = Ran (\k r -> runIdentity (k (f Identity r (g Identity r))))
hunk ./doc/html/monad-ran/src/Control-Monad-Ran.html 511
-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 Monad (Ran ((->)e)) where
+ return a = Ran (\f _ -> runIdentity (f a))
+ Ran f >>= h = Ran (\k r -> getRan (h (f Identity r)) k r)
+
+instance MonadReader e (Ran ((->)e)) where
+ ask = Ran (\k r -> runIdentity (k r))
+ local f (Ran m) = Ran (\k r -> m k (f r))
+
+instance Monoid m => Monoid (Ran ((->)e) m) where
+ mempty = return mempty
+ Ran a `mappend` Ran b = Ran (\k r -> runIdentity (k (a Identity r `mappend` b Identity r)))
+
+
+
+instance RanIso (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
+
+instance Pointed (Ran (Reader e)) where
+ point = return
hunk ./doc/html/monad-ran/src/Control-Monad-Ran.html 534
-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 Applicative (Ran (Reader e)) where
+ pure = return
+ Ran f <*> Ran g = Ran (\k -> Reader (\r -> runIdentity (k (runReader (f Identity) r (runReader (g Identity) r)))))
+
+instance Monad (Ran (Reader e)) where
+ return a = Ran (\f -> Reader (\_ -> runIdentity (f a)))
+ Ran f >>= h = Ran (\k -> Reader (\r -> runReader(getRan (h (runReader (f Identity) r)) k) r))
+
+instance MonadReader e (Ran (Reader e)) where
+ ask = Ran (\k -> Reader (\r -> runIdentity (k r)))
+ local f (Ran m) = Ran (\k -> Reader (\r -> runReader (m k) (f r)))
hunk ./doc/html/monad-ran/src/Control-Monad-Ran.html 546
-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))
+instance Monoid m => Monoid (Ran (Reader e) m) where
+ mempty = return mempty
+ Ran a `mappend` Ran b = Ran (\k -> Reader (\r -> runIdentity (k (runReader (a Identity) r `mappend` runReader (b Identity) r))))
+
+
+
+
+
+instance RanIso m => RanIso (ReaderT e m) where
+ type G (ReaderT e m) = G m
+ type H (ReaderT e m) = e :-> H m
+ liftRan (ReaderT f) = Ran (\k -> ReaderT (\e -> getRan (liftRan (f e)) k))
+ lowerRan (Ran f) = ReaderT (\e -> lowerRan (Ran (\k -> runReaderT (f k) e)))
+
+instance RanTrans (ReaderT e) where
+ liftRanT (Ran m) = Ran (ReaderT . const . m)
+ outRan (Ran m) = ReaderT (\e -> Ran (\k -> runReaderT (m k) e))
+ inRan (ReaderT f) = Ran (\k -> ReaderT (\e -> getRan (f e) k))
+
+instance RMonad m => Pointed (Ran (ReaderT e m)) where
+ point = inRan . return
+
+instance RMonad m => Applicative (Ran (ReaderT e m)) where
+ pure = inRan . return
+ f <*> g = inRan (outRan f `ap` outRan g)
+
+instance (RMonad m, MonadPlus (Ran m)) => Alternative (Ran (ReaderT e m)) where
+ empty = inRan mzero
+ f <|> g = inRan (outRan f `mplus` outRan g)
+
+instance RMonad m => Monad (Ran (ReaderT e m)) where
+ return = inRan . return
+ m >>= f = inRan (outRan m >>= outRan . f)
+
+instance (RMonad m, MonadState s (Ran m)) => MonadState s (Ran (ReaderT e m)) where
+ get = inRan get
+ put = inRan . put
+
+instance RMonad m => MonadReader r (Ran (ReaderT r m)) where
+ ask = inRan (ReaderT return)
+ local f = inRan . local f . outRan
+
+instance (RMonad m, MonadWriter w (Ran m)) => MonadWriter w (Ran (ReaderT e m)) where
+ tell = inRan . tell
+ listen = inRan . listen . outRan
+ pass = inRan . pass . outRan
+
+instance (RMonad m, MonadIO (Ran m)) => MonadIO (Ran (ReaderT e m)) where
+ liftIO = inRan . liftIO
+
+instance (RMonad m, MonadPlus (Ran m)) => MonadPlus (Ran (ReaderT e m)) where
+ mzero = inRan mzero
+ a `mplus` b = inRan (outRan a `mplus` outRan b)
+
+
+
+
+unwrapErrorT :: (RanIso m, Error a) => Ran (ErrorT a m) b -> Ran m (Either a b)
+unwrapErrorT (Ran m) = Ran (\k -> getErrorTH (m (k . Right)) (k . Left))
+
+wrapErrorT :: (RanIso m, Error a) => Ran m (Either a b) -> Ran (ErrorT a m) b
+wrapErrorT (Ran m) = Ran (\k -> ErrorTH (\e -> m (either e k)))
+
+
+data ErrorTH e m o = ErrorTH { getErrorTH :: (e -> G m o) -> H m o }
+instance (RanIso m, Error e) => RanIso (ErrorT e m) where
+ type G (ErrorT e m) = G m
+ type H (ErrorT e m) = ErrorTH e m
+ liftRan (ErrorT m) = Ran (\k -> ErrorTH (\e -> getRan (liftRan m) (either e k)))
+ lowerRan (Ran m) = ErrorT (lowerRan (Ran (\k -> getErrorTH (m (k . Right)) (k . Left))))
+
+instance RanTrans (ErrorT e) where
+ liftRanT (Ran m) = Ran (\k -> ErrorTH (\_ -> m k))
+ outRan (Ran m) = ErrorT (Ran (\k -> getErrorTH (m (k . Right)) (k . Left)))
+ inRan (ErrorT m) = Ran (\k -> ErrorTH (\e -> getRan m (either e k)))
+
+instance (RMonad m, Error e) => Pointed (Ran (ErrorT e m)) where
+ point = inRan . return
+
+instance (RMonad m, Error e) => Applicative (Ran (ErrorT e m)) where
+ pure = inRan . return
+ f <*> g = inRan (outRan f `ap` outRan g)
+
+instance (RMonad m, Error e, MonadPlus (Ran m)) => Alternative (Ran (ErrorT e m)) where
+ empty = inRan mzero
+ f <|> g = inRan (outRan f `mplus` outRan g)
+
+instance (RMonad m, Error e) => Monad (Ran (ErrorT e m)) where
+ return = inRan . return
+ m >>= f = inRan (outRan m >>= outRan . f)
+
+instance (RMonad m, Error e, MonadState s (Ran m)) => MonadState s (Ran (ErrorT e m)) where
+ get = inRan get
+ put = inRan . put
+
+instance (RMonad m, Error e, MonadReader r (Ran m)) => MonadReader r (Ran (ErrorT e m)) where
+ ask = inRan ask
+ local f = inRan . local f . outRan
+
+instance (RMonad m, Error e, MonadWriter w (Ran m)) => MonadWriter w (Ran (ErrorT e m)) where
+ tell = inRan . tell
+ listen = inRan . listen . outRan
+ pass = inRan . pass . outRan
+
+instance (RMonad m, Error e, MonadRWS r w s (Ran m)) => MonadRWS r w s (Ran (ErrorT e m))
+
+
+
}
|