# 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 `case`s?

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)

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