(Or, extensible effects in under 40 lines)
ReaderT
pattern (or sometimes capability pattern, or simply Has
pattern) is perhaps one of the most representative "simple Haskell" design patterns. It is simple and understandable, they say. It is unlike those slow extensible effects toys, they say.
Well, those conclusions are mostly drawn from the following sequence of logical fallacies:
- Many extensible effects libraries are implemented with free(r) monads (True)
- Therefore extensible effects = free(r) monads (False)
- Free(r) monads require certain mathematical concepts to grasp (True)
- Free(r) monads don't have very good performance (True, to some extent)
- Therefore extensible effects are slow, ivory-towerish toys (False)
"What are extensible effects then?" I'm glad you asked. It's a pretty vague phrase, but for this blog post we'll just say:
An extensible effects library is one that has similar interfaces to the
freer-simple
library, but not necessarily the same implementation.In other words, extensible effects expresses effects as GADTs and allows you to write simple case-splitting functions as their implementations.
In this blog post I'll show how ReaderT
pattern can be simply transformed into extensible effects. First let's look at a simple program that uses ReaderT
pattern:
-- 1) Framework
type App ctx = ReaderT ctx IO
class Has e ctx where
get :: ctx -> e
-- 2) Effect
data Logging = Logging
{ _log :: String -> IO ()
}
log :: Has Logging ctx => String -> App ctx ()
log msg = do
f <- asks (_log . get)
liftIO $ f msg
-- 3) Implementation
data AppCtx = AppCtx
{ _Logging :: Logging
}
instance Has Logging AppCtx where
get = _Logging
myCtx :: AppCtx
myCtx = AppCtx
{ _Logging = Logging
{ _log = putStrLn
}
}
-- 4) Application
myApp :: Has Logging ctx => App ctx ()
myApp = do
log "Hello ReaderT pattern"
main :: IO ()
main = runReaderT myApp myCtx
In real world, the "Effect", "Implementation", and "Application" part all requires you, the end user, to write; not quite a pleasant experience.
We can quickly spot that defining Has
instances is entirely boilerplate. Any entry in the record type AppCtx
should have a Has
instance, and the definition of each get
is just their respective accessor functions.
We have a tool exactly for this scenario: extensible records. They are data structures that explicitly state what entries are in it on its type. The most famous extensible records library is vinyl
(which has a terrible API, but we won't get into that here). It looks something like this, if you haven't seen before:
data Rec (f :: k -> Type) (xs :: [k])
RNil :: Rec f '[]
(:&) :: f x -> Rec f xs -> Rec f (x ': xs) -- cons
This type means that for any x
in xs
, there is an element f x
in the record. We also have a way to express "x
is in xs
":
class Member (x :: k) (xs :: [k]) where
rget :: Rec f xs -> f x -- get an element
rset :: f x -> Rec f xs -> Rec f xs -- set an element
instance {-# OVERLAPPING #-} Member x (x ': xs) where ...
instance Member x xs => Member x (y ': xs) where ...
So we can just use an extensible record for AppCtx
, and Member
constraints in place of Has
:
-- 1) Framework
type App es = ReaderT (Rec Identity es) IO -- We use Rec here
-- Has is gone
-- 2) Effect
data Logging = Logging
{ _log :: String -> IO ()
}
log :: Member Logging es => String -> App es ()
log msg = do
f <- asks (_log . runIdentity . rget)
liftIO $ f msg
-- 3) Implementation
myCtx :: Rec Identity '[Logging]
myCtx -- Construct extensible records instead of Haskell records
= Logging
{ _log = putStrLn
}
:& RNil
-- 4) Application
myApp :: Member Logging es => App es ()
myApp = do
log "Hello Not-so-ReaderT pattern"
main :: IO ()
main = runReaderT myApp myCtx
Nice - we've eliminated the Has
boilerplate. But look at the definition of log
- it is also tedious to write. How can we make that easier?
Well, note that all effects have the form:
data E = E
{ _operationA :: A1 -> A2 -> A3 -> ... -> IO An
, _operationB :: B1 -> B2 -> B3 -> ... -> IO Bn
, ...
}
which makes it equivalent to a GADT and a handling function:
data E a where
OperationA :: A1 -> A2 -> A3 -> ... -> E An
OperationB :: B1 -> B2 -> B3 -> ... -> E Bn
type HandleE = forall a. E a -> IO a
This suggests us to define a Handler
type for all "effect GADTs":
type Effect = Type -> Type -- The kind of effect GADTs
data Handler (e :: Effect) = Handler { runHandler :: forall a. e a -> IO a }
Now we can transition away from all the records and store handlers instead in our Rec
:
type App (es :: [Effect]) = ReaderT (Rec Handler es) IO
Does this make our life easier? Yes! We can define a general "send" function that performs an operation when you pass an effect GADT in:
send :: Member e es => e a -> App es a
send e = do
handle <- asks rget
liftIO $ runHandler handle e
So back to our little application, the boilerplate of the log
function magically disappears too:
-- 1) Framework
type Effect = Type -> Type
data Handler (e :: Effect) =
Handler { runHandler :: forall a. e a -> IO a }
type App (es :: [Effect]) = ReaderT (Rec Handler es) IO
send :: Member e es => e a -> App es a
send e = do
handle <- asks rget
liftIO $ runHandler handle e
-- 2) Effect
data Logging :: Effect where
Log :: String -> Logging ()
log :: Member Logging es => String -> App es ()
log msg = send $ Log msg -- Just a simple send will do the job
-- 3) Implementation
myCtx :: Rec Identity '[Logging]
myCtx
= Handler (\case -- We now write handler functions instead of records
Log msg -> putStrLn msg)
:& RNil
-- 4) Application
myApp :: Member Logging es => App es ()
myApp = do
log "Hello Even-less-ReaderT pattern"
main :: IO ()
main = runReaderT myApp myCtx
Now one problem lefts. We do not want to define a monolithic myCtx
for all our effects - which would be really painful in large applications. Is there a way we can give implementations of effects one-by-one? Why sure! Here it is:
interpret :: (forall x. e x -> IO x) -> App (e ': es) a -> App es a
interpret f m = do
es <- ask
liftIO $ runReaderT m (Handler f :& es)
Even better, we can allow the user-supplied handler function to use other effects:
interpret :: (forall x. e x -> App es x) -> App (e ': es) a -> App es a
interpret f m = do -- ^ Changed from IO to App
es <- ask
let handler = Handler $ \e -> runReaderT (f e) es
liftIO $ runReaderT m (handler :& es)
We now have:
-- 1) Framework
type Effect = Type -> Type
data Handler (e :: Effect) =
Handler { runHandler :: forall a. e a -> IO a }
type App (es :: [Effect]) = ReaderT (Rec Handler es) IO
send :: Member e es => e a -> App es a
send e = do
handle <- asks rget
liftIO $ runHandler handle e
interpret :: (forall x. e x -> App es x) -> App (e ': es) a -> App es a
interpret f m = do
es <- ask
let handler = Handler $ \e -> runReaderT (f e) es
liftIO $ runReaderT m (handler :& es)
run :: App '[] a -> IO a -- Extract the IO after we gave all implementations
run m = runReaderT m RNil
-- 2) Effect
data Logging :: Effect where
Log :: String -> Logging ()
log :: Member Logging es => String -> App es ()
log msg = send $ Log msg
-- 3) Implementation
-- Now we can define implementations of each effect separately
runLogging :: App (Logging ': es) a -> App es a
runlogging = interpret $ \case
Log msg -> liftIO $ putStrLn msg
-- 4) Application
myApp :: Member Logging es => App es ()
myApp = do
log "Hello extensible effects?"
main :: IO ()
main = run . runLogging $ myApp -- Beautiful!
I can hear you shouting: "but users can still do IO
freely!" So let's make App
a monad that is representationally equal to ReaderT (Rec Handler es) IO
but doesn't expose MonadIO
:
data App (es :: [Effect]) a = App { unApp :: Rec Handler es -> IO a }
deriving (Functor, Applicative, Monad, MoandReader (Rec Handler es))
via (ReaderT (Rec Handler es) IO)
Then let's make IO
an effect too! Note that the kind of IO
is Type -> Type
, so IO
is really an Effect
, and we can write an interpreter for it:
unsafeLiftIO :: IO a -> App es a
unsafeLiftIO = App . const
runIO :: App '[IO] a -> IO a
runIO m = unApp (interpret unsafeLiftIO m) RNil
Everything fits together now:
-- 1) Framework
type Effect = Type -> Type
data Handler (e :: Effect) =
Handler { runHandler :: forall a. e a -> IO a }
data App (es :: [Effect]) a = App { unApp :: Rec Handler es -> IO a }
deriving (Functor, Applicative, Monad, MoandReader (Rec Handler es))
via (ReaderT (Rec Handler es) IO)
unsafeLiftIO :: IO a -> App es a -- Not to be exposed to users!
unsafeLiftIO = App . const
send :: Member e es => e a -> App es a
send e = do
handle <- asks rget
unsafeLiftIO $ runHandler handle e
interpret :: (forall x. e x -> App es x) -> App (e ': es) a -> App es a
interpret f m = do
es <- ask
let handler = Handler $ \e -> runReaderT (f e) es
unsafeLiftIO $ runReaderT m (handler :& es)
runIO :: App '[IO] a -> IO a
runIO m = unApp (interpret unsafeLiftIO m) RNil
-- 2) Effect
data Logging :: Effect where
Log :: String -> Logging ()
log :: Member Logging es => String -> App es ()
log msg = send $ Log msg
-- 3) Implementation
-- We need to use the IO effect here
runLogging :: Member IO es => App (Logging ': es) a -> App es a
runlogging = interpret $ \case
Log msg -> send $ putStrLn msg -- Use send instead of liftIO
-- 4) Application
myApp :: Member Logging es => App es ()
myApp = do
log "Hello extensible effects!"
main :: IO ()
main = runIO . runLogging $ myApp
You can view a fuller version of the code here.
# Conclusion
Writing "simple" code doesn't mean you need to scrap any framework you can use for your application and write your own ones that require even more boilerplate. Surely, you can choose not to use a framework because it's too heavy, it's slow, etc - they are valid reasons. But extensible effects really doesn't fall into that category. Using extensible effects doesn't mean you must import a ton of code that manipulates Yoneda
or Freer
internally; all it means is an interface that can make your life a bit easier.
# Addendum
# How is the overhead of the Rec
type?
Well, it is not optimal. vinyl
implemented Rec
as a list, so lookup is . A better choice is to implement Rec
as an array, which I'm planning to release a library on.
# How is the overhead of the IO
effect?
Same - not optimal. In practice you can use IO
as a "pseudo-effect"; instead of really using send
to trigger IO, you just use it as a barrier from the MonadIO
instance:
instance Member IO es => MonadIO (App es) where
liftIO = unsafeLiftIO
# With those two problems addressed, how will the performance of this be overall?
It won't be worse than using the Has
typeclass and writing those ton of boilerplates manually.