[Haskell-beginners] order of monad transformers
Stephen Tetley
stephen.tetley at gmail.com
Wed Nov 4 04:49:02 EST 2009
> {-# LANGUAGE GeneralizedNewtypeDeriving #-}
Hello Mike
If the is a principal as such, I'd suggest that's working
out the return type that you want your run function to have.
Or more plainly - work out what you want the result to be.
Thats a bit gnomic of course, so here are two examples with
ErrorT (for failure) and WriterT (for logging), the ErrMsg type
is contrived slightly to be a distinct type.
This message should be literate Haskell if my mail
service likes me:
> module Transforming where
> import Control.Monad.Error
> import Control.Monad.Identity
> import Control.Monad.Writer
> type Log = String
> newtype ErrMsg = ErrMsg { getMsg :: String } deriving Show
> newtype EWI a = EWI {
> getEWI :: ErrorT ErrMsg (WriterT Log Identity) a }
> deriving (Functor, Monad, MonadWriter Log, MonadError ErrMsg)
The run functions are pretty /natural/ just the run functions
of the monad transformer stack in the reverse order.
Note the /outer tupling/ over the Either type in the run
function - runEWI always returns a log regardless of whether
the computation fails with an error...
[ without embellishments: (Either _ _,_) ]
> runEWI :: EWI a -> (Either ErrMsg a, Log)
> runEWI ma = runIdentity (runWriterT (runErrorT (getEWI ma)))
> newtype WEI a = WEI {
> getWEI :: WriterT Log (ErrorT ErrMsg Identity) a }
> deriving (Functor, Monad, MonadWriter Log, MonadError ErrMsg)
Note the Either type has an inner tuple in the run function -
runWEI returns a log /only/ when the computation succeeds otherwise
it fails with just an error...
[ without embellishments: Either _ (_,_) ]
> runWEI :: WEI a -> Either ErrMsg (a, Log)
> runWEI ma = runIdentity (runErrorT (runWriterT (getWEI ma)))
Support code
> instance Error ErrMsg where
> noMsg = ErrMsg ""
> strMsg = ErrMsg
More information about the Beginners
mailing list