使用免费monad进行记录

Question

这个问题与本文有关

我们的想法是定义一个用于操作云中文件的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做到这一点,但我不能用它来做logCloudfilesI.

在这些情况下使用免费monad时采用的方法是什么？请注意,问题似乎是这样一个事实:对于日志记录的情况,我们可以提供给函数的有意义的值ListFiles来构建程序的延续.然而, 在作者使用的第二篇文章Halt中,这在我当前的实现中不起作用.

Answer 1

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

诀窍是在上下文中解释程序,该上下文可以访问日志记录效果和一些基本效果.这种monad中的指令可以是记录指令或来自基础仿函数的指令.这是functor coproduct,基本上是" Eitherfor 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是一个解释器,它吐出一个程序,其指令集由来自LogF和的指令组成RestF.

现在我们需要做的是编写一个解释(LogF :+: RestF) a -> IO a,我们将打造出的interpLogIO :: LogF a -> IO a和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的IO单子.整个编译器编写为foldFree interpLogRestIO . foldFree (decorateLog interpretCloudWithRest) :: Free CloudFilesF a -> IO a.

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

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