Freer play with effects
- Magnus Therning
In the previous posts on my playing with free I got stuck at combining APIs. I recalled reading a paper on extensible effects as an alternatve to monad transformers. I have to admit to not having finished the paper, and not quite understanding the part I did read. When looking it up again I found that the work had continued and that there is a paper on more extensible effects. (I got to it via http://okmij.org/ftp/Haskell/extensible/.)
A quick search of Hackage revealed the package extensible-effects with an implementation of the ideas, including the stuff in the latter paper. So, what would the examples from my previous posts look like using extensible effects?
Opening
The examples require a few extensions and modules:
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeOperators #-}
and
import Control.Eff
import Control.Eff.Lift
import Control.Eff.Operational
import Data.Typeable
Just an API
This part was greatly helped by the fact that there is a example in extensible-effects.
I start with defining the SimpleFile
API using GADTs
data SimpleFileAPI a where
LoadFile :: FilePath -> SimpleFileAPI String
SaveFile :: FilePath -> String -> SimpleFileAPI ()
The usage of the constructors need to be wrapped up in singleton
. To remember that I create two convenience functions
loadFile :: Member (Program SimpleFileAPI) r => FilePath -> Eff r String
= singleton . LoadFile
loadFile
saveFile :: Member (Program SimpleFileAPI) r => FilePath -> String -> Eff r ()
= singleton . SaveFile fp saveFile fp
For withSimpleFile
I only have to modify the type
withSimpleFile :: Member (Program SimpleFileAPI) r => (String -> String) -> FilePath -> Eff r ()
= do
withSimpleFile f fp <- loadFile fp
d let result = f d
++ "_new") result saveFile (fp
Now for the gut of it, the interpreter.
runSimpleFile :: (Member (Lift IO) r, SetMember Lift (Lift IO) r) => Eff (Program SimpleFileAPI :> r) a -> Eff r a
= runProgram f
runSimpleFile where
f :: (Member (Lift IO) r, SetMember Lift (Lift IO) r) => SimpleFileAPI a -> Eff r a
LoadFile fp) = lift $ readFile fp
f (SaveFile fp s) = lift $ writeFile fp s f (
Runnnig it is fairly simple after this
> :! cat test.txt
Lorem ipsum dolor sit amet, consectetur adipiscing elit. Donec a diam lectus.
Sed sit amet ipsum mauris. Maecenas congue ligula ac quam viverra nec
consectetur ante hendrerit.
> runLift $ runSimpleFile $ withSimpleFile (map toUpper) "test.txt"
> :! cat test.txt_new
LOREM IPSUM DOLOR SIT AMET, CONSECTETUR ADIPISCING ELIT. DONEC A DIAM LECTUS.
SED SIT AMET IPSUM MAURIS. MAECENAS CONGUE LIGULA AC QUAM VIVERRA NEC
CONSECTETUR ANTE HENDRERIT.
Now, that was pretty easy. It looks almost exactly like when using Free
, only without the Functor
instance and rather more complicated types.
Combining two APIs
Now I get to the stuff that I didn’t manage to do using Free
; combining two different APIs.
I start with defining another API. This one is truly a play example, sorry for that, but it doesn’t really matter. The type with convenience function looks like this
data StdIoAPI a where
WriteStrLn :: String -> StdIoAPI ()
writeStrLn :: Member (Program StdIoAPI) r => String -> Eff r ()
= singleton . WriteStrLn writeStrLn
The interpreter then is straight forward
runStdIo :: (Member (Lift IO) r, SetMember Lift (Lift IO) r) => Eff (Program StdIoAPI :> r) a -> Eff r a
= runProgram f
runStdIo where
f :: (Member (Lift IO) r, SetMember Lift (Lift IO) r) => StdIoAPI a -> Eff r a
WriteStrLn s) = lift $ putStrLn s f (
Now I just need a program that combines the two APIs
verboseWithSimpleFile :: (Member (Program StdIoAPI) r, Member (Program SimpleFileAPI) r) =>
String -> String) -> String -> Eff r ()
(= writeStrLn ("verboseWithSimpleFile on " ++ fp) >> withSimpleFile f fp verboseWithSimpleFile f fp
That type is surprisingly clear I find, albeit a bit on the long side. Running it is just a matter of combining runStdIo
and runSimpleFile
.
> :! cat test.txt
Lorem ipsum dolor sit amet, consectetur adipiscing elit. Donec a diam lectus.
Sed sit amet ipsum mauris. Maecenas congue ligula ac quam viverra nec
consectetur ante hendrerit.
> runLift $ runSimpleFile $ runStdIo $ verboseWithSimpleFile (map toUpper) "test.txt"
verboseWithSimpleFile on test.txt
> :! cat test.txt_new
LOREM IPSUM DOLOR SIT AMET, CONSECTETUR ADIPISCING ELIT. DONEC A DIAM LECTUS.
SED SIT AMET IPSUM MAURIS. MAECENAS CONGUE LIGULA AC QUAM VIVERRA NEC
CONSECTETUR ANTE HENDRERIT.
Oh, and it doesn’t matter in what order the interpreters are run!
At this point I got really excited about Eff
because now it’s obvious that I’ll be able to write the logging “decorator”, in fact it’s clear that it’ll be rather simple too.
The logging
As before I start with a data type and a convenience function
data LoggerAPI a where
Log :: String -> LoggerAPI ()
logStr :: Member (Program LoggerAPI) r => String -> Eff r ()
= singleton . Log logStr
For the decorating I can make use of the fact that APIs can be combined like I did above. That is, I don’t need to bother with any coproduct (Sum
) or anything like that, I can simply just push in a call to logStr
before each use of SimpleFileAPI
logSimpleFileOp :: (Member (Program SimpleFileAPI) r, Member (Program LoggerAPI) r) => SimpleFileAPI a -> Eff r a
@(LoadFile fp) = logStr ("LoadFile " ++ fp) *> singleton op
logSimpleFileOp op@(SaveFile fp _) = logStr ("SaveFile " ++ fp) *> singleton op logSimpleFileOp op
Of course an interpreter is needed as well
runLogger :: (Member (Lift IO) r, SetMember Lift (Lift IO) r) => Eff (Program LoggerAPI :> r) a -> Eff r a
= runProgram f
runLogger where
f :: (Member (Lift IO) r, SetMember Lift (Lift IO) r) => LoggerAPI a -> Eff r a
Log s) = lift $ putStrLn s f (
Running is, once again, a matter of stacking interpreters
> :! cat test.txt
Lorem ipsum dolor sit amet, consectetur adipiscing elit. Donec a diam lectus.
Sed sit amet ipsum mauris. Maecenas congue ligula ac quam viverra nec
consectetur ante hendrerit.
> runLift $ runLogger $ runSimpleFile $ runProgram logSimpleFileOp $ withSimpleFile (map toUpper) "test.txt"
LoadFile test.txt
SaveFile test.txt_new
> :! cat test.txt_new
LOREM IPSUM DOLOR SIT AMET, CONSECTETUR ADIPISCING ELIT. DONEC A DIAM LECTUS.
SED SIT AMET IPSUM MAURIS. MAECENAS CONGUE LIGULA AC QUAM VIVERRA NEC
CONSECTETUR ANTE HENDRERIT.
Closing thoughts
With Eff
I’ve pretty much arrived where I wanted, I can
- define APIs of operations in a simple way (simpler than when using
Free
even). - write a definitional interpreter for the operations.
- combine two different APIs in the same function.
- translate from one API to another (or even to a set of other APIs).
On top, I can do this without having to write a ridiculous amount of code.
I’m sure there are drawbacks as well. There’s a mention of some of them in the paper. However, for my typical uses of Haskell I haven’t read anything that would be a deal breaker.