是否有可能扩展免费的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撰写图书馆!:)

Answer 2

这是一个使用operational包的非常简单的解决方案- 免费monad的合理替代方案.

您可以将printFoo函数分解为打印正确指令的部分和添加附加信息的部分,这是代码重复的标准处理方式.

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