diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,12 @@ `pagure-hs` uses [PVP Versioning](https://pvp.haskell.org). +## 0.2.0 (2024-05-06) +- queryPagureCountPaged replaces queryPagurePaged +- warnings now go to stderr +- remove queryPagure' which errored +- queryPagureCount and queryPagurePaged: no longer error + ## 0.1.2 (2024-05-05) - add pagureGroupInfo for group endpoint diff --git a/pagure.cabal b/pagure.cabal --- a/pagure.cabal +++ b/pagure.cabal @@ -1,6 +1,6 @@ cabal-version: 1.22 name: pagure -version: 0.1.2 +version: 0.2.0 synopsis: Pagure REST client library description: A library for querying Pagure gitforges via REST. homepage: https://github.com/juhp/pagure-hs @@ -24,6 +24,7 @@ GHC == 9.2.8 GHC == 9.4.8 GHC == 9.6.5 + GHC == 9.8.2 source-repository head type: git diff --git a/src/Fedora/Pagure.hs b/src/Fedora/Pagure.hs --- a/src/Fedora/Pagure.hs +++ b/src/Fedora/Pagure.hs @@ -25,10 +25,9 @@ , pagureGroupInfo , pagureProjectGitURLs , queryPagure - , queryPagure' , queryPagureSingle - , queryPagurePaged , queryPagureCount + , queryPagureCountPaged , makeKey , makeItem , maybeKey @@ -48,13 +47,13 @@ -- | Project info -- --- @@ --- pagureProjectInfo server "" --- pagureProjectInfo server "/" --- @@ +-- @pagureProjectInfo server ""@ +-- @pagureProjectInfo server "/"@ -- -- https://pagure.io/api/0/#projects-tab -pagureProjectInfo :: String -> String -> IO (Either String Object) +pagureProjectInfo :: String -- ^ server + -> String -- ^ project + -> IO (Either String Object) pagureProjectInfo server project = do let path = project queryPagureSingle server path [] @@ -62,7 +61,9 @@ -- | List projects -- -- https://pagure.io/api/0/#projects-tab -pagureListProjects :: String -> Query -> IO Object +pagureListProjects :: String -- ^ server + -> Query -- ^ parameters + -> IO Object pagureListProjects server params = do let path = "projects" queryPagure server path params @@ -70,7 +71,9 @@ -- | List project issues -- -- https://pagure.io/api/0/#issues-tab -pagureListProjectIssues :: String -> String -> Query +pagureListProjectIssues :: String -- ^ server + -> String -- ^ project repo + -> Query -- ^ parameters -> IO (Either String Object) pagureListProjectIssues server repo params = do let path = repo +/+ "issues" @@ -86,7 +89,9 @@ -- | List project issue titles -- -- https://pagure.io/api/0/#issues-tab -pagureListProjectIssueTitlesStatus :: String -> String -> Query +pagureListProjectIssueTitlesStatus :: String -- ^ server + -> String -- ^ repo + -> Query -- ^ parameters -> IO (Either String [IssueTitleStatus]) pagureListProjectIssueTitlesStatus server repo params = do let path = repo +/+ "issues" @@ -107,7 +112,10 @@ -- | Issue information -- -- https://pagure.io/api/0/#issues-tab -pagureProjectIssueInfo :: String -> String -> Int -> IO (Either String Object) +pagureProjectIssueInfo :: String -- ^ server + -> String -- ^ repo + -> Int -- ^ issue number + -> IO (Either String Object) pagureProjectIssueInfo server repo issue = do let path = repo +/+ "issue" +/+ show issue queryPagureSingle server path [] @@ -115,7 +123,9 @@ -- | List repo branches -- -- https://pagure.io/api/0/#projects-tab -pagureListGitBranches :: String -> String -> IO (Either String [String]) +pagureListGitBranches :: String -- ^ server + -> String -- ^ repo + -> IO (Either String [String]) pagureListGitBranches server repo = do let path = repo +/+ "git/branches" res <- queryPagureSingle server path [] @@ -126,7 +136,8 @@ -- | List repo branches with commits -- -- https://pagure.io/api/0/#projects-tab -pagureListGitBranchesWithCommits :: String -> String +pagureListGitBranchesWithCommits :: String -- ^ server + -> String -- ^ repo -> IO (Either String Object) pagureListGitBranchesWithCommits server repo = do let path = repo +/+ "git/branches" @@ -139,7 +150,9 @@ -- | List users -- -- https://pagure.io/api/0/#users-tab -pagureListUsers :: String -> String -> IO Object +pagureListUsers :: String -- ^ server + -> String -- ^ pattern + -> IO Object pagureListUsers server pat = do let path = "users" params = makeKey "pattern" pat @@ -148,7 +161,10 @@ -- | User information -- -- https://pagure.io/api/0/#users-tab -pagureUserInfo :: String -> String -> Query -> IO (Either String Object) +pagureUserInfo :: String -- ^ server + -> String -- ^ user + -> Query -- ^ parameters + -> IO (Either String Object) pagureUserInfo server user params = do let path = "user" +/+ user queryPagureSingle server path params @@ -156,7 +172,10 @@ -- | List groups -- -- https://pagure.io/api/0/#groups-tab -pagureListGroups :: String -> Maybe String -> Query -> IO Object +pagureListGroups :: String -- ^ server + -> Maybe String -- ^ optional pattern + -> Query -- ^ parameters + -> IO Object pagureListGroups server mpat paging = do let path = "groups" params = maybeKey "pattern" mpat ++ paging @@ -165,7 +184,10 @@ -- | Group information -- -- https://pagure.io/api/0/#groups-tab -pagureGroupInfo :: String -> String -> Query -> IO (Either String Object) +pagureGroupInfo :: String -- ^ server + -> String -- ^ group + -> Query -- ^ parameters + -> IO (Either String Object) pagureGroupInfo server group params = do let path = "group" +/+ group queryPagureSingle server path params @@ -173,27 +195,27 @@ -- | Project Git URLs -- -- https://pagure.io/api/0/#projects-tab -pagureProjectGitURLs :: String -> String -> IO (Either String Object) +pagureProjectGitURLs :: String -- ^ server + -> String -- ^ repo + -> IO (Either String Object) pagureProjectGitURLs server repo = do let path = repo +/+ "git/urls" queryPagureSingle server path [] -- | low-level query -queryPagure :: String -> String -> Query -> IO Object +queryPagure :: String -- ^ server + -> String -- ^ api path + -> Query -- ^ parameters + -> IO Object queryPagure server path params = let url = "https://" ++ server +/+ "api/0" +/+ path in webAPIQuery url params --- | low-level query --- Like queryPagure but errors if JSON has "error" field: --- eg for a non-existent API query path -queryPagure' :: String -> String -> Query -> IO Object -queryPagure' server path params = do - eres <- queryPagureSingle server path params - either error return eres - -- | single query -queryPagureSingle :: String -> String -> Query -> IO (Either String Object) +queryPagureSingle :: String -- ^ server + -> String -- ^ api path + -> Query -- ^ parameters + -> IO (Either String Object) queryPagureSingle server path params = do res <- queryPagure server path params return $ case lookupKey "error" res of @@ -201,30 +223,45 @@ Nothing -> Right res -- | count total number of hits --- FIXME: errors if the query fails -queryPagureCount :: String -> String -> Query -> String -> IO (Maybe Integer) +queryPagureCount :: String -- ^ server + -> String -- ^ api path + -> Query -- ^ parameters + -> String -- ^ pagination name + -> IO (Maybe Integer) queryPagureCount server path params pagination = do - res <- queryPagure' server path (params ++ makeKey "per_page" "1") - return $ lookupKey (T.pack pagination) res >>= lookupKey "pages" + eres <- queryPagureSingle server path (params ++ makeKey "per_page" "1") + case eres of + Left err -> do + warning err + return Nothing + Right res -> + return $ lookupKey (T.pack pagination) res >>= lookupKey "pages" -- | get all pages of results -- -- Warning: this can potentially download very large amounts of data. -- For potentially large queries, it is a good idea to queryPagureCount first. --- --- Errors for a non-existent API path -queryPagurePaged :: String -> String -> Query -> (String,String) -> IO [Object] +queryPagurePaged :: String -- ^ server + -> String -- ^ api path + -> Query -- ^ parameters + -> (String,String) -- ^ pagination and paging names + -> IO [Object] queryPagurePaged server path params (pagination,paging) = do -- FIXME allow overriding per_page let maxPerPage = "100" - res1 <- queryPagure' server path (params ++ makeKey "per_page" maxPerPage) - case (lookupKey (T.pack pagination) res1 :: Maybe Object) >>= lookupKey "pages" :: Maybe Int of - Nothing -> return [] - Just pages -> do - when (pages > 1) $ - hPutStrLn stderr $ "receiving " ++ show pages ++ " pages × " ++ maxPerPage ++ " results..." - rest <- mapM nextPage [2..pages] - return $ res1 : rest + eres <- queryPagureSingle server path (params ++ makeKey "per_page" maxPerPage) + case eres of + Left err -> do + warning err + return [] + Right res1 -> + case (lookupKey (T.pack pagination) res1 :: Maybe Object) >>= lookupKey "pages" :: Maybe Int of + Nothing -> return [] + Just pages -> do + when (pages > 1) $ + warning $ "receiving " ++ show pages ++ " pages × " ++ maxPerPage ++ " results..." + rest <- mapM nextPage [2..pages] + return $ res1 : rest where nextPage p = queryPagure server path (params ++ makeKey "per_page" "100" ++ makeKey paging (show p)) @@ -232,14 +269,18 @@ -- FIXME treat these as special cases/filters of userinfo -- | list user's repos -pagureUserRepos :: String -> String -> IO [Text] +pagureUserRepos :: String -- ^ server + -> String -- ^ user + -> IO [Text] pagureUserRepos server user = do let path = "user" +/+ user pages <- queryPagurePaged server path [] ("repos_pagination", "repopage") return $ concatMap (getRepos "repos") pages -- | list user's forks -pagureUserForks :: String -> String -> IO [Text] +pagureUserForks :: String -- ^ server + -> String -- ^ user + -> IO [Text] pagureUserForks server user = do let path = "user" +/+ user pages <- queryPagurePaged server path [] ("forks_pagination", "forkpage") @@ -248,3 +289,21 @@ getRepos :: Text -> Object -> [Text] getRepos field obj = map (lookupKey' "fullname") $ lookupKey' field obj + +queryPagureCountPaged :: String -- ^ server + -> Bool -- ^ count + -> String -- ^ api path + -> Query -- ^ parameters + -> (String,String) -- ^ pagination and paging names + -> IO [Object] +queryPagureCountPaged server count path params (pagination,paging) = + if count + then do + mnum <- queryPagureCount server path params pagination + maybe (warning "no results found") print mnum + return [] + else queryPagurePaged server path params (pagination,paging) + +-- from simple-cmd +warning :: String -> IO () +warning s = hPutStrLn stderr $! s