Код с отслеживанием состояния под другой монадой

У меня есть хобби веб-проект. Очень просто, просто чтобы изучить Haskell и веб-программирование. Для наглядности я использую Snap framework. И у меня есть следующий код (обработчик 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, но контекст может измениться во время обработки запроса. Я думаю, что я могу решить это, определив свою монаду (правильно?), но я уже должен использовать Snap-монаду, и я не могу ее расширить (это тоже вопрос)?

Надеюсь, я говорю это довольно ясно, чтобы помочь мне.


haskell monads haskell-snap-framework
person demi    schedule 11.05.2012    source источник
comment
Как withSession читает текущий сеанс? Если экземпляр MonadSnap m предоставляет доступ к сеансу, то все функции, возвращающие значение в монаде m, также должны иметь доступ к сеансу теми же средствами.   -  person pat    schedule 11.05.2012
comment
Это моя собственная сессия, которую я сделал своими руками. Она реализована в виде файла cookie и файла на сервере с таким именем :) Я не устанавливал подсистему snap для управления сессией, потому что хочу коснуться внутренностей сети.   -  person demi    schedule 11.05.2012
comment
Ответ Пэта о StateT верен, и именно поэтому мы сделали снэплеты и монаду Handler. Обработчик на самом деле является StateT под капотом. Он позаботится обо всех деталях для вас. Чтобы начать работу, ознакомьтесь с руководством по сниплетам.   -  person mightybyte    schedule 14.05.2012

Ответы (1)


arrow_upward
4
arrow_downward

Вы можете обернуть свою монаду MonadSnap в StateT, у которой ваш контекст является состоянием. Как только соответствующие экземпляры определены, вы можете написать в своей новой монаде функции, которые имеют доступ к состоянию сеанса, но при этом могут вызывать 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
person pat    schedule 11.05.2012