{-# LANGUAGE OverloadedStrings #-}
module GitLab.API.MergeRequests where
import Control.Monad.IO.Unlift
import Data.Either
import Data.Text (Text)
import qualified Data.Text as T
import GitLab.Types
import GitLab.WebRequests.GitLabWebCalls
import Network.HTTP.Types.Status
mergeRequests ::
(MonadIO m) =>
Project ->
GitLab m [MergeRequest]
mergeRequests p = do
result <- mergeRequests' (project_id p)
return (fromRight (error "mergeRequests error") result)
mergeRequests' ::
(MonadIO m) =>
Int ->
GitLab m (Either Status [MergeRequest])
mergeRequests' projectId =
gitlabWithAttrs addr "&scope=all"
where
addr =
"/projects/"
<> T.pack (show projectId)
<> "/merge_requests"
createMergeRequest ::
(MonadIO m) =>
Project ->
Text ->
Text ->
Int ->
Text ->
Text ->
GitLab m (Either Status MergeRequest)
createMergeRequest project =
createMergeRequest' (project_id project)
createMergeRequest' ::
(MonadIO m) =>
Int ->
Text ->
Text ->
Int ->
Text ->
Text ->
GitLab m (Either Status MergeRequest)
createMergeRequest' projectId sourceBranch targetBranch targetProjectId mrTitle mrDescription =
gitlabPost addr dataBody
where
dataBody :: Text
dataBody =
"source_branch=" <> sourceBranch <> "&target_branch=" <> targetBranch
<> "&target_project_id="
<> T.pack (show targetProjectId)
<> "&title="
<> mrTitle
<> "&description="
<> mrDescription
addr = T.pack $ "/projects/" <> show projectId <> "/merge_requests"
acceptMergeRequest ::
(MonadIO m) =>
Project ->
Int ->
GitLab m (Either Status MergeRequest)
acceptMergeRequest project =
acceptMergeRequest' (project_id project)
acceptMergeRequest' ::
(MonadIO m) =>
Int ->
Int ->
GitLab m (Either Status MergeRequest)
acceptMergeRequest' projectId mergeRequestIid = gitlabPost addr dataBody
where
dataBody :: Text
dataBody =
T.pack $
"id=" <> show projectId <> "&merge_request_iid=" <> show mergeRequestIid
addr =
T.pack $
"/projects/" <> show projectId <> "/merge_requests/"
<> show mergeRequestIid
<> "/merge"