Skip to content

Instantly share code, notes, and snippets.

@sevanspowell
Created February 14, 2019 06:47
Show Gist options
  • Save sevanspowell/b6386cefa49c0d38e919b5e9bf7be583 to your computer and use it in GitHub Desktop.
Save sevanspowell/b6386cefa49c0d38e919b5e9bf7be583 to your computer and use it in GitHub Desktop.
Abstracting source of function parameters using MonadReader
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DeriveFunctor #-}
module DynamicReader where
import Control.Monad.Reader (MonadReader(ask, local), ask, ReaderT(ReaderT), runReaderT)
import Data.Time.Clock (UTCTime, getCurrentTime)
data Env = Env String
data Result = ResultGood | ResultBad
deriving Show
-- We have two different ways of getting the environment,
-- statically:
-- usesEnv :: Env -> Result
-- and dynamically:
-- usesEnv :: m Env -> m Result
-- I wanted to have a function that abstracted away the idea that
-- the Env was fetched dynamically or statically, i.e. the implementation
-- didn't care how it was fetched.
-- The following function can capture both of these functions:
usesEnv :: MonadReader Env m => m Result
usesEnv = do
env <- ask
case env of
(Env "good") -> pure $ ResultGood
_ -> pure $ ResultBad
-- To recover the static behaviour, we call the function like so:
mainStatic :: IO ()
mainStatic = do
let env = Env "good"
-- usesEnv specialises to `usesEnv :: Env -> Result` in this case, no
-- side-effects.
let result = usesEnv env
print result
-- To recover the dynamic behaviour, we have to create a MonadReader instance
-- for a type that dynamically retrieves the Env.
-- Let's call this type `DynamicReaderT`, modelled off `ReaderT`:
newtype DynamicReaderT r m a = DynamicReaderT { runDynamicReaderT :: m r -> m a }
-- ReaderT has the signature `r -> m a`.
-- DynamicReaderT is very similar, but has the signature `m r -> m a` to reflect
-- the fact that the `r` is retrieved as a monadic action.
-- We can make a MonadReader instance for DynamicReaderT:
instance Monad m => MonadReader r (DynamicReaderT r m) where
ask :: DynamicReaderT r m r
ask = DynamicReaderT $ id
local :: (r -> r) -> DynamicReaderT r m a -> DynamicReaderT r m a
local modify dyn = DynamicReaderT $ \mr ->
let
mr' = modify <$> mr
in
runDynamicReaderT dyn $ mr'
-- Which lets us recover our dynamic behaviour:
mainDynamic :: IO ()
mainDynamic = do
envAction <- cachedEnv
-- usesEnv specialises to `usesEnv :: DynamicReaderT Env IO Result`
result <- (flip runDynamicReaderT) envAction $ usesEnv
print result
-- Dummy "dynamic" action
cachedEnv :: IO (IO Env)
cachedEnv = pure . pure $ Env "good"
-- Let's verify it's correctness:
getTime :: IO (IO UTCTime)
getTime = pure $ getCurrentTime
usesTime :: MonadReader UTCTime m => m (UTCTime, UTCTime)
usesTime = do
time1 <- ask
time2 <- ask
pure (time1, time2)
mainTimeDynamic :: IO ()
mainTimeDynamic = do
timeAction <- getTime
(t1, t2) <- (flip runDynamicReaderT) timeAction $ usesTime
putStrLn $ show t1
putStrLn $ show t2
-- λ> mainTimeDynamic
-- 2019-02-14 05:21:32.90285643 UTC
-- 2019-02-14 05:21:32.90298538 UTC
-- Notice changing time.
mainTimeStatic :: IO ()
mainTimeStatic = do
time <- getCurrentTime
let (t1, t2) = usesTime time
putStrLn $ show t1
putStrLn $ show t2
-- λ> mainTimeStatic
-- 2019-02-14 06:14:23.715250967 UTC
-- 2019-02-14 06:14:23.715250967 UTC
-- Notice same time.
-- Thanks to #qfpl, it turns out that DynamicReaderT can be more easily expressed as:
newtype DReaderT r m a = DReaderT (ReaderT (m r) m a)
deriving (Functor, Applicative, Monad)
runDReaderT :: DReaderT r m a -> m r -> m a
runDReaderT (DReaderT reader) = runReaderT reader
instance Monad m => MonadReader r (DReaderT r m) where
ask :: DReaderT r m r
ask = DReaderT . ReaderT $ id
local :: (r -> r) -> DReaderT r m a -> DReaderT r m a
local modify reader = DReaderT . ReaderT $ \mr ->
let
mr' = modify <$> mr
in
runDReaderT reader mr'
mainTimeDynamic' :: IO ()
mainTimeDynamic' = do
timeAction <- getTime
(t1, t2) <- flip runDReaderT timeAction $ usesTime
putStrLn $ show t1
putStrLn $ show t2
-- λ> mainTimeDynamic'
-- 2019-02-14 06:22:12.911106505 UTC
-- 2019-02-14 06:22:12.911107567 UTC
-- Notice changing time.
-- Something to watch out for:
-- The signature of `ask` is `ask :: m r`. Nothing about this signature suggests
-- that `r` doesn't change between calls. Quite the opposite, the `m` signals that
-- the `r` might change between calls, we're operating in a monadic context after all.
-- We're taking advantage of exactly this in `usesTime` to have the time change between
-- calls to `ask` in the dynamic implementation, and not change in the static implementation.
-- However, most people don't think about this when using ask and will probably assume that
-- using `ask` twice in the body of a function returns the same result. This is true in our
-- static case, but definitely not true in our dynamic case.
-- DynamicReaderT Functor, Applicative, and Monad instances.
instance (Functor m) => Functor (DynamicReaderT r m) where
fmap :: (a -> b) -> DynamicReaderT r m a -> DynamicReaderT r m b
fmap f dyn = DynamicReaderT $ fmap f . (runDynamicReaderT dyn)
instance (Applicative m) => Applicative (DynamicReaderT r m) where
pure :: a -> DynamicReaderT r m a
pure = DynamicReaderT . const . pure
(<*>) :: DynamicReaderT r m (a -> b) -> DynamicReaderT r m a -> DynamicReaderT r m b
dynFn <*> dynA = DynamicReaderT $ \mr ->
let
mfn = (runDynamicReaderT dynFn) mr
ma = (runDynamicReaderT dynA) mr
in
mfn <*> ma
instance (Monad m) => Monad (DynamicReaderT r m) where
(>>=) :: DynamicReaderT r m a -> (a -> DynamicReaderT r m b) -> DynamicReaderT r m b
dynA >>= fn = DynamicReaderT $ \mr ->
let
ma = (runDynamicReaderT dynA) mr
fn' = flip runDynamicReaderT mr . fn
in
ma >>= fn'
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment