如何扩展Servant Client分页端点实现自动分页结果累加？

问题背景 #

对应的Servant API定义如下：

type API =
  "single-content" :> Get '[JSON] Int
    :<|> "contents" :> QueryParam "page" Int :> Get '[JSON] (Headers '[Header "Link" String] [Int])

其中第二个端点是分页接口，当存在更多待返回元素时，响应会携带next类型的Link头部。

通过servant-client生成的客户端函数：

paginatedClient :: Maybe Int -> ClientM (Headers '[Header "Link" String] [Int])
singleClient :: ClientM Int
singleClient :<|> paginatedClient = client (Proxy :: Proxy API)

需求是扩展分页端点的客户端函数，使其自动从响应头部提取下一页链接、自动发起下一页请求并累加所有分页结果。理想状态下，封装后的函数类型签名与默认客户端保持一致，同时支持在ClientM之外的其他monad中执行。

此前尝试过的思路均未达成目标：

• 参考过servant-github包的实现，完全符合需求，但该包长期未更新，与新版Servant不兼容，暂未找到迁移适配方法；
• Servant仓库相关issue讨论过分页，但未涉及客户端自动分页功能；提到的servant-pagination包不覆盖客户端场景，且分页实现思路与当前需求不符；
• servant-client的中间件可拦截请求，但仅能访问原始响应，无法完成结果的反序列化与累加；
• 认为hoistClient无法实现需求，因为它无法区分分页与非分页场景的行为，无法基于monad内部的返回值调整逻辑。

实现方案 #

1. 解析Link头部的下一页参数 #

首先实现函数从Link头部提取下一页的page参数，依赖http-link-header包处理标准Link头部格式：

import Data.List (find)
import Data.Text (unpack)
import Network.HTTP.Link (Link, parseLinkHeader, linkURI, linkParams)
import qualified Network.URI as URI
import Text.Read (readMaybe)

getNextPage :: Maybe String -> Maybe Int
getNextPage Nothing = Nothing
getNextPage (Just linkHeader) = do
  links <- parseLinkHeader linkHeader
  nextLink <- find (\link -> ("rel", "next") `elem` linkParams link) links
  let uri = linkURI nextLink
      queryPairs = URI.parseQuery (URI.uriQuery uri)
  pageStr <- lookup "page" queryPairs
  readMaybe pageStr

2. 递归分页累加函数 #

实现递归函数自动处理分页请求并累加所有结果：

import Servant.Client (ClientM)
import Servant.API.Headers (Headers, getHeaders, getResponse)

fetchAllPages :: Maybe Int -> ClientM [Int]
fetchAllPages page = do
  response <- paginatedClient page
  let currentItems = getResponse response
      nextPage = getNextPage (getHeaders response)
  case nextPage of
    Nothing -> pure currentItems
    Just nextNum -> (currentItems ++) <$> fetchAllPages (Just nextNum)

3. 适配其他Monad #

若需在ClientM以外的monad（比如IO）中执行，可通过hoistClient结合自然变换适配：

import Servant.Client (hoistClient, Proxy(Proxy), ClientEnv, runClientM, ServantError)
import Control.Monad.Except (ExceptT, runExceptT)

-- 定义ClientM到IO的自然变换
clientToIO :: ClientEnv -> ClientM a -> IO (Either ServantError a)
clientToIO env client = runExceptT $ runClientM client env

-- 生成适配IO的自动分页客户端
fetchAllPagesIO :: ClientEnv -> Maybe Int -> IO (Either ServantError [Int])
fetchAllPagesIO env = hoistClient (Proxy :: Proxy API) (clientToIO env) fetchAllPages

4. 保持类型签名兼容 #

如果希望封装后的函数与原客户端类型签名尽量一致，可调整返回值为包含所有结果的Headers结构：

import Servant.API.Headers (addHeader)

fetchAllPagesWithHeaders :: Maybe Int -> ClientM (Headers '[Header "Link" String] [Int])
fetchAllPagesWithHeaders page = do
  allItems <- fetchAllPages page
  -- 示例清空Link头部，若需保留最后一页头部，可修改递归逻辑传递最后一次响应的Header
  pure $ addHeader "" allItems

注意事项 #

• 确保服务端返回的Link头部符合RFC 5988标准格式，否则解析函数可能无法正确提取下一页参数；
• 需确保服务端在最后一页不会返回next类型的Link头部，避免递归进入无限循环；
• 若需处理分页过程中的错误，可在递归函数中使用catchError捕获ClientM中的错误并做相应处理。

内容的提问来源于stack exchange，提问作者l7r7