{-# LANGUAGE CPP, OverloadedStrings #-}
module Fedora.Pagure
( pagureProjectInfo
, pagureListProjects
, pagureListProjectIssues
, IssueTitleStatus(..)
, pagureListProjectIssueTitlesStatus
, pagureProjectIssueInfo
, pagureListGitBranches
, pagureListGitBranchesWithCommits
, pagureListUsers
, pagureUserForks
, pagureUserInfo
, pagureUserRepos
, pagureListGroups
, pagureProjectGitURLs
, queryPagure
, queryPagure'
, queryPagureSingle
, queryPagurePaged
, queryPagureCount
, makeKey
, makeItem
, maybeKey
, Query
, QueryItem
, lookupKey
, lookupKey'
) where
import Control.Monad
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 Object)
pagureProjectInfo :: [Char] -> [Char] -> IO (Either [Char] Object)
pagureProjectInfo [Char]
server [Char]
project = do
let path :: [Char]
path = [Char]
project
[Char] -> [Char] -> Query -> IO (Either [Char] Object)
queryPagureSingle [Char]
server [Char]
path []
pagureListProjects :: String -> Query -> IO Object
pagureListProjects :: [Char] -> Query -> IO Object
pagureListProjects [Char]
server Query
params = do
let path :: [Char]
path = [Char]
"projects"
[Char] -> [Char] -> Query -> IO Object
queryPagure [Char]
server [Char]
path Query
params
pagureListProjectIssues :: String -> String -> Query
-> IO (Either String Object)
pagureListProjectIssues :: [Char] -> [Char] -> Query -> IO (Either [Char] Object)
pagureListProjectIssues [Char]
server [Char]
repo Query
params = do
let path :: [Char]
path = [Char]
repo [Char] -> [Char] -> [Char]
+/+ [Char]
"issues"
[Char] -> [Char] -> Query -> IO (Either [Char] Object)
queryPagureSingle [Char]
server [Char]
path Query
params
data IssueTitleStatus =
IssueTitleStatus { IssueTitleStatus -> Integer
pagureIssueId :: Integer
, IssueTitleStatus -> [Char]
pagureIssueTitle :: String
, IssueTitleStatus -> Text
pagureIssueStatus :: T.Text
, IssueTitleStatus -> Maybe Text
pagureIssueCloseStatus :: Maybe T.Text
}
pagureListProjectIssueTitlesStatus :: String -> String -> Query
-> IO (Either String [IssueTitleStatus])
pagureListProjectIssueTitlesStatus :: [Char] -> [Char] -> Query -> IO (Either [Char] [IssueTitleStatus])
pagureListProjectIssueTitlesStatus [Char]
server [Char]
repo Query
params = do
let path :: [Char]
path = [Char]
repo [Char] -> [Char] -> [Char]
+/+ [Char]
"issues"
Either [Char] Object
res <- [Char] -> [Char] -> Query -> IO (Either [Char] Object)
queryPagureSingle [Char]
server [Char]
path Query
params
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Either [Char] Object
res of
Left [Char]
e -> forall a b. a -> Either a b
Left [Char]
e
Right Object
v -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Object -> Maybe IssueTitleStatus
parseIssue forall a b. (a -> b) -> a -> b
$ forall a. FromJSON a => Text -> Object -> a
lookupKey' Text
"issues" Object
v
where
parseIssue :: Object -> Maybe IssueTitleStatus
parseIssue :: Object -> Maybe IssueTitleStatus
parseIssue =
forall a b. (a -> Parser b) -> a -> Maybe b
parseMaybe forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
Integer
id' <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
Text
title <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"title"
Text
status <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"status"
Maybe Text
mcloseStatus <- Object
obj forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"close_status"
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Integer -> [Char] -> Text -> Maybe Text -> IssueTitleStatus
IssueTitleStatus Integer
id' (Text -> [Char]
T.unpack Text
title) Text
status Maybe Text
mcloseStatus
pagureProjectIssueInfo :: String -> String -> Int -> IO (Either String Object)
pagureProjectIssueInfo :: [Char] -> [Char] -> Int -> IO (Either [Char] Object)
pagureProjectIssueInfo [Char]
server [Char]
repo Int
issue = do
let path :: [Char]
path = [Char]
repo [Char] -> [Char] -> [Char]
+/+ [Char]
"issue" [Char] -> [Char] -> [Char]
+/+ forall a. Show a => a -> [Char]
show Int
issue
[Char] -> [Char] -> Query -> IO (Either [Char] Object)
queryPagureSingle [Char]
server [Char]
path []
pagureListGitBranches :: String -> String -> IO (Either String [String])
pagureListGitBranches :: [Char] -> [Char] -> IO (Either [Char] [[Char]])
pagureListGitBranches [Char]
server [Char]
repo = do
let path :: [Char]
path = [Char]
repo [Char] -> [Char] -> [Char]
+/+ [Char]
"git/branches"
Either [Char] Object
res <- [Char] -> [Char] -> Query -> IO (Either [Char] Object)
queryPagureSingle [Char]
server [Char]
path []
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Either [Char] Object
res of
Left [Char]
e -> forall a b. a -> Either a b
Left [Char]
e
Right Object
v -> forall a b. (a -> b) -> [a] -> [b]
map Text -> [Char]
T.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Text -> Object -> Either [Char] a
lookupKeyEither Text
"branches" Object
v
pagureListGitBranchesWithCommits :: String -> String
-> IO (Either String Object)
pagureListGitBranchesWithCommits :: [Char] -> [Char] -> IO (Either [Char] Object)
pagureListGitBranchesWithCommits [Char]
server [Char]
repo = do
let path :: [Char]
path = [Char]
repo [Char] -> [Char] -> [Char]
+/+ [Char]
"git/branches"
params :: Query
params = [Char] -> [Char] -> Query
makeKey [Char]
"with_commits" [Char]
"1"
Either [Char] Object
res <- [Char] -> [Char] -> Query -> IO (Either [Char] Object)
queryPagureSingle [Char]
server [Char]
path Query
params
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Either [Char] Object
res of
Left [Char]
e -> forall a b. a -> Either a b
Left [Char]
e
Right Object
v -> forall a. FromJSON a => Text -> Object -> Either [Char] a
lookupKeyEither Text
"branches" Object
v
pagureListUsers :: String -> String -> IO Object
pagureListUsers :: [Char] -> [Char] -> IO Object
pagureListUsers [Char]
server [Char]
pat = do
let path :: [Char]
path = [Char]
"users"
params :: Query
params = [Char] -> [Char] -> Query
makeKey [Char]
"pattern" [Char]
pat
[Char] -> [Char] -> Query -> IO Object
queryPagure [Char]
server [Char]
path Query
params
pagureUserInfo :: String -> String -> Query -> IO (Either String Object)
pagureUserInfo :: [Char] -> [Char] -> Query -> IO (Either [Char] Object)
pagureUserInfo [Char]
server [Char]
user Query
params = do
let path :: [Char]
path = [Char]
"user" [Char] -> [Char] -> [Char]
+/+ [Char]
user
[Char] -> [Char] -> Query -> IO (Either [Char] Object)
queryPagureSingle [Char]
server [Char]
path Query
params
pagureListGroups :: String -> Maybe String -> Query -> IO Object
pagureListGroups :: [Char] -> Maybe [Char] -> Query -> IO Object
pagureListGroups [Char]
server Maybe [Char]
mpat Query
paging = do
let path :: [Char]
path = [Char]
"groups"
params :: Query
params = [Char] -> Maybe [Char] -> Query
maybeKey [Char]
"pattern" Maybe [Char]
mpat forall a. [a] -> [a] -> [a]
++ Query
paging
[Char] -> [Char] -> Query -> IO Object
queryPagure [Char]
server [Char]
path Query
params
pagureProjectGitURLs :: String -> String -> IO (Either String Object)
pagureProjectGitURLs :: [Char] -> [Char] -> IO (Either [Char] Object)
pagureProjectGitURLs [Char]
server [Char]
repo = do
let path :: [Char]
path = [Char]
repo [Char] -> [Char] -> [Char]
+/+ [Char]
"git/urls"
[Char] -> [Char] -> Query -> IO (Either [Char] Object)
queryPagureSingle [Char]
server [Char]
path []
queryPagure :: String -> String -> Query -> IO Object
queryPagure :: [Char] -> [Char] -> Query -> IO Object
queryPagure [Char]
server [Char]
path Query
params =
let url :: [Char]
url = [Char]
"https://" forall a. [a] -> [a] -> [a]
++ [Char]
server [Char] -> [Char] -> [Char]
+/+ [Char]
"api/0" [Char] -> [Char] -> [Char]
+/+ [Char]
path
in forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
[Char] -> Query -> m a
webAPIQuery [Char]
url Query
params
queryPagure' :: String -> String -> Query -> IO Object
queryPagure' :: [Char] -> [Char] -> Query -> IO Object
queryPagure' [Char]
server [Char]
path Query
params = do
Either [Char] Object
eres <- [Char] -> [Char] -> Query -> IO (Either [Char] Object)
queryPagureSingle [Char]
server [Char]
path Query
params
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. HasCallStack => [Char] -> a
error forall (m :: * -> *) a. Monad m => a -> m a
return Either [Char] Object
eres
queryPagureSingle :: String -> String -> Query -> IO (Either String Object)
queryPagureSingle :: [Char] -> [Char] -> Query -> IO (Either [Char] Object)
queryPagureSingle [Char]
server [Char]
path Query
params = do
Object
res <- [Char] -> [Char] -> Query -> IO Object
queryPagure [Char]
server [Char]
path Query
params
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case forall a. FromJSON a => Text -> Object -> Maybe a
lookupKey Text
"error" Object
res of
Just Text
err -> forall a b. a -> Either a b
Left (Text -> [Char]
T.unpack Text
err)
Maybe Text
Nothing -> forall a b. b -> Either a b
Right Object
res
queryPagureCount :: String -> String -> Query -> String -> IO (Maybe Integer)
queryPagureCount :: [Char] -> [Char] -> Query -> [Char] -> IO (Maybe Integer)
queryPagureCount [Char]
server [Char]
path Query
params [Char]
pagination = do
Object
res <- [Char] -> [Char] -> Query -> IO Object
queryPagure' [Char]
server [Char]
path (Query
params forall a. [a] -> [a] -> [a]
++ [Char] -> [Char] -> Query
makeKey [Char]
"per_page" [Char]
"1")
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. FromJSON a => Text -> Object -> Maybe a
lookupKey ([Char] -> Text
T.pack [Char]
pagination) Object
res forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. FromJSON a => Text -> Object -> Maybe a
lookupKey Text
"pages"
queryPagurePaged :: String -> String -> Query -> (String,String) -> IO [Object]
queryPagurePaged :: [Char] -> [Char] -> Query -> ([Char], [Char]) -> IO [Object]
queryPagurePaged [Char]
server [Char]
path Query
params ([Char]
pagination,[Char]
paging) = do
let maxPerPage :: [Char]
maxPerPage = [Char]
"100"
Object
res1 <- [Char] -> [Char] -> Query -> IO Object
queryPagure' [Char]
server [Char]
path (Query
params forall a. [a] -> [a] -> [a]
++ [Char] -> [Char] -> Query
makeKey [Char]
"per_page" [Char]
maxPerPage)
case (forall a. FromJSON a => Text -> Object -> Maybe a
lookupKey ([Char] -> Text
T.pack [Char]
pagination) Object
res1 :: Maybe Object) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. FromJSON a => Text -> Object -> Maybe a
lookupKey Text
"pages" :: Maybe Int of
Maybe Int
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return []
Just Int
pages -> do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
pages forall a. Ord a => a -> a -> Bool
> Int
1) forall a b. (a -> b) -> a -> b
$
Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr forall a b. (a -> b) -> a -> b
$ [Char]
"receiving " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
pages forall a. [a] -> [a] -> [a]
++ [Char]
" pages × " forall a. [a] -> [a] -> [a]
++ [Char]
maxPerPage forall a. [a] -> [a] -> [a]
++ [Char]
" results..."
[Object]
rest <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {a}. Show a => a -> IO Object
nextPage [Int
2..Int
pages]
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Object
res1 forall a. a -> [a] -> [a]
: [Object]
rest
where
nextPage :: a -> IO Object
nextPage a
p =
[Char] -> [Char] -> Query -> IO Object
queryPagure [Char]
server [Char]
path (Query
params forall a. [a] -> [a] -> [a]
++ [Char] -> [Char] -> Query
makeKey [Char]
"per_page" [Char]
"100" forall a. [a] -> [a] -> [a]
++ [Char] -> [Char] -> Query
makeKey [Char]
paging (forall a. Show a => a -> [Char]
show a
p))
pagureUserRepos :: String -> String -> IO [Text]
pagureUserRepos :: [Char] -> [Char] -> IO [Text]
pagureUserRepos [Char]
server [Char]
user = do
let path :: [Char]
path = [Char]
"user" [Char] -> [Char] -> [Char]
+/+ [Char]
user
[Object]
pages <- [Char] -> [Char] -> Query -> ([Char], [Char]) -> IO [Object]
queryPagurePaged [Char]
server [Char]
path [] ([Char]
"repos_pagination", [Char]
"repopage")
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Text -> Object -> [Text]
getRepos Text
"repos") [Object]
pages
getRepos :: Text -> Object -> [Text]
getRepos :: Text -> Object -> [Text]
getRepos Text
field Object
obj =
forall a b. (a -> b) -> [a] -> [b]
map (forall a. FromJSON a => Text -> Object -> a
lookupKey' Text
"fullname") forall a b. (a -> b) -> a -> b
$ forall a. FromJSON a => Text -> Object -> a
lookupKey' Text
field Object
obj
pagureUserForks :: String -> String -> IO [Text]
pagureUserForks :: [Char] -> [Char] -> IO [Text]
pagureUserForks [Char]
server [Char]
user = do
let path :: [Char]
path = [Char]
"user" [Char] -> [Char] -> [Char]
+/+ [Char]
user
[Object]
pages <- [Char] -> [Char] -> Query -> ([Char], [Char]) -> IO [Object]
queryPagurePaged [Char]
server [Char]
path [] ([Char]
"forks_pagination", [Char]
"forkpage")
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Text -> Object -> [Text]
getRepos Text
"forks") [Object]
pages