-- | The deployments API, as described at <https://developer.github.com/v3/repos/deployments/>
module GitHub.Endpoints.Repos.Deployments
    ( deploymentsWithOptionsForR
    , createDeploymentR

    , deploymentStatusesForR
    , createDeploymentStatusR

    , module GitHub.Data
    ) where

import Control.Arrow (second)

import GitHub.Data
import GitHub.Internal.Prelude

-- | List deployments.
-- See <https://developer.github.com/v3/repos/deployments/#list-deployments>
deploymentsWithOptionsForR
    :: FromJSON a
    => Name Owner
    -> Name Repo
    -> FetchCount
    -> [DeploymentQueryOption]
    -> Request 'RA (Vector (Deployment a))
deploymentsWithOptionsForR :: forall a.
FromJSON a =>
Name Owner
-> Name Repo
-> FetchCount
-> [DeploymentQueryOption]
-> Request 'RA (Vector (Deployment a))
deploymentsWithOptionsForR Name Owner
owner Name Repo
repo FetchCount
limit [DeploymentQueryOption]
opts =
    forall a (mt :: RW).
FromJSON a =>
Paths -> QueryString -> FetchCount -> Request mt (Vector a)
pagedQuery (Name Owner -> Name Repo -> Paths
deployPaths Name Owner
owner Name Repo
repo)
        (forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. DeploymentQueryOption -> (ByteString, ByteString)
renderDeploymentQueryOption) [DeploymentQueryOption]
opts)
        FetchCount
limit

-- | Create a deployment.
-- See <https://developer.github.com/v3/repos/deployments/#create-a-deployment>
createDeploymentR
    :: ( ToJSON   a
       , FromJSON a
       )
    => Name Owner
    -> Name Repo
    -> CreateDeployment a
    -> Request 'RW (Deployment a)
createDeploymentR :: forall a.
(ToJSON a, FromJSON a) =>
Name Owner
-> Name Repo -> CreateDeployment a -> Request 'RW (Deployment a)
createDeploymentR Name Owner
owner Name Repo
repo =
    forall a. CommandMethod -> Paths -> ByteString -> Request 'RW a
command CommandMethod
Post (Name Owner -> Name Repo -> Paths
deployPaths Name Owner
owner Name Repo
repo) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> ByteString
encode

-- | List deployment statuses.
-- See <https://developer.github.com/v3/repos/deployments/#list-deployment-statuses>
deploymentStatusesForR
    :: Name Owner
    -> Name Repo
    -> Id (Deployment a)
    -> FetchCount
    -> Request 'RA (Vector DeploymentStatus)
deploymentStatusesForR :: forall a.
Name Owner
-> Name Repo
-> Id (Deployment a)
-> FetchCount
-> Request 'RA (Vector DeploymentStatus)
deploymentStatusesForR Name Owner
owner Name Repo
repo Id (Deployment a)
deploy =
    forall a (mt :: RW).
FromJSON a =>
Paths -> QueryString -> FetchCount -> Request mt (Vector a)
pagedQuery (forall a. Name Owner -> Name Repo -> Id (Deployment a) -> Paths
statusesPaths Name Owner
owner Name Repo
repo Id (Deployment a)
deploy) []

-- | Create a deployment status.
-- See <https://developer.github.com/v3/repos/deployments/#list-deployment-statuses>
createDeploymentStatusR
    :: Name Owner
    -> Name Repo
    -> Id (Deployment a)
    -> CreateDeploymentStatus
    -> Request 'RW DeploymentStatus
createDeploymentStatusR :: forall a.
Name Owner
-> Name Repo
-> Id (Deployment a)
-> CreateDeploymentStatus
-> Request 'RW DeploymentStatus
createDeploymentStatusR Name Owner
owner Name Repo
repo Id (Deployment a)
deploy =
    forall a. CommandMethod -> Paths -> ByteString -> Request 'RW a
command CommandMethod
Post (forall a. Name Owner -> Name Repo -> Id (Deployment a) -> Paths
statusesPaths Name Owner
owner Name Repo
repo Id (Deployment a)
deploy) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> ByteString
encode

statusesPaths :: Name Owner -> Name Repo -> Id (Deployment a) -> Paths
statusesPaths :: forall a. Name Owner -> Name Repo -> Id (Deployment a) -> Paths
statusesPaths Name Owner
owner Name Repo
repo Id (Deployment a)
deploy =
    Name Owner -> Name Repo -> Paths
deployPaths Name Owner
owner Name Repo
repo forall a. [a] -> [a] -> [a]
++ [forall a. IsPathPart a => a -> Text
toPathPart Id (Deployment a)
deploy, Text
"statuses"]

deployPaths :: Name Owner -> Name Repo -> Paths
deployPaths :: Name Owner -> Name Repo -> Paths
deployPaths Name Owner
owner Name Repo
repo =
    [Text
"repos", forall a. IsPathPart a => a -> Text
toPathPart Name Owner
owner, forall a. IsPathPart a => a -> Text
toPathPart Name Repo
repo, Text
"deployments"]