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

Updating a nested data structure using lenses

我目前正在尝试使用镜头使我的部分代码更加简洁。特别是,我有一个 HTTP Request,我想用名称 Private-Header.

替换 header 的值

我设法编写了更新 RequestHeaders 的函数:

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

但是,我正在努力想出一个从请求中提取 header 并更新它们的函数。没有镜头,它可能看起来像这样:

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

有没有办法使用镜头来实现这个功能?

当然可以。首先,您需要一个代表 "Private-Header" header 在 RequestHeaders object 中的值的光学元件。一个合理的候选者是遍历,它允许一种类型在另一种类型中出现零次或多次。 (通常,您只有零个或一个私有 headers,但是 RequestHeader 类型并没有什么基本的东西可以防止两个或更多 headers 具有相同的名称,因此遍历似乎是最安全的选择。)

适合此光学器件的类型是:

privateHeader :: Traversal' RequestHeaders ByteString

您已经完成了在 updateHeaders 中定义此光学器件的大部分工作,您只需要重新排列零件即可。表达式:

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

是一种从 RequestHeader 中提取匹配 Header 值的光学器件。只要你不使用它来修改键和破坏过滤,它就是一个有效的遍历,所以我们可以直接用镜头 _2 组合它来创建一个提取 header 值的新遍历来自 type Header = (ByteString, ByteString):

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

顺便说一下,这个新的遍历也让我们可以简化 updateHeaders 的实现。

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

其次,我们需要一个代表 RequestRequestHeaders 字段值的光学器件。您可以使用 lens 函数构建一个:

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

现在,您可以组合 headersprivateHeaders 来创建新的遍历:

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')