Handling `IO Bool` and `IO (Either a b)` inside `IO (Maybe b)`

Posted on

Problem

{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE ScopedTypeVariables #-}

data E a
  = E1
  | E2
  | E3 a

data L
data R

f :: IO (Maybe (E L))
f =
  (undefined :: IO Bool) >>= case
    False -> return (Just E1)
    True  ->
      (undefined :: IO Bool) >>= case
        False -> return (Just E2)
        True  ->
          (undefined :: IO (Either L R)) >>= case
            Left e  -> return (Just (E3 e))
            Right v -> (undefined :: R -> IO ()) v >> return Nothing

How to get rid of these three nested cases?

Solution

Since you need to abort your computation early and return a value different from the final output, the ExceptT transformer would be useful.

import Control.Monad (unless)
import Control.Monad.IO.Class
import Control.Monad.Trans.Except

data E a
  = E1
  | E2
  | E3 a

data L
data R

f :: ExceptT (E L) IO ()
f = do
  liftIO (undefined :: IO Bool) >>= flip unless (throwE E1)
  liftIO (undefined :: IO Bool) >>= flip unless (throwE E2)
  liftIO (undefined :: IO (Either L R)) >>=
    either (throwE . E3) (liftIO . (undefined :: R -> IO ()))

If we want, we can then convert ExceptT (E L) IO () to IO (Maybe (E L)):

f' :: IO (Maybe (E L))
f' = either Just (const Nothing) <$> runExceptT f

If could be further polished by using helper functions from Control.Conditional or a similar library, and by extending the functions, for which undefined fills in, to work within any MonadIO (if that’s possible).

It may worth inventing your own combinators with semantically appropriate names. Here is an example using ExceptRT monad from errors package:

import Control.Monad.Trans (liftIO)
import Control.Error (rightMay, ExceptRT, runExceptT, runExceptRT, succeedT)

runE :: Functor m => ExceptRT a m e -> m (Maybe a)
runE = fmap rightMay . runExceptT . runExceptRT

report :: Monad m => a -> Bool -> ExceptRT a m ()
report res False = succeedT res
report _   _     = return ()

f :: IO (Maybe (E L))
f = runE $ do
  liftIO foo >>= report E1
  liftIO bar >>= report E2
  liftIO baz >>= either (succeedT . E3) (liftIO . quxx)

Leave a Reply

Your email address will not be published. Required fields are marked *