Skip to content

Instantly share code, notes, and snippets.

@omnibs
Created September 18, 2021 14:13
Show Gist options
  • Save omnibs/a4aba847f76fb778c23766e00a85ccae to your computer and use it in GitHub Desktop.
Save omnibs/a4aba847f76fb778c23766e00a85ccae to your computer and use it in GitHub Desktop.
ReaderT Pattern example
{-
This is a port of https://jordanmartinez.github.io/purescript-jordans-reference-site/content/21-Hello-World/05-Application-Structure/src/02-MTL/32-The-ReaderT-Capability-Design-Pattern.html
There was no simple, working example of the ReaderT pattern in Haskell
-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
import qualified Control.Monad.IO.Class as MonadIO
import qualified Control.Monad.Reader as Reader
import Prelude
-- Layer 4
newtype Name = Name String
getName :: Name -> String
getName (Name s) = s
-- Layer 3
-- Capability type classes:
class Monad m => LogToScreen m where
putLog :: String -> m ()
class Monad m => GetUserName m where
getUserName :: m Name
-- Business logic that uses these capabilities
-- which makes it easier to test
program ::
LogToScreen m =>
GetUserName m =>
m ()
program = do
putLog "What is your name?"
name <- getUserName
putLog $ "You name is " <> (getName name)
-- Layer 2 (Production)
-- Environment type
data Environment = Environment {someValue :: Int} -- mutable state, read-only values, etc. go in this record
-- newtyped ReaderT that implements the capabilities
newtype AppM a = AppM (Reader.ReaderT Environment IO a)
deriving (Functor, Applicative, Monad, MonadIO.MonadIO, Reader.MonadReader Environment)
runApp :: AppM a -> Environment -> IO a
runApp (AppM fInReaderT) env = Reader.runReaderT fInReaderT env
-- Layer 1 (the implementations of each instance)
instance LogToScreen AppM where
putLog = MonadIO.liftIO . putStrLn
instance GetUserName AppM where
getUserName = MonadIO.liftIO $ do
-- some IOful thing that produces a string
Name <$> getLine
-- Layer 0 (production)
main :: IO ()
main = do
let globalEnvironmentInfo = Environment 123
runApp program globalEnvironmentInfo
-----------------------
-- Layer 2 (test)
-- newtyped ReaderT that implements the capabilities for testing
newtype TestM a = TestM (Reader.ReaderT Environment IO a)
deriving (Functor, Applicative, Monad, MonadIO.MonadIO, Reader.MonadReader Environment)
runTest :: TestM a -> Environment -> IO a
runTest (TestM fInReaderT) env = Reader.runReaderT fInReaderT env
-- Layer 1 (test: implementations of instances)
instance LogToScreen TestM where
putLog _ = pure () -- no need to implement this
instance GetUserName TestM where
getUserName = pure (Name "John") -- general idea. Don't do this in real code.
-- Layer 0 (test)
mainTest :: IO ()
mainTest = do
let globalEnvironmentInfo = Environment 123 -- mutable state, read-only values, etc.
runTest program globalEnvironmentInfo
@m-col
Copy link

m-col commented Sep 21, 2021

Very helpful, thanks for putting this up.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment