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

问题描述

给定一个免费的monad DSL如：

  data FooF x = Foo String x 
 | Bar Int x 
派生（Functor）
 
类型Foo =免费FooF 
  

以及 Foo 的随机解释器：

  printFoo :: Foo  - > IO（）
 printFoo（Free（Foo s n））=打印s>> printFoo n 
 printFoo（免费（Bar i n））=打印i>> printFoo n 
  

在我看来，应该可以将某些东西散布到printFoo的每个迭代中，手动操作：

  printFoo':: Foo  - > IO（）
 printFoo'（Free（Foo s n））=打印s>>打印额外信息>> printFoo'n 
 printFoo'（Free（Bar i n））= print i>>打印额外信息>> printFoo'n 
  

通过'包装'原始 printFoo ？

---

动机：我正在编写一个小型DSL，将其编译为二进制格式。二进制格式包含每个用户命令后的一些额外信息。它必须在那里，但在我的用例中是完全不相关的。

解决方案

其他答案错过了简单免费使这个！ :)目前你有

$ $ p $ $ $ c $ {>＃LANGUAGE DeriveFunctor＃ - }

导入Control.Monad。免费

数据FooF x = Foo字符串x
| Bar Int x
派生（Functor）

类型Foo =免费FooF

程序::免费FooF（）
程序=做
liftF（FooHello（））
liftF（Bar 1（））
liftF（FooBye（））

printFoo :: Foo（） - > IO（）
printFoo（Free（Foo s n））=打印s>> printFoo n
printFoo（免费（Bar i n））=打印i>> printFoo n
printFoo（Pure a）=返回一个

给出

  *主要> printFoo程序
Hello
 1 
Bye
  

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

  printFooF :: FooF（IO a） - > IO a 
 printFooF（Foo s x）=打印s>> x 
 printFooF（Bar i x）= print i>> x 
 
 printFooBetter :: Foo（） - > IO（）
 printFooBetter = iterM printFooF 
  

然后我们得到

  *主要> printFooBetter程序
Hello
 1 
Bye
  

好极了，和以前一样。但是 printFooF 给了我们更多
的灵活性，可以沿着你想要的路线扩充翻译人员。

  printFooFExtra :: FooF（IO a） - > IO a 
 printFooFExtra =（打印IO动作前的东西>>）
。 printFooF 
。 fmap（打印IO操作后的东西>>）
 
 printFooExtra :: Foo（） - > IO（）
 printFooExtra = iterM printFooFExtra 
  

然后我们得到

  *主要> printFooExtra程序
IO动作前的东西
Hello
IO动作后的东西
IO动作前的东西
 1 
stuff在IO动作之前
的东西之后
再见
IO动作之后的东西
  

$之后b
$ b

感谢Gabriel Gonzalez为图书馆的推广推广免费单子和Edward Kmett
！ ：）

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.

解决方案

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 moreflexibility 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 Kmettfor writing the library! :)

这篇关于是否可以扩展免费的monad解释器？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！