{-# 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 where

import qualified Data.ByteString.Lazy as BSL
import Data.Either
import qualified Data.Text as T
import GitLab.Types
import GitLab.WebRequests.GitLabWebCalls
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' :: Int -> GitLab (Either (Response BSL.ByteString) [Branch])
branches' :: Int -> GitLab (Either (Response ByteString) [Branch])
branches' Int
projectId =
  Text -> GitLab (Either (Response ByteString) [Branch])
forall a.
FromJSON a =>
Text -> GitLab (Either (Response ByteString) [a])
gitlab 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"