8

这个问题与这篇文章有关

这个想法是定义一个 DSL 来操作云中的文件，并定义一个解释器的组合来处理不同的方面，例如与 REST 接口的通信和日志记录。

为了使这一点更具体，假设我们有以下定义 DSL 术语的数据结构。

data CloudFilesF a
= SaveFile Path Bytes a
| ListFiles Path ([Path] -> a)
deriving Functor

我们定义函数来构建 CloudFiles 程序如下：

saveFile :: Path -> Bytes -> Free CloudFilesF ()
saveFile path bytes = liftF $ SaveFile path bytes ()

listFiles :: Path -> Free CloudFilesF [Path]
listFiles path = liftF $ ListFiles path id

然后这个想法是用另外两个 DSL 来解释这个：

data RestF a = Get Path (Bytes -> a)
         | Put Path Bytes (Bytes -> a)
         deriving Functor

data Level = Debug | Info | Warning | Error deriving Show
data LogF a = Log Level String a deriving Functor

我设法使用以下类型定义了从 CloudFiles DSL 到 REST DSL 的自然转换：

interpretCloudWithRest :: CloudFilesF a -> Free RestF a

然后给出一个形式的程序：

sampleCloudFilesProgram :: Free CloudFilesF ()
sampleCloudFilesProgram = do
  saveFile "/myfolder/pepino" "verde"
  saveFile "/myfolder/tomate" "rojo"
  _ <- listFiles "/myfolder"
  return ()

可以使用 REST 调用来解释程序，如下所示：

runSampleCloudProgram =
  interpretRest $ foldFree interpretCloudWithRest sampleCloudFilesProgram

当试图使用日志定义对 DSL 的解释时，问题就出现了。在我上面提到的文章中，作者定义了一个带有类型的解释器：

logCloudFilesI :: forall a. CloudFilesF a -> Free LogF ()

Free LogF a我们定义了一个具有类型的解释器：

interpretLog :: Free LogF a -> IO ()

问题是这个解释器不能 foldFree像我上面那样结合使用。所以问题是如何解释 Free CloudFilesF a使用上面定义的函数logCloudfilesI的程序interpretLog ？基本上，我正在寻找构造一个类型的函数：

interpretDSLWithLog :: Free ClouldFilesF a -> IO ()

我可以用 REST DSL 做到这一点，但我不能用 usng 做到这一点logCloudfilesI。

在这些情况下使用免费 monad 时采取的方法是什么？请注意，问题似乎在于，对于日志记录情况，我们无法为函数 in 提供任何有意义的值ListFiles来构建程序的延续。 然而，在作者使用的第二篇文章中，这在我当前的实现Halt中不起作用。

4

1 回答 1

6

日志记录是装饰器模式的经典用例。

诀窍是在可以访问日志记录效果和一些基本效果的上下文中解释程序。这种 monad 中的指令要么是记录指令，要么是来自基本函子的指令。这是函子 coproduct，它基本上是“Either用于函子”。

data (f :+: g) a = L (f a) | R (g a) deriving Functor

我们需要能够将程序从一个基本的自由单子注入到一个联积函子的自由单子中。

liftL :: (Functor f, Functor g) => Free f a -> Free (f :+: g) a
liftL = hoistFree L
liftR :: (Functor f, Functor g) => Free g a -> Free (f :+: g) a
liftR = hoistFree R

现在我们有足够的结构来编写日志解释器作为围绕其他解释器的装饰器。decorateLog将记录指令与来自任意自由单子的指令交错，将解释委托给函数CloudFiles f a -> Free f a。

-- given log :: Level -> String -> Free LogF ()

decorateLog :: Functor f => (CloudFilesF a -> Free f a) -> CloudFilesF a -> Free (LogF :+: f) a
decorateLog interp inst@(SaveFile _ _ _) = do
    liftL $ log Info "Saving"
    x <- liftR $ interp inst
    liftL $ log Info "Saved"
    return x
decorateLog interp inst@(ListFiles _ _) = do
    liftL $ log Info "Listing files"
    x <- liftR $ interp inst
    liftL $ log Info "Listed files"
    return x

解释器也是如此decorateLog interpretCloudWithRest :: CloudFilesF a -> Free (LogF :+: RestF) a，它会吐出一个程序，其指令集由来自LogF和的指令组成RestF。

现在我们需要做的就是编写一个解释器(LogF :+: RestF) a -> IO a，我们将从interpLogIO :: LogF a -> IO aand构建它interpRestIO :: RestF a -> IO a。

elim :: (f a -> b) -> (g a -> b) -> (f :+: g) a -> b
elim l r (L x) = l x
elim l r (R y) = r y

interpLogRestIO :: (LogF :+: RestF) a -> IO a
interpLogRestIO = elim interpLogIO interpRestIO

因此foldFree interpLogRestIO :: Free (LogF :+: RestF) a -> IO a将decorateLog interpretCloudWithRest在IOmonad 中运行输出。整个编译器写成foldFree interpLogRestIO . foldFree (decorateLog interpretCloudWithRest) :: Free CloudFilesF a -> IO a.

在他的文章中，de Goes 更进一步（哈哈）并使用prisms构建了这个副产品基础设施。这使得对指令集的抽象变得更简单。

该extensible-effects库的 USP 是它为您自动使用函子副产品进行所有这些争论。如果您打算追求免费的 monad 路线（就我个人而言，我并不像 de Goes 那样迷恋它），那么我建议您使用extensible-effects而不是滚动您自己的效果系统。

于 2016-10-18T14:12:42.540 回答