haskell - 另一个 monad 下的有状态代码

Question

我有一个爱好网络项目。很简单，就是学习Haskell和web编程。为清楚起见，我使用 Snap 框架。我有以下代码(site.com/auth 处理程序):

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 读取当前 session 并运行参数中的函数。在这里，我遇到了一个问题:用户获得授权，我想将新值赋予 session s 并使用它运行代码。最好的方法是什么？你会怎么做？假设下面的代码也使用了 s。

另一个问题:我能否以某种方式使上下文在处理程序(如 auth)和其他函数中透明可用？我不想使用 ctx:

这样的参数在所有函数中提取所有上下文(比如数据库连接、 session 和可能的其他)

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

理想情况下，我希望有一个函数 withContext 但在处理请求期间上下文可能会更改。我想我可以通过定义我的 monad 来解决它(对吧？)，但我已经不得不使用 Snap monad 而我不能扩展它(这也是一个问题)？

希望我说的很清楚对我有帮助。

Answer 1

您可以将 MonadSnap monad 包装在一个 StateT 中，该状态将您的上下文作为其状态。一旦定义了适当的实例，您就可以在新的 monad 中编写函数，这些函数可以访问 session 状态，但仍然可以在没有 lift 的情况下调用 MonadSnap 函数。

{-# 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