{-# LANGUAGE CPP #-}
module Fedora.Pagure
( pagureProjectInfo
, pagureListProjects
, pagureListProjectIssues
, IssueTitleStatus(..)
, pagureListProjectIssueTitlesStatus
, pagureProjectIssueInfo
, pagureListGitBranches
, pagureListGitBranchesWithCommits
, pagureListUsers
, pagureUserForks
, pagureUserInfo
, pagureUserRepos
, pagureListGroups
, pagureProjectGitURLs
, queryPagure
, queryPagureSingle
, queryPagurePaged
, queryPagureCount
, makeKey
, makeItem
, maybeKey
, Query
, QueryItem
, lookupKey
, lookupKey'
) where
import Control.Monad
#if (defined(VERSION_lens_aeson))
import Control.Lens
import Data.Aeson.Lens
#else
import Lens.Micro
import Lens.Micro.Aeson
#endif
import Data.Aeson.Types
import Data.Maybe
import Data.Text (Text)
import qualified Data.Text as T
import Network.HTTP.Query
import System.IO (hPutStrLn, stderr)
pagureProjectInfo :: String -> String -> IO (Either String Value)
pagureProjectInfo :: String -> String -> IO (Either String Value)
pagureProjectInfo String
server String
project = do
let path :: String
path = String
project
String -> String -> Query -> IO (Either String Value)
queryPagureSingle String
server String
path []
pagureListProjects :: String -> Query -> IO Value
pagureListProjects :: String -> Query -> IO Value
pagureListProjects String
server Query
params = do
let path :: String
path = String
"projects"
String -> String -> Query -> IO Value
queryPagure String
server String
path Query
params
pagureListProjectIssues :: String -> String -> Query -> IO (Either String Value)
pagureListProjectIssues :: String -> String -> Query -> IO (Either String Value)
pagureListProjectIssues String
server String
repo Query
params = do
let path :: String
path = String
repo String -> String -> String
+/+ String
"issues"
String -> String -> Query -> IO (Either String Value)
queryPagureSingle String
server String
path Query
params
data IssueTitleStatus =
IssueTitleStatus { IssueTitleStatus -> Integer
pagureIssueId :: Integer
, IssueTitleStatus -> String
pagureIssueTitle :: String
, IssueTitleStatus -> Text
pagureIssueStatus :: T.Text
, IssueTitleStatus -> Maybe Text
pagureIssueCloseStatus :: Maybe T.Text
}
pagureListProjectIssueTitlesStatus :: String -> String -> Query
-> IO (Either String [IssueTitleStatus])
pagureListProjectIssueTitlesStatus :: String -> String -> Query -> IO (Either String [IssueTitleStatus])
pagureListProjectIssueTitlesStatus String
server String
repo Query
params = do
let path :: String
path = String
repo String -> String -> String
+/+ String
"issues"
Either String Value
res <- String -> String -> Query -> IO (Either String Value)
queryPagureSingle String
server String
path Query
params
Either String [IssueTitleStatus]
-> IO (Either String [IssueTitleStatus])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String [IssueTitleStatus]
-> IO (Either String [IssueTitleStatus]))
-> Either String [IssueTitleStatus]
-> IO (Either String [IssueTitleStatus])
forall a b. (a -> b) -> a -> b
$ case Either String Value
res of
Left String
e -> String -> Either String [IssueTitleStatus]
forall a b. a -> Either a b
Left String
e
Right Value
v -> [IssueTitleStatus] -> Either String [IssueTitleStatus]
forall a b. b -> Either a b
Right ([IssueTitleStatus] -> Either String [IssueTitleStatus])
-> [IssueTitleStatus] -> Either String [IssueTitleStatus]
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (Endo [Object]) Value Object -> [Object]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key (String -> Text
T.pack String
"issues") ((Value -> Const (Endo [Object]) Value)
-> Value -> Const (Endo [Object]) Value)
-> Getting (Endo [Object]) Value Object
-> Getting (Endo [Object]) Value Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Const (Endo [Object]) Value)
-> Value -> Const (Endo [Object]) Value
forall t. AsValue t => IndexedTraversal' Int t Value
values ((Value -> Const (Endo [Object]) Value)
-> Value -> Const (Endo [Object]) Value)
-> Getting (Endo [Object]) Value Object
-> Getting (Endo [Object]) Value Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Endo [Object]) Value Object
forall t. AsValue t => Prism' t Object
_Object [Object] -> ([Object] -> [IssueTitleStatus]) -> [IssueTitleStatus]
forall a b. a -> (a -> b) -> b
& (Object -> Maybe IssueTitleStatus)
-> [Object] -> [IssueTitleStatus]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Object -> Maybe IssueTitleStatus
parseIssue
where
parseIssue :: Object -> Maybe IssueTitleStatus
parseIssue :: Object -> Maybe IssueTitleStatus
parseIssue =
(Object -> Parser IssueTitleStatus)
-> Object -> Maybe IssueTitleStatus
forall a b. (a -> Parser b) -> a -> Maybe b
parseMaybe ((Object -> Parser IssueTitleStatus)
-> Object -> Maybe IssueTitleStatus)
-> (Object -> Parser IssueTitleStatus)
-> Object
-> Maybe IssueTitleStatus
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
Integer
id' <- Object
obj Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"id"
Text
title <- Object
obj Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"title"
Text
status <- Object
obj Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"status"
Maybe Text
mcloseStatus <- Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"close_status"
IssueTitleStatus -> Parser IssueTitleStatus
forall (m :: * -> *) a. Monad m => a -> m a
return (IssueTitleStatus -> Parser IssueTitleStatus)
-> IssueTitleStatus -> Parser IssueTitleStatus
forall a b. (a -> b) -> a -> b
$ Integer -> String -> Text -> Maybe Text -> IssueTitleStatus
IssueTitleStatus Integer
id' (Text -> String
T.unpack Text
title) Text
status Maybe Text
mcloseStatus
pagureProjectIssueInfo :: String -> String -> Int -> IO (Either String Object)
pagureProjectIssueInfo :: String -> String -> Int -> IO (Either String Object)
pagureProjectIssueInfo String
server String
repo Int
issue = do
let path :: String
path = String
repo String -> String -> String
+/+ String
"issue" String -> String -> String
+/+ Int -> String
forall a. Show a => a -> String
show Int
issue
Either String Value
res <- String -> String -> Query -> IO (Either String Value)
queryPagureSingle String
server String
path []
Either String Object -> IO (Either String Object)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Object -> IO (Either String Object))
-> Either String Object -> IO (Either String Object)
forall a b. (a -> b) -> a -> b
$ case Either String Value
res of
Left String
e -> String -> Either String Object
forall a b. a -> Either a b
Left String
e
Right Value
v -> Object -> Either String Object
forall a b. b -> Either a b
Right (Object -> Either String Object) -> Object -> Either String Object
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting Object Value Object -> Object
forall s a. s -> Getting a s a -> a
^. Getting Object Value Object
forall t. AsValue t => Prism' t Object
_Object
pagureListGitBranches :: String -> String -> IO (Either String [String])
pagureListGitBranches :: String -> String -> IO (Either String [String])
pagureListGitBranches String
server String
repo = do
let path :: String
path = String
repo String -> String -> String
+/+ String
"git/branches"
Either String Value
res <- String -> String -> Query -> IO (Either String Value)
queryPagureSingle String
server String
path []
Either String [String] -> IO (Either String [String])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String [String] -> IO (Either String [String]))
-> Either String [String] -> IO (Either String [String])
forall a b. (a -> b) -> a -> b
$ case Either String Value
res of
Left String
e -> String -> Either String [String]
forall a b. a -> Either a b
Left String
e
Right Value
v -> [String] -> Either String [String]
forall a b. b -> Either a b
Right ([String] -> Either String [String])
-> [String] -> Either String [String]
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting (Endo [Text]) Value Text -> [Text]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key (String -> Text
T.pack String
"branches") ((Value -> Const (Endo [Text]) Value)
-> Value -> Const (Endo [Text]) Value)
-> Getting (Endo [Text]) Value Text
-> Getting (Endo [Text]) Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Const (Endo [Text]) Value)
-> Value -> Const (Endo [Text]) Value
forall t. AsValue t => IndexedTraversal' Int t Value
values ((Value -> Const (Endo [Text]) Value)
-> Value -> Const (Endo [Text]) Value)
-> Getting (Endo [Text]) Value Text
-> Getting (Endo [Text]) Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Endo [Text]) Value Text
forall t. AsPrimitive t => Prism' t Text
_String [Text] -> ([Text] -> [String]) -> [String]
forall a b. a -> (a -> b) -> b
& (Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
T.unpack
pagureListGitBranchesWithCommits :: String -> String -> IO (Either String Object)
pagureListGitBranchesWithCommits :: String -> String -> IO (Either String Object)
pagureListGitBranchesWithCommits String
server String
repo = do
let path :: String
path = String
repo String -> String -> String
+/+ String
"git/branches"
params :: Query
params = String -> String -> Query
makeKey String
"with_commits" String
"1"
Either String Value
res <- String -> String -> Query -> IO (Either String Value)
queryPagureSingle String
server String
path Query
params
Either String Object -> IO (Either String Object)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Object -> IO (Either String Object))
-> Either String Object -> IO (Either String Object)
forall a b. (a -> b) -> a -> b
$ case Either String Value
res of
Left String
e -> String -> Either String Object
forall a b. a -> Either a b
Left String
e
Right Value
v -> Object -> Either String Object
forall a b. b -> Either a b
Right (Object -> Either String Object) -> Object -> Either String Object
forall a b. (a -> b) -> a -> b
$ Value
v Value -> Getting Object Value Object -> Object
forall s a. s -> Getting a s a -> a
^. Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key (String -> Text
T.pack String
"branches") ((Value -> Const Object Value) -> Value -> Const Object Value)
-> Getting Object Value Object -> Getting Object Value Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Object Value Object
forall t. AsValue t => Prism' t Object
_Object
pagureListUsers :: String -> String -> IO Value
pagureListUsers :: String -> String -> IO Value
pagureListUsers String
server String
pat = do
let path :: String
path = String
"users"
params :: Query
params = String -> String -> Query
makeKey String
"pattern" String
pat
String -> String -> Query -> IO Value
queryPagure String
server String
path Query
params
pagureUserInfo :: String -> String -> Query -> IO (Either String Value)
pagureUserInfo :: String -> String -> Query -> IO (Either String Value)
pagureUserInfo String
server String
user Query
params = do
let path :: String
path = String
"user" String -> String -> String
+/+ String
user
String -> String -> Query -> IO (Either String Value)
queryPagureSingle String
server String
path Query
params
pagureListGroups :: String -> Maybe String -> Query -> IO Value
pagureListGroups :: String -> Maybe String -> Query -> IO Value
pagureListGroups String
server Maybe String
mpat Query
paging = do
let path :: String
path = String
"groups"
params :: Query
params = String -> Maybe String -> Query
maybeKey String
"pattern" Maybe String
mpat Query -> Query -> Query
forall a. [a] -> [a] -> [a]
++ Query
paging
String -> String -> Query -> IO Value
queryPagure String
server String
path Query
params
pagureProjectGitURLs :: String -> String -> IO (Either String Value)
pagureProjectGitURLs :: String -> String -> IO (Either String Value)
pagureProjectGitURLs String
server String
repo = do
let path :: String
path = String
repo String -> String -> String
+/+ String
"git/urls"
String -> String -> Query -> IO (Either String Value)
queryPagureSingle String
server String
path []
queryPagure :: String -> String -> Query -> IO Value
queryPagure :: String -> String -> Query -> IO Value
queryPagure String
server String
path Query
params =
let url :: String
url = String
"https://" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
server String -> String -> String
+/+ String
"api/0" String -> String -> String
+/+ String
path
in String -> Query -> IO Value
forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
String -> Query -> m a
webAPIQuery String
url Query
params
queryPagureSingle :: String -> String -> Query -> IO (Either String Value)
queryPagureSingle :: String -> String -> Query -> IO (Either String Value)
queryPagureSingle String
server String
path Query
params = do
Value
res <- String -> String -> Query -> IO Value
queryPagure String
server String
path Query
params
if Maybe Value -> Bool
forall a. Maybe a -> Bool
isJust (Value
res Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"error") then
Either String Value -> IO (Either String Value)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Value -> IO (Either String Value))
-> Either String Value -> IO (Either String Value)
forall a b. (a -> b) -> a -> b
$ String -> Either String Value
forall a b. a -> Either a b
Left (Value
res Value -> Getting Text Value Text -> Text
forall s a. s -> Getting a s a -> a
^. Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"error" ((Value -> Const Text Value) -> Value -> Const Text Value)
-> Getting Text Value Text -> Getting Text Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Text Value Text
forall t. AsPrimitive t => Prism' t Text
_String Text -> (Text -> String) -> String
forall a b. a -> (a -> b) -> b
& Text -> String
T.unpack)
else
Either String Value -> IO (Either String Value)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Value -> IO (Either String Value))
-> Either String Value -> IO (Either String Value)
forall a b. (a -> b) -> a -> b
$ Value -> Either String Value
forall a b. b -> Either a b
Right Value
res
queryPagureCount :: String -> String -> Query -> String -> IO (Maybe Integer)
queryPagureCount :: String -> String -> Query -> String -> IO (Maybe Integer)
queryPagureCount String
server String
path Query
params String
pagination = do
Value
res <- String -> String -> Query -> IO Value
queryPagure String
server String
path (Query
params Query -> Query -> Query
forall a. [a] -> [a] -> [a]
++ String -> String -> Query
makeKey String
"per_page" String
"1")
Maybe Integer -> IO (Maybe Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Integer -> IO (Maybe Integer))
-> Maybe Integer -> IO (Maybe Integer)
forall a b. (a -> b) -> a -> b
$ Value
res Value -> Getting (First Integer) Value Integer -> Maybe Integer
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key (String -> Text
T.pack String
pagination) ((Value -> Const (First Integer) Value)
-> Value -> Const (First Integer) Value)
-> Getting (First Integer) Value Integer
-> Getting (First Integer) Value Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"pages" ((Value -> Const (First Integer) Value)
-> Value -> Const (First Integer) Value)
-> Getting (First Integer) Value Integer
-> Getting (First Integer) Value Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Integer) Value Integer
forall t. AsNumber t => Prism' t Integer
_Integer
queryPagurePaged :: String -> String -> Query -> (String,String) -> IO [Value]
queryPagurePaged :: String -> String -> Query -> (String, String) -> IO [Value]
queryPagurePaged String
server String
path Query
params (String
pagination,String
paging) = do
let maxPerPage :: String
maxPerPage = String
"100"
Value
res1 <- String -> String -> Query -> IO Value
queryPagure String
server String
path (Query
params Query -> Query -> Query
forall a. [a] -> [a] -> [a]
++ String -> String -> Query
makeKey String
"per_page" String
maxPerPage)
let mpages :: Maybe Integer
mpages = Value
res1 Value -> Getting (First Integer) Value Integer -> Maybe Integer
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key (String -> Text
T.pack String
pagination) ((Value -> Const (First Integer) Value)
-> Value -> Const (First Integer) Value)
-> Getting (First Integer) Value Integer
-> Getting (First Integer) Value Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"pages" ((Value -> Const (First Integer) Value)
-> Value -> Const (First Integer) Value)
-> Getting (First Integer) Value Integer
-> Getting (First Integer) Value Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Integer) Value Integer
forall t. AsNumber t => Prism' t Integer
_Integer
case Maybe Integer
mpages of
Maybe Integer
Nothing -> [Value] -> IO [Value]
forall (m :: * -> *) a. Monad m => a -> m a
return []
Just Integer
pages -> do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
pages Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
1) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"receiving " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
pages String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" pages × " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
maxPerPage String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" results..."
[Value]
rest <- (Integer -> IO Value) -> [Integer] -> IO [Value]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Integer -> IO Value
forall a. Show a => a -> IO Value
nextPage [Integer
2..Integer
pages]
[Value] -> IO [Value]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Value] -> IO [Value]) -> [Value] -> IO [Value]
forall a b. (a -> b) -> a -> b
$ Value
res1 Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rest
where
nextPage :: a -> IO Value
nextPage a
p =
String -> String -> Query -> IO Value
queryPagure String
server String
path (Query
params Query -> Query -> Query
forall a. [a] -> [a] -> [a]
++ String -> String -> Query
makeKey String
"per_page" String
"100" Query -> Query -> Query
forall a. [a] -> [a] -> [a]
++ String -> String -> Query
makeKey String
paging (a -> String
forall a. Show a => a -> String
show a
p))
pagureUserRepos :: String -> String -> IO [Text]
pagureUserRepos :: String -> String -> IO [Text]
pagureUserRepos String
server String
user = do
let path :: String
path = String
"user" String -> String -> String
+/+ String
user
[Value]
pages <- String -> String -> Query -> (String, String) -> IO [Value]
queryPagurePaged String
server String
path [] (String
"repos_pagination", String
"repopage")
[Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> IO [Text]) -> [Text] -> IO [Text]
forall a b. (a -> b) -> a -> b
$ (Value -> [Text]) -> [Value] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Text -> Value -> [Text]
getRepos Text
"repos") [Value]
pages
getRepos :: Text -> Value -> [Text]
getRepos :: Text -> Value -> [Text]
getRepos Text
field Value
result =
Value
result Value -> Getting (Endo [Text]) Value Text -> [Text]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
field ((Value -> Const (Endo [Text]) Value)
-> Value -> Const (Endo [Text]) Value)
-> Getting (Endo [Text]) Value Text
-> Getting (Endo [Text]) Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Const (Endo [Text]) Value)
-> Value -> Const (Endo [Text]) Value
forall t. AsValue t => IndexedTraversal' Int t Value
values ((Value -> Const (Endo [Text]) Value)
-> Value -> Const (Endo [Text]) Value)
-> Getting (Endo [Text]) Value Text
-> Getting (Endo [Text]) Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"fullname" ((Value -> Const (Endo [Text]) Value)
-> Value -> Const (Endo [Text]) Value)
-> Getting (Endo [Text]) Value Text
-> Getting (Endo [Text]) Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Endo [Text]) Value Text
forall t. AsPrimitive t => Prism' t Text
_String
pagureUserForks :: String -> String -> IO [Text]
pagureUserForks :: String -> String -> IO [Text]
pagureUserForks String
server String
user = do
let path :: String
path = String
"user" String -> String -> String
+/+ String
user
[Value]
pages <- String -> String -> Query -> (String, String) -> IO [Value]
queryPagurePaged String
server String
path [] (String
"forks_pagination", String
"forkpage")
[Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> IO [Text]) -> [Text] -> IO [Text]
forall a b. (a -> b) -> a -> b
$ (Value -> [Text]) -> [Value] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Text -> Value -> [Text]
getRepos Text
"forks") [Value]
pages