[Haskell-cafe] M1 + M2 = M3 where both computations in M1 and
M2 can be used?
Twan van Laarhoven
twanvl at gmail.com
Mon May 12 10:38:47 EDT 2008
sam lee wrote:
> Hi.
>
> I want to compose two monads to build another monad where
> computations of the two monads can be used inside.
>
> I have:
>
> - MonadTypeInfer : interface (class) for TypeInfer monad
> - TypeInfer : a monad that has Map String Type (association of names and types)
> - TypeInferT : transformer of above monad
> - MonadEval : interface (class) for Eval monad
> - Eval : a monad that has Map String Expr (association of names and
> code/function body)
> - EvalT : transformer of Eval
> - tInfer :: Expr -> TypeInfer Type -- given expr, returns type of it
> in TypeInfer monad
> - eval :: Expr -> Eval Expr -- given expr, returns normalized expr in Eval monad
>
> Is there a way to build a monad where you could use sub-monads'
> (monads used to build current monad) computations?
A solution to this problem is to use type classes, and in particular MonadTrans.
You can then give an instance of MonadTypeInfer for EvalT m where m is an
instance of MonadTypeInfer, and similarly an instance MonadEval for TypeInferT
m. How this is implemented depends on the Monads in question, but if you use the
monad transformer library with newtype deriving you can just add "deriving
MonadTrans".
class Monad m => MonadTypeInfer m where
-- functions --
tiStuff :: X -> m Whatever
class Monad m => MonadEval m where
-- functions --
instance Monad m => MonadTypeInfer (TypeInferT m) where
-- implementation --
tiStuff = ...
instance Monad m => MonadEval (EvalT m) where
-- implementation --
instance MonadEval m => MonadTypeInfer (EvalT m) where
-- lift the functions from TypeInfer through the EvalT type,
-- MonadTrans from the mtl might help here
tiStuff x = lift (tiStuff x)
tInfer :: MonadTypeInfer m => Expr -> m Type
eval :: MonadEval m => Expr -> m Expr
Twan
More information about the Haskell-Cafe
mailing list