{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module      : Branches
-- Description : Queries about repository branches
-- Copyright   : (c) Rob Stewart, Heriot-Watt University, 2019
-- License     : BSD3
-- Maintainer  : robstewart57@gmail.com
-- Stability   : stable
module GitLab.API.Branches
  ( -- * List repository branches
    branches,

    -- * Get single repository branch
    branch,

    -- * Create repository branch
    createRepositoryBranch,

    -- * Delete repository branch
    deleteRepositoryBranch,

    -- * Delete merged branches
    deleteMergedBranches,
  )
where

import qualified Data.ByteString.Lazy as BSL
import Data.Either
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import GitLab.Types
import GitLab.WebRequests.GitLabWebCalls
  ( gitlabDelete,
    gitlabGetMany,
    gitlabGetOne,
    gitlabPost,
  )
import Network.HTTP.Client

-- | Get a list of repository branches from a project, sorted by name
-- alphabetically.
branches :: Project -> GitLab [Branch]
branches :: Project -> GitLab [Branch]
branches Project
project = do
  Either (Response ByteString) [Branch]
result <- Int -> GitLab (Either (Response ByteString) [Branch])
branches' (Project -> Int
project_id Project
project)
  [Branch] -> GitLab [Branch]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Branch] -> Either (Response ByteString) [Branch] -> [Branch]
forall b a. b -> Either a b -> b
fromRight ([Char] -> [Branch]
forall a. HasCallStack => [Char] -> a
error [Char]
"branches error") Either (Response ByteString) [Branch]
result)

-- | Get a list of repository branches from a project given its
-- project ID, sorted by name alphabetically.
branches' ::
  -- | project ID
  Int ->
  GitLab (Either (Response BSL.ByteString) [Branch])
branches' :: Int -> GitLab (Either (Response ByteString) [Branch])
branches' Int
projectId =
  Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) [Branch])
forall a.
FromJSON a =>
Text -> [GitLabParam] -> GitLab (Either (Response ByteString) [a])
gitlabGetMany Text
addr []
  where
    addr :: Text
addr =
      Text
"/projects/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
projectId)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/repository"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/branches"

-- | Get a single project repository branch.
branch ::
  -- | the project
  Project ->
  -- | the branch name
  Text ->
  GitLab (Maybe Branch)
branch :: Project -> Text -> GitLab (Maybe Branch)
branch Project
project Text
branchName = do
  Either (Response ByteString) (Maybe Branch)
result <- Int -> Text -> GitLab (Either (Response ByteString) (Maybe Branch))
branch' (Project -> Int
project_id Project
project) Text
branchName
  Maybe Branch -> GitLab (Maybe Branch)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Branch
-> Either (Response ByteString) (Maybe Branch) -> Maybe Branch
forall b a. b -> Either a b -> b
fromRight ([Char] -> Maybe Branch
forall a. HasCallStack => [Char] -> a
error [Char]
"branch error") Either (Response ByteString) (Maybe Branch)
result)

-- | Get a single project repository branch.
branch' ::
  -- | the project ID
  Int ->
  -- | name of the branch
  Text ->
  GitLab (Either (Response BSL.ByteString) (Maybe Branch))
branch' :: Int -> Text -> GitLab (Either (Response ByteString) (Maybe Branch))
branch' Int
projectId Text
branchName =
  Text
-> [GitLabParam]
-> GitLab (Either (Response ByteString) (Maybe Branch))
forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabGetOne Text
addr []
  where
    addr :: Text
addr =
      Text
"/projects/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
projectId)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/repository"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/branches/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
branchName

-- | Create a new branch in the repository.
createRepositoryBranch ::
  -- | the project
  Project ->
  -- | branch name
  Text ->
  -- | Branch name or commit SHA to create branch from
  Text ->
  GitLab (Maybe Branch)
createRepositoryBranch :: Project -> Text -> Text -> GitLab (Maybe Branch)
createRepositoryBranch Project
project Text
branchName Text
branchFrom = do
  Either (Response ByteString) (Maybe Branch)
result <- Int
-> Text
-> Text
-> GitLab (Either (Response ByteString) (Maybe Branch))
createRepositoryBranch' (Project -> Int
project_id Project
project) Text
branchName Text
branchFrom
  -- return an empty list if the repository could not be found.
  Maybe Branch -> GitLab (Maybe Branch)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Branch
-> Either (Response ByteString) (Maybe Branch) -> Maybe Branch
forall b a. b -> Either a b -> b
fromRight Maybe Branch
forall a. Maybe a
Nothing Either (Response ByteString) (Maybe Branch)
result)

-- | Create a new branch in the repository.
createRepositoryBranch' ::
  -- | project ID
  Int ->
  -- | branch name
  Text ->
  -- | Branch name or commit SHA to create branch from
  Text ->
  GitLab (Either (Response BSL.ByteString) (Maybe Branch))
createRepositoryBranch' :: Int
-> Text
-> Text
-> GitLab (Either (Response ByteString) (Maybe Branch))
createRepositoryBranch' Int
projectId Text
branchName Text
branchFrom =
  Text
-> [GitLabParam]
-> GitLab (Either (Response ByteString) (Maybe Branch))
forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabPost Text
newBranchAddr [(ByteString
"branch", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 Text
branchName)), (ByteString
"ref", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 Text
branchFrom))]
  where
    newBranchAddr :: Text
    newBranchAddr :: Text
newBranchAddr =
      Text
"/projects/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
projectId)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/repository"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/branches"

-- | Delete a branch from the repository.
deleteRepositoryBranch ::
  -- | project
  Project ->
  -- | branch name
  Text ->
  GitLab (Either (Response BSL.ByteString) (Maybe ()))
deleteRepositoryBranch :: Project -> Text -> GitLab (Either (Response ByteString) (Maybe ()))
deleteRepositoryBranch Project
project =
  Int -> Text -> GitLab (Either (Response ByteString) (Maybe ()))
deleteRepositoryBranch' (Project -> Int
project_id Project
project)

-- | Delete a branch from the repository.
deleteRepositoryBranch' ::
  -- | project ID
  Int ->
  -- | branch name
  Text ->
  GitLab (Either (Response BSL.ByteString) (Maybe ()))
deleteRepositoryBranch' :: Int -> Text -> GitLab (Either (Response ByteString) (Maybe ()))
deleteRepositoryBranch' Int
projectId Text
branchName =
  Text
-> [GitLabParam]
-> GitLab (Either (Response ByteString) (Maybe ()))
forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabDelete Text
branchAddr []
  where
    branchAddr :: Text
    branchAddr :: Text
branchAddr =
      Text
"/projects/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
projectId)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/repository"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/branches/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
branchName

-- | Deletes all branches that are merged into the project’s default branch.
deleteMergedBranches ::
  -- | project
  Project ->
  GitLab (Either (Response BSL.ByteString) (Maybe ()))
deleteMergedBranches :: Project -> GitLab (Either (Response ByteString) (Maybe ()))
deleteMergedBranches Project
project =
  Int -> GitLab (Either (Response ByteString) (Maybe ()))
deleteMergedBranches' (Project -> Int
project_id Project
project)

-- | Deletes all branches that are merged into the project’s default branch.
deleteMergedBranches' ::
  -- | project ID
  Int ->
  GitLab (Either (Response BSL.ByteString) (Maybe ()))
deleteMergedBranches' :: Int -> GitLab (Either (Response ByteString) (Maybe ()))
deleteMergedBranches' Int
projectId =
  Text
-> [GitLabParam]
-> GitLab (Either (Response ByteString) (Maybe ()))
forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabDelete Text
branchAddr []
  where
    branchAddr :: Text
    branchAddr :: Text
branchAddr =
      Text
"/projects/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
projectId)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/repository"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/merged_branches"