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