{-# LANGUAGE CPP #-}
module GitHub.Endpoints.Issues (
currentUserIssuesR,
organizationIssuesR,
issue,
issue',
issueR,
issuesForRepo,
issuesForRepo',
issuesForRepoR,
createIssue,
createIssueR,
newIssue,
editIssue,
editIssueR,
editOfIssue,
module GitHub.Data,
) where
import GitHub.Data
import GitHub.Internal.Prelude
import GitHub.Request
import Prelude ()
currentUserIssuesR :: IssueMod -> FetchCount -> Request 'RA (Vector Issue)
currentUserIssuesR :: IssueMod -> FetchCount -> Request 'RA (Vector Issue)
currentUserIssuesR opts :: IssueMod
opts =
Paths -> QueryString -> FetchCount -> Request 'RA (Vector Issue)
forall a (mt :: RW).
FromJSON a =>
Paths -> QueryString -> FetchCount -> Request mt (Vector a)
pagedQuery ["user", "issues"] (IssueMod -> QueryString
issueModToQueryString IssueMod
opts)
organizationIssuesR :: Name Organization -> IssueMod -> FetchCount -> Request k (Vector Issue)
organizationIssuesR :: Name Organization
-> IssueMod -> FetchCount -> Request k (Vector Issue)
organizationIssuesR org :: Name Organization
org opts :: IssueMod
opts =
Paths -> QueryString -> FetchCount -> Request k (Vector Issue)
forall a (mt :: RW).
FromJSON a =>
Paths -> QueryString -> FetchCount -> Request mt (Vector a)
pagedQuery ["orgs", Name Organization -> Text
forall a. IsPathPart a => a -> Text
toPathPart Name Organization
org, "issues"] (IssueMod -> QueryString
issueModToQueryString IssueMod
opts)
issue' :: Maybe Auth -> Name Owner -> Name Repo -> Id Issue -> IO (Either Error Issue)
issue' :: Maybe Auth
-> Name Owner -> Name Repo -> Id Issue -> IO (Either Error Issue)
issue' auth :: Maybe Auth
auth user :: Name Owner
user reqRepoName :: Name Repo
reqRepoName reqIssueNumber :: Id Issue
reqIssueNumber =
Maybe Auth
-> GenRequest 'MtJSON 'RO Issue -> IO (Either Error Issue)
forall am (mt :: MediaType *) a.
(AuthMethod am, ParseResponse mt a) =>
Maybe am -> GenRequest mt 'RO a -> IO (Either Error a)
executeRequestMaybe Maybe Auth
auth (GenRequest 'MtJSON 'RO Issue -> IO (Either Error Issue))
-> GenRequest 'MtJSON 'RO Issue -> IO (Either Error Issue)
forall a b. (a -> b) -> a -> b
$ Name Owner -> Name Repo -> Id Issue -> GenRequest 'MtJSON 'RO Issue
forall (k :: RW).
Name Owner -> Name Repo -> Id Issue -> Request k Issue
issueR Name Owner
user Name Repo
reqRepoName Id Issue
reqIssueNumber
issue :: Name Owner -> Name Repo -> Id Issue -> IO (Either Error Issue)
issue :: Name Owner -> Name Repo -> Id Issue -> IO (Either Error Issue)
issue = Maybe Auth
-> Name Owner -> Name Repo -> Id Issue -> IO (Either Error Issue)
issue' Maybe Auth
forall a. Maybe a
Nothing
issueR :: Name Owner -> Name Repo -> Id Issue -> Request k Issue
issueR :: Name Owner -> Name Repo -> Id Issue -> Request k Issue
issueR user :: Name Owner
user reqRepoName :: Name Repo
reqRepoName reqIssueNumber :: Id Issue
reqIssueNumber =
Paths -> QueryString -> Request k Issue
forall (mt :: RW) a. Paths -> QueryString -> Request mt a
query ["repos", Name Owner -> Text
forall a. IsPathPart a => a -> Text
toPathPart Name Owner
user, Name Repo -> Text
forall a. IsPathPart a => a -> Text
toPathPart Name Repo
reqRepoName, "issues", Id Issue -> Text
forall a. IsPathPart a => a -> Text
toPathPart Id Issue
reqIssueNumber] []
issuesForRepo' :: Maybe Auth -> Name Owner -> Name Repo -> IssueRepoMod -> IO (Either Error (Vector Issue))
issuesForRepo' :: Maybe Auth
-> Name Owner
-> Name Repo
-> IssueRepoMod
-> IO (Either Error (Vector Issue))
issuesForRepo' auth :: Maybe Auth
auth user :: Name Owner
user reqRepoName :: Name Repo
reqRepoName opts :: IssueRepoMod
opts =
Maybe Auth
-> GenRequest 'MtJSON 'RO (Vector Issue)
-> IO (Either Error (Vector Issue))
forall am (mt :: MediaType *) a.
(AuthMethod am, ParseResponse mt a) =>
Maybe am -> GenRequest mt 'RO a -> IO (Either Error a)
executeRequestMaybe Maybe Auth
auth (GenRequest 'MtJSON 'RO (Vector Issue)
-> IO (Either Error (Vector Issue)))
-> GenRequest 'MtJSON 'RO (Vector Issue)
-> IO (Either Error (Vector Issue))
forall a b. (a -> b) -> a -> b
$ Name Owner
-> Name Repo
-> IssueRepoMod
-> FetchCount
-> GenRequest 'MtJSON 'RO (Vector Issue)
forall (k :: RW).
Name Owner
-> Name Repo
-> IssueRepoMod
-> FetchCount
-> Request k (Vector Issue)
issuesForRepoR Name Owner
user Name Repo
reqRepoName IssueRepoMod
opts FetchCount
FetchAll
issuesForRepo :: Name Owner -> Name Repo -> IssueRepoMod -> IO (Either Error (Vector Issue))
issuesForRepo :: Name Owner
-> Name Repo -> IssueRepoMod -> IO (Either Error (Vector Issue))
issuesForRepo = Maybe Auth
-> Name Owner
-> Name Repo
-> IssueRepoMod
-> IO (Either Error (Vector Issue))
issuesForRepo' Maybe Auth
forall a. Maybe a
Nothing
issuesForRepoR :: Name Owner -> Name Repo -> IssueRepoMod -> FetchCount -> Request k (Vector Issue)
issuesForRepoR :: Name Owner
-> Name Repo
-> IssueRepoMod
-> FetchCount
-> Request k (Vector Issue)
issuesForRepoR user :: Name Owner
user reqRepoName :: Name Repo
reqRepoName opts :: IssueRepoMod
opts =
Paths -> QueryString -> FetchCount -> Request k (Vector Issue)
forall a (mt :: RW).
FromJSON a =>
Paths -> QueryString -> FetchCount -> Request mt (Vector a)
pagedQuery ["repos", Name Owner -> Text
forall a. IsPathPart a => a -> Text
toPathPart Name Owner
user, Name Repo -> Text
forall a. IsPathPart a => a -> Text
toPathPart Name Repo
reqRepoName, "issues"] QueryString
qs
where
qs :: QueryString
qs = IssueRepoMod -> QueryString
issueRepoModToQueryString IssueRepoMod
opts
newIssue :: Text -> NewIssue
newIssue :: Text -> NewIssue
newIssue title :: Text
title = Text
-> Maybe Text
-> Vector (Name User)
-> Maybe (Id Milestone)
-> Maybe (Vector (Name IssueLabel))
-> NewIssue
NewIssue Text
title Maybe Text
forall a. Maybe a
Nothing Vector (Name User)
forall a. Monoid a => a
mempty Maybe (Id Milestone)
forall a. Maybe a
Nothing Maybe (Vector (Name IssueLabel))
forall a. Maybe a
Nothing
createIssue :: Auth -> Name Owner -> Name Repo -> NewIssue
-> IO (Either Error Issue)
createIssue :: Auth
-> Name Owner -> Name Repo -> NewIssue -> IO (Either Error Issue)
createIssue auth :: Auth
auth user :: Name Owner
user repo :: Name Repo
repo ni :: NewIssue
ni =
Auth -> GenRequest 'MtJSON 'RW Issue -> IO (Either Error Issue)
forall am (mt :: MediaType *) a (rw :: RW).
(AuthMethod am, ParseResponse mt a) =>
am -> GenRequest mt rw a -> IO (Either Error a)
executeRequest Auth
auth (GenRequest 'MtJSON 'RW Issue -> IO (Either Error Issue))
-> GenRequest 'MtJSON 'RW Issue -> IO (Either Error Issue)
forall a b. (a -> b) -> a -> b
$ Name Owner -> Name Repo -> NewIssue -> GenRequest 'MtJSON 'RW Issue
createIssueR Name Owner
user Name Repo
repo NewIssue
ni
createIssueR :: Name Owner -> Name Repo -> NewIssue -> Request 'RW Issue
createIssueR :: Name Owner -> Name Repo -> NewIssue -> GenRequest 'MtJSON 'RW Issue
createIssueR user :: Name Owner
user repo :: Name Repo
repo =
CommandMethod
-> Paths -> ByteString -> GenRequest 'MtJSON 'RW Issue
forall a. CommandMethod -> Paths -> ByteString -> Request 'RW a
command CommandMethod
Post ["repos", Name Owner -> Text
forall a. IsPathPart a => a -> Text
toPathPart Name Owner
user, Name Repo -> Text
forall a. IsPathPart a => a -> Text
toPathPart Name Repo
repo, "issues"] (ByteString -> GenRequest 'MtJSON 'RW Issue)
-> (NewIssue -> ByteString)
-> NewIssue
-> GenRequest 'MtJSON 'RW Issue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewIssue -> ByteString
forall a. ToJSON a => a -> ByteString
encode
editOfIssue :: EditIssue
editOfIssue :: EditIssue
editOfIssue = Maybe Text
-> Maybe Text
-> Maybe (Vector (Name User))
-> Maybe IssueState
-> Maybe (Id Milestone)
-> Maybe (Vector (Name IssueLabel))
-> EditIssue
EditIssue Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe (Vector (Name User))
forall a. Maybe a
Nothing Maybe IssueState
forall a. Maybe a
Nothing Maybe (Id Milestone)
forall a. Maybe a
Nothing Maybe (Vector (Name IssueLabel))
forall a. Maybe a
Nothing
editIssue :: Auth -> Name Owner -> Name Repo -> Id Issue -> EditIssue
-> IO (Either Error Issue)
editIssue :: Auth
-> Name Owner
-> Name Repo
-> Id Issue
-> EditIssue
-> IO (Either Error Issue)
editIssue auth :: Auth
auth user :: Name Owner
user repo :: Name Repo
repo iss :: Id Issue
iss edit :: EditIssue
edit =
Auth -> GenRequest 'MtJSON 'RW Issue -> IO (Either Error Issue)
forall am (mt :: MediaType *) a (rw :: RW).
(AuthMethod am, ParseResponse mt a) =>
am -> GenRequest mt rw a -> IO (Either Error a)
executeRequest Auth
auth (GenRequest 'MtJSON 'RW Issue -> IO (Either Error Issue))
-> GenRequest 'MtJSON 'RW Issue -> IO (Either Error Issue)
forall a b. (a -> b) -> a -> b
$ Name Owner
-> Name Repo
-> Id Issue
-> EditIssue
-> GenRequest 'MtJSON 'RW Issue
editIssueR Name Owner
user Name Repo
repo Id Issue
iss EditIssue
edit
editIssueR :: Name Owner -> Name Repo -> Id Issue -> EditIssue -> Request 'RW Issue
editIssueR :: Name Owner
-> Name Repo
-> Id Issue
-> EditIssue
-> GenRequest 'MtJSON 'RW Issue
editIssueR user :: Name Owner
user repo :: Name Repo
repo iss :: Id Issue
iss =
CommandMethod
-> Paths -> ByteString -> GenRequest 'MtJSON 'RW Issue
forall a. CommandMethod -> Paths -> ByteString -> Request 'RW a
command CommandMethod
Patch ["repos", Name Owner -> Text
forall a. IsPathPart a => a -> Text
toPathPart Name Owner
user, Name Repo -> Text
forall a. IsPathPart a => a -> Text
toPathPart Name Repo
repo, "issues", Id Issue -> Text
forall a. IsPathPart a => a -> Text
toPathPart Id Issue
iss] (ByteString -> GenRequest 'MtJSON 'RW Issue)
-> (EditIssue -> ByteString)
-> EditIssue
-> GenRequest 'MtJSON 'RW Issue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EditIssue -> ByteString
forall a. ToJSON a => a -> ByteString
encode