Monad Transformers Example (using mtl)

TransformerExample.hs

{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module TransformerExample where


{-

We'll layer StateT and IO together in order to track the most recent
response received in interactive communication with the user.

This produces a stack of transformers which has IO at the base and
StateT at the top.

-}


--------------------------------------------------------------------------------

import Control.Applicative
import Control.Monad.State
import Control.Monad.Trans


-- 'App' will be our application monad which contains all of the
-- needed effects to run the whole application. We make it a newtype
-- so that we can completely hide the implementation. We use
-- GeneralizedNewtypeDeriving to drive most of the implementation to
-- the compiler. The typeclass instances like MonadState and MonadIO
-- let us access the "effect basis" of the underlying stack
-- directly. These are available in the @mtl@ package (@mtl@ exports a
-- lot of stuff from @transformers@ adding typeclass-driven machinery
-- for more generic approaches to transformers).

newtype App a =
  App { unApp :: StateT AppState IO a }
  deriving ( Functor, Applicative, Monad, MonadState AppState, MonadIO )

-- It's traditional to build a function @runX@ for a monad @X@ which
-- interprets the monad in general terms. In the case of 'App' we'll
-- run it with a default initial state and throw away that state at
-- the end (see 'evalStateT' versus 'runStateT' versus 'execStateT').

runApp :: App a -> IO a
runApp = flip evalStateT appState0 . unApp


-- Above, we built the App monad atop a notion of 'AppState'. We'll
-- track the last line received and how many have been received
-- overall.

data AppState =
  AppState
  { lastLine  :: Maybe String
  , lineCount :: Int
  }

appState0 :: AppState
appState0 = AppState { lastLine = Nothing, lineCount = 0 }

-- And now we have all the machinery we need to write our
-- application. We'll actually write it generically using the methods
-- from 'MonadState' and 'MonadIO'. It would thus work for other
-- concrete stacks than just 'App' alone, but we'll eventually run it
-- using the concrete stack inside of 'App'. To be clear, the type could be
--
--     app :: App r
--
-- but the one actually taken would be the one that GHC would infer which 
-- makes no commitment to being evaluated as 'App'.

-- runs forever, the return is thus polymorphic
app :: (MonadState AppState m, MonadIO m) => m a
app = forever $ do
  -- show a prompt
  cnt <- gets lineCount
  liftIO (putStr $ show cnt ++ ": ")

  -- ask for input
  l <- liftIO getLine

  -- echo if needed
  if l == "echo"
    then do
      st <- get -- uses @instance MonadState ApState App@

      -- 'liftIO' lets us inject an 'IO' computation into 'App',
      -- realizing that the base of 'App' /is/ 'IO'.
      liftIO $ case (lastLine st) of
        Nothing  -> putStrLn "nothing to echo"
        Just old -> do
          putStrLn "--------------"
          putStrLn $ show (lineCount st) ++ " received so far"
          putStrLn $ "last was: " ++ old
          putStrLn "--------------"
    else modify $ \st ->
      st { lastLine = Just l
         , lineCount = lineCount st + 1
         }

-- And we're done

main :: IO ()
main = runApp app