8

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.

Damian Nadales
  • 4,907
  • 1
  • 21
  • 34
  • Sorry, I deleted my remark which was missing some bit of the story. It seems you are trying to interpret a `Free CloudFilesF` thing entirely in terms of `LogF`, but this will never work if you don't also somehow feed `[Path]` into the process, since most of a `Free CloudFilesF a` is stuck behind functions `[Path] -> a`, so you can't get to it - unless you feed it `[]` – Michael Oct 18 '16 at 13:55
  • For example you can write `debugI :: CloudFilesF r -> Free LogF r` as `debugI (SaveFile path bytes r) = log Debug (path ++ bytes) >> return r`; `debugI (ListFiles path next) = log Debug path >> return (next [])` – Michael Oct 18 '16 at 14:02
  • I think that's part of the problem (and also part of my question): how to add logging in a context of free monads. It seems interpreting `Free CloudFilesF` in terms of `Free LogF` is not the right approach, but I wonder what's the place of `LogF` in the whole process. – Damian Nadales Oct 18 '16 at 14:02
  • What you mention in your second comment is what I did at some point, but returning an empty list did not seem right (at least from an architectural point of view), although it did the job. – Damian Nadales Oct 18 '16 at 14:04
  • 1
    When he did it, he interpreted `CloudFilesF` into `Sum LogF RestF` or whatever - i.e. he stuck a bit of logging onto his rest interpreter, so he could write something like `logRest :: CloudFilesF r -> Free (Sum LogF RestF) r` as `logRest cf = hoistFree InL (logCloudFilesI cf) *> hoistFree InR (interpretCloudWithRest cf)` (here using `Data.Functor.Sum` for his coproducts) – Michael Oct 18 '16 at 14:05
  • That way, I don't lose the all-important connectedness of a `Free CloudFilesF` item - it is preserved by `interpretCloudWithRest` which knows how to 'get' files. – Michael Oct 18 '16 at 14:09

1 Answers1

6

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.

Benjamin Hodgson
  • 42,952
  • 15
  • 108
  • 157
  • This is what de Goes does in the relevant section of the post, though, with `loggingCloudFilesI` – Michael Oct 18 '16 at 14:18
  • Yep, more or less. The above is basically a recap of the part of the article that OP seems not to understand. The main difference is that de Goes doesn't build his logger as a decorator. – Benjamin Hodgson Oct 18 '16 at 14:22
  • 1
    `decorateLog` might be clearer as something like `addLogging :: CloudFilesF a -> Free (Sum LogF CloudFilesF) a` then other manipulations would use standard combinators like `retract` `hoistFree` etc. – Michael Oct 18 '16 at 14:32
  • Indeed, I was thrown off by the fact that de Goes uses `logCloudFilesI :: forall a. CloudFilesF a -> Free LogF ()`. In his second post he uses `Halt` as well, but none of these constructs can be put together in the same way as the REST interpreter. – Damian Nadales Oct 19 '16 at 07:46
  • @Michael, any reason for preferring `Sum` over `Coproduct`? – Damian Nadales Oct 19 '16 at 07:51
  • @DamianNadales `Data.Functor.Sum` is in `base` (previously it was in `transformers` which is a boot package that comes with ghc) so it's the standard module for forming the coproduct of two functors. – Michael Oct 19 '16 at 10:39
  • 1
    @DamianNadales in fact you don't need coproducts for this kind of manipulation, if you use `FreeT`, which gives you room to act on the different functors separately. Here is a version using the `streaming` library (where the general `Stream` type is the same as `FreeT` )http://lpaste.net/281553 – Michael Oct 19 '16 at 11:18
  • 1
    I walked through this for my own sake, but without the use of co-product (sum), instead I rolled my own: http://therning.org/magnus/posts/2016-06-18-free--take-2.html – Magnus Oct 19 '16 at 11:44
  • @Magnus right, here is a version that dispenses with coproducts http://lpaste.net/281889 You can toggle back and forth between the coproduct view and the other (more natural?) view of decoration with [separate](http://hackage.haskell.org/package/streaming-0.1.4.3/docs/Streaming.html#v:separate) and unseparate. Note that these compose so `separate . separate` disaggregates a `Sum (Sum f g) h)` so that f can be acted on separately, and so on. – Michael Oct 19 '16 at 13:52