`mtl` style enables reinterpretation of a monad, like `free`

mtl.hs

{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE FlexibleContexts #-}

module Mtl where

import Control.Monad.State
import Control.Monad.Except

runMtl
    :: Bool
    -> (forall m. (MonadState Int m, MonadError String m) => m a)
    -> Either String Int
runMtl backtrack action
    | backtrack = runExcept (execStateT action 3)
    | otherwise = Right (execState (runExceptT action) 3) 

foobar :: (MonadState Int m, MonadError String m) => m Int
foobar = do
    x <- get
    put 5
    if x >= 3
        then throwError "x too great"
        else pure 3

-- Mtl> runMtl True foobar
-- Left "x too great"
-- Mtl> runMtl False foobar
-- Right 5

-- | AND OF COURSE...

-- | There's nothing stopping you from `Free`ing it all up anyway:

data StErrF st err next
    = GetF (st -> next)
    | PutF st next
    | ThrowF err
    deriving Functor

makeFree ''StErrF

newtype Interpret s e a = Interpret { interpret :: Free (StErrF s e) a }
    deriving (Functor, Applicative, Monad)

instance MonadState s (Interpret s e) where
    get = Interpret (liftF (GetF id))
    put = Interpret . putF

instance MonadError e (Interpret s e) where
    throwError = Interpret . throwF
    catchError (Interpret (Free (ThrowF e))) handle = handle e
    catchError k _ = k

showProgram :: (Show e, Show s, Show a) => s -> Interpret s e a -> String
showProgram s = unlines . flip evalState s . f . interpret
  where
    f (Free (GetF k)) = do
        s <- get
        ss <- f (k s)
        pure (("Getting state: " ++ show s) : ss)
    f (Free (PutF s k)) = do
        put s
        ss <- f k
        pure (("Putting: " ++ show s) : ss)
    f (Free (ThrowF err)) =
        pure ["Throwing " ++ show err]
    f (Pure a) =
        pure ["Result: " ++ show a]
        
-- *Mtl> putStrLn (showProgram 2 foobar)
-- Getting state: 2
-- Putting: 5
-- Result: 3

-- *Mtl> putStrLn (showProgram 3 foobar)
-- Getting state: 3
-- Putting: 5
-- Throwing "x too great"

reify :: (forall m . MonadState Int m, MonadError String m => m a) -> Interpret Int String a
reify = id