{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- |
-- Module      : Groups
-- Description : Queries about and updates to groups
-- Copyright   : (c) Rob Stewart, Heriot-Watt University, 2019
-- License     : BSD3
-- Maintainer  : robstewart57@gmail.com
-- Stability   : stable
module GitLab.API.Groups where

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

-- | gets groups with the given group name, path or full path.
--
-- > projectsWithNameOrPath "group1"
groupsWithNameOrPath ::
  -- | group name being searched for.
  Text ->
  GitLab (Either (Response BSL.ByteString) [Group])
groupsWithNameOrPath :: Text -> GitLab (Either (Response ByteString) [Group])
groupsWithNameOrPath Text
groupName = do
  Either (Response ByteString) [Group]
result <- Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) [Group])
forall a.
FromJSON a =>
Text -> [GitLabParam] -> GitLab (Either (Response ByteString) [a])
gitlabGetMany Text
"/groups" [(ByteString
"search", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 Text
groupName))]
  case Either (Response ByteString) [Group]
result of
    Left {} -> Either (Response ByteString) [Group]
-> GitLab (Either (Response ByteString) [Group])
forall (m :: * -> *) a. Monad m => a -> m a
return Either (Response ByteString) [Group]
result
    Right [Group]
groups ->
      Either (Response ByteString) [Group]
-> GitLab (Either (Response ByteString) [Group])
forall (m :: * -> *) a. Monad m => a -> m a
return
        ( [Group] -> Either (Response ByteString) [Group]
forall a b. b -> Either a b
Right ([Group] -> Either (Response ByteString) [Group])
-> [Group] -> Either (Response ByteString) [Group]
forall a b. (a -> b) -> a -> b
$
            (Group -> Bool) -> [Group] -> [Group]
forall a. (a -> Bool) -> [a] -> [a]
filter
              ( \Group
group ->
                  Text
groupName Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Group -> Text
group_name Group
group
                    Bool -> Bool -> Bool
|| Text
groupName Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Group -> Text
group_path Group
group
                    Bool -> Bool -> Bool
|| Text
groupName Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Group -> Text
group_full_path Group
group
              )
              [Group]
groups
        )

-- | Get a list of projects in this group
groupProjects ::
  -- | group
  Group ->
  GitLab (Either (Response BSL.ByteString) [Project])
groupProjects :: Group -> GitLab (Either (Response ByteString) [Project])
groupProjects Group
group = do
  Int -> GitLab (Either (Response ByteString) [Project])
groupProjects' (Group -> Int
group_id Group
group)

-- | Get a list of projects in this group
groupProjects' ::
  -- | group ID
  Int ->
  GitLab (Either (Response BSL.ByteString) [Project])
groupProjects' :: Int -> GitLab (Either (Response ByteString) [Project])
groupProjects' Int
groupID = do
  let urlPath :: Text
urlPath =
        String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$
          String
"/groups/"
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
groupID
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/projects"
  Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) [Project])
forall a.
FromJSON a =>
Text -> [GitLabParam] -> GitLab (Either (Response ByteString) [a])
gitlabGetMany Text
urlPath []