Updating a nested data structure using lenses

I'm currently trying to make parts of my code more concise using lenses. In particular, I have a HTTP Request where I want to replace the value of a header with the name Private-Header.

I managed to write the function that updates the RequestHeaders:

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

However, I'm struggling with coming up with a function that extracts the headers from a requests and updates them. Without lenses, it could look like this:

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

Is there a way to implement this function using lenses?

Solution

Certainly. First, you need an optic that represents the value of the "Private-Header" header within a RequestHeaders object. A reasonable candidate is a traversal, which allows zero or more occurrences of one type within another. (Typically, you'd only have zero or one private headers, but there's nothing fundamental about the RequestHeader type that prevents two or more headers with the same name, so a traversal seems the safest bet.)

The appropriate type for this optic is:

privateHeader :: Traversal' RequestHeaders ByteString

You've already done most of the work for defining this optic in updateHeaders, you just need to rearrange the parts. The expression:

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

is an optic that pulls out matching Header values from the RequestHeader. It's a valid traversal as long as you don't use it to modify the keys and break the filtering, so we can compose it directly with the lens _2 to create a new traversal that extracts the header values from type Header = (ByteString, ByteString):

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

By the way, this new traversal allows us to simplify the implementation of updateHeaders, too.

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

Second, we need an optic that represents the value of the RequestHeaders fields of a Request. You can build one with the lens function:

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

Now, you can compose headers and privateHeaders to create a new traversal:

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

and updateRequest can be implemented as:

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

Full code:

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