Freer play with effects

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

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?


The examples require a few extensions and modules:

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeOperators #-}


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
loadFile = singleton . LoadFile

saveFile :: Member (Program SimpleFileAPI) r => FilePath -> String -> Eff r ()
saveFile fp = singleton . SaveFile fp

For withSimpleFile I only have to modify the type

withSimpleFile :: Member (Program SimpleFileAPI) r => (String -> String) -> FilePath -> Eff r ()
withSimpleFile f fp = do
  d <- loadFile fp
  let result = f d
  saveFile (fp ++ "_new") result

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
runSimpleFile = runProgram f
    f :: (Member (Lift IO) r, SetMember Lift (Lift IO) r) => SimpleFileAPI a -> Eff r a
    f (LoadFile fp) = lift $ readFile fp
    f (SaveFile fp s) = lift $ writeFile fp s

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 

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 ()
writeStrLn = singleton . 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
runStdIo = runProgram f
    f :: (Member (Lift IO) r, SetMember Lift (Lift IO) r) => StdIoAPI a -> Eff r a
    f (WriteStrLn s) = lift $ putStrLn s

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 ()
verboseWithSimpleFile f fp = writeStrLn ("verboseWithSimpleFile on " ++ fp) >> withSimpleFile 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 

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 ()
logStr = singleton . Log

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
logSimpleFileOp op@(LoadFile fp) = logStr ("LoadFile " ++ fp) *> singleton op
logSimpleFileOp op@(SaveFile fp _) = logStr ("SaveFile " ++ fp) *> singleton 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
runLogger = runProgram f
    f :: (Member (Lift IO) r, SetMember Lift (Lift IO) r) => LoggerAPI a -> Eff r a
    f (Log s) = lift $ putStrLn s

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 

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.

Free play, part three

The code in the previous post can do with a bit of cleaning up. I start with introducing a type class for an API that can be run

class RunnableF f where
  runOp :: f a -> IO a

and a function that actually runs iteFile

runF :: (RunnableF o) => Free o a -> IO a
runF = foldFree runOp

A coproduct (Sum) of two runnable APIs can itself be runnable

instance (RunnableF f, RunnableF g) => RunnableF (Sum f g) where
  runOp (InL op) = runOp op
  runOp (InR op) = runOp op

After this all I have to do is to move the guts of runSimpleF and runLogging into implementations for SimpleFil and LogF respectively

instance RunnableF SimpleFileF where
  runOp (LoadFile fp f') = liftM f' $ readFile fp
  runOp (SaveFile fp d r) = writeFile fp d >> return r

instance RunnableF LogF where
  runOp (Log s a)= putStrLn s >> return a

The rest is left as is. Running now looks like 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.
> runF $ withSimpleFile (map toUpper) "test.txt"
> :! cat test.txt_new
> runF $ foldFree loggingSimpleFileI $ withSimpleFile (map toLower) "test.txt"
** load file test.txt
** save file 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.

What else?

With these changes it becomes slightly esier to create new basic API types. but there are still a few things I think could be useful:

  • More generic decorators. logSimpleFileI is tied to decorating only SimpleFileF. I’m fairly sure this could be dealt with by a type class LoggableF and have APIs implement it. I also think there’s a rather natural implementation of LoggableF for Sum f g.
  • Combining decorators (and other interpreters). I’m guessing this is what John refers to as “generalizing interpreters.”
  • Combining APIs. I’d prefer making small APIs of related operations, but then that also means I need a nice way of combining APIs. I had a go at using FreeT but simply gave up on bending the types to my will. In any case I’m not completely sure that a stack of various FreeT is a good direction to go.

Free play, part two

This post on Free play builds on my previous one. It was John A De Goes’ post that finally got me started on playing with Free and his post contian the following:

Moreover, not only do algebras compose (that is, if you have algebras f and g, you can compose them into a composite algebra Coproduct f g for some suitable definition of Coproduct), but interpreters also compose — both horizontally and vertically.

And a little bit later he offers a few types and some details, but not all details. How could something like that look in Haskell?

Starting from the code in the previous post I first created a new type for a logging action

data LogF a = Log String a

This type has to be a Functor

instance Functor LogF where
  fmap f (Log s a) = Log s (f a)

The logging should basically decorate a SimpleFileF a action, so I need a function to map one into a Free LogF a

logSimpleFileI :: SimpleFileF a -> Free LogF ()
logSimpleFileI (LoadFile fp _) = liftF $ Log ("** load file " ++ fp) ()
logSimpleFileI (SaveFile fp _ _) = liftF $ Log ("** save file " ++ fp) ()

Now I needed a Coproduct for Functor. Searching hackage only offered up one for Monoid (in monoid-extras) so I first translated one from PureScript, but later I got some help via Twitter and was pointed to two in Haskell, Data.Functor.Coproduct from comonad and Data.Functor.Sum from transformers, I decided on the one from transformers because of its shorter name and the fact that it was very different from my translated-from-PureScript version.

Following John’s example I use Applicative to combine the logging with the file action

loggingSimpleFileI :: SimpleFileF a -> Free (Sum LogF SimpleFileF) a
loggingSimpleFileI op = toLeft (logSimpleFileI op) *> toRight (liftF op)

with toLeft and toRight defined like this

toLeft :: (Functor f, Functor g) => Free f a -> Free (Sum f g) a
toLeft = hoistFree InL
toRight :: (Functor f, Functor g) => Free g a -> Free (Sum f g) a
toRight = hoistFree InR

With all of this in place I can decorate the program from the last post like this foldFree loggingSimpleFileI (withSimpleF toUpper "FreePlay.hs"). What’s left is a way to run it. The function for that is a natural extension of runsimpleFile

runLogging :: Free (Sum LogF SimpleFileF) a -> IO a
runLogging = foldFree f
    f :: (Sum LogF SimpleFileF) a -> IO a
    f (InL op) = g op
    f (InR op) = h op

    g :: LogF a -> IO a
    g (Log s a)= putStrLn s >> return a

    h :: SimpleFileF a -> IO a
    h (LoadFile fp f') = liftM f' $ readFile fp
    h (SaveFile fp d r) = writeFile fp d >> return r

Running the decorated program

runLogging $ foldFree loggingSimpleFileI (withSimpleF toUpper "FreePlay.hs")

does indeed result in the expected output

** load file FreePlay.hs
** save file FreePlay.hs_new

and the file FreePlay.hs_new contains only uppercase letters.

My thoughts

This ability to decorate actions (or compose algebras) is very nice. There’s probably value in the “multiple interpreters for a program” in some domains, but I have a feeling that it could be a hard sell. However, combining it with this kind of composability adds quite a bit of value in my opinion. I must say I don’t think my code scales very well for adding more decorators (composing more algebras), but hopefully some type wizard can show me a way to improve on that.

The code above is rather crude though, and I have another version that cleans it up quite a bit. That’ll be in the next post.

Free play, part one

When I read John A De Goes post A Modern Architecture for FP I found it to be a bit too vague for me, but the topic was just interesting enough to finally push me to play a little with free monads. It’s not the first post I’ve read on the topic, there have been many before. None have quite managed to push me into actually doing something though!

A file API

To make it concrete but still short enough to not bore readers I came up with a small API for working with files:

data SimpleFileF a =
  LoadFile FilePath (String -> a)
  | SaveFile FilePath String a

The free monad wraps a functor, so here’s an implementation of that

instance Functor SimpleFileF where
  fmap f (LoadFile fp f')= LoadFile fp (f . f')
  fmap f (SaveFile fp d a) = SaveFile fp d (f a)

Now for some convenient functions to work with the API type

loadFile :: FilePath -> Free SimpleFileF String
loadFile fp = liftF $ LoadFile fp id

saveFile :: FilePath -> String -> Free SimpleFileF ()
saveFile fp d = liftF $ SaveFile fp d ()

With this in place I can write a somewhat more complex one

withSimpleFile :: (String -> String) -> FilePath -> Free SimpleFileF ()
withSimpleFile f fp = do
  d <- loadFile fp
  let result = f d
  saveFile (fp ++ "_new") result

Now I need a way to run programs using the API

runSimpleFile :: Free SimpleFileF a -> IO a
runSimpleFile = foldFree f
    f (LoadFile fp f') = liftM f' $ readFile fp
    f (SaveFile fp d r) = writeFile fp d >> return r

If this code was save in the file FreePlay.hs I can now convert it all to upper case by using

runSimpleFile $ withSimpleFile toUpper "FreePlay.hs"

which of course will create the file FreePlay.hs_new.

What have I bought so far?

Well, not much really.

So far it’s not much more than a rather roundabout way to limit what IO actions are available. In other words it’s not much more than what can be done by creating a limited IO, as in my earlier posts here and here.

Of course it would be possible to write another run function, e.g. one that doesn’t actually perform the file actions but just says what it would do. The nice thing though is, to use that same metaphor as John does, that I can add a layer to the onion. In other words, I can decorate each use of my SimpleFileF API with some other API. I think it was John’s description of this layering that pushed me to play with Free.

Trick for pre-processing source in CMake

When using <LANG>_COMPILER_LAUCHER or RULE_LAUNCH_COMPILER the following is a nice little pattern to deal with the arguments.

#! /usr/bin/python3

import argparse
import subprocess
import sys

# create an argumentparser for the stuff the launcher script needs, some
# specific to it and some of the compiler arguments
parser = argparse.ArgumentParser(description='Compiler launcher for C.')
parser.add_argument('--flag-for-wrapper', type=str)
parser.add_argument('-I', dest='includes', action='append', type=str, default=[])
parser.add_argument('-D', dest='defines', action='append', type=str, default=[])
parser.add_argument('-o', dest='output', type=str)
parser.add_argument('-c', dest='input', type=str)

args, rest = parser.parse_known_args(sys.argv)

# do stuff with the source, e.g. pass it through the C pre-processor (using the
# arguments picked out above) and then process the output

# build another argument parser to prepare the call to the compiler
cc_parser = argparse.ArgumentParser(description='Parser for removing launcher-specific arguments.')
cc_parser.add_argument('--flag-for-wrapper', type=str)
cc_cmd = cc_parser.parse_known_args(sys.argv)[1][1:]

That is, first create a parser for launcher-specific arguments and the compiler arguments1 that are of interest to the launcher. Then perform the magic of the launcher. Finally, create another parser and use it to remove the launcher-specific arguments and use the remainder to perform the compilation.

  1. Here I’m relying on CMake always putting -c just before the source file, which seems to hold most of the time.

Elm 0.16 with stack

I just noticed that there’s been a new release of the elm tools. The previous release was fairly easy to build using stack, but this release made it a little bit easier still.

The script for cloning should be modified to look like this:

#! /usr/bin/zsh

repos=("git clone -b 0.16"
       "git clone -b 0.16"
       "git clone -b 0.16"
       "git clone -b 0.16"
       "git clone -b 0.16"

for r in ${repos[@]}; do
    eval ${r}

When creating the inital stack.yaml tell stack to use release 7.10.2 of ghc:

% stack init --resolver ghc-7.10.2

That makes it possible to use the installed version of ghc. It’s also unecessary to provide any flag for aeson, which means there’s no need for any manual changed to stack.yaml prior to running (add --install-ghc if you don’t have it on your system already)

% stack solver --modify-stack-yaml

Now just build and install as before:

% stack install elm-{compiler,make,package,repl}
% stack install elm-reactor

That’s it!

How can I unit test failure cases?

When writing unit tests, especially when using mock objects, there’s always a risk of falling into the trap of writing tests for the implementation rather than for the API. In my experience the most obvious indication of that is that any refactoring of the code requires major rework of the tests.

Right now I’m sitting with the task of writing tests for a function that promises to return NULL on failure. The function in question allocates memory up to three times, opens two message queues, sends a message on one and expects a reponse on the other. If all goes well it returns the pointer to one of the memory areas allocated. And if it fails, for whatever reason, it returns NULL.

Is it even possible to write a set of tests for it without testing the specific implementation?

I know some of the calls can be re-arranged, e.g. moving all memory allocation to the start of the function, without affecting the caller of the function. However, if I use mock objects to simulate failure in the external libraries and system calls I’d be forced to modify the tests on each such re-arranging of calls. In other words I’m testing the implementation!

Should I think differently about testing failure cases?

Should the API be changed in some way to make unit tests a better fit for testing failures?

Docker container with ip address on local network, p2

In my latest post I described described a way to give a docker container an address on the local network. That’s a general way of achieving it, but it’s also rather complicated. If you know exactly what ports need to be exposed there is a simpler way.

Add a second IP to the system interface

There’s a good description on how to give an interface multiple in Debian at the Debian Wiki. The completely manual way is

ip addr add dev eth0 label eth0:0

The configuration in Debian is

auto eth0:0
iface eth0:0 inet static

If you’re using Systemd it seems to be enough to just add extra Address=... statements to the .network file:



Bind ports of the container to a specific IP

Using the image from my latest post it’s just to run it using the --publish option:

docker --rm --interactive --tty --name=echo --publish= nw /home/myusre/echosrv

Just like the last time it’s easy to verify everything’s working using netcat.

Docker container with ip address on local network

Shortly after I started my new job in August I put an instance of gitlab on a server and started promoting using it over the git-repos-on-an-NFS-share that had been used thus far. Thanks to the Docker image of Gitlab CE it only took about 5 minutes to have a running instance – setting up authentication via LDAP only took slightly longer. So far I’ve been running it on non-standard ports, just like the guide suggests, but I’ve gotten to the point where I’d like to make it a bit more official. That means I’d like to get it off non-standard ports, but I do really like running it in Docker. In short, I need to give the Docker image an ip address on the local network.

Unfortunately Docker doesn’t make it easy to do that, but I found an article on four ways to connect a docker container to a local network. What follows is my take on the instruction for how to use a macvlan device to achieve it.

An image for testing

First I looked around for a simple echo server to run in my testing image:

module Main

import Control.Concurrent
import Control.Monad
import Network.Socket
import System.IO

srvPort :: PortNumber
srvPort = 2048

main :: IO ()
main = withSocketsDo $ do
  newSocket <- socket AF_INET Stream defaultProtocol
  setSocketOption newSocket ReuseAddr 1
  bindSocket newSocket $ SockAddrInet srvPort iNADDR_ANY
  listen newSocket 2
  runServer echo newSocket

runServer :: (String -> String) -> Socket -> IO()
runServer f s = forever $ do
  (usableSocket,_) <- accept s
  forkIO $ interactWithSocket f usableSocket

interactWithSocket :: (String -> String) -> Socket -> IO()
interactWithSocket f s = do
  handle <- socketToHandle s ReadWriteMode
  forever $ f <$> hGetLine handle >>= hPutStrLn handle

echo :: String -> String
echo = ("R: " ++)

Run it and test it by pointing netcat to port 2048.

Once that was built I put together a Dockerfile that uses Debian Jessie as a base and copies in the echo server (I based it on another image):

FROM debian:8.2
MAINTAINER Magnus Therning <>

RUN TERM=vt220 apt-get update && \
    TERM=vt220 DEBIAN_FRONTEND=noninteractive apt-get -y install \
        apt-utils \
        dialog \
        libgmp10 \
    && true

RUN useradd -G users -m -s /bin/bash myuser && \
    echo "root:root" | chpasswd

USER myuser
COPY echosrv /home/myuser/
CMD bash --login

I popped the Dockerfile and the binary into a folder srv/ so I can build the image using

$ docker build --rm --tag=nw srv

and then started using

$ docker run --rm --interactive --tty --name=echo nw /home/myuser/echosrv

A handy alias

The following alias will turn out to be very handy indeed

$ alias docker-pid="docker inspect --format '{{ .State.Pid }}'"

The network setup

The local network is and I found an unused address, that I decided to use for my experiment. The gateway is on

First create the macvlan device:

$ sudo ip link add mybridge link enp0s25 type macvlan mode bridge

Then put it into the network namespace of the running container, and bring it up:

$ sudo ip link set netns $(docker-pid echo) mybridge
$ sudo nsenter -t $(docker-pid echo) -n ip link set mybridge up

Now the device need its address and the routing has to be set up:

$ sudo nsenter -t $(docker-pid echo) -n ip route del default
$ sudo nsenter -t $(docker-pid echo) -n ip addr add dev mybridge
$ sudo nsenter -t $(docker-pid echo) -n ip route add default via dev mybridge

That’s it, now the docker container is reachable on Well, it’s reachable on that ip from any computer on the network except for the host. In order for the host to be able to reach it add another route:

$ sudo ip route add dev docker0


If you’d rather have the container on an ip handed out by a DHCP server, then you replace the three commands for setting ip and route with:

$ sudo nsenter -t $(docker-pid echo) -n -- dhclient -d maclan

Building elm with stack

Building elm is a slightly invasive procedure if your distro doesn’t have any pre-built packages for it and has a non-ancient version of ghc. Removing all haskell packages and installing HaskellPlatform didn’t really appeal to me. Then it occured to me that stack ought to be perfectly suited for this task. It took me a while to sort it out, but here’s how I got a working build of the elm tools installed on Archlinux.

Installing stack and cabal

Add the ArchHaskell repo by following the instructions on the wiki. Then install the haskell-stack-bin package. For stack to work fully one also needs the libtinfo package from AUR.

If you aren’t using Archlinux there are instructions on the stack page.

Now build cabal-install using stack:

% stack --install-ghc install cabal-install

After this make sure ~/.local/bin is in your $PATH.

Cloning the elm tool repos

The elm developers have decided to not use Hackage so to get the tools one has to clone the repos from GitHub. I used the following shell script to get them all cloned in one go:

#! /usr/bin/zsh

repos=("git clone -b 0.15.1"
       "git clone -b 0.5.1"
       "git clone -b 0.2"
       "git clone -b 0.3.2"
       "git clone -b 0.4.2"

for r in ${repos[@]}; do
    eval ${r}

Creating stack.yaml

To create the initial stack.yalm run

% stack init --resolver ghc-7.8.4

Now open it and make a couple of modifications. First add the line

system-ghc: false

This is to make sure stack won’t try to use any ghc version already installed on the system. Then add a flag for aeson:

    old-locale: true

Now use stack to create the full stack.yaml:

% stack --install-ghc solver --modify-stack-yaml

Patch elm-reactor

In order to build elm-reactor it first needs a tiny patch:

diff --git a/backend/Socket.hs b/backend/Socket.hs
index b80a98f..69fe488 100644
--- a/backend/Socket.hs
+++ b/backend/Socket.hs
@@ -18,7 +18,7 @@ fileChangeApp :: FilePath -> WS.ServerApp
 fileChangeApp watchedFile pendingConnection =
   do  connection <- WS.acceptRequest pendingConnection
       Notify.withManager $ \notifyManager ->
-        do  _ <- NDevel.treeExtExists notifyManager "." "elm" (sendHotSwap watchedFile connection)
+        do  _ <- NDevel.treeExtExists notifyManager "." "elm" (sendHotSwap watchedFile connection . FP.decodeString)
             keepAlive connection

Building the tools

Now build the elm tools (it’s important that elm-reactor is built after elm-make):

% stack install elm-{compiler,make,package,repl}
% stack install elm-reactor

Now just sit back and wait for the building to finish.

Verify that it works

Follow the instructions for running example 1 of the elm architecture tutorial. I had to use the following two commands to get it running properly:

% elm make
% elm reactor

Then I can point my browser at http://localhost:8000/Main.elm?debug and play with the counter.