Как использовать, может быть, монаду внутри другой монады?

У меня есть этот код (внутри happstack, но может быть просто монадой ввода-вывода):

accountHandler conn = do
  sessionId <- optional $ readCookieValue "sessionId"

  case sessionId of
    Nothing -> seeOther ("/" :: String) $ toResponse ()
    Just s  -> do
      result <- loggedInUserId conn s

      case result of
        Just userId -> seeOther ("/account/" ++ unUserId userId) $ toResponse ()
        Nothing -> seeOther ("/" :: String) $ toResponse ()

Я хочу удалить вложенные операторы case и написать что-то вроде:

accountHandler conn = do

  let action = do
                sessionId <- optional $ readCookieValue "sessionId"
                userId    <- loggedInUserId conn sessionId

                return $ seeOther ("/account/" ++ userId)

  maybe (seeOther ("/" :: String)) id action $ toResponse ()

... но userId оказывается типом Maybe String, а не просто String. Как я могу оценить вложенный блок do с помощью монады may? (Я бы также согласился на другой рефакторинг, удаляющий вложенные случаи.)

ОБНОВЛЕНИЕ: Ниже приведена общая, хотя и надуманная версия той же проблемы:

module Main where

getAnswer expected = do
  l <- getLine

  if l == expected
    then return $ Just l
    else return $ Nothing

main = do
  a <- getAnswer "a"

  case a of
    Nothing -> putStrLn "nope"
    Just x -> do
      b <- getAnswer x

      case b of
        Nothing -> putStrLn "nope"
        Just _ -> putStrLn "correct!"

person Xavier Shay    schedule 29.11.2013    source источник


Ответы (2)


Хорошо, с вашим общим примером я мог бы что-то сделать с Control¸Monad.Transformers. Это позволяет вам создать стек монад. Вы можете проверить это здесь: http://hackage.haskell.org/package/transformers-0.3.0.0/docs/Control-Monad-Trans-Maybe.html Вы можете применить MaybeT ко всему типу IO (Maybe a), а затем выполнить все вычисления во внутреннем do заблокировать, а затем проверить Ничего в конце.

module Main where
import Control.Monad.Trans.Maybe


getAnswer expected = MaybeT $ do
       l <- getLine
       if l == expected
       then return $ Just l
       else return $ Nothing

main = do
    y <- runMaybeT $ do a <- getAnswer "a"
                        b <- getAnswer a
                        return b
    case y of Nothing  -> putStrLn "failure"
              (Just _) -> putStrLn "correct"

Другая версия с использованием liftIO и класса типов Alternative:

module Main where
import Control.Monad.Trans.Maybe
import Control.Monad.IO.Class
import Control.Applicative


getAnswer expected = MaybeT $ do
  l <- getLine
  if l == expected
    then return $ Just l
    else return $ Nothing

main = do
    _ <- runMaybeT $ do a <- getAnswer "a"
                        b <- getAnswer a
                        liftIO $ putStrLn "correct" 
                   <|> do liftIO $ putStrLn "failure"
    return ()

Но использование многих операций подъема не очень элегантно.

person MoFu    schedule 29.11.2013

Я хотел бы добавить к ответу MoFu, что если у вас есть MaybeT IO, вы можете использовать всю мощь его экземпляра MonadPlus. Например, если вам нужно проверить выполнение какого-либо условия, используйте guard или mfilter. Итак, вы можете написать:

import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans
import Control.Monad.Trans.Maybe

getAnswer :: (MonadPlus m, MonadIO m) => String -> m String
getAnswer expected = mfilter (== expected) $ liftIO getLine

Его тип очень общий, он работает для любой монады MonadPlus и MonadIO. Это удобно, если вы решите позже изменить стек монад. Но мы могли бы также использовать более конкретный тип (MonadIO m) => String -> MaybeT m String.

Для извлечения значения MaybeT IO из ваших внутренних вычислений я предлагаю написать вариант fromMaybe для MaybeT:

fromMaybeT :: (Monad m) => m a -> MaybeT m a -> m a
fromMaybeT onFail = maybe onFail return <=< runMaybeT

Он извлекает результат с помощью runMaybeT. Если это Just, просто верните его, иначе выполните действие onFail.

Соединив вместе, мы получим:

main = fromMaybeT (putStrLn "nope") $ do
  a <- getAnswer "a"
  b <- getAnswer a
  liftIO $ putStrLn "correct!"
person Petr    schedule 01.12.2013