Demonstrate use of typeclasses and simple monad transformer stacks to structure haskell apps

pragmatic.hs

-- This is a small example for structuring Haskell programs so that
-- you neither have to 1) define half your program to live in IO or
-- 2) build complex Monad transformer stacks where you have to lift
-- several times to be able to do the correct operations.
-- Instead, this approach (shown to me by @am_i_tom at BusConf 2018)
-- uses type classes that define a set of operations and then define
-- a type `App a` that is a small Monad transformer stack of EitherT,
-- ReaderT and IO that implement these type classes. This allows
-- you to write functions that declare (via these type classes) which
-- capabilities they need to run. You can also easily write a different
-- implementation substituing for App for testing :)

{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Main where

import Control.Monad.Identity
import           Control.Monad.Reader
import           Control.Monad.Except
import qualified Data.Char as C
import qualified Data.List as L

-- config for the program
data Config = Config
    { makeUpperCase :: Bool
    }

-- union type enumerating the possible errors
data AppError
    = NameEmpty
    | SomeOtherError

-- first example typeclass, here doing nothing but getting
-- the config
class Monad m => MonadConfigReader m where
    getConfig :: m Config

-- second example typeclass that demonstrates a logging concern
class Monad m => MonadLogger m where
    logMessage :: String -> m ()

-- third example typeclass for asking for a name (most real world typeclasses would be
-- a bit more complex ;) )
class Monad m => MonadNameGet m where
    getName :: String -> m String


-- The App type. This is a small monad transformer stack that gives you the ExceptT
-- so you are able to handle failures; ReaderT so you have access to the config;
-- and IO so you can do everything else you need
newtype App a = App { runApp :: ExceptT AppError (ReaderT Config IO) a }
    deriving (Functor, Applicative, Monad, MonadReader Config, MonadIO, MonadError AppError)

-- Instances for the App type for the three type classes above
instance MonadConfigReader App where
    getConfig = ask

instance MonadLogger App where
    logMessage msg = liftIO (putStrLn msg)

instance MonadNameGet App where
    getName prompt = do
        liftIO $ putStrLn prompt
        name <- liftIO getLine
        if name == "" then
            throwError NameEmpty
        else
            return name

-- Function that will turn a string into upper case if the config says so. It only
-- needs the capabilities of the MonadConfigReader type class
uppercase :: MonadConfigReader m => String -> m String
uppercase text = do
    options <- getConfig
    let uppercased = if makeUpperCase options then L.map C.toUpper text else text
    return uppercased

-- Function that asks for a name. It needs the capabilities of the 
-- MonadLogger and MonadNameGet typeclass
askName :: (MonadLogger m, MonadNameGet m) => m String
askName = do
    name <- getName "Please enter your Name"
    logMessage ("The name was " ++ name)
    return name

main :: IO ()
main = do
    -- create the option type (in a real app these values would come from a file or command line args)
    let options = Config { makeUpperCase = True }

    -- run the three nested monad transformers and do the main app logic
    appResult <-
        runReaderT (runExceptT $ runApp $ do
            name <- askName
            uppercase name
        )
        options

    -- pattern match on the result and print some output
    case appResult of
        Left NameEmpty -> putStrLn "The name was empty!"
        Left SomeOtherError -> putStrLn "Some other error occured"
        Right name -> putStrLn $ "Hello " ++ name