Is it possible to extend free monad interpreters?

Question

Given a free monad DSL such as:

data FooF x = Foo String x
            | Bar Int    x
  deriving (Functor)

type Foo = Free FooF

And a random interpreter for Foo:

printFoo :: Foo -> IO ()
printFoo (Free (Foo s n)) = print s >> printFoo n
printFoo (Free (Bar i n)) = print i >> printFoo n

It appears to me that it should be possible to intersperse something into each iteration of printFoo without resorting to doing it manually:

printFoo' :: Foo -> IO ()
printFoo' (Free (Foo s n)) = print s >> print "extra info" >> printFoo' n
printFoo' (Free (Bar i n)) = print i >> print "extra info" >> printFoo' n

Is this somehow possible by 'wrapping' the original printFoo?

---

Motivation: I am writing a small DSL that 'compiles' down to a binary format. The binary format contains some extra information after each user command. It has to be there, but is totally irrelevant in my usecase.

Answer 1

The other answers have missed how simplefree makes this! :) Currently you have

{-# LANGUAGE DeriveFunctor #-}

import Control.Monad.Free

data FooF x = Foo String x
            | Bar Int    x
  deriving (Functor)

type Foo = Free FooF

program :: Free FooF ()
program = do
  liftF (Foo "Hello" ())
  liftF (Bar 1 ())
  liftF (Foo "Bye" ())

printFoo :: Foo () -> IO ()
printFoo (Free (Foo s n)) = print s >> printFoo n
printFoo (Free (Bar i n)) = print i >> printFoo n
printFoo (Pure a) = return a

which gives

*Main> printFoo program 
"Hello"
1
"Bye"

That's fine, but iterM can do the requisite plumbing for you

printFooF :: FooF (IO a) -> IO a
printFooF (Foo s x) = print s >> x
printFooF (Bar i x) = print i >> x

printFooBetter :: Foo () -> IO ()
printFooBetter = iterM printFooF

Then we get

*Main> printFooBetter program
"Hello"
1
"Bye"

OK great, it's the same as before. But printFooF gives us more flexibility to augment the translator along the lines you want

printFooFExtra :: FooF (IO a) -> IO a
printFooFExtra = (print "stuff before IO action" >>)
                 . printFooF
                 . fmap (print "stuff after IO action" >>)

printFooExtra :: Foo () -> IO ()
printFooExtra = iterM printFooFExtra

then we get

*Main> printFooExtra program
"stuff before IO action"
"Hello"
"stuff after IO action"
"stuff before IO action"
1
"stuff after IO action"
"stuff before IO action"
"Bye"
"stuff after IO action"

Thanks Gabriel Gonzalez for popularizing free monads and Edward Kmett for writing the library! :)

Answer 2

Here a very simple solution using the operational package -- the reasonable alternative to free monads.

You can just factor the printFoo function into a part that prints the instruction proper and a part that adds the additional information, the standard treatment for code duplication like this.

{-# LANGUAGE GADTs #-}

import Control.Monad.Operational

data FooI a where
    Foo :: String -> FooI ()
    Bar :: Int    -> FooI ()

type Foo = Program FooI

printFoo :: Foo a -> IO a
printFoo = interpretWithMonad printExtra
    where
    printExtra :: FooI a -> IO a
    printExtra instr = do { a <- execFooI instr; print "extra info"; return a; }

execFooI :: FooI a -> IO a
execFooI (Foo s) = print s
execFooI (Bar i) = print i