{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module      : Tags
-- Description : Queries about tags in repositories
-- Copyright   : (c) Jihyun Yu, 2021
-- License     : BSD3
-- Maintainer  : yjh0502@gmail.com
-- Stability   : stable
module GitLab.API.Tags where

import qualified Data.ByteString.Lazy as BSL
import Data.Either
import Data.Text (Text)
import qualified Data.Text as T
import GitLab.Types
import GitLab.WebRequests.GitLabWebCalls
import Network.HTTP.Client

-- | returns all commits with tags.
tags ::
  -- | project
  Project ->
  GitLab [Tag]
tags :: Project -> GitLab [Tag]
tags Project
project = do
  Either (Response ByteString) [Tag]
result <- Int -> GitLab (Either (Response ByteString) [Tag])
tags' (Project -> Int
project_id Project
project)
  [Tag] -> GitLab [Tag]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Tag] -> Either (Response ByteString) [Tag] -> [Tag]
forall b a. b -> Either a b -> b
fromRight [] Either (Response ByteString) [Tag]
result)

-- | returns all commits with tags from a project given its project ID.
tags' ::
  -- | project ID
  Int ->
  GitLab (Either (Response BSL.ByteString) [Tag])
tags' :: Int -> GitLab (Either (Response ByteString) [Tag])
tags' Int
projectId = do
  Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) [Tag])
forall a.
FromJSON a =>
Text -> [GitLabParam] -> GitLab (Either (Response ByteString) [a])
gitlabGetMany (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
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
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
"/tags"