如何利用 Free 的 MonadReader 实例？答案

【问题标题】：How do I leverage the MonadReader instance of Free?如何利用 Free 的 MonadReader 实例？
【发布时间】：2015-09-16 23:21:42
【问题描述】：

我想在我使用 Free monad 创建的 DSL 中使用 Reader。

我注意到这里有一个免费的 MonadReader 实例：

https://hackage.haskell.org/package/free-4.12.1/docs/src/Control-Monad-Free.html#line-264

如果我尝试在用我的 EDSL 编写的程序中调用 ask，我会收到类型错误“No such instance MonadReader Free MyDSL”

我最终会想在我的 DSL 中使用其他 Monad，例如 MonadError 和 Logging monad，但 Reader monad 只是我尝试过的第一个。

【问题讨论】：

您应该发布确切的错误。我敢打赌它实际上更具体一些：我敢打赌它说MyDSL 没有MonadReader 的实例，Free MyDSL 没有Free MyDSL 的实例，正如您在问题中所声称的那样。这应该是一个非常强烈的暗示，表明它需要什么才能起作用。
@DanielWagner 由于各种原因，我无法重现确切的错误，但具体细节并不重要。我只是在寻找任何将任何 mtl monad 与 Free 相结合的示例。
对于适当的环境类型，您需要 MyDSL 成为 MonadReader 的实例。 Free 没有添加阅读器效果；它只是使用一个底层的。如果您无法发布您的确切代码和错误消息，则很难了解我们如何为您提供帮助。

标签： haskell free-monad reader-monad

【解决方案1】：

正如您在上面链接的那样，Free 有一个 MonadReader 实例：

instance (Functor m, MonadReader e m) => MonadReader e (Free m) where

这说明的是，鉴于m 是一个Functor，并且m 有一个MonadReader e 实例，我们还可以利用Free 内部的MonadReader 实例。但是这要求已经有一个MonadReader 实例m 在你的情况下是你的DSL Functor。这通常不是你想要的，因为这极大地限制了你的 DSL 仿函数的可用选择，因为它不再是一个仿函数，而且它也必须是一个单子。

因此，我建议不要使用Free (ReaderT r DSL) a，而是将其分层，即ReaderT r (Free DSL) a，其好处是DSL 只需是一个函子。为了更具体，鉴于您没有说明您的 DSL 的外观，让我们使用Teletype DSL 示例：

data TeletypeF a = GetChar (Char -> a) | PutChar Char a deriving Functor

type Teletype a = Free TeletypeF a

getChar :: Teletype Char
getChar = liftF (GetChar id)

putChar :: Char -> Teletype ()
putChar c = liftF (PutChar c ())

putStrLn :: String -> Teletype ()
putStrLn str = traverse putChar str >> putChar '\n'

runTeletype :: Teletype a -> IO a
runTeletype = foldFree go
  where go (GetChar k) = k <$> IO.getChar
        go (PutChar c k) = IO.putChar c >> return k

putStrLn 是从 DSL 原语PutChar 派生的程序。我们可以使用IO monad 来解释程序。现在我们想使用ReaderT monad 转换器来推迟putStrLn 中行尾分隔符的选择。所以我们进行如下操作：

type TeletypeReader a = ReaderT Char (Free TeletypeF) a

getChar' :: TeletypeReader Char
getChar' = lift getChar

putChar' :: Char -> TeletypeReader ()
putChar' c = lift (putChar c)

putStrLn' :: String -> TeletypeReader ()
putStrLn' str = do
  traverse_ putChar' str
  sep <- ask
  putChar' sep

runTeletypeReader :: Char -> TeletypeReader a -> IO a
runTeletypeReader sep = runTeletype . flip runReaderT sep

现在我们可以这样做了：

λ> runTeletypeReader '\n' (putStrLn' "Hello" >> putStrLn' "World")
Hello
World

λ> runTeletypeReader ':' (putStrLn' "Hello" >> putStrLn' "World")
Hello:World:

【讨论】：

很好地解决了潜在的问题！