I’m familiar with how one can chain Maybe monads, so the final result is only there if all the computation succeeds. But I was in a situation where I needed to do something different, based on where the computation fails. I thought I have no choice than falling back to deeply nested case expressions, until I successfully utilized ExceptT
to avoid doing so.
I wrote a contrived example:
{-# language LambdaCase #-}
import Text.Read
import Control.Monad.Except
import Control.Error.Util
-- Tests
-- "abc" : Should print "Input is not a number."
-- "15" : Should create a file "new_error_file.txt" with text "Number is not even."
-- "12" : Should create a file "quotient_is_not_at_least_10.txt" with "6.0" inside.
-- "26" : Should print "Successful computation with final result 3.0."
main :: IO ()
main = do
putStrLn "Using method: "
methodStr <- getLine
case readMaybe methodStr of
Just 1 -> methodOne
Just 2 -> do
runExceptT methodTwo >>= \case
Right _ -> return ()
Left m -> m
_ -> return ()
f :: Int -> Maybe Float
f x =
case x `mod` 2 of
1 -> Nothing
0 -> Just $ ( fromIntegral x ) / 2.0
g :: Float -> Maybe Float
g y =
case y >= 10 of
False -> Nothing
True -> Just $ y - 10
-- Method 1, with nested case expressions.
methodOne :: IO ()
methodOne = do
putStrLn "Your input: "
inputStr <- getLine
let maybeNum = readMaybe inputStr
case maybeNum of
Nothing -> putStrLn "Input is not a number."
Just num ->
case f num of
Nothing -> appendFile "new_error_file.txt" "Number is not even."
Just quotient ->
case g quotient of
Nothing -> writeFile "quotient_is_not_at_least_10.txt" ( show quotient )
Just result -> putStrLn $ "Successful computation with final result " ++ show result
methodTwo :: ExceptT ( IO () ) IO ()
methodTwo = do
liftIO $ putStrLn "Your input"
inputStr <- liftIO getLine
num <- failWith ( putStrLn "Input is not a number." ) ( readMaybe inputStr )
quotient <- failWith ( appendFile "new_error_file.txt" "Number is not even." ) ( f num )
result <- failWith ( writeFile "quotient_is_not_at_least_10.txt" ( show quotient ) ) ( g quotient )
liftIO $ putStrLn $ "Successful computation with final result " ++ show result
I think the e
in ExceptT e m a
has to be IO ()
, instead of something like String
, since different kinds of IO actions like putStrLn
, writeFile
, appendFile
, and potentially playSound
, drawImage
, launchMissiles
are performed, based on where it fails.
ExceptT ( IO () ) IO ()
is complicated-looking though, so I want to ask if its usage here is proper. If yes then I can promote it to others. If not then I should learn the proper solution.