Short circuiting a chain of operations in Haskell

Main.hs

module Main where

import Control.Monad.Except
  (ExceptT
  , runExceptT
  , throwError
  )
import Control.Monad.IO.Class ( liftIO )

-- |This is the core of the function, where we are chaining together several
-- steps, where each may depend on the previous. The chain is run within the
-- function `runExceptT`, which will catch errors thrown by `throwError`. The
-- key is that calling `throwError` in test3 will "short circuit" the chain,
-- meaning test4 is never executed. This may be useful if the operation in
-- test3, which is critical for test4, fails.
-- Compiling and running this example as is will result in the following output
--
--   start
--   test1
--   test2
--   ======= Error =======
--   error3
--
-- Change the `Left` on line 52 to a `Right`. Then recompile and execute. The
-- `throwError` is not called and execution of the rest of the chain proceeds
-- as expected.
--
--   start
--   test1
--   test2
--   test3
--   ======= Success =======
--   test4
--
main :: IO ()
main = do
  x <- runExceptT (test1 "start" >>= test2 >>= test3 >>= test4)
  case x of
    Left e  -> do
      putStrLn "======= Error ======="
      putStrLn e
    Right r -> do
      putStrLn "======= Success ======="
      putStrLn r
      return ()
  where
    test1 :: String -> (ExceptT String IO) String
    test1 s = do
      liftIO $ putStrLn s
      case (Right "test1") of
        Left _  -> throwError "error1"
        Right s' -> return s'

    test2 :: String -> (ExceptT String IO) String
    test2 s = do
      liftIO $ putStrLn s
      case (Right "test2") of
        Left _  -> throwError "error2"
        Right s' -> return s'

    test3 :: String -> (ExceptT String IO) String
    test3 s = do
      liftIO $ putStrLn s
      case (Left "test3") of
        Left _  -> throwError "error3"
        Right s' -> return s'

    test4 :: String -> (ExceptT String IO) String
    test4 s = do
      liftIO $ putStrLn s
      case (Right "test4") of
        Left _  -> throwError "error4"
        Right s' -> return s'