[Haskell-cafe] operating on nested monads
MR K P SCHUPKE
k.schupke at imperial.ac.uk
Sat Mar 27 12:17:51 EST 2004
For operating on nested monads is do:
declare a class MonadIO which contains the IO functions along
with monad monad-transformer lifted versions, for example:
class Monad m => MonadIO m where
ioPrint :: Show a => a -> m ()
instance MonadIO IO where
ioPrint = print
instance (MonadIO m,MonadT t m) => MonadIO (t m) where
ioPrint = up . ioPrint
where MonadT is defined:
class (Monad m,Monad (t m)) => MonadT t m where
up :: m a -> t m a
down :: t m a -> m a
instance Runnable (m a) (m a) where
run = id
instance (Monad m,Monad n,MonadT t m,Runnable (m a) (n a)) => Runnable (t m a) (n a) where
run = run . down
instance (Monad m,MonadT t m,Monad (t m)) => Runnable (t m a) (m a) where
run = down
You can then define MonadMaybe similarly... you end up with code like:
test :: (MonadIO m,MonadMaybe m) => m a
test = do
ioPrint "something"
c <- ioGetChar -- note: c is automatically lifted into MonadMaybe by
-- MonadMaybe's definition of up in class MonadT
return Nothing
Then to call it you must specify the stacking:
main :: IO ()
main = do
case run (test :: MonadMaybeT MonadIO Char) of
Just x -> print x
Nothing -> print "NOTHING"
I have not defined MonadMaybeT here... but its fairly straightforward.
Regards,
Keean.
More information about the Haskell-Cafe
mailing list