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

Question

给定一个免费的 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，它可以“编译”为二进制格式。二进制格式在每个用户命令之后包含一些额外信息。它必须在那里，但与我的用例完全无关。

Answer 1

其他答案忽略了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 推广自由单子(monad)和 Edward Kmett用于编写库! :)