当然。首先,您需要一个表示RequestHeaders 对象内"Private-Header" 标头值的光学元件。一个合理的候选者是遍历,它允许一种类型在另一种类型中出现零次或多次。 (通常情况下,您只有零个或一个私有标头,但 RequestHeader 类型没有任何基本功能可以防止两个或多个具有相同名称的标头,因此遍历似乎是最安全的选择。)
此光学元件的适当类型是:
privateHeader :: Traversal' RequestHeaders ByteString
您已经完成了在updateHeaders 中定义此光学器件的大部分工作,您只需要重新排列这些部件。表达式:
traverse . filtered (\header -> fst header == "Private-Header")
是一种从RequestHeader 中提取匹配Header 值的光学元件。这是一个有效的遍历,只要你不使用它来修改key和破坏过滤,所以我们可以直接用镜头_2组合它来创建一个从type Header = (ByteString, ByteString)中提取header值的新遍历:
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')