Logging using the free monad

Question

This question is related to this article

The idea is to define a DSL for manipulating files in the cloud, and define a composition of interpreters that take care of the different aspects, such as communication with the REST interface and logging.

To make this more concrete, assume we have the following data structure that defines the terms of the DSL.

data CloudFilesF a
= SaveFile Path Bytes a
| ListFiles Path ([Path] -> a)
deriving Functor

We define functions to build CloudFiles programs as follows:

saveFile :: Path -> Bytes -> Free CloudFilesF ()
saveFile path bytes = liftF $ SaveFile path bytes ()

listFiles :: Path -> Free CloudFilesF [Path]
listFiles path = liftF $ ListFiles path id

Then the idea is to interpret this in terms of two other DSL's:

data RestF a = Get Path (Bytes -> a)
         | Put Path Bytes (Bytes -> a)
         deriving Functor

data Level = Debug | Info | Warning | Error deriving Show
data LogF a = Log Level String a deriving Functor

I managed to define a natural transformation from the CloudFiles DSL to the REST DSL with the following type:

interpretCloudWithRest :: CloudFilesF a -> Free RestF a

Then given a program of the form:

sampleCloudFilesProgram :: Free CloudFilesF ()
sampleCloudFilesProgram = do
  saveFile "/myfolder/pepino" "verde"
  saveFile "/myfolder/tomate" "rojo"
  _ <- listFiles "/myfolder"
  return ()

It is possible to interpret the program using REST calls as follows:

runSampleCloudProgram =
  interpretRest $ foldFree interpretCloudWithRest sampleCloudFilesProgram

The problem comes when trying to define an interpretation of the DSL using logging. In the article I referred above, the author defines an interpreter with type:

logCloudFilesI :: forall a. CloudFilesF a -> Free LogF ()

and we define an interpreter for Free LogF a having type:

interpretLog :: Free LogF a -> IO ()

The problem is that this interpreter cannot be used in combination with foldFree as I did above. So the question is how to interpret a program in Free CloudFilesF a using the function logCloudfilesI and interpretLog defined above? Basically, I'm looking to construct a function with type:

interpretDSLWithLog :: Free ClouldFilesF a -> IO ()

I can do this with the REST DSL, but I cannot do it usng logCloudfilesI.

What is the approach taken when using free monads in these situations? Note that the problem seems to be the fact that for the logging case, there is no meaningful value we can supply to the function in ListFiles to build the continuation of the program. In a second article the author uses Halt, however, this does not work in my current implementation.

Answer 1

Logging is a classic use-case for the decorator pattern.

The trick is to interpret the program in a context which has access to both the logging effects and some base effect. The instructions in such a monad would either be logging instructions or instructions from the base functor. Here's the functor coproduct, which is basically "Either for functors".

data (f :+: g) a = L (f a) | R (g a) deriving Functor

We need to be able to inject programs from a base free monad into the free monad of a coproduct functor.

liftL :: (Functor f, Functor g) => Free f a -> Free (f :+: g) a
liftL = hoistFree L
liftR :: (Functor f, Functor g) => Free g a -> Free (f :+: g) a
liftR = hoistFree R

Now we have enough structure to write the logging interpreter as a decorator around some other interpreter. decorateLog interleaves logging instructions with instructions from an arbitrary free monad, delegating interpretation to a function CloudFiles f a -> Free f a.

-- given log :: Level -> String -> Free LogF ()

decorateLog :: Functor f => (CloudFilesF a -> Free f a) -> CloudFilesF a -> Free (LogF :+: f) a
decorateLog interp inst@(SaveFile _ _ _) = do
    liftL $ log Info "Saving"
    x <- liftR $ interp inst
    liftL $ log Info "Saved"
    return x
decorateLog interp inst@(ListFiles _ _) = do
    liftL $ log Info "Listing files"
    x <- liftR $ interp inst
    liftL $ log Info "Listed files"
    return x

So decorateLog interpretCloudWithRest :: CloudFilesF a -> Free (LogF :+: RestF) a is an interpreter which spits out a program whose instruction set consists of instructions from LogF and RestF.

Now all we need to do is write an interpreter (LogF :+: RestF) a -> IO a, which we'll build out of interpLogIO :: LogF a -> IO a and interpRestIO :: RestF a -> IO a.

elim :: (f a -> b) -> (g a -> b) -> (f :+: g) a -> b
elim l r (L x) = l x
elim l r (R y) = r y

interpLogRestIO :: (LogF :+: RestF) a -> IO a
interpLogRestIO = elim interpLogIO interpRestIO

So foldFree interpLogRestIO :: Free (LogF :+: RestF) a -> IO a will run the output of decorateLog interpretCloudWithRest in the IO monad. The whole compiler is written as foldFree interpLogRestIO . foldFree (decorateLog interpretCloudWithRest) :: Free CloudFilesF a -> IO a.

In his article, de Goes goes (ha ha) a step further and builds this coproduct infrastructure using prisms. This makes it simpler to abstract over the instruction set.

The USP of the extensible-effects library is that it automates all this wrangling with functor coproducts for you. If you're set on pursuing the free monad route (personally, I'm not as smitten with it as de Goes is) then I'd recommend using extensible-effects rather than rolling your own effect system.