{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module      : Commits
-- Description : Queries about commits in repositories
-- Copyright   : (c) Rob Stewart, Heriot-Watt University, 2019
-- License     : BSD3
-- Maintainer  : robstewart57@gmail.com
-- Stability   : stable
module GitLab.API.Commits where

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

-- | returns all commits for a project.
projectCommits ::
  -- | the project
  Project ->
  GitLab [Commit]
projectCommits :: Project -> GitLab [Commit]
projectCommits Project
project = do
  Either Status [Commit]
result <- Int -> GitLab (Either Status [Commit])
projectCommits' (Project -> Int
project_id Project
project)
  [Commit] -> GitLab [Commit]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Commit] -> Either Status [Commit] -> [Commit]
forall b a. b -> Either a b -> b
fromRight ([Char] -> [Commit]
forall a. HasCallStack => [Char] -> a
error [Char]
"projectCommits error") Either Status [Commit]
result)

-- | returns all commits for a project given its project ID.
projectCommits' ::
  -- | project ID
  Int ->
  GitLab (Either Status [Commit])
projectCommits' :: Int -> GitLab (Either Status [Commit])
projectCommits' Int
projectId =
  Text -> Text -> GitLab (Either Status [Commit])
forall a. FromJSON a => Text -> Text -> GitLab (Either Status [a])
gitlabWithAttrs (Int -> Text
commitsAddr Int
projectId) Text
"&with_stats=true"
  where
    commitsAddr :: Int -> Text
    commitsAddr :: Int -> Text
commitsAddr Int
projId =
      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
projId) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/repository" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/commits"

-- | returns all commits of a branch from a project given the branch
-- name.
branchCommits ::
  -- | project
  Project ->
  -- | branch name
  Text ->
  GitLab (Either Status [Commit])
branchCommits :: Project -> Text -> GitLab (Either Status [Commit])
branchCommits Project
project =
  Int -> Text -> GitLab (Either Status [Commit])
branchCommits' (Project -> Int
project_id Project
project)

-- | returns all commits of a branch from a project
-- given its project ID and the branch name.
branchCommits' ::
  -- | project ID
  Int ->
  -- | branch name
  Text ->
  GitLab (Either Status [Commit])
branchCommits' :: Int -> Text -> GitLab (Either Status [Commit])
branchCommits' Int
projectId Text
branchName = do
  Text -> Text -> GitLab (Either Status [Commit])
forall a. FromJSON a => Text -> Text -> GitLab (Either Status [a])
gitlabWithAttrs (Int -> Text
commitsAddr Int
projectId) (Text
"&ref_name=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
branchName)
  where
    commitsAddr :: Int -> Text
    commitsAddr :: Int -> Text
commitsAddr Int
projId =
      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
projId) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/repository" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/commits"

-- | returns a commit for the given project and commit hash, if such
-- a commit exists.
commitDetails ::
  -- | the project
  Project ->
  -- | the commit hash
  Text ->
  GitLab (Maybe Commit)
commitDetails :: Project -> Text -> GitLab (Maybe Commit)
commitDetails Project
project Text
theHash = do
  Either Status (Maybe Commit)
result <- Int -> Text -> GitLab (Either Status (Maybe Commit))
commitDetails' (Project -> Int
project_id Project
project) Text
theHash
  Maybe Commit -> GitLab (Maybe Commit)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Commit -> Either Status (Maybe Commit) -> Maybe Commit
forall b a. b -> Either a b -> b
fromRight ([Char] -> Maybe Commit
forall a. HasCallStack => [Char] -> a
error [Char]
"commitDetails error") Either Status (Maybe Commit)
result)

-- | returns a commit for the given project ID and commit hash, if
-- such a commit exists.
commitDetails' ::
  -- | project ID
  Int ->
  -- | the commit hash
  Text ->
  GitLab (Either Status (Maybe Commit))
commitDetails' :: Int -> Text -> GitLab (Either Status (Maybe Commit))
commitDetails' Int
projectId Text
hash =
  Text -> GitLab (Either Status (Maybe Commit))
forall a. FromJSON a => Text -> GitLab (Either Status (Maybe a))
gitlabOne (Int -> Text
commitsAddr Int
projectId)
  where
    commitsAddr :: Int -> Text
    commitsAddr :: Int -> Text
commitsAddr Int
projId =
      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
projId)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/repository"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/commits"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
hash