[翻译]ReaderT 设计模式

讲解工程实践中为什么需要 ReaderT 模式比较清晰的文章，就翻译了一下。原文见这里

在工程实践中，一些语言比如 Java 通过设计模式用来解决某些常见的场景问题。Haskell 语言没有这类设计模式，它通过语言层面的特性解决这些问题。然而，我相信仍然有一些关于程序结构的高级指导的空间，我将其松散地称为 Haskell 设计模式。这次描述的模式被称为 ReaderT 模式 。我将其用作 Yesod 框架 Handler 类型设计的基础。

先整体介绍一下模式，然后再深入细节和例外场景：

你的 application 定义一个核心数据类型（一般叫 Env）
这个数据类型包含所有的运行时配置和全局函数（可以被mock），例如日志记录函数或者数据库访问。
如果你必须存在一些可变的状态，把它放在 Env 中作为可变引用(IORef, TVar，等等)。
通常这个数据类型代码应该包装成 ReaderT Env IO ，也可以定义为：type App = ReaderT Env IO ，或者直接用newtype 包装器而不是直接使用 ReaderT
你可以偶尔使用额外的 monad transformers ，但只适用于你的应用程序的一小部分，最好这些子集是纯的（pure code）。
可选的：除了直接使用上面提到的 App 数据类型，还可以采用 mtl-style typeclasses （例如 MonadReader 和 MonadIO）写你的函数。这使得你恢复一些纯净度（purity），你认为我刚才让你丢弃纯净度，而使用 IO 和可变引用（ mutable references）。

全局变量与资源初始化

全局变量是糟糕的，可变的全局变量更糟糕。一般处理全局变量的方式是，在 main 函数中读取配置文件，然后将这些变量值传递给其他代码。

初始化资源对于应用程序中需要初始化资源的场景，假如你需要初始化一个随机数生成器，或者打开一个 handler 向其发送日志信息，或者创建一个数据库连接池，或者创建一个临时目录存储文件，把这些操作放在 main 函数里，远比从某个全局位置进行操作更有条理性。

对于这些初始化操作，全局变量的方法的另一个优点是延迟初始化。大部分情况下都不需要立刻全部初始化这些资源。如果需要的话，也可以使用 runOnce 来完成。

避免使用 WriterT 和 StateT

可变引用是我最后推荐的一种手段。我们都知道，在 Haskell 中，purity 至关重要，可变性是魔鬼。此外，我们还有 WriterT 和 StateT 这些很棒的东西。如果我们的应用中有一些值需要随时间改变，为什么不使用它们呢? 实际上，Yesod 的早期版本就是这样做的：他们使用 StateT 状态方法，通过 Handler 允许你修改用户会话值和设置响应标头。但是，很久以前，我切换到了可变引用，下面是原因：

Exception-survival 如果运行中出现异常，在 WriterT 和 StateT 中你将丢失状态（state），使用可变引用则不会出现这个问题，你可以在引发运行时异常之前读取最后一个可用状态。我们在 Yesod 中使用此功能有很大的好处，即使响应失败例如 notFound 也可以设置 response headers。
False purity 我们说 WriterT 和 StateT 是纯的，技术上讲它们是。但说实话：如果你的应用程序完全位于 StateT 内，您将无法从纯代码中获得想要的约束可变性的好处。还不如直接承认你有一个可变变量。
Concurrency 下面的代码结果是多少？

put 4 >> concurrently (modify (+ 1)) (modify (+ 2)) >> get

你可能会说是7么？但它肯定不是。根据与 StateT 提供的状态相关的并发实现方式，结果可能是4、5或6。不相信我吗?试一下下面的代码：

#!/usr/bin/env stack
-- stack --resolver lts-8.12 script
import Control.Concurrent.Async.Lifted
import Control.Monad.State.Strict

main :: IO ()
main = execStateT
    (concurrently (modify (+ 1)) (modify (+ 2)))
    4 >>= print

假如我们需要将父线程的状态克隆到两个子线程中，然后任意选择哪个子状态将继续存在。或者我们可以只丢弃两个子状态，然后继续原始的父状态。处理不同线程之间的可变状态是一个难题，但是 StateT 并不能解决问题，而是将问题隐藏起来。如果使用可变变量，将不得不考虑这一点。我们想要什么语义？我们应该使用 IORef 和坚持 atomicModifyIORef 吗？我们应该使用 TVar 吗？这些是合理的问题，我们不得不对其检验。对于类似 TVar 的方法：

#!/usr/bin/env stack
-- stack --resolver lts-8.12 script
{-# LANGUAGE FlexibleContexts #-}
import Control.Concurrent.Async.Lifted.Safe
import Control.Monad.Reader
import Control.Concurrent.STM

modify :: (MonadReader (TVar Int) m, MonadIO m)
       => (Int -> Int)
       -> m ()
modify f = do
  ref <- ask
  liftIO $ atomically $ modifyTVar' ref f

main :: IO ()
main = do
  ref <- newTVarIO 4
  runReaderT (concurrently (modify (+ 1)) (modify (+ 2))) ref
  readTVarIO ref >>= print

WriterT is broken。正如 Gabriel Gonzalez 所展示的，即使 strict WriterT 也存在空间泄漏问题。
Caveats 。我依然经常使用 StateT 和 WriterT 。一个例子是 Yesod's WidgetT，它实际上是一个在 HandlerT 之上的 WriterT 。在这种情况下它是有道理的：

可变状态预计被应用的一小部分代码修改。
尽管我们在构建 widget 时可以产生副作用，但是窗口小部件构造本身是一种 pure 的活动
我们不需要让状态在异常中生存：如果出现问题，我们将发回错误页面
构造 widget 时，没有充分的理由使用并发
尽管存在空间泄漏的问题，但我还是对 WriterT 以及其他替代方案进行了基准测试，发现它是该用例中最快的

此规则的另一个重大例外是纯代码。如果您的应用程序的某些子集不执行IO，但是需要某种可变状态，请使用 StateT 。

避免 ExceptT

我已经有强烈的记录表明，ExceptT over IO 是一个坏主意。简单重复一下我那篇文章的内容：IO 的约定是任何异常在任何时候都可以抛出来。所以 ExceptT 实际上并不记录可能的异常，它会误导人，你可以阅读那篇博客获取更详细的信息。我在这里重复这一点是因为，StateT WriterT 的某些缺点同样适用于 ExceptT。例如如何在 ExceptT 中处理并发性？对于运行时异常，其行为是明确的:当并发使用时，如果任何子线程抛出异常，则杀死另一个线程，并在父线程中重新抛出异常。对于 ExceptT 你想要什么行为? 同样，您可以在运行时异常不是契约的一部分的纯代码中使用 ExceptT，就像您应该在纯代码中使用 StateT 一样。但是，一旦我们从我们的主要应用 transformers 中消除了 StateT、WriterT 和 ExceptT，我们就剩下了……

只有 ReaderT

现在你知道我为什么叫它“ReaderT设计模式”了。ReaderT 与其他三个transformers 相比有一个巨大的优势:它没有可变状态。它只是一种向所有函数传递额外参数的方便方式。即使该参数包含可变的引用，该参数本身也是完全不可变的。考虑到: 我们可以忽略我提到的关于并发性的所有状态覆盖问题。这是因为使用 ReaderT 进行并发实际上是安全的。类似地，你可以使用 monad-unlift library package，深层 monad transformer stack 很容易让人困惑。把所有这些都减少到一个 transformer 可大大降低复杂度，这不仅对你更简单，对GHC也更简单，它往往有更好的时间优化一层 ReaderT 代码，而不是有5层深度的 transformer 代码。顺便说一下，你引入了 ReaderT，但你可以把它完全扔掉，然后手动传递你的 Env 。大多数人都不这样做，因为这让人觉得受虐(想象一下，必须告诉每一个调用logDebug 的地方到哪里去获取日志函数)。但是，如果你试图编写一个不需要理解 transformer 的更简单的代码库，现在您就可以掌握它了。

has typeclass 方法

假设我们扩展上面可变变量示例，以包括一个日志记录功能。它可能看起来像这样：

#!/usr/bin/env stack
-- stack --resolver lts-8.12 script
{-# LANGUAGE FlexibleContexts #-}
import Control.Concurrent.Async.Lifted.Safe
import Control.Monad.Reader
import Control.Concurrent.STM
import Say

data Env = Env
  { envLog :: !(String -> IO ())
  , envBalance :: !(TVar Int)
  }

modify :: (MonadReader Env m, MonadIO m)
       => (Int -> Int)
       -> m ()
modify f = do
  env <- ask
  liftIO $ atomically $ modifyTVar' (envBalance env) f

logSomething :: (MonadReader Env m, MonadIO m)
             => String
             -> m ()
logSomething msg = do
  env <- ask
  liftIO $ envLog env msg

main :: IO ()
main = do
  ref <- newTVarIO 4
  let env = Env
        { envLog = sayString
        , envBalance = ref
        }
  runReaderT
    (concurrently
      (modify (+ 1))
      (logSomething "Increasing account balance"))
    env
  balance <- readTVarIO ref
  sayString $ "Final balance: " ++ show balance

对于你的应用来讲， Env 数据类型看起来是一种开销（overhead）和样板代码。是这样，正如我上面说的，最好一开始先忍受一些痛苦，以便于更好地长期进行应用开发实践。这段代码有个更大的问题：太耦合了。即使从未使用 logging 函数，我们的 modify 函数也还是获得整个 Env 值。同样的， logSomething 也从不使用它（env）提供的那个可变变量。向函数提供太多的状态是不好的：

我们无法从类型签名中知道代码是做什么的
测试变得困难。为了检查 modify 是否正确，我们需要给它提供一些垃圾 logging 函数。我们使用 has typeclass 方法改造一下上面的样板代码，这与MonadReader和其他mtl类如MonadThrow和MonadIO组合得很好，使得我们能准确地表明我们的函数需要什么，代价是需要定义很多类型类。让我们看看这看起来是怎样的:

#!/usr/bin/env stack
-- stack --resolver lts-8.12 script
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
import Control.Concurrent.Async.Lifted.Safe
import Control.Monad.Reader
import Control.Concurrent.STM
import Say

data Env = Env
  { envLog :: !(String -> IO ())
  , envBalance :: !(TVar Int)
  }

class HasLog a where
  getLog :: a -> (String -> IO ())
instance HasLog (String -> IO ()) where
  getLog = id
instance HasLog Env where
  getLog = envLog

class HasBalance a where
  getBalance :: a -> TVar Int
instance HasBalance (TVar Int) where
  getBalance = id
instance HasBalance Env where
  getBalance = envBalance

modify :: (MonadReader env m, HasBalance env, MonadIO m)
       => (Int -> Int)
       -> m ()
modify f = do
  env <- ask
  liftIO $ atomically $ modifyTVar' (getBalance env) f

logSomething :: (MonadReader env m, HasLog env, MonadIO m)
             => String
             -> m ()
logSomething msg = do
  env <- ask
  liftIO $ getLog env msg

main :: IO ()
main = do
  ref <- newTVarIO 4
  let env = Env
        { envLog = sayString
        , envBalance = ref
        }
  runReaderT
    (concurrently
      (modify (+ 1))
      (logSomething "Increasing account balance"))
    env
  balance <- readTVarIO ref
  sayString $ "Final balance: " ++ show balance

天哪，更多的样板代码！是呀，类型签名更长了，呆板的 instance 写法。但是我们的类型签名现在可以提供丰富的信息，并且可以轻松地测试我们的功能，例如：

main :: IO ()
main = hspec $ do
  describe "modify" $ do
    it "works" $ do
      var <- newTVarIO (1 :: Int)
      runReaderT (modify (+ 2)) var
      res <- readTVarIO var
      res `shouldBe` 3
  describe "logSomething" $ do
    it "works" $ do
      var <- newTVarIO ""
      let logFunc msg = atomically $ modifyTVar var (++ msg)
          msg1 = "Hello "
          msg2 = "World\n"
      runReaderT (logSomething msg1 >> logSomething msg2) logFunc
      res <- readTVarIO var
      res `shouldBe` (msg1 ++ msg2)

如果手动定义所有这些类会让您感到困扰，如果你是lens库的忠实粉丝的话：

#!/usr/bin/env stack
-- stack --resolver lts-8.12 script
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
import Control.Concurrent.Async.Lifted.Safe
import Control.Monad.Reader
import Control.Concurrent.STM
import Say
import Control.Lens
import Prelude hiding (log)

data Env = Env
  { envLog :: !(String -> IO ())
  , envBalance :: !(TVar Int)
  }

makeLensesWith camelCaseFields ''Env

modify :: (MonadReader env m, HasBalance env (TVar Int), MonadIO m)
       => (Int -> Int)
       -> m ()
modify f = do
  env <- ask
  liftIO $ atomically $ modifyTVar' (env^.balance) f

logSomething :: (MonadReader env m, HasLog env (String -> IO ()), MonadIO m)
             => String
             -> m ()
logSomething msg = do
  env <- ask
  liftIO $ (env^.log) msg

main :: IO ()
main = do
  ref <- newTVarIO 4
  let env = Env
        { envLog = sayString
        , envBalance = ref
        }
  runReaderT
    (concurrently
      (modify (+ 1))
      (logSomething "Increasing account balance"))
    env
  balance <- readTVarIO ref
  sayString $ "Final balance: " ++ show balance

上面的例子中，Env 不再有immutable config-style的数据。因此 lens 方法的优势就没那么明显了。但是如果你有深层嵌套的配置值，并且特别想在整个应用中使用 local 调整其中的一些值，那么 lens 方法的好处就能体现出来了。所以总结一下:这个方法就是咬紧牙关，接受一些开始阶段的痛苦和样板代码。在应用开发过程中你能从这种方法获得的无数好处。记住:只需要预先支付一次性费用，你便能够每天都获得回报。

恢复 purity

不幸的是，我们的 modify 函数具有 MonadIO 约束。尽管我们的实际实现需要 IO 操作执行副作用（具体来说，就是读取、写入 TVar），但我们感染了所有的对该函数的调用者。我们说"我们有权执行任何副作用，包括发射导弹，或者更糟糕的是，抛出运行时异常。" 我们能恢复某种程度的纯度（purity）吗?答案是肯定的，只是需要更多的样板文件:

#!/usr/bin/env stack
-- stack --resolver lts-8.12 script
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
import Control.Concurrent.Async.Lifted.Safe
import Control.Monad.Reader
import qualified Control.Monad.State.Strict as State
import Control.Concurrent.STM
import Say
import Test.Hspec

data Env = Env
  { envLog :: !(String -> IO ())
  , envBalance :: !(TVar Int)
  }

class HasLog a where
  getLog :: a -> (String -> IO ())
instance HasLog (String -> IO ()) where
  getLog = id
instance HasLog Env where
  getLog = envLog

class HasBalance a where
  getBalance :: a -> TVar Int
instance HasBalance (TVar Int) where
  getBalance = id
instance HasBalance Env where
  getBalance = envBalance

class Monad m => MonadBalance m where
  modifyBalance :: (Int -> Int) -> m ()
instance (HasBalance env, MonadIO m) => MonadBalance (ReaderT env m) where
  modifyBalance f = do
    env <- ask
    liftIO $ atomically $ modifyTVar' (getBalance env) f
instance Monad m => MonadBalance (State.StateT Int m) where
  modifyBalance = State.modify

modify :: MonadBalance m => (Int -> Int) -> m ()
modify f = do
  -- Now I know there's no way I'm performing IO here
  modifyBalance f

logSomething :: (MonadReader env m, HasLog env, MonadIO m)
             => String
             -> m ()
logSomething msg = do
  env <- ask
  liftIO $ getLog env msg

main :: IO ()
main = hspec $ do
  describe "modify" $ do
    it "works, IO" $ do
      var <- newTVarIO (1 :: Int)
      runReaderT (modify (+ 2)) var
      res <- readTVarIO var
      res `shouldBe` 3
  it "works, pure" $ do
      let res = State.execState (modify (+ 2)) (1 :: Int)
      res `shouldBe` 3
  describe "logSomething" $ do
    it "works" $ do
      var <- newTVarIO ""
      let logFunc msg = atomically $ modifyTVar var (++ msg)
          msg1 = "Hello "
          msg2 = "World\n"
      runReaderT (logSomething msg1 >> logSomething msg2) logFunc
      res <- readTVarIO var
      res `shouldBe` (msg1 ++ msg2)

上面这个例子中整个modify函数都实现在一个类型类中，这有点傻。但是在更大的示例中，你可以看到我们如何能够指导我们的整个逻辑部分不执行任何副作用，同时仍然充分使用 ReaderT 模式。换一种说法，函数 foo :: Monad m => Int -> m Double 可能看起来不纯，因为它存在于一个 monad 中。事实并非如此：通过给他一个“ Monad 的任意一个实例”的约束，我们可以说，这里没有任何副作用。毕竟，上面（函数）那个 type 跟 Identity 函数是 unify 的。而 Identity 显然是纯的。这个例子看起来可能有点搞笑，那么这个呢？parseInt :: MonadThrow m => Text -> m Int 你可能认为这个是不纯的，因为它可能会抛出一个运行时异常。但是该类型与 parseInt :: Text -> Maybe Int 是unify 的，而后者明显是纯的。对于我们的函数我们已经获取了很多知识，现在可以放心地调用它们。我们的结论是：如果你可以推广你的函数为 mtl-style 单子约束，那就做。你将会获得纯度，从而获得很多好处。

分析

虽然这里讲解的技术确实有点笨拙，但对于任何大规模的应用程序或库开发，成本都是摊销的。我发现在许多实际项目中，以这种方式工作的好处远远超过成本。

它还会导致其他问题，比如更令人困惑的错误消息，对新加入项目的人增加更多的认知开销。但根据我的经验，一旦人们熟悉了这种方法，它就会产生良好的效果。

除了上面我列出的具体好处，使用这个方法自然引导着你查看周围许多常见的 monad transformer stack 痛点，你会看到人们在现实世界中经历。我鼓励其他人分享他们在现实生活中的例子。我个人已经很久没有遇到这些问题了，因为我一直坚持这种方法。

翻译自： https://www.fpcomplete.com/blog/2017/06/readert-design-pattern/

2021-08-14

blog