Adding MonadReader/MonadError instances to a Transformer Type

happstack, haskell, monad-transformers, monads

Solution

In theory, you would write something like this, except you can't because the `ClientSessionT` constructor and 'unClientSessionT` function are not exported:

instance (Monad m, MonadError e m) => MonadError e (ClientSessionT st m) where
    throwError = ClientSessionT . throwError
    catchError (ClientSessionT m) f =
        ClientSessionT $ ReaderT $ \r -> StateT $ \s ->
          (runStateT (runReaderT m r) s) `catchError` (\e -> runStateT (runReaderT (unClientSessionT (f e)) r) s)

instance (Functor m, Monad m, MonadReader r m) => MonadReader r (ClientSessionT st m) where
    ask = ClientSessionT $ lift $ lift ask
    local f (ClientSessionT m) = ClientSessionT $ mapReaderT (mapStateT (local f)) m

Writing these types of instances by hand is pretty mechanical -- there are patterns you will see arise again and again. (Which is why the compiler can figure out how to do it automatically most of the time).

In this case, the best fix is to complain to the authors about the missing instances.

The darcs version now includes `MonadError`, `MonadReader`, and a bunch more. Plus some other changes that break things a tiny bit, but make things better over all.

There is also a demo directory now:

http://patch-tag.com/r/mae/happstack/snapshot/current/content/pretty/happstack-clientsession

I will probably release it, with a few minor changes, and more comments in a day or two.

Problem

As it's usual when working with Happstack, I have been making my own server monad to use for the handlers, to cover my DB and Sessions, plus some error handling. I have recently discovered the `happstack-clientsession`-Package that is a big help and prevents me from writing my own solution. Though there's a little trouble wiring in the `ClientSessionT` monad to my own. As it turns out, there are no `MonadReader` or `MonadError` instances for it, so I cannot instance them in my wrapper monad. Here is the full code of the module: ``` {-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving, DeriveDataTypeable, EmptyDataDecls, TemplateHaskell #-} module Server where import Control.Monad import Control.Monad.Error import Control.Monad.Reader import Control.Monad.Trans import Data.Data (Data, Typeable) import Data.SafeCopy (base, deriveSafeCopy) import Database.MongoDB as M import Happstack.Server import Happstack.Server.Error import Happstack.Server.ClientSession import System.IO.Pool import System.IO.Error import Web.ClientSession (getDefaultKey) type MongoPool e = Pool e Pipe data PonySession = PonySession -- TODO: Fill in User type when available deriving (Ord, Read,Show, Eq, Typeable, Data) $(deriveSafeCopy 0 'base ''PonySession) instance ClientSession PonySession where empty = PonySession newtype PonyServerPartT e m a = PonyServerPart (ClientSessionT PonySession (ReaderT (MongoPool IOError) (ServerPartT (ErrorT e m))) a) deriving (Monad, MonadIO, MonadReader (MongoPool e), MonadError e, ServerMonad, MonadPlus) type PonyServerPart = PonyServerPartT IOError IO runServerT s = mapServerPartT' (spUnwrapErrorT errorHandler) $ do key <- liftIO getDefaultKey let sessConf = (mkSessionConf key) { sessionCookieLife = MaxAge $ 60 * 60 * 24 * 7 } pool <- liftIO mongoPool runReaderT (runClientSessionT s sessConf) pool where errorHandler = simpleErrorHandler . show mongoPool :: IO (MongoPool IOError) mongoPool = newPool fac 10 where fac = Factory { newResource = connect $ M.host "127.0.0.1", killResource = close, isExpired = isClosed } ``` The error I am getting is obvious: The deriving from `MonadError` and `MonadReader` does not work. But I'd need those, otherwise the entire performance is kind of useless. Since I have never been able to figure out how these are done (And relied on `deriving`), I'd like for an answer that covers this specific problem and kind of tells me how it is done generally.

Original source