Extensible Effects in the van Laarhoven Free Monad
Edit: you can find this code on Hackage at free-vl.
Algebraic effects seem to be a sort of holy grail in functional programming. What I mean when I say “algebraic effect” here is: treating any effect like a value or type in your program, while also having some simple operations (an algebra) to combine effects.
What does this look like practically? The two languages that come to mind are Idris and PureScript. When you program using their Effects support, you write monadic code, but essentially have a list of effects you can pull from the environment: logging, state, IO, etc. Further, you can program against a stack of effects, only assuming the ones you need are present, allowing us to arbitrarily grow that effect stack as needed. It’s very nice.
Unfortunately we don’t have access to these tools in Haskell. Instead, haskellers usually rely on mtl or Free Monads.
What I want to present today is an Effects library close to that of Idris and PureScript using the van Laarhoven encoded Free Monad armed with a Heterogeneous List (HList) of effects. I claim this has some of the benefits of Effect tooling in Idris and PureScript, the same expressiveness of regular Free Monads, a more performant encoding than Church, Fused, or Oleg encodings, and only costs us a few extensions. All in about 60 lines of code.
Motivating Example
First, an example of what we’ll end up with:
-- | we use the explicit `liftVL` combinator for illustrative purposes.
-- in real code you'd have your own combinators.
-- Make a post request
postReq :: HasEffect effects Http
=> Url
-> RequestBody
-> FreeVL effects StatusCode
postReq url body = do
resp <- liftVL (\http -> put http url body)
return (statusCode resp)
-- take any arbitrary free monad and wrap it with logging
withLog :: HasEffect effects Logging
=> String
-> String
-> FreeVL effects a
-> FreeVL effects a
withLog preMsg postMsg program = do
liftVL (\log -> infoLogger log preMsg)
a <- program
liftVL (\log -> infoLogger log postMsg)
return a
-- a concrete list of effects used to define an interpreter
type MyEffects = ( Http ': Logging ': Random ': State ': '[] )
-- an interpreter as a value
ioInterpreter :: Effects MyEffects IO
ioInterpreter = httpIO .: loggerIO .: randomIO .: stateIO .: EmptyEffect
-- actually running our program
main :: IO ()
main = interpret ioInterpreter (withLog "POST!"
"phew! made it!"
(postReq "https://weirdcanada.com" "rare=cool")
)The only part that’s missing from the above is what our effects (Http, Logger, etc.) look like. Here is an example:
-- the HTTP effect
data Http m = Http { get :: Url -> m Response
, put :: Url -> RequestBody -> m Response
-- etc.
}
-- the Logging effect
data Logging m = Logging { infoLogger :: String -> m ()
, debugLogger :: String -> m ()
-- etc.
}The rest of this post is written in literate haskell. I encourage you to cut-and-paste this code and play with it yourself! To start, let’s get some extensions and imports out of the way!
> {-# LANGUAGE DataKinds #-}
> {-# LANGUAGE FlexibleContexts #-}
> {-# LANGUAGE FlexibleInstances #-}
> {-# LANGUAGE GADTs #-}
> {-# LANGUAGE KindSignatures #-}
> {-# LANGUAGE MultiParamTypeClasses #-}
> {-# LANGUAGE PolyKinds #-}
> {-# LANGUAGE RankNTypes #-}
> {-# LANGUAGE TypeOperators #-}
>
> module Main where
>
> import Control.Arrow ((&&&))
> import Control.Concurrent (threadDelay)
> import Control.Exception (catch)
> import Control.Lens ((^.))
> import Data.ByteString.Lazy (ByteString)
> import Network.Wreq (get, post, Response, responseStatus, statusCode)
> import Network.HTTP.Client (HttpException(StatusCodeException))
> import qualified Network.HTTP.Types.Status as S
> import System.Random (randomIO)van Laarhoven Free Monad
I refer you to Russell O'Connor’s great blog post on the van Laarhoven Free Monad. It’s a short and succinct read. In some sense, the van Laarhoven Free Monad is dual to the usual one; instead of using a sum type to model operations we use a product.
Here is the usual Free Monad encoding:
> -- type aliases to make this look like real code.
> type Url = String
> type RequestBody = ByteString
>
> -- old-fashioned free monad encoding
> data Free effect a = Pure a
> | Free (effect (Free effect a))
>
> -- example http effect: using Strings to represent urls and responses for brevity
> data YeOldeHttp a = Get Url (Response ByteString -> a)
> | Post Url RequestBody (Response ByteString -> a)
>
> -- example interpreter
> freeIOInterp :: Free YeOldeHttp a -> IO a
> freeIOInterp (Pure a) = return a
> freeIOInterp (Free (Get url next)) = get url >>= freeIOInterp . next
> freeIOInterp (Free (Post url body next)) = post url body >>= freeIOInterp . next
>
> -- example combinator
> oldGet :: Url -> Free YeOldeHttp (Response ByteString)
> oldGet url = Free (Get url Pure)Given an effect, which is itself a sum-type (each branch a different operation (e.g. Get, Put)) we can show that Free YeOldHttp a is a monad (see Gabriel’s blog post for more) and write interpreters against it, supplying it with the right semantics. The great part about Free Monads is that we can write different interpreters, each for their own specific use (testing, production, debugging, etc.).
Now, the van Laarhoven Free Monad is a different encoding, and requires you to represent effects as products instead of sums. The above example is equivalent to:
> -- (simple) van Laarhoven Free Monad encoding
> newtype FreeVL1 effect a =
> FreeVL1 { runFreeVL1 :: forall m. Monad m => effect m -> m a }
>
> -- example Http effect
> data NewHttp m =
> NewHttp { getNewHttp :: Url -> m (Response ByteString)
> , postNewHttp :: Url -> RequestBody -> m (Response ByteString)
> }
>
> -- example interpreter
> newHttpIO :: NewHttp IO
> newHttpIO = NewHttp { getNewHttp = get, postNewHttp = post }
>
> freeVL1IOInterpreter :: FreeVL1 NewHttp a -> IO a
> freeVL1IOInterpreter program = runFreeVL1 program newHttpIO
>
> -- example combinator
> newGet :: Url -> FreeVL1 NewHttp (Response ByteString)
> newGet url = FreeVL1 (\httpEffects -> getNewHttp httpEffects url)The nice thing about FreeVL1 is it’s just a function. To interpret a program written in FreeVL1 NewHttp a requires us only to provide a value of type NewHttp m as demonstrated above. This means that writing programs against FreeVL1 NewHttp a will have the same runtime cost as function composition or the Reader monad. Contrast this to the regular encoding of Free which performs horrendously under binds (it’s basically a fancy linked list of operations). We can use the Church-encoding to improve this substantially, but it has other trade offs as well.
Now, the downside of the simple van Laarhoven encoding is that we only have one effect at a time. Let’s see how we can improve that!
The van Laarhoven Free Monad With Arbitrary Effect Stacks
Our motivation now is to create new effects (for example, instead of just Http perhaps we want logging, random numbers, etc.) and combine them. One way of doing this in the traditional Free Monad encoding is to use co-products (see blog post here). Since each effect is a Functor, and Co-Products of Functors is still a Functor, this is technically possible. However, it makes pulling effects out of the stack and writing and combining interpreters finnicky.
In the van Laarhoven encoding, our effect is already a product type. What we want is to be able to add more “fields” to our effect. For example, if we could add the field log :: String -> m (), that would be almost like adding a logger to our effect stack!
An equivalent way of adding fields would be to create a Heterogeneous list of effects! If instead of “multiplying” our effect products we appended them to a heterogeneous list, then we’ve got a way to add more effects that is isomorphic to adding more fields.
Let us design such an HList and show how this empowers us to extend the previous van Laarhoven encoding!
> -- | our HList of effects
> -- note that as per the van Laarhoven encoding, our effects are parameterized
> -- by a monad m.
> data EffectStack a (m :: * -> *) where
> EmptyEffect :: EffectStack '[] m
> ConsEffect :: effect m -> EffectStack effects m -> EffectStack (effect ': effects) mEffectStack now contains an arbitrary list of effects, each one paramaterized by m. We are now ready to define the stack-driven van Laarhoven Free Monad:
> -- van Laarhoven Free Monad with Effect Stacks encoding
> newtype FreeVL effects a =
> FreeVL { runFreeVL :: forall m. Monad m => EffectStack effects m -> m a }
>
> -- Yes, it is a monad
> instance Functor (FreeVL effects) where
> fmap f (FreeVL run) = FreeVL (fmap f . run)
>
> instance Applicative (FreeVL effects) where
> pure a = FreeVL (const (pure a))
> (FreeVL fab) (FreeVL a) =
> FreeVL $ uncurry () . (fab &&& a)
>
> instance Monad (FreeVL effects) where
> (FreeVL run) >>= f =
> FreeVL $ \effects -> run effects >>= \a -> runFreeVL (f a) effectsAs with the previous van Laarhoven encoding, interpreters are simple functions:
> -- interpret a van Laarhoven Free Monad with Effect Stacks
> interperet :: Monad m
> => EffectStack effects m
> -> FreeVL effects a
> -> m a
> interperet interpreter program = runFreeVL program interpreterUnfortunately we are not quite ready to write programs in our new fancy Free Monad. We need to construct programs with arbitrary effect stacks, and for that, we need a way to pull an effect from EffectStack and use it.
To achieve this I borrowed a trick from Julian Arni of haskell-servant (you can see his code here). Essentially, we create a typeclass capable of crawling the HList in EffectStack and search for the effect we want, and then return it.
> -- define a type class that will only compile if a certain effect is
> -- present in the stack, and if it is present, return it.
> class HasEffect (effects :: [((* -> *) -> *)]) (effect :: ((* -> *) -> *)) where
> getEffect :: EffectStack effects m -> effect m
>
> -- Let's provide some instances of `HasEffect` that can crawl EffectStack looking
> -- for an effect that matches and then return it.
>
> -- this first instances handles the case where our effect type doesn't match the
> -- head of the HList and recurses further.
> instance {-# OVERLAPPABLE #-}
> HasEffect effects effect => HasEffect (notIt ': effects) effect where
> getEffect (ConsEffect _ effects) = getEffect effects
>
> -- this instance matches the case where our 'effect' type matches the head
> -- of the HList. we then return that effect.
> instance {-# OVERLAPPABLE #-}
> HasEffect (effect ': effects) effect where
> getEffect (ConsEffect effect _) = effectThose typeclasses will likely bend your mind a little (they most certainly bent mine), but if you write it our yourself (which I encourage you to do) you kind of get the hang of it. (PS - I’m forever grateful to Julian for this idea because it’s so handy!)
Now that we have tooling to pick our effects, we can start writing combinators that will allow us to write programs against an arbitrary effect stack.
> -- lift operations into the van Laarhoven Free Monad
> liftVL :: HasEffect effects effect
> -- ^ constraint enforcing that our effect is in the effect stack
> => (forall m. effect m -> m a)
> -- ^ method to pull our operation from our effect.
> -> FreeVL effects a
> liftVL getOp = FreeVL (\effects -> getOp (getEffect effects))Programs in the VL Free Monad with Effects Stack
Let’s write some user code. We’ll start by defining three effects:
> -- HTTP Effect
> data Http m =
> Http { getHttpEff :: Url -> m (Either Int (Response ByteString))
> , postHttpEff :: Url -> RequestBody -> m (Either Int (Response ByteString))
> }
>
> -- Logging Effect
> data Logging m = Logging { logEff :: String -> m () }
>
> -- random number effect
> data Random m = Random { getRandEff :: m Int }
>
> -- suspend effect
> data Suspend m = Suspend { suspendEff :: Int -> m () }Now for some code. Let’s write combinators for each operator in each effect.
> getHttp :: HasEffect effects Http
> => Url
> -> FreeVL effects (Either Int (Response ByteString))
> getHttp url = liftVL (`getHttpEff` url)
>
> postHttp :: HasEffect effects Http
> => Url
> -> RequestBody
> -> FreeVL effects (Either Int (Response ByteString))
> postHttp url body = liftVL (\http -> postHttpEff http url body)
>
> logMsg :: HasEffect effects Logging
> => String
> -> FreeVL effects ()
> logMsg msg = liftVL (`logEff` msg)
>
> getRand :: HasEffect effects Random
> => FreeVL effects Int
> getRand = liftVL getRandEff
>
> suspend :: HasEffect effects Suspend
> => Int
> -> FreeVL effects ()
> suspend i = liftVL (`suspendEff` i)With these combinators we can write programs! Let’s write a program that makes a web-request and if it fails, suspends for 100ms and retries. It will retry a random number of times.
> repeatReq :: ( HasEffect effects Http
> , HasEffect effects Random
> , HasEffect effects Suspend
> )
> => Url
> -> FreeVL effects (Either Int (Response ByteString))
> repeatReq url = do
> numRetries <- (flip mod 10) getRand
> eResponse <- getHttp url
> go numRetries eResponse
> where
> go 0 r = return r
> go i _ = do
> eResponse <- getHttp url
> case eResponse of
> r@(Right _) -> return r
> l@(Left _) -> suspend 100 >> go (i-1) eResponseNow, let’s write a combinator that will add logging to any program!
> withLog :: HasEffect effects Logging
> => String
> -> String
> -> FreeVL effects a
> -> FreeVL effects a
> withLog preMsg postMsg program = do
> logMsg preMsg
> a <- program
> logMsg postMsg
> return aAnd finally, let me show you that we can combine arbitrary programs and effect stacks by wrapping our previous repeatReq code with logging and supplying a url.
> -- let's combine some programs
> program :: ( HasEffect effects Http
> , HasEffect effects Random
> , HasEffect effects Suspend
> , HasEffect effects Logging
> )
> => FreeVL effects (Either Int (Response ByteString))
> program = withLog "running request!" "done!" (repeatReq "http://aaronlevin.ca")Note that if you remove one of those constraints (like Suspend for example), you will get a compile error:
01.lhs:313:49:
Could not deduce (HasEffect effects Suspend)
arising from a use of ‘repeatReq’
from the context (HasEffect effects Http,
HasEffect effects Random,
HasEffect effects Logging)
bound by the type signature for
program :: (HasEffect effects Http, HasEffect effects Random,
HasEffect effects Logging) =>
FreeVL effects (Maybe (Response ByteString))
at 01.lhs:(308,14)-(312,57)
In the third argument of ‘withLog’, namely
‘(repeatReq "http://aaronlevin.ca")’
In the expression:
withLog
"running request!" "done!" (repeatReq "http://aaronlevin.ca")
In an equation for ‘program’:
program
= withLog
"running request!" "done!" (repeatReq "http://aaronlevin.ca")Interpreters in the van Laarhoven Free Monad with Arbitrary Effects Stack
Now that we’ve written some programs, we need to supply some interpreters. We’ll supply the main interpreter in IO and leave it as an exercise to the reader to create a pure one.
Recall that an interpreter in the van Laarhoven Free Monad is just a value of type effect m. Similarly, in the effect stack version, it’s a value of type EffectStack effects m, which is just an HList of our effects.
> -- a combinator to make creating HLists syntactically nicer.
> (.:.) :: effect m -> EffectStack effects m -> EffectStack (effect ': effects) m
> effect .:. effects = ConsEffect effect effects
> infixr 4 .:.
>
> -- interpret http actions in IO
> handleExcep :: HttpException -> Either Int a
> handleExcep (StatusCodeException status _ _) = Left (S.statusCode status)
> handleExcep _ = error "unhandled HttpException"
>
> httpIO :: Http IO
> httpIO =
> Http { getHttpEff = \req -> (Right get req) `catch` (return . handleExcep)
> , postHttpEff = \req body -> (Right post req body) `catch` (return . handleExcep)
> }
>
> -- interpret logging actions in IO
> logIO :: Logging IO
> logIO = Logging { logEff = putStrLn }
>
> -- random number generator in IO
> randIO :: Random IO
> randIO = Random { getRandEff = randomIO }
>
> -- suspend in IO
> suspendIO :: Suspend IO
> suspendIO = Suspend { suspendEff = threadDelay }
>
> -- our effect stack
> type MyEffects = ( Http ': Logging ': Random ': Suspend ': '[] )
>
> -- our interpreter
> ioInterpreter :: EffectStack MyEffects IO
> ioInterpreter = httpIO .:. logIO .:. randIO .:. suspendIO .:. EmptyEffectNow that we have an interpreter, we can run our program!
> main :: IO ()
> main = interperet ioInterpreter program >> putStrLn "exit!"Conclusion
Hopefully by now you’ve been convinced that we’ve achieved our goal: we can program against effects in Haskell just like our comrades programming with Idris and PureScript (I say this fully tongue-in-cheek). Further, we can provide arbitrary effect stacks and combine interpreters in whatever way we want (so long as they share the same monad).
While this is all very exciting, there is still some work to do:
put this in a library on Hackagesee free-vl- our
EffectStackshould obey some laws, but which ones? - start creating an ecosystem of effects and interpreters!
- How to store pure state when combining interpreters
- investigate program analysis. The van Laarhoven Free Monad is just a function, but can we supply it with an effect stack built for program or static analysis?
franciskim-co liked this liamgoodacre liked this
noah-luck-easterly liked this
oceanofantics liked this
aaronmblevin posted this
© 2014–2018 - aaron levin
