pagure-cli 0.1 → 0.2
raw patch · 4 files changed
+339/−68 lines, 4 filesdep +aesondep +filepathdep +http-conduitdep −http-clientdep −http-client-tlsdep ~simple-cmd-args
Dependencies added: aeson, filepath, http-conduit, lens, lens-aeson
Dependencies removed: http-client, http-client-tls
Dependency ranges changed: simple-cmd-args
Files
- CHANGELOG.md +6/−0
- Main.hs +236/−49
- README.md +78/−11
- pagure-cli.cabal +19/−8
CHANGELOG.md view
@@ -1,4 +1,10 @@ # Changelog +## 0.2 (2020-04-06)+- new commands: 'branches', 'issues', 'users', 'username', 'groups', 'git-url'+- 'list': new options --namespace, --username, --include-forks, --only-forks+- switch to http-conduit and default to lens instead of microlens for aeson+- -U is now the short option for --url, which displays the API url+ ## 0.1 (2019-12-11) - initial release with list and user commands
Main.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-} module Main (main) where @@ -12,79 +13,265 @@ (<|>) #endif )-import Control.Monad (when)-import Data.Maybe (fromMaybe)+import Control.Monad (unless, when)+import Data.Aeson (eitherDecode)+import Data.Aeson.Types+#if (defined(MIN_VERSION_http_conduit) && MIN_VERSION_http_conduit(2,3,1))+#else+import Data.ByteString (ByteString)+#endif+#if (defined(VERSION_lens_aeson))+import Control.Lens+import Data.Aeson.Lens+#else+import Lens.Micro+import Lens.Micro.Aeson+#endif+import qualified Data.ByteString.Char8 as B+import qualified Data.ByteString.Lazy.Char8 as BL+import Data.Maybe #if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,11,0)) #else import Data.Semigroup ((<>)) #endif-import Data.List (isSuffixOf)-import qualified Data.ByteString.Lazy.Char8 as B+import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.IO as T-import Network.HTTP.Client-import Network.HTTP.Client.TLS-import Lens.Micro-import Lens.Micro.Aeson+import Network.HTTP.Conduit (queryString)+import Network.HTTP.Simple import SimpleCmdArgs+import System.FilePath ((</>)) import Paths_pagure_cli (version) -data Filter = Owner String (Maybe String) | All String- main :: IO () main = simpleCmdArgs (Just version) "Pagure client" "Simple pagure CLI" $ subcommands [ Subcommand "list" "list projects" $- listProjects <$> serverOpt <*> countOpt <*> detailsOpt <*> urlOpt <*> searchFilter+ listProjects <$> serverOpt <*> countOpt <*> urlOpt <*> jsonOpt <*> forksOpt <*> optional namespaceOpt <*> optional packagerOpt <*> optional (strArg "PATTERN") , Subcommand "user" "user repos" $- userRepos <$> serverOpt <*> countOpt <*> detailsOpt <*> urlOpt <*> strArg "USER"+ userRepos <$> serverOpt <*> countOpt <*> urlOpt <*> jsonOpt <*> strArg "USER"+ , Subcommand "branches" "list project branches" $+ repoBranches <$> serverOpt <*> urlOpt <*> jsonOpt <*> strArg "REPO"+ , Subcommand "issues" "list project issues" $+ projectIssues <$> serverOpt <*> countOpt <*> urlOpt <*> jsonOpt <*> strArg "REPO" <*> switchWith 'A' "all" "list Open and Closed issues" <*> optional (strOptionWith 'a' "author" "AUTHOR" "Filter issues by creator") <*> optional (strOptionWith 'S' "since" "Y-M-D" "Filter issues updated after date") <*> optional (strOptionWith 't' "title" "pattern" "Filter issues by title")+ , Subcommand "users" "list users" $+ users <$> serverOpt <*> urlOpt <*> jsonOpt <*> strArg "PATTERN"+ , Subcommand "username" "fullname of user" $+ username <$> serverOpt <*> urlOpt <*> jsonOpt <*> strArg "USERNAME"+ , Subcommand "groups" "list groups" $+ groups <$> serverOpt <*> countOpt <*> urlOpt <*> jsonOpt <*> optional (strArg "PATTERN")+ , Subcommand "git-url" "show project repo's git urls" $+ gitUrl <$> serverOpt <*> urlOpt <*> jsonOpt <*> strArg "REPO" ] where countOpt = switchWith 'c' "count" "Show number only"- detailsOpt = switchWith 'd' "detail" "Show all details"- urlOpt = switchWith 'u' "url" "Show url"+ jsonOpt = switchWith 'j' "json" "Print raw json response"+ -- FIXME should this be no-op?+ urlOpt = switchWith 'U' "url" "Print API url"+ namespaceOpt = strOptionWith 'n' "namespace" "NAMESPACE" "Specify project repo namespace"+ packagerOpt = Owner <$> ownerOpt <|> Committer <$> usernameOpt+ usernameOpt = strOptionWith 'u' "username" "USERNAME" "Projects to which username can commit" ownerOpt = strOptionWith 'o' "owner" "OWNER" "Projects with certain owner"- serverOpt = strOptionalWith 's' "server" "SERVER" "Pagure server" "src.fedoraproject.org"- searchFilter = All <$> strArg "PATTERN" <|>- Owner <$> ownerOpt <*> optional (strArg "PATTERN")+ serverOpt = strOptionalWith 's' "server" "SERVER" "Pagure server" srcFedoraprojectOrg+ forksOpt = flagWith' OnlyForks 'F' "only-forks" "Only list forks" <|>+ flagWith NoForks IncludeForks 'f' "include-forks" "Include forks [default: ignore forks]" -listProjects :: String -> Bool -> Bool -> Bool -> Filter -> IO ()-listProjects server count detail showurl search = do- let query = "projects?namespace=rpms&fork=0&" <> render search <> "&"- listPagure server count detail showurl query ("pagination", "page", "projects")+data Packager = Owner String | Committer String++data Forks = NoForks | IncludeForks | OnlyForks++srcFedoraprojectOrg :: String+srcFedoraprojectOrg = "src.fedoraproject.org"++#if (defined(MIN_VERSION_http_conduit) && MIN_VERSION_http_conduit(2,3,1))+#else+type Query = [(ByteString, Maybe ByteString)]+#endif++listProjects :: String -> Bool -> Bool -> Bool -> Forks -> Maybe String -> Maybe Packager -> Maybe String -> IO ()+listProjects server count showurl json forks mnamespace mpackager mpattern = do+ unless (count || isJust mpackager || isJust mpattern) $+ error' "Please give a package pattern, --count, or --owner/--username"+ let path = "projects"+ params = makeKey "short" "1" ++ fork ++ packager ++ maybeKey "namespace" mnamespace ++ maybeKey "pattern" mpattern+ pages <- queryPaged server count showurl json path params ("pagination", "page")+ unless json $+ mapM_ printPage pages where- render :: Filter -> String- -- hack until internal server API upgraded to >=0.29- render (All s) = (if ".redhat.com" `isSuffixOf` server then "" else "owner=!orphan&") <> "pattern=" <> s- render (Owner n mpat) = "owner=" <> n <> maybe "" ("&pattern=" <>) mpat+ -- (!orphan only works on pagure >=0.29)+ packager = case mpackager of+ Nothing -> boolKey "owner" (server == srcFedoraprojectOrg) "!orphan"+ Just (Owner o) -> makeKey "owner" o+ Just (Committer c) -> makeKey "username" c + fork = case forks of+ NoForks -> makeKey "fork" "0"+ IncludeForks -> []+ OnlyForks -> makeKey "fork" "1"++ printPage :: Value -> IO ()+ printPage result =+ let key' = if isJust mnamespace then "name" else "fullname" in+ mapM_ T.putStrLn $ result ^.. key "projects" . values . key (T.pack key') . _String+ userRepos :: String -> Bool -> Bool -> Bool -> String -> IO ()-userRepos server count detail showurl user = do- let query = "user/" <> user <> "?"- listPagure server count detail showurl query ("repos_pagination", "repopage", "repos")+userRepos server count showurl json user = do+ let path = "user" </> user+ pages <- queryPaged server count showurl json path [] ("repos_pagination", "repopage")+ unless json $+ mapM_ printPage pages+ where+ printPage :: Value -> IO ()+ printPage result = do+ let repos = result ^.. key (T.pack "repos") . values . _Object+ mapM_ printRepo repos -listPagure :: String -> Bool -> Bool -> Bool -> String -> (String,String,String) -> IO ()-listPagure server count detail showurl query (pagination,paging,object) = do- let url = "https://" <> server <> "/api/0/" <> query <> "per_page=" <> if count then "1" else "100"- when showurl $ putStrLn url- req1 <- parseRequest url- mgr <- newManager tlsManagerSettings- res1 <- responseBody <$> httpLbs req1 mgr- if detail then B.putStrLn res1+ printRepo :: Object -> IO ()+ printRepo repo = do+ let mfields = parseRepo repo+ case mfields of+ Nothing -> error' "parsing repo failed"+ Just (mnamespace,name) ->+ T.putStrLn $ maybe "" (<> "/") mnamespace <> name++ parseRepo :: Object -> Maybe (Maybe Text, Text)+ parseRepo =+ parseMaybe $ \obj -> do+ namespace <- obj .:? "namespace"+ name <- obj .: "name"+ return (namespace,name)++maybeKey :: String -> Maybe String -> Query+maybeKey _ Nothing = []+maybeKey k mval = [(B.pack k, fmap B.pack mval)]++makeKey :: String -> String -> Query+makeKey k val = [(B.pack k, Just (B.pack val))]++boolKey :: String -> Bool -> String -> Query+boolKey _ False _ = []+boolKey k True val = makeKey k val++-- FIXME limit max number of issues+projectIssues :: String -> Bool -> Bool -> Bool -> String -> Bool -> Maybe String -> Maybe String -> Maybe String -> IO ()+projectIssues server count showurl json repo allstatus mauthor msince mpat = do+ let path = repo </> "issues"+ params = [("status", Just "all") | allstatus] +++ maybeKey "author" mauthor ++ maybeKey "since" msince+ results <- queryPaged server count showurl json path params ("pagination", "page")+ unless json $+ mapM_ printIssues results+ where+ printIssues :: Value -> IO ()+ printIssues result = do+ let issues = result ^.. key (T.pack "issues") . values . _Object+ mapM_ printIssue issues++ printIssue :: Object -> IO ()+ printIssue issue = do+ let mfields = parseIssue issue+ case mfields of+ Nothing -> putStrLn "parsing issue failed"+ Just (id',title,status) ->+ when (isNothing mpat || T.pack (fromJust mpat) `T.isInfixOf` title) $+ putStrLn $ "https://" <> server </> repo </> "issue" </> show id' <> " (" <> T.unpack status <> "): " <> T.unpack title++ parseIssue :: Object -> Maybe (Integer, Text, Text)+ parseIssue =+ parseMaybe $ \obj -> do+ id' <- obj .: "id"+ title <- obj .: "title"+ status <- obj .: "status"+ return (id',title,status)++-- FIXME limit max number of pages (10?) or --pages+queryPaged :: String -> Bool -> Bool -> Bool -> String -> Query -> (String,String) -> IO [Value]+queryPaged server count showurl json path params (pagination,paging) = do+ res1 <- pagureQuery showurl server json path (params ++ makeKey "per_page" (if count then "1" else "100"))+ let mpages = res1 ^? key (T.pack pagination) . key "pages" . _Integer+ if count+ then do+ print $ fromMaybe (error' "pages not found") mpages+ return [] else do- let pages = res1 ^? key (T.pack pagination) . key "pages" . _Integer- if count- then print $ fromMaybe (error "not found") pages- else do- printRepos res1- mapM_ (nextPage mgr url) [2..(fromMaybe 0 pages)]- where- nextPage mgr url p = do- req <- parseRequest $ url <> "&" <> paging <> "=" <> show p- res <- responseBody <$> httpLbs req mgr- printRepos res+ rest <- mapM nextPage [2..(fromMaybe 0 mpages)]+ return $ res1 : rest+ where+ nextPage p =+ pagureQuery False server json path (params ++ makeKey "per_page" "100" ++ makeKey paging (show p)) - printRepos res =- mapM_ T.putStrLn $ res ^.. key (T.pack object) . values . key "name" . _String+pagureQuery :: Bool -> String -> Bool -> String -> Query -> IO Value+pagureQuery showurl server json path params = do+ let url = "https://" <> server </> "api/0" </> path+ req <- setRequestQueryString params <$> parseRequest url+ when showurl $ putStrLn $ url ++ B.unpack (queryString req)+ if json then do+ res <- getResponseBody <$> httpLBS req+ BL.putStrLn res+ case eitherDecode res of+ Left e -> error' e+ Right v -> return v+ else getResponseBody <$> httpJSON req++repoBranches :: String -> Bool -> Bool -> String -> IO ()+repoBranches server showurl json repo = do+ let namespace =+ if server == srcFedoraprojectOrg && '/' `notElem` repo+ then "rpms/" else ""+ path = namespace ++ repo </> "git/branches"+ res <- pagureQuery showurl server json path []+ unless json $+ printKeyList "branches" res++users :: String -> Bool -> Bool -> String -> IO ()+users server showurl json pat = do+ let path = "users"+ params = makeKey "pattern" pat+ res <- pagureQuery showurl server json path params+ unless json $+ printKeyList "users" res++username :: String -> Bool -> Bool -> String -> IO ()+username server showurl json user = do+ let path = "user" </> user+ res <- pagureQuery showurl server json path $ makeKey "per_page" "1"+ unless json $+ case res ^? key "user" . key "fullname" . _String of+ Nothing -> error' "User fullname not found"+ Just fn -> T.putStrLn fn++groups :: String -> Bool -> Bool -> Bool -> Maybe String -> IO ()+groups server count showurl json mpat = do+ let path = "groups"+ params = maybeKey "pattern" mpat+ results <- queryPaged server count showurl json path params ("pagination", "page")+ unless json $+ mapM_ (printKeyList "groups") results++printKeyList :: String -> Value -> IO ()+printKeyList key' res =+ mapM_ T.putStrLn $ res ^.. key (T.pack key') . values . _String++gitUrl :: String -> Bool -> Bool -> String -> IO ()+gitUrl server showurl json repo = do+ let namespace =+ if server == srcFedoraprojectOrg && '/' `notElem` repo+ then "rpms/" else ""+ path = namespace ++ repo </> "git/urls"+ res <- pagureQuery showurl server json path []+ unless json $+ printURLs res+ where+ printURLs :: Value -> IO ()+ printURLs result =+ mapM_ T.putStrLn $ result ^.. key (T.pack "urls") . members . _String++-- from simple-cmd+error' :: String -> a+#if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,9,0))+error' = errorWithoutStackTrace+#else+error' = error+#endif
README.md view
@@ -1,35 +1,102 @@-# pagure+# pagure-cli [](https://hackage.haskell.org/package/pagure-cli) [](LICENSE) [](http://stackage.org/lts/package/pagure-cli) [](http://stackage.org/nightly/package/pagure-cli) [](https://travis-ci.org/juhp/pagure-cli)+[](https://copr.fedorainfracloud.org/coprs/petersen/pagure-cli/) -Pagure client+A [pagure](https://docs.pagure.org/pagure/) client for querying+projects and users. -## Usage examples-It defaults to using the src.fedoraproject.org Pagure instance.+## Usage+By default it uses the [src.fedoraproject.org](https://src.fedoraproject.org/)+Pagure server instance (aka Fedora dist-git), but this can be overriden+by the `--server` option. -List or search for source packages:+## List/search for repos ``` $ pagure list emacs\* emacs : ```-(can also filter by owner).+Note by default 'orphan' owned packages are excluded. -List packages by user:+One can also filter by owner or committer. +## List user's projects++Count projects of a user: ```-$ pagure user --count mattdm-19+$ pagure user -s pagure.io --count mattdm+93 ``` -List projects on pagure.io:+## List groups: ```-$ pagure list -s pagure.io \*+$ pagure groups : ```++## More commands++- `branches` lists the git branches of a repo++- `issues` to query and list issues++- `users` to list usernames of users++- `username` shows the fullname of a user++- `git-url` shows the git urls for a repo++## Help++Use `--help` to get help on individual commands:++```+$ pagure list --help+Usage: pagure list [-s|--server SERVER] [-c|--count] [-U|--url] [-j|--json]+ [(-F|--only-forks) | (-f|--include-forks)]+ [-n|--namespace NAMESPACE]+ [(-o|--owner OWNER) | (-u|--username USERNAME)] [PATTERN]+ list projects++Available options:+ -s,--server SERVER Pagure server+ -c,--count Show number only+ -U,--url Print API url+ -j,--json Print raw json response+ -F,--only-forks Only list forks+ -f,--include-forks Include forks [default: ignore forks]+ -n,--namespace NAMESPACE Specify project repo namespace+ -o,--owner OWNER Projects with certain owner+ -u,--username USERNAME Projects to which username can commit+ -h,--help Show this help text+```++## Installation++To build the latest release you will need cabal-install and ghc, or stack:++`stack install pagure-cli` or `cabal new-install pagure-cli`.++Or to build from the git source, run directly without the package name.++## Binaries++If you are using Fedora you can install the package from my+[copr repo](https://copr.fedorainfracloud.org/coprs/petersen/pagure-cli/).++## Contributions++Pagure rest API can be found on pagure servers: eg <https://pagure.io/api/0>.+There are still many unsupported commands and options.+Please open a ticket or PR to request adding more.++## Other clients+After writing the initial version I discovered that+Ricky Elrod (relrod) had made <https://github.com/fedora-infra/pagure-cli>.
pagure-cli.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.0 name: pagure-cli-version: 0.1+version: 0.2 synopsis: Pagure client description: A commandline Pagure client for querying projects and users. homepage: https://github.com/juhp/pagure-cli@@ -14,24 +14,35 @@ build-type: Simple extra-doc-files: README.md , CHANGELOG.md-tested-with: GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5+tested-with: GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5,+ GHC == 8.8.3 source-repository head type: git location: https://github.com/juhp/pagure-cli.git ++flag microlens+ description: Use smaller microlens instead of lens+ default: False+ executable pagure main-is: Main.hs - build-depends: bytestring+ build-depends: aeson , base < 5- , http-client- , http-client-tls- , microlens- , microlens-aeson+ , bytestring+ , filepath+ , http-conduit , optparse-applicative- , simple-cmd-args >= 0.1.2+ , simple-cmd-args >= 0.1.6 , text+ if flag(microlens)+ build-depends: microlens, microlens-aeson+ cpp-options: -DMICROLENS+ else+ build-depends: lens, lens-aeson+ if impl(ghc<8.0) build-depends: semigroups