如何用Lens实现mapMaybe处理GitHub API返回的JSON数据

背景 #

我用wreq调用GitHub API获取仓库文件列表，请求代码如下（请求逻辑无需关注）：

let
    myOpts = defaults
      &  header "Accept" .~ ["application/vnd.github.raw"]
      &  header "X-GitHub-Api-Version" .~ ["2022-11-28"]

    url = "https://api.github.com/repos/rubenmoor/learn-palantype/git/trees/main?recursive=1"

liftIO (try $ getWith (myOpts & auth .~ mAuth) $ Text.unpack url) <&> \case
  Left (HttpExceptionRequest _ content) -> Error 500 $ Text.pack $ show content
  Left (InvalidUrlException u msg) -> Error 500 $ "Url " <> Text.pack u <> " invalid: " <> Text.pack msg
  Right resp -> -- ... 

API返回的JSON示例：

{
  "sha": "7fd9d59c9b101261ca500827eb9d6b4c4421431b",
  "url": "https://api.github.com/repos/rubenmoor/learn-palantype/git/trees/7fd9d59c9b101261ca500827eb9d6b4c4421431b",
  "tree": [
    {
      "path": ".github",
      "mode": "040000",
      "type": "tree",
      "sha": "eb21b416a406ebae963116911afd3cd0994132ce",
      "url": "https://api.github.com/repos/rubenmoor/learn-palantype/git/trees/eb21b416a406ebae963116911afd3cd0994132ce"
    },
    {
      "path": ".gitignore",
      "mode": "100644",
      "type": "blob",
      "sha": "a47bd530c4b8677af24b291b7c401202ca1170d4",
      "size": 186,
      "url": "https://api.github.com/repos/rubenmoor/learn-palantype/git/blobs/a47bd530c4b8677af24b291b7c401202ca1170d4"
    },
    {
      "path": "static.nix",
      "mode": "100644",
      "type": "blob",
      "sha": "fcac7837dc13cce9368517ba8ba49a00d5b76734",
      "size": 353,
      "url": "https://api.github.com/repos/rubenmoor/learn-palantype/git/blobs/fcac7837dc13cce9368517ba8ba49a00d5b76734"
    },
    {
      "path": "cms-content/SystemDE/EN/Introduction.md",
      "mode": "100644",
      "type": "blob",
      "sha": "25b2be5dd3fd3d2a7a1c8fc95ed7e9623e7bd5c6",
      "size": 2670,
      "url": "https://api.github.com/repos/rubenmoor/learn-palantype/git/blobs/25b2be5dd3fd3d2a7a1c8fc95ed7e9623e7bd5c6"
    },
    {
      "path": "cms-content/SystemDE/EN/Pattern Overview.md",
      "mode": "100644",
      "type": "blob",
      "sha": "c34f97e9666e56ec12e554afc7f684e9666b74fd",
      "size": 18,
      "url": "https://api.github.com/repos/rubenmoor/learn-palantype/git/blobs/c34f97e9666e56ec12e554afc7f684e9666b74fd"
    }
  ],
  "truncated": false
}

我用Data.Aeson.Lens访问JSON结构，目前写了：

resp ^. responseBody . key "tree" ^.. -- ???

需求 #

需要筛选出满足以下条件的文件：

• type为"blob"
• 路径位于cms-content目录及其子目录下
• 是Markdown文件（路径后缀为.md）

最终要提取去掉cms-content/前缀和.md后缀的路径，期望结果：

["SystemDE/EN/Introduction", "SystemDE/EN/Pattern Overview"] :: [Text]

我已经能用mapMaybe实现：

maybeCMSFile :: Text -> Text -> Maybe Text
maybeCMSFile strType strPath | strType == "blob" =
    case Text.stripPrefix "cms-content/" strPath of
        Nothing  -> Nothing
        Just suf -> Text.stripSuffix ".md" suf
maybeCMSFile _ _ = Nothing

调用方式：

\o -> maybeCMSFile (o ^. key "type" . _String) (o ^. key "path" . _String)

但我希望不把JSON数组转成列表再用mapMaybe，而是纯靠Lens组合来实现。请问该怎么写？

注：我通过示例学习Lens，对类型签名和官方文档理解起来比较困难。

解决方案 #

可以通过traverse遍历数组元素，结合filtered做条件筛选，再用to转换路径，最后用^..收集结果。以下是几种实现方式：

方式一：拆分筛选与转换 #

import qualified Data.Text as Text
import Data.Aeson.Lens
import Control.Lens

resp ^. responseBody 
    . key "tree" 
    . values 
    -- 筛选type为blob的元素
    . filtered (\o -> o ^. key "type" . _String == "blob")
    -- 筛选符合路径要求的元素
    . filtered (\o -> let path = o ^. key "path" . _String in 
                      Text.isPrefixOf "cms-content/" path && Text.isSuffixOf ".md" path)
    -- 转换路径：去掉前缀和后缀
    . to (\o -> let path = o ^. key "path" . _String in
                Text.stripSuffix ".md" (Text.drop (length "cms-content/") path) ^. _Just)
    -- 收集所有结果
    ^.. folded

方式二：用Maybe链式操作简化转换 #

resp ^. responseBody 
    . key "tree" 
    . values 
    . filtered (\o -> o ^. key "type" . _String == "blob")
    -- 内联路径处理逻辑，返回Maybe Text
    . to (\o -> do
            path <- o ^? key "path" . _String
            suf <- Text.stripPrefix "cms-content/" path
            Text.stripSuffix ".md" suf)
    -- 过滤掉Nothing，收集Just值
    ^.. folded . _Just

方式三：合并筛选条件 #

resp ^. responseBody 
    . key "tree" 
    . values 
    -- 合并所有筛选条件
    . filtered (\o -> 
        o ^. key "type" . _String == "blob" &&
        let path = o ^. key "path" . _String in
        Text.isPrefixOf "cms-content/" path && Text.isSuffixOf ".md" path)
    -- 路径转换
    . to (\o -> 
        let path = o ^. key "path" . _String in
        Text.drop (length "cms-content/") path & Text.stripSuffix ".md" ^. _Just)
    ^.. folded

代码解释 #

• values：遍历JSON数组中的每个元素，对应tree数组的每个对象
• filtered：用于筛选满足条件的元素，支持链式调用叠加多个筛选规则
• to：将符合条件的JSON对象转换为目标格式，这里把路径处理逻辑内联到Lens组合中
• ^.. folded：收集遍历过程中的所有有效值，最终得到[Text]类型的结果

这样就完全不需要将JSON数组转成列表再用mapMaybe，纯靠Lens组合完成所有筛选和转换操作。

内容的提问来源于stack exchange，提问作者ruben.moor