examples of output of various monadic functions with different monad transformer orders

transformers-tests.hs

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}

module Main where

import Control.Monad.Except
import Control.Monad.State
import Control.Monad.Writer
import Data.Functor.Identity
import Data.Text (Text)

type StateExWriterM = StateT String (ExceptT Int (WriterT Text Identity))

runStateExWriterM :: StateExWriterM Char -> (Either Int (Char, String), Text)
runStateExWriterM m =
  runIdentity $ runWriterT $ runExceptT (runStateT m "foo")

type StateWriterExM = StateT String (WriterT Text (ExceptT Int Identity))

runStateWriterExM :: StateWriterExM Char -> Either Int ((Char, String), Text)
runStateWriterExM m =
  runIdentity $ runExceptT $ runWriterT (runStateT m "foo")

type WriterStateExM = WriterT Text (StateT String (ExceptT Int Identity))

runWriterStateExM :: WriterStateExM Char -> Either Int ((Char, Text), String)
runWriterStateExM m =
  runIdentity $ runExceptT $ runStateT (runWriterT m) "foo"

type WriterExStateM = WriterT Text (ExceptT Int (StateT String Identity))

runWriterExStateM :: WriterExStateM Char -> (Either Int (Char, Text), String)
runWriterExStateM m =
  runIdentity $ runStateT (runExceptT (runWriterT m)) "foo"

type ExWriterStateM = ExceptT Int (WriterT Text (StateT String Identity))

runExWriterStateM :: ExWriterStateM Char -> ((Either Int Char, Text), String)
runExWriterStateM m =
  runIdentity $ runStateT (runWriterT (runExceptT m)) "foo"

type ExStateWriterM = ExceptT Int (StateT String (WriterT Text Identity))

runExStateWriterM :: ExStateWriterM Char -> ((Either Int Char, String), Text)
runExStateWriterM m =
  runIdentity $ runWriterT (runStateT (runExceptT m) "foo")

putThrowTell :: (MonadError Int m, MonadState String m, MonadWriter Text m) => m Char
putThrowTell = do
  put "bar"
  throwError 100
  tell "aaa"
  pure 'c'

throwPutTell :: (MonadError Int m, MonadState String m, MonadWriter Text m) => m Char
throwPutTell = do
  throwError 100
  put "bar"
  tell "aaa"
  pure 'c'

putTellThrow :: (MonadError Int m, MonadState String m, MonadWriter Text m) => m Char
putTellThrow = do
  put "bar"
  tell "aaa"
  throwError 100
  pure 'c'

throwTellPut :: (MonadError Int m, MonadState String m, MonadWriter Text m) => m Char
throwTellPut = do
  throwError 100
  tell "aaa"
  put "bar"
  pure 'c'

tellPutThrow :: (MonadError Int m, MonadState String m, MonadWriter Text m) => m Char
tellPutThrow = do
  tell "aaa"
  put "bar"
  throwError 100
  pure 'c'

tellThrowPut :: (MonadError Int m, MonadState String m, MonadWriter Text m) => m Char
tellThrowPut = do
  tell "aaa"
  throwError 100
  put "bar"
  pure 'c'

main :: IO ()
main = do
  putStrLn "StateExWriterM:"
  putStrLn $ "  wrapped:   StateT String (ExceptT Int (WriterT Text Identity))"
  putStrLn $ "  unwrapped: (Either Int (Char, String), Text)"
  putStrLn $ "    putThrowTell: " <> show (runStateExWriterM putThrowTell)
  putStrLn $ "    throwPutTell: " <> show (runStateExWriterM throwPutTell)
  putStrLn $ "    putTellThrow: " <> show (runStateExWriterM putTellThrow)
  putStrLn $ "    throwTellPut: " <> show (runStateExWriterM throwTellPut)
  putStrLn $ "    tellPutThrow: " <> show (runStateExWriterM tellPutThrow)
  putStrLn $ "    tellThrowPut: " <> show (runStateExWriterM tellThrowPut)
  putStrLn ""
  putStrLn "StateWriterExM:"
  putStrLn $ "  wrapped:   StateT String (WriterT Text (ExceptT Int Identity))"
  putStrLn $ "  unwrapped: Either Int ((Char, String), Text)"
  putStrLn $ "    putThrowTell: " <> show (runStateWriterExM putThrowTell)
  putStrLn $ "    throwPutTell: " <> show (runStateWriterExM throwPutTell)
  putStrLn $ "    putTellThrow: " <> show (runStateWriterExM putTellThrow)
  putStrLn $ "    throwTellPut: " <> show (runStateWriterExM throwTellPut)
  putStrLn $ "    tellPutThrow: " <> show (runStateWriterExM tellPutThrow)
  putStrLn $ "    tellThrowPut: " <> show (runStateWriterExM tellThrowPut)
  putStrLn ""
  putStrLn "WriterStateExM:"
  putStrLn $ "  wrapped:   WriterT Text (StateT String (ExceptT Int Identity))"
  putStrLn $ "  unwrapped: Either Int ((Char, Text), String)"
  putStrLn $ "    putThrowTell: " <> show (runWriterStateExM putThrowTell)
  putStrLn $ "    throwPutTell: " <> show (runWriterStateExM throwPutTell)
  putStrLn $ "    putTellThrow: " <> show (runWriterStateExM putTellThrow)
  putStrLn $ "    throwTellPut: " <> show (runWriterStateExM throwTellPut)
  putStrLn $ "    tellPutThrow: " <> show (runWriterStateExM tellPutThrow)
  putStrLn $ "    tellThrowPut: " <> show (runWriterStateExM tellThrowPut)
  putStrLn ""
  putStrLn "WriterExStateM:"
  putStrLn $ "  wrapped:   WriterT Text (ExceptT Int (StateT String Identity))"
  putStrLn $ "  unwrapped: (Either Int (Char, Text), String)"
  putStrLn $ "    putThrowTell: " <> show (runWriterExStateM putThrowTell)
  putStrLn $ "    throwPutTell: " <> show (runWriterExStateM throwPutTell)
  putStrLn $ "    putTellThrow: " <> show (runWriterExStateM putTellThrow)
  putStrLn $ "    throwTellPut: " <> show (runWriterExStateM throwTellPut)
  putStrLn $ "    tellPutThrow: " <> show (runWriterExStateM tellPutThrow)
  putStrLn $ "    tellThrowPut: " <> show (runWriterExStateM tellThrowPut)
  putStrLn ""
  putStrLn "ExWriterStateM:"
  putStrLn $ "  wrapped:   ExceptT Int (WriterT Text (StateT String Identity))"
  putStrLn $ "  unwrapped: ((Either Int Char, Text), String)"
  putStrLn $ "    putThrowTell: " <> show (runExWriterStateM putThrowTell)
  putStrLn $ "    throwPutTell: " <> show (runExWriterStateM throwPutTell)
  putStrLn $ "    putTellThrow: " <> show (runExWriterStateM putTellThrow)
  putStrLn $ "    throwTellPut: " <> show (runExWriterStateM throwTellPut)
  putStrLn $ "    tellPutThrow: " <> show (runExWriterStateM tellPutThrow)
  putStrLn $ "    tellThrowPut: " <> show (runExWriterStateM tellThrowPut)
  putStrLn ""
  putStrLn "ExStateWriterM:"
  putStrLn $ "  wrapped:   ExceptT Int (StateT String (WriterT Text Identity))"
  putStrLn $ "  unwrapped: ((Either Int Char, String), Text)"
  putStrLn $ "    putThrowTell: " <> show (runExStateWriterM putThrowTell)
  putStrLn $ "    throwPutTell: " <> show (runExStateWriterM throwPutTell)
  putStrLn $ "    putTellThrow: " <> show (runExStateWriterM putTellThrow)
  putStrLn $ "    throwTellPut: " <> show (runExStateWriterM throwTellPut)
  putStrLn $ "    tellPutThrow: " <> show (runExStateWriterM tellPutThrow)
  putStrLn $ "    tellThrowPut: " <> show (runExStateWriterM tellThrowPut)
  putStrLn ""

This Gist shows the output of various monadic actions when you change the order of the monad transformers that are used. This Gist uses StateT, ExceptT, and WriterT.

Here is the output of the above code:

StateExWriterM:
  wrapped:   StateT String (ExceptT Int (WriterT Text Identity))
  unwrapped: (Either Int (Char, String), Text)
    putThrowTell: (Left 100,"")
    throwPutTell: (Left 100,"")
    putTellThrow: (Left 100,"aaa")
    throwTellPut: (Left 100,"")
    tellPutThrow: (Left 100,"aaa")
    tellThrowPut: (Left 100,"aaa")

StateWriterExM:
  wrapped:   StateT String (WriterT Text (ExceptT Int Identity))
  unwrapped: Either Int ((Char, String), Text)
    putThrowTell: Left 100
    throwPutTell: Left 100
    putTellThrow: Left 100
    throwTellPut: Left 100
    tellPutThrow: Left 100
    tellThrowPut: Left 100

WriterStateExM:
  wrapped:   WriterT Text (StateT String (ExceptT Int Identity))
  unwrapped: Either Int ((Char, Text), String)
    putThrowTell: Left 100
    throwPutTell: Left 100
    putTellThrow: Left 100
    throwTellPut: Left 100
    tellPutThrow: Left 100
    tellThrowPut: Left 100

WriterExStateM:
  wrapped:   WriterT Text (ExceptT Int (StateT String Identity))
  unwrapped: (Either Int (Char, Text), String)
    putThrowTell: (Left 100,"bar")
    throwPutTell: (Left 100,"foo")
    putTellThrow: (Left 100,"bar")
    throwTellPut: (Left 100,"foo")
    tellPutThrow: (Left 100,"bar")
    tellThrowPut: (Left 100,"foo")

ExWriterStateM:
  wrapped:   ExceptT Int (WriterT Text (StateT String Identity))
  unwrapped: ((Either Int Char, Text), String)
    putThrowTell: ((Left 100,""),"bar")
    throwPutTell: ((Left 100,""),"foo")
    putTellThrow: ((Left 100,"aaa"),"bar")
    throwTellPut: ((Left 100,""),"foo")
    tellPutThrow: ((Left 100,"aaa"),"bar")
    tellThrowPut: ((Left 100,"aaa"),"foo")

ExStateWriterM:
  wrapped:   ExceptT Int (StateT String (WriterT Text Identity))
  unwrapped: ((Either Int Char, String), Text)
    putThrowTell: ((Left 100,"bar"),"")
    throwPutTell: ((Left 100,"foo"),"")
    putTellThrow: ((Left 100,"bar"),"aaa")
    throwTellPut: ((Left 100,"foo"),"")
    tellPutThrow: ((Left 100,"bar"),"aaa")
    tellThrowPut: ((Left 100,"foo"),"aaa")