是否可以扩展免费的 monad 解释器？

给定一个免费的 monad DSL，例如：

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

type Foo = Free FooF

和一个随机解释器Foo:

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

在我看来，应该可以在 printFoo 的每次迭代中散布一些东西，而无需手动执行：

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

这是否可以通过“包装”原件来实现printFoo?

动机：我正在编写一个小型 DSL，它可以“编译”为二进制格式。二进制格式在每个用户命令之后包含一些额外信息。它必须在那里，但与我的用例完全无关。

其他答案忽略了多么简单free做这个！ :) 目前你有

{-# 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

这使

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

那很好，但是iterM可以为您做必要的管道工作

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

然后我们得到

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

好吧，太好了，和以前一样。但printFooF给我们更多 灵活地按照您想要的方式增强翻译器

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

然后我们得到

*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"

感谢 Gabriel Gonzalez 推广自由单子和 Edward Kmett 用于编写库！ :)