如何做地图也许使用镜头

问题描述 投票：0回答：2

我在 github api 上使用 

wreq
来获取存储库中的文件列表。为了完整起见，我将其包括在内。这不是关于做网络请求：

    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 -> -- ... 


resp
是 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" ^.. -- ???

现在是棘手的部分。 我只对名为“cms-content”的目录或其子目录中的降价文件感兴趣。 文件在键“类型”处具有值“blob”。 对于这些文件，我想要它们的完整路径，不带文件类型扩展名。 所以，给定示例 JSON，我正在寻找这个结果

["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" strPath
maybeCMSFile _ _ = Nothing


maybeCMSFile
的参数是 JSON 数组中对象的特定键的值：

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

但不是将 JSON 数组转换为列表（

_Array
来自 Data.Aeson.Lens 让我到达那里）并运行 
mapMaybe maybeCMSFile . Vector.toList
，我正在寻找一种方法来使用镜头达到相同的目的。 我可以通过更简单的步骤分解问题来为自己简化问题：

  1. 键/值“类型”的过滤器：“blob”
  2. 在键“路径”的值中过滤后缀“.md”
  3. 提取没有后缀“cms-content”且没有前缀“.md”的文件路径

但我当然想知道，如果这一切都可以通过组合合适的镜片来完成。

让我补充一点，我很清楚这个问题非常具体。 就个人而言，我通过这些例子了解了镜头。 仅在 hackage 文档的帮助下，我仍然无法阅读类型签名和理解镜头（和棱镜）。

haskell fold aeson lenses
2个回答
0
投票

我试过了，我找到了这个解决方案：

_MarkdownFile :: Text -> Prism Value Value Text Text
_MarkdownFile ext = prism fromFile toFile
  where
    -- not needed in practice, is there such a thing as half a prism?
    fromFile str = object
      [ "type" .= ("blob" :: Text)
      , "path" .= ("cms-content" <> str)
      ]
    toFile   o   = case o ^. key "type" . _String of
      "blob" -> let path = o ^. key "path" . _String
                in  bool (Left o) (Right path) $ checkStr path
      _ -> Left o
    checkStr str =
         "cms-content/" `Text.isPrefixOf` str
      && ext            `Text.isSuffixOf` str

getFileList :: Text -> Handler (Response [Text])
getFileList ext = do
    mAuth <- asks toMAuth
    let
        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                            ->
        Success $ resp ^.. responseBody . key "tree" . _Array . each . _MarkdownFile ext

但是，

_MarkdownFile
不应该是棱镜。 我不知道那是什么。

所以这个版本，实际上使用

mapMaybe
对我来说更有意义：

getFileList :: Text -> Handler (Response [Text])
getFileList ext = do
    mAuth <- asks toMAuth
    let
        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                            ->
        Success $ mapMaybe maybeCMSFile $
          resp ^.. responseBody . key "tree" . _Array . each
  where
    maybeCMSFile o =
        case o ^. key "type" . _String of
          "blob" -> let path = o ^. key "path" . _String
                    in  bool Nothing (Just path) $ checkStr path
          _ -> Nothing
    checkStr str =
         "cms-content/" `Text.isPrefixOf` str
      && ext            `Text.isSuffixOf` str

但实际问题仍然存在：有没有办法以类似镜头的方式做到这一点？

编辑：

此代码无法编译，但这就是我想象的镜头解决方案：

    resp ^.. responseBody . key "tree" . _Array . each
            . filteredBy (key "type" . _String . only "blob") -- index (), how to discard?
            . filteredBy (_Path . filtered                    -- index ?, how to discard?
                (\str -> "cms-content/" `Text.isPrefixOf` str -- filtered expects a fold
                      && ext `Text.isSuffixOf` str
                )) . _Path
  where
    _Path = key "path" . _String
0
投票

你的未编译代码的一个小变化：

resp ^.. responseBody . key "tree" . _Array . each
  . filteredBy (key "type" . _String . only "blob")
  . key "path" . _String
  . filtered (\str -> "cms-content/" `Text.isPrefixOf` str && ext `Text.isSuffixOf` str)
  . folding (Text.stripPrefix "cms-content/" >=> Text.stripSuffix ext)
最新问题
© www.soinside.com 2019 - 2024. All rights reserved.