使用免费的 monad 进行日志记录

Logging using the free monad

此问题与 this article

有关

想法是定义一个用于在云中操作文件的 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 使用函数 logCloudfilesIinterpretLog 上面定义?基本上,我正在寻找构造一个类型为的函数:

interpretDSLWithLog :: Free ClouldFilesF a -> IO ()

我可以用 REST DSL 做到这一点,但我不能用 logCloudfilesI

在这些情况下使用自由 monad 时采用的方法是什么?笔记 问题似乎是对于日志记录案例,没有 我们可以为 ListFiles 中的函数提供有意义的值来构建 该计划的延续。在 second article 作者使用 Halt,但是, 这在我的 current implementation.

中不起作用

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

诀窍是在可以访问日志效果和某些基本效果的上下文中解释程序。这样的 monad 中的指令将 记录指令 来自基本函子的指令。这是 仿函数余积 ,基本上是“Either 仿函数”。

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

我们需要能够将程序从基本的自由 monad 注入到余积函子的自由 monad 中。

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 将日志记录指令与来自任意自由 monad 的指令交错,将解释委托给函数 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是一个解释器,它吐出一个程序,其指令集由来自LogFRestF的指令组成。

现在我们需要做的就是编写一个解释器 (LogF :+: RestF) a -> IO a,我们将从 interpLogIO :: LogF a -> IO ainterpRestIO :: 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 将 运行 IO monad 中 decorateLog interpretCloudWithRest 的输出。整个编译器写成foldFree interpLogRestIO . foldFree (decorateLog interpretCloudWithRest) :: Free CloudFilesF a -> IO a.

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

extensible-effects 库的 USP 是它为您自动处理所有这些与仿函数余积的争论。如果你打算追求免费的 monad 路线(就个人而言,我不像 de Goes 那样迷恋它)那么我建议使用 extensible-effects 而不是滚动你自己的效果系统。