使用镜片更新嵌套数据结构

Question

我目前正在尝试使用镜头使我的代码更加简洁。特别是，我有一个HTTP请求，我想用名称Private-Header替换标题的值。

我成功编写了更新RequestHeaders的函数：

updateHeaders :: RequestHeaders -> RequestHeaders
updateHeaders headers = headers & traverse . filtered (\header -> fst header == "Private-Header") %~ set _2 "xxxxxx"

然而，我在编写一个从请求中提取标题并更新它们的函数方面遇到了困难。如果没有使用镜头，代码可能如下所示：

updateRequest :: Request -> Request
updateRequest req = req {requestHeaders = updateHeaders (requestHeaders req)}

有没有一种使用镜头实现此功能的方法？

- l7r7

Answer 1

当然。首先，您需要一个代表"Private-Header"头在RequestHeaders对象中的值的光学器。一个合理的选择是遍历器，它允许在另一个类型中出现零次或多次。 （通常，您只会有零个或一个私有标头，但是RequestHeader类型中没有防止具有相同名称的两个或多个标头的基本属性，因此遍历器似乎是最安全的选择。）

此操作的适当类型为：

privateHeader :: Traversal' RequestHeaders ByteString

您已经在updateHeaders中完成了定义此光学元件的大部分工作，您只需要重新排列这些部分即可。以下表达式：

traverse . filtered (\header -> fst header == "Private-Header")

这是一个从RequestHeader中提取匹配的Header值的光学器。只要不使用它来修改键并破坏过滤，它就是有效的遍历方式，因此我们可以直接与镜头_2组合，创建一个从type Header = (ByteString, ByteString)中提取头部值的新遍历：

privateHeader = traverse . filtered (\header -> fst header == "Private-Header") . _2

顺便说一下，这种新的遍历方式还可以简化updateHeaders的实现。

updateHeaders :: RequestHeaders -> RequestHeaders
updateHeaders = set privateHeader "xxxxxx"

其次，我们需要一种光学元素，能够代表Request中的RequestHeaders字段的值。你可以使用lens函数来构建它：

headers :: Lens' Request RequestHeaders
headers = lens getter setter
  where getter = requestHeaders
        setter req hdrs = req { requestHeaders = hdrs }

现在，您可以组合headers和privateHeaders 来创建一个新的遍历方式：

privateHeaderInRequest :: Traversal' Request ByteString
privateHeaderInRequest = headers . privateHeader

可以这样实现 updateRequest:

updateRequest :: Request -> Request
updateRequest = set (headers . privateHeader) "xxxxxx"

完整代码:

{-# LANGUAGE OverloadedStrings #-}

import Control.Lens
import Network.HTTP.Client
import Network.HTTP.Types
import Data.ByteString (ByteString)

privateHeader :: Traversal' RequestHeaders ByteString
privateHeader = traverse . filtered (\header -> fst header == "Private-Header") . _2

updateHeaders :: RequestHeaders -> RequestHeaders
updateHeaders = set privateHeader "xxxxxx"

headers :: Lens' Request RequestHeaders
headers = lens getter setter
  where getter = requestHeaders
        setter req hdrs = req { requestHeaders = hdrs }

updateRequest :: Request -> Request
updateRequest = set (headers . privateHeader) "xxxxxx"

main = do
  request <- parseRequest "http://localhost:8888/"
  -- could use "headers" lens to set this, but let's do it manually
  -- for clarity...
  let request' = request { requestHeaders = [("Private-Header","hello"),
                                             ("Other-Header","goodbye")] }
  print $ requestHeaders (updateRequest request')

- K. A. Buhr

---

好的，我错过的主要点是我构建一个单一的光学指向我想要更新的字段，在最后一步调用set。顺便说一下，标题名称不区分大小写，因此它会自动执行不区分大小写的匹配。 - l7r7

哦，你说得对。我已经删除了关于执行不区分大小写匹配的注释。 - K. A. Buhr