module Web.Routes.MTL where
import "mtl" Control.Monad.Trans (MonadTrans(lift), MonadIO(liftIO))
import Web.Routes.RouteT (RouteT(RouteT, unRouteT), liftRouteT, mapRouteT)
import Control.Monad.Reader(MonadReader(ask,local))
import Control.Monad.State(MonadState(get,put))
import Control.Monad.Writer(MonadWriter(listen, tell, pass))
import Control.Monad.Error (MonadError(throwError, catchError))
import Control.Monad.RWS (MonadRWS)
import Control.Monad.Cont(MonadCont(callCC))
instance MonadTrans (RouteT url) where
lift = liftRouteT
instance (MonadIO m) => MonadIO (RouteT url m) where
liftIO = lift . liftIO
instance (MonadReader r m) => MonadReader r (RouteT url m) where
ask = liftRouteT ask
local f = mapRouteT (local f)
instance (MonadState s m) => MonadState s (RouteT url m) where
get = liftRouteT get
put s = liftRouteT $ put s
instance (MonadWriter w m) => MonadWriter w (RouteT url m) where
tell w = liftRouteT $ tell w
listen m = mapRouteT listen m
pass m = mapRouteT pass m
instance (MonadRWS r w s m) => MonadRWS r w s (RouteT url m)
instance (MonadError e m) => MonadError e (RouteT url m) where
throwError = liftRouteT . throwError
catchError action handler = RouteT $ \f -> catchError (unRouteT action f) (\e -> unRouteT (handler e) f)
instance (MonadCont m) => MonadCont (RouteT url m) where
callCC f = RouteT $ \url ->
callCC $ \c ->
unRouteT (f (\a -> RouteT $ \_ -> c a)) url