[Haskell-cafe] Dynamically stackable monads
Christophe Poucet
christophe.poucet at gmail.com
Fri May 5 07:51:19 EDT 2006
Hello,
I was wondering if it's possible to stack a runtime-known amount of
monads on top of each other. Let me illustrate. Assume I have a monad
that can consume data and expects as starting parameter an action of the
underlying monad to use this data (call it produce at the lower level
monad).
Now one could imagine stacking one of these consumers on top of the
other, as can be seen below. However I can not choose at runtime how
many I want to stack. Is there any solution for this?
Regards,
Christophe
------------------------------
--------------------------------------------------
{-# OPTIONS_GHC -fglasgow-exts #-}
module Main where
import Control.Monad
import Control.Monad.Identity
import Control.Monad.State
import Control.Monad.Trans
data Action e m = Action {
produce :: e -> m ()
}
newtype SequencerT e m a = SequencerT (StateT (Action e m) m a)
deriving (Functor, Monad, MonadIO)
newtype Sequencer e a = Sequencer (SequencerT e Identity a)
deriving (Functor, Monad, MonadSequencer e)
instance MonadTrans (SequencerT e) where
lift = SequencerT . lift
class Monad m => MonadSequencer e m | m -> e where
consume :: e -> m ()
instance Monad m => MonadSequencer e (SequencerT e m) where
consume x = SequencerT $ do
s <- get
lift . (produce s) $ x
evalSequencerT (SequencerT s) action =
evalStateT s action
evalSequencer (Sequencer s) inputs action =
evalSequencerT s action
runSequencerT (SequencerT s) action =
runStateT s action
runSequencer (Sequencer s) action =
runSequencerT s action
main :: IO () =
evalSequencerT
(evalSequencerT
(consume 1 >> consume 2 >> consume 3)
(Action{produce = \x -> if x > 1 then consume x else liftIO . print $
("A" ++ show x)}))
(Action{produce = print . ("B" ++) . show })
--
Christophe Poucet
Ph.D. Student
Phone:+32 16 28 87 20
E-mail: --- <Christophe.Poucet at imec.be>
IMEC vzw – Register of Legal Entities Leuven VAT BE 0425.260.668 –
Kapeldreef 75, B-3001 Leuven, Belgium – www.imec.be
*****DISCLAIMER*****
This e-mail and/or its attachments may contain confidential information. It
is intended solely for the intended addressee(s).
Any use of the information contained herein by other persons is prohibited.
IMEC vzw does not accept any liability for the contents of this e-mail
and/or its attachments.
**********
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org//pipermail/haskell-cafe/attachments/20060505/28fd1413/attachment.htm
More information about the Haskell-Cafe
mailing list