Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

How to use maybe monad inside another monad?

I have this code (inside happstack, but could be just the IO monad):

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 ()

I want to remove the nested case statements and write something like:

accountHandler conn = do

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

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

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

... but userId ends up as a type of Maybe String rather than just String. How can I evaluate the nested do block using the maybe monad? (I would also accept a different refactoring that removes the nested cases.)

UPDATE: Below is a generic, though contrived, version of the same problem:

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!"
like image 579
Xavier Shay Avatar asked Nov 29 '13 20:11

Xavier Shay


2 Answers

Ok, with your generic example I could do something with Control¸Monad.Transformers. This allows you to create a stack of monads. You can check it out here: http://hackage.haskell.org/package/transformers-0.3.0.0/docs/Control-Monad-Trans-Maybe.html You can apply MaybeT to everything of type IO (Maybe a) and then do all the computations in the inner do block and then check for Nothing at the end.

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"

Another version using liftIO and the Alternative type class:

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 ()

But using many lift operations is not very elegant.

like image 84
MoFu Avatar answered Oct 27 '22 12:10

MoFu


I'd like to add to MoFu's answer that once you have MaybeT IO, you can use the full power of its MonadPlus instance. For example, if you need to check that some condition holds, use guard or mfilter. So you can write:

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

It's type is very generic, it works for any monad that is MonadPlus and MonadIO. This is handy if you decide to modify your monad stack later. But we could also use more specific type (MonadIO m) => String -> MaybeT m String.

For extracting a MaybeT IO value from your inner computation I'd suggest to write a variant of fromMaybe for MaybeT:

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

It extracts the result with runMaybeT. If it's Just, just return it, otherwise run onFail action.

Combined together, we get:

main = fromMaybeT (putStrLn "nope") $ do
  a <- getAnswer "a"
  b <- getAnswer a
  liftIO $ putStrLn "correct!"
like image 35
Petr Avatar answered Oct 27 '22 14:10

Petr