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

另一个问题：我可以以某种方式在处理程序（如auth）和其他函数中透明地提供上下文吗？我不想在所有函数中使用ctx之类的参数拉出所有上下文（如数据库连接，会话和其他可能的上下文）：

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中编写可以访问会话状态的函数，但仍然可以在没有MonadSnap的情况下调用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

另一个monad下的有状态代码

1 个答案: