使用免费monad进行记录

时间:2016-10-18 10:26:45

标签: haskell logging functional-programming 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中无效。

1 个答案:

答案 0 :(得分:6)

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

诀窍是在一个可以同时访问日志记录效果和一些基本效果的上下文中解释该程序。这样的monad中的指令要么记录来自基础仿函数的指令指令。这是仿函数coproduct ,基本上是“Either for functors”。

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将在decorateLog interpretCloudWithRest monad中运行IO的输出。整个编译器编写为foldFree interpLogRestIO . foldFree (decorateLog interpretCloudWithRest) :: Free CloudFilesF a -> IO a

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

extensible-effects库的USP是它为你自动化所有这些与functor coproducts的争论。如果你开始追求免费的monad路线(就个人而言,我并不像de Goes那样迷恋它)那么我建议使用extensible-effects而不是滚动你自己的效果系统。