
I don't have an especially deep understanding of monad transformers... basically, I asked around (thanks #haskell!) and struggled and with helpful advice came up with something that seemed to work for me, only now I'm having trouble. What I'm trying to do is hardly revolutionary or even advanced, so I'd like to come up with some kind of standard best practices way to do this. Basically, the question is, "how do you combine multiple sets of monad transformers, each of which may contain their own exception mechanism, and throw and catch exceptions for each one?" This seems like a perfectly normal thing to want to do, so someone must have figured this out. For more details: I have several subsystems, each of which runs in its own monad. For instance, the Ui level has a monad that provides state, logging of updates, and an exception (LoggerT is simply a type alias for a WriterT with DList): module Ui.State where type StateStack m = State.StateT State (Logger.LoggerT Update.Update (Error.ErrorT StateError m)) newtype StateT m a = StateT (StateStack m a) deriving (Functor, Monad, Trans.MonadIO, Error.MonadError StateError) I wished to wrap up this Ui.StateT as its own transformer that can be reused inside other transformers.... because another subsystem has its own set of needs, including its own logging, state, and exception, in addition to Ui.StateT: module Cmd.Cmd where type CmdStack m = Ui.State.StateT (Monad.State.StateT State (Error.ErrorT Abort (Log.LogT m))) newtype CmdT m a = CmdT (CmdStack m a) deriving (Functor, Monad, Trans.MonadIO) I want to provide unlifted access to Ui.State operations, so I have: class (Monad m, Functor m) => UiStateMonad m where get :: m State put :: State -> m () modify :: (State -> State) -> m () update :: Update.Update -> m () throw :: String -> m a Along with instances for Ui.StateT and Cmd.CmdT where Ui.StateT does the appropriate lifting and CmdT just "delegates": 'put st = CmdT (State.put st)' etc. So now I can throw a StateError within Ui.State by calling State.throw. I can throw the error within Cmd with: abort = (CmdT . lift . lift . lift) (Error.throwError Abort) So this all works fine and each "level" of transformers can provide access to its throw by exporting a 'throw' with the appropriate lifts already applied. But then I want to catch an exception, and there's a problem because catchException takes a monadic argument in addition to having a monadic result. I can easily lift the result into the proper layer, but I can't so easily "lower" the result of the monadic argument back down to the StateT or CmdT or whatever. I can use fancy newtype deriving to put Ui.StateT into MonadError and get catchError for free, but if I try to do the same with CmdT then I get: Couldn't match expected type `Abort' against inferred type `State.StateError' When using functional dependencies to combine Error.MonadError State.StateError (State.StateT m), arising from the dependency `m -> e' So evidentally they are not co-existing. In any case, I would need different names for the throw and catch in the different monads. So all I want to do is to be able to catch an Abort. The closest I can think of is something vaguely like: catch_abort :: (Monad m) => CmdT m a -> CmdT m (Maybe a) catch_abort cmd = do ustate <- State.get cstate <- get_state (cmd_result, logs) <- run_cmd ustate cstate mapM_ Log.record logs case cmd_result of Left Abort -> return Nothing Right ui_result -> case ui_result of Left ui_err -> State.throw ui_err Right (val, ustate, updates) -> do State.put ustate mapM_ State.update updates return (Just val) All of this manual "unlifting" is quite ugly and clearly doesn't scale... and it's quite easy to introduce a subtle bug by forgetting to merge one of the many results that come out. So... what should I have done? What do other people who have a project with >1 kind of exception do? Is there an easier way to write 'catch_abort'? Should I break modularity by making a global exception type and putting them all in StateError? Then (I think) I could use catchError directly since I'd only have one occurrance of ErrorT in any transformer stack.