Stateful code under another monad

Question

I have a hobby web project. Very simple, just to learn Haskell and web programming. For clarity, I use Snap framework. And I have the following code (site.com/auth handler):

auth :: MonadSnap m => m ByteString  
auth = withSession $ \s -> do  
    Just user <- getPostParam "user"
    Just password <- getPostParam "password"
    if user == "demi" && password == "1234"
       then redirect "/"
       else redirect "/login"

withSession reads current session and runs the function in the parameter. Here I face a problem: user gets authorized and I want to put new value to session s and run code with it. What is the best way to do it? How will you do it? Assume that code below also uses s.

Another question: can I somehow make context available transparently in the handler (like auth) and other functions? I don't want to pull all the context (like DB connection, session and probably other) in all functions with parameter like ctx:

findGoodies :: MonadSnap m => MyContext -> String -> m String
checkCaptcha :: MonadSnap m => MyContext -> m Bool
breakingNews :: MonadSnap m => MyContext -> m ByteString

Ideally, I want to have a function withContext but context may be changed during handling a request. I think I may solve it defining my monad (right?), but I already have to use Snap monad and I can't extend it (this is a question too)?

Hope I tell it pretty clear to help me.

Answer 1

You can wrap your MonadSnap monad in a StateT that has your context as its state. Once the appropriate instances have been defined, you can write functions in your new monad that have access to the session state but can still invoke MonadSnap functions without lift.

{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
import Control.Monad.State

-- StateT wrapper
newtype MySnapT m a = MySnapT { unMySnapT :: StateT MyContext m a }
    deriving ( Monad )

instance MonadTrans MySnapT where
    lift = MySnapT . lift

instance MonadSnap m => MonadSnap (MySnapT m) where
    liftSnap = lift . liftSnap

instance MonadSnap m => MonadState MyContext (MySnapT m) where
    get = MySnapT get
    put = MySnapT . put

runMySnapT :: MonadSnap m => MySnapT m a -> MyContext -> m (a, MyContext)
runMySnapT m = runStateT . unMySnapT $ m

-- wrapper for withSession that runs a MySnapT action with
-- the current session as the StateT state, and sets the
-- resulting state back when it is done
withMySession :: MonadSnap m => MySnapT m a -> m a
withMySession m = do
    (a, s') <- withSession $ runMySnapT m -- read the session and run the action
    setSession s' -- write the session back to disk
    return a        



-- functions that run in the MySnapT monad have access to context as
-- state, but can still call MonadSnap functions
findGoodies :: MonadSnap m => String -> MySnapT m String
findGoodies s = do
    s <- get -- get the session
    put $ modifySession s -- modify and set the session back into the State
    liftSnap undefined -- I can still call Snap functions
    return "Hello"

auth :: MonadSnap m => m String  
auth = withMySession $ do -- use withMySession to run MySnapT actions
    findGoodies "foo"


-- dummy definitions for stuff I don't have

data Snap a = Snap a

class Monad m => MonadSnap m where
  liftSnap :: Snap a -> m a

data MyContext = MyContext

withSession :: MonadSnap m => (MyContext -> m a) -> m a
withSession = undefined

setSession :: MonadSnap m => MyContext -> m ()
setSession = undefined

modifySession :: MyContext -> MyContext
modifySession = undefined