{-# LANGUAGE CPP #-}
-----------------------------------------------------------------------------
-- |
-- License     :  BSD-3-Clause
-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>
--
-- The issues API as described on <http://developer.github.com/v3/issues/>.
module GitHub.Endpoints.Issues (
    currentUserIssuesR,
    organizationIssuesR,
    issueR,
    issuesForRepoR,
    createIssueR,
    newIssue,
    editIssueR,
    editOfIssue,
    module GitHub.Data,
    ) where

import GitHub.Data
import GitHub.Internal.Prelude
import Prelude ()

-- | See <https://developer.github.com/v3/issues/#list-issues>.
currentUserIssuesR :: IssueMod -> FetchCount -> Request 'RA (Vector Issue)
currentUserIssuesR :: IssueMod -> FetchCount -> Request 'RA (Vector Issue)
currentUserIssuesR IssueMod
opts =
    Paths -> QueryString -> FetchCount -> Request 'RA (Vector Issue)
forall a (mt :: RW).
FromJSON a =>
Paths -> QueryString -> FetchCount -> Request mt (Vector a)
pagedQuery [Text
"user", Text
"issues"] (IssueMod -> QueryString
issueModToQueryString IssueMod
opts)

-- | See <https://developer.github.com/v3/issues/#list-issues>.
organizationIssuesR :: Name Organization -> IssueMod -> FetchCount -> Request k (Vector Issue)
organizationIssuesR :: Name Organization
-> IssueMod -> FetchCount -> Request k (Vector Issue)
organizationIssuesR Name Organization
org IssueMod
opts =
    Paths -> QueryString -> FetchCount -> Request k (Vector Issue)
forall a (mt :: RW).
FromJSON a =>
Paths -> QueryString -> FetchCount -> Request mt (Vector a)
pagedQuery [Text
"orgs", Name Organization -> Text
forall a. IsPathPart a => a -> Text
toPathPart Name Organization
org, Text
"issues"] (IssueMod -> QueryString
issueModToQueryString IssueMod
opts)

-- | Query a single issue.
-- See <https://developer.github.com/v3/issues/#get-a-single-issue>
issueR :: Name Owner -> Name Repo -> IssueNumber -> Request k Issue
issueR :: Name Owner -> Name Repo -> IssueNumber -> Request k Issue
issueR Name Owner
user Name Repo
reqRepoName IssueNumber
reqIssueNumber =
    Paths -> QueryString -> Request k Issue
forall (mt :: RW) a. Paths -> QueryString -> Request mt a
query [Text
"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, Text
"issues", IssueNumber -> Text
forall a. IsPathPart a => a -> Text
toPathPart IssueNumber
reqIssueNumber] []

-- | List issues for a repository.
-- See <https://developer.github.com/v3/issues/#list-issues-for-a-repository>
issuesForRepoR :: Name Owner -> Name Repo -> IssueRepoMod -> FetchCount -> Request k (Vector Issue)
issuesForRepoR :: Name Owner
-> Name Repo
-> IssueRepoMod
-> FetchCount
-> Request k (Vector Issue)
issuesForRepoR Name Owner
user Name Repo
reqRepoName IssueRepoMod
opts =
    Paths -> QueryString -> FetchCount -> Request k (Vector Issue)
forall a (mt :: RW).
FromJSON a =>
Paths -> QueryString -> FetchCount -> Request mt (Vector a)
pagedQuery [Text
"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, Text
"issues"] QueryString
qs
  where
    qs :: QueryString
qs = IssueRepoMod -> QueryString
issueRepoModToQueryString IssueRepoMod
opts

-- Creating new issues.

newIssue :: Text -> NewIssue
newIssue :: Text -> NewIssue
newIssue 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

-- | Create an issue.
-- See <https://developer.github.com/v3/issues/#create-an-issue>
createIssueR :: Name Owner -> Name Repo -> NewIssue -> Request 'RW Issue
createIssueR :: Name Owner -> Name Repo -> NewIssue -> Request 'RW Issue
createIssueR Name Owner
user Name Repo
repo =
    CommandMethod -> Paths -> ByteString -> Request 'RW Issue
forall a. CommandMethod -> Paths -> ByteString -> Request 'RW a
command CommandMethod
Post [Text
"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, Text
"issues"] (ByteString -> Request 'RW Issue)
-> (NewIssue -> ByteString) -> NewIssue -> Request 'RW Issue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewIssue -> ByteString
forall a. ToJSON a => a -> ByteString
encode

-- Editing issues.

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

-- | Edit an issue.
-- See <https://developer.github.com/v3/issues/#edit-an-issue>
editIssueR :: Name Owner -> Name Repo -> IssueNumber -> EditIssue -> Request 'RW Issue
editIssueR :: Name Owner
-> Name Repo -> IssueNumber -> EditIssue -> Request 'RW Issue
editIssueR Name Owner
user Name Repo
repo IssueNumber
iss =
    CommandMethod -> Paths -> ByteString -> Request 'RW Issue
forall a. CommandMethod -> Paths -> ByteString -> Request 'RW a
command CommandMethod
Patch [Text
"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, Text
"issues", IssueNumber -> Text
forall a. IsPathPart a => a -> Text
toPathPart IssueNumber
iss] (ByteString -> Request 'RW Issue)
-> (EditIssue -> ByteString) -> EditIssue -> Request 'RW Issue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EditIssue -> ByteString
forall a. ToJSON a => a -> ByteString
encode