2

I am using wreq on the github api to get a list of files in a repository. I include this for completeness sake. This isn't about doing the web request:

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

The resp is a JSON-encoded and looks something like this (only in reality a lot more files):

{
  "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
}

Now I can use Data.Aeson.Lens to go into the json structure like this:

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

Now comes the tricky part. I am only interested in markdown files inside a directory called "cms-content", or subdirectories thereof. Files have the value "blob" at the key "type". And for those files, I want their full path w/o the filetype extension. So, given the example JSON, I am looking for this result

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

I think of mapMaybe and can define a suitable function like that:

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

The arguments for maybeCMSFile are values for specific keys of the objects in the JSON array:

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

But instead of converting the JSON array into a list (_Array from Data.Aeson.Lens gets me there) and running mapMaybe maybeCMSFile . Vector.toList, I am looking for a way to use lenses to the same end. I can simplify the problem for myself quite a bit by breaking things down in simpler steps:

  1. filter for the key/value "type": "blob"
  2. filter for the suffix ".md" in the value at key "path"
  3. extract the filepath without the suffix "cms-content" and without the prefix ".md"

But of course I am wondering, if this can all be done just combining the right lenses.

Let me add that I am well aware that this question is awfully specific. Personally, I learned my way around lenses by these kind of examples. I still have troubles reading the type signatures and making sense of the lenses (and prisms) with the help of the documentation on hackage alone.

duplode
  • 33,731
  • 7
  • 79
  • 150
ruben.moor
  • 1,876
  • 15
  • 27

3 Answers3

1

A minor variation on your not-compiling code:

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)
duplode
  • 33,731
  • 7
  • 79
  • 150
DDub
  • 3,884
  • 1
  • 5
  • 12
1

Quoting your answer:

is there such a thing as half a prism?

A half-prism with only the forward, fallible part amounts to a traversal. In fact, that already is how filteredBy is being used in the work-in-progress solution at the end of your answer. filteredBy p is a traversal which ignores a value if preview p on it is Nothing.

We can also apply this the idea to the second part of your (or DDub's) solution, by using the prefixed and suffixed prisms as traversals:

fileList :: Value -> [Text]
fileList body =
    body ^.. key "tree" . _Array . each
        . filteredBy (key "type" . _String . only "blob")
        . key "path" . _String
        . prefixed "cms-content/" . suffixed ".md"

P.S.: Lensifying mapMaybe itself, in a way that allows you to directly supply an a -> Maybe b function to a combinator instead of encoding it as a prism or traversal, is nontrivial, and would require extra machinery not included in lens. Two explorations of the problem space are Chris Penner's Composable filters using Witherable optics and Oleg Grenrus' Coindexed optics.

duplode
  • 33,731
  • 7
  • 79
  • 150
  • So in my case, a lensified mapMaybe isn't needed. `prefixed` and `suffixed` are pretty elegant and there definition makes sense: `prefixed p = prism' (p <>) (TS.stripPrefix p)`. It seems the mapMaybe functionality is built in into lenses. Why is a `_Just` prism not need? – ruben.moor Apr 01 '23 at 13:48
  • 1
    @ruben.moor The target of e.g. `prefixed` is `Text` rather than `Maybe Text`, so there's no need to dig further into it with an additional `_Just`. A prism (or a fallible traversal) already incorporates the possibility of failure that is expressed by the `Maybe` result type of `stripPrefix`. – duplode Apr 01 '23 at 15:58
0

I tried and I found this solution:

_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

However, _MarkdownFile shouldn' be a prism. I don't know what it is.

So this version, actually using mapMaybe makes more sense to me:

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

But the actual question remains: Is there a way to do this in a lense-like fashion?

EDIT:

This code doesn't compile, but this is how I imagine a lens solution:

    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
ruben.moor
  • 1,876
  • 15
  • 27
  • A half-prism with just the fallible direction is a traversal. (More precisely, it would be an affine traversal, as it can reach at most one target, but *lens* doesn't capture that distinction.) – duplode Apr 01 '23 at 01:07