{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module      : Boards
-- Description : Project issue boards, see https://docs.gitlab.com/ce/api/boards.html
-- Copyright   : (c) Rob Stewart, Heriot-Watt University, 2021
-- License     : BSD3
-- Maintainer  : robstewart57@gmail.com
-- Stability   : stable
module GitLab.API.Boards where

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

-- | returns all issue boards for a project.
projectIssueBoards ::
  -- | the project
  Project ->
  GitLab [IssueBoard]
projectIssueBoards :: Project -> GitLab [IssueBoard]
projectIssueBoards Project
project = do
  Either (Response ByteString) [IssueBoard]
result <- Int -> GitLab (Either (Response ByteString) [IssueBoard])
projectIssueBoards' (Project -> Int
project_id Project
project)
  -- return an empty list if the repository could not be found.
  [IssueBoard] -> GitLab [IssueBoard]
forall (m :: * -> *) a. Monad m => a -> m a
return ([IssueBoard]
-> Either (Response ByteString) [IssueBoard] -> [IssueBoard]
forall b a. b -> Either a b -> b
fromRight [] Either (Response ByteString) [IssueBoard]
result)

-- | returns all issue boards for a project given its project ID.
projectIssueBoards' ::
  -- | project ID
  Int ->
  GitLab (Either (Response BSL.ByteString) [IssueBoard])
projectIssueBoards' :: Int -> GitLab (Either (Response ByteString) [IssueBoard])
projectIssueBoards' Int
projectId =
  Text -> GitLab (Either (Response ByteString) [IssueBoard])
forall a.
FromJSON a =>
Text -> GitLab (Either (Response ByteString) [a])
gitlab (Int -> Text
boardsAddr Int
projectId)
  where
    boardsAddr :: Int -> Text
    boardsAddr :: Int -> Text
boardsAddr 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
"/boards"

-- | returns all issue boards for a project.
projectIssueBoard ::
  -- | the project
  Project ->
  -- | the board ID
  Int ->
  GitLab (Either (Response BSL.ByteString) (Maybe IssueBoard))
projectIssueBoard :: Project
-> Int -> GitLab (Either (Response ByteString) (Maybe IssueBoard))
projectIssueBoard Project
project = do
  Int
-> Int -> GitLab (Either (Response ByteString) (Maybe IssueBoard))
projectIssueBoard' (Project -> Int
project_id Project
project)

-- | returns all issue boards for a project.
projectIssueBoard' ::
  -- | the project ID
  Int ->
  -- | the board ID
  Int ->
  GitLab (Either (Response BSL.ByteString) (Maybe IssueBoard))
projectIssueBoard' :: Int
-> Int -> GitLab (Either (Response ByteString) (Maybe IssueBoard))
projectIssueBoard' Int
projectId Int
boardId = do
  Text -> GitLab (Either (Response ByteString) (Maybe IssueBoard))
forall a.
FromJSON a =>
Text -> GitLab (Either (Response ByteString) (Maybe a))
gitlabOne Text
boardAddr
  where
    boardAddr :: Text
    boardAddr :: Text
boardAddr =
      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
projectId) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/boards/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
boardId)

-- | Creates a project issue board.
createIssueBoard ::
  -- | the project
  Project ->
  -- | board name
  Text ->
  GitLab (Maybe IssueBoard)
createIssueBoard :: Project -> Text -> GitLab (Maybe IssueBoard)
createIssueBoard Project
project Text
boardName = do
  Either (Response ByteString) (Maybe IssueBoard)
result <- Int
-> Text -> GitLab (Either (Response ByteString) (Maybe IssueBoard))
createIssueBoard' (Project -> Int
project_id Project
project) Text
boardName
  Maybe IssueBoard -> GitLab (Maybe IssueBoard)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe IssueBoard
-> Either (Response ByteString) (Maybe IssueBoard)
-> Maybe IssueBoard
forall b a. b -> Either a b -> b
fromRight Maybe IssueBoard
forall a. Maybe a
Nothing Either (Response ByteString) (Maybe IssueBoard)
result)

-- | Creates a project issue board.
createIssueBoard' ::
  -- | the project ID
  Int ->
  -- | board name
  Text ->
  GitLab (Either (Response BSL.ByteString) (Maybe IssueBoard))
createIssueBoard' :: Int
-> Text -> GitLab (Either (Response ByteString) (Maybe IssueBoard))
createIssueBoard' Int
projectId Text
boardName = do
  Text
-> Text -> GitLab (Either (Response ByteString) (Maybe IssueBoard))
forall b.
FromJSON b =>
Text -> Text -> GitLab (Either (Response ByteString) (Maybe b))
gitlabPost Text
boardAddr Text
T.empty
  where
    boardAddr :: Text
    boardAddr :: Text
boardAddr =
      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
projectId) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/boards/?name=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
boardName

-- | Updates a project issue board.
updateIssueBoard' ::
  -- | the project ID
  Int ->
  -- | the board ID
  Int ->
  -- | attributes for updating boards
  UpdateBoardAttrs ->
  GitLab (Either (Response BSL.ByteString) IssueBoard)
updateIssueBoard' :: Int
-> Int
-> UpdateBoardAttrs
-> GitLab (Either (Response ByteString) IssueBoard)
updateIssueBoard' Int
projectId Int
boardId UpdateBoardAttrs
attrs = do
  Text -> Text -> GitLab (Either (Response ByteString) IssueBoard)
forall b.
FromJSON b =>
Text -> Text -> GitLab (Either (Response ByteString) b)
gitlabPut Text
boardAddr Text
T.empty
  where
    boardAddr :: Text
    boardAddr :: Text
boardAddr =
      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
projectId)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/boards/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
boardId)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (UpdateBoardAttrs -> String
updateBoardAttrs UpdateBoardAttrs
attrs)

-- | Deletes a project issue board.
deleteIssueBoard ::
  -- | the project
  Project ->
  -- | the board
  IssueBoard ->
  GitLab (Either (Response BSL.ByteString) ())
deleteIssueBoard :: Project -> IssueBoard -> GitLab (Either (Response ByteString) ())
deleteIssueBoard Project
project IssueBoard
board = do
  Int -> Int -> GitLab (Either (Response ByteString) ())
deleteIssueBoard' (Project -> Int
project_id Project
project) (IssueBoard -> Int
board_id IssueBoard
board)

-- | Deletes a project issue board.
deleteIssueBoard' ::
  -- | the project ID
  Int ->
  -- | the board ID
  Int ->
  GitLab (Either (Response BSL.ByteString) ())
deleteIssueBoard' :: Int -> Int -> GitLab (Either (Response ByteString) ())
deleteIssueBoard' Int
projectId Int
boardId = do
  Text -> GitLab (Either (Response ByteString) ())
gitlabDelete Text
boardAddr
  where
    boardAddr :: Text
    boardAddr :: Text
boardAddr =
      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
projectId)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/boards/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
boardId)

-- | Get a list of the board’s lists. Does not include open and closed lists.
projectBoardLists ::
  -- | the project
  Project ->
  -- | the board
  IssueBoard ->
  GitLab [BoardIssue]
projectBoardLists :: Project -> IssueBoard -> GitLab [BoardIssue]
projectBoardLists Project
project IssueBoard
board = do
  Either (Response ByteString) [BoardIssue]
result <- Int -> Int -> GitLab (Either (Response ByteString) [BoardIssue])
projectBoardLists' (Project -> Int
project_id Project
project) (IssueBoard -> Int
board_id IssueBoard
board)
  -- return an empty list if the repository could not be found.
  [BoardIssue] -> GitLab [BoardIssue]
forall (m :: * -> *) a. Monad m => a -> m a
return ([BoardIssue]
-> Either (Response ByteString) [BoardIssue] -> [BoardIssue]
forall b a. b -> Either a b -> b
fromRight [] Either (Response ByteString) [BoardIssue]
result)

-- | Get a list of the board’s lists. Does not include open and closed lists.
projectBoardLists' ::
  -- | project ID
  Int ->
  -- | board ID
  Int ->
  GitLab (Either (Response BSL.ByteString) [BoardIssue])
projectBoardLists' :: Int -> Int -> GitLab (Either (Response ByteString) [BoardIssue])
projectBoardLists' Int
projectId Int
boardId =
  Text -> GitLab (Either (Response ByteString) [BoardIssue])
forall a.
FromJSON a =>
Text -> GitLab (Either (Response ByteString) [a])
gitlab Text
boardsAddr
  where
    boardsAddr :: Text
    boardsAddr :: Text
boardsAddr =
      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
projectId) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/boards/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
boardId) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/lists"

-- | Get a list of the board’s lists. Does not include open and closed lists.
boardList ::
  -- | the project
  Project ->
  -- | the board
  IssueBoard ->
  -- | list ID
  Int ->
  GitLab (Maybe BoardIssue)
boardList :: Project -> IssueBoard -> Int -> GitLab (Maybe BoardIssue)
boardList Project
project IssueBoard
board Int
listId = do
  Either (Response ByteString) (Maybe BoardIssue)
result <- Int
-> Int
-> Int
-> GitLab (Either (Response ByteString) (Maybe BoardIssue))
boardList' (Project -> Int
project_id Project
project) (IssueBoard -> Int
board_id IssueBoard
board) Int
listId
  -- return an empty list if the repository could not be found.
  Maybe BoardIssue -> GitLab (Maybe BoardIssue)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe BoardIssue
-> Either (Response ByteString) (Maybe BoardIssue)
-> Maybe BoardIssue
forall b a. b -> Either a b -> b
fromRight Maybe BoardIssue
forall a. Maybe a
Nothing Either (Response ByteString) (Maybe BoardIssue)
result)

-- | Get a list of the board’s lists. Does not include open and closed lists.
boardList' ::
  -- | project ID
  Int ->
  -- | board ID
  Int ->
  -- | list ID
  Int ->
  GitLab (Either (Response BSL.ByteString) (Maybe BoardIssue))
boardList' :: Int
-> Int
-> Int
-> GitLab (Either (Response ByteString) (Maybe BoardIssue))
boardList' Int
projectId Int
boardId Int
listId =
  Text -> GitLab (Either (Response ByteString) (Maybe BoardIssue))
forall a.
FromJSON a =>
Text -> GitLab (Either (Response ByteString) (Maybe a))
gitlabOne Text
boardsAddr
  where
    boardsAddr :: Text
    boardsAddr :: Text
boardsAddr =
      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
projectId) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/boards/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
boardId) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/lists/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
listId)

-- | Creates a new issue board list.
createBoardList ::
  -- | the project
  Project ->
  -- | the board
  IssueBoard ->
  -- | attributes for creating boards
  CreateBoardAttrs ->
  GitLab (Maybe BoardIssue)
createBoardList :: Project
-> IssueBoard -> CreateBoardAttrs -> GitLab (Maybe BoardIssue)
createBoardList Project
project IssueBoard
board CreateBoardAttrs
attrs = do
  Either (Response ByteString) (Maybe BoardIssue)
result <- Int
-> Int
-> CreateBoardAttrs
-> GitLab (Either (Response ByteString) (Maybe BoardIssue))
createBoardList' (Project -> Int
project_id Project
project) (IssueBoard -> Int
board_id IssueBoard
board) CreateBoardAttrs
attrs
  -- return an empty list if the repository could not be found.
  Maybe BoardIssue -> GitLab (Maybe BoardIssue)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe BoardIssue
-> Either (Response ByteString) (Maybe BoardIssue)
-> Maybe BoardIssue
forall b a. b -> Either a b -> b
fromRight Maybe BoardIssue
forall a. Maybe a
Nothing Either (Response ByteString) (Maybe BoardIssue)
result)

-- | Creates a new issue board list.
createBoardList' ::
  -- | project ID
  Int ->
  -- | board ID
  Int ->
  -- | attributes for creating the board
  CreateBoardAttrs ->
  GitLab (Either (Response BSL.ByteString) (Maybe BoardIssue))
createBoardList' :: Int
-> Int
-> CreateBoardAttrs
-> GitLab (Either (Response ByteString) (Maybe BoardIssue))
createBoardList' Int
projectId Int
boardId CreateBoardAttrs
attrs =
  Text
-> Text -> GitLab (Either (Response ByteString) (Maybe BoardIssue))
forall b.
FromJSON b =>
Text -> Text -> GitLab (Either (Response ByteString) (Maybe b))
gitlabPost Text
boardsAddr Text
T.empty
  where
    boardsAddr :: Text
    boardsAddr :: Text
boardsAddr =
      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
projectId)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/boards/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
boardId)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/lists"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (CreateBoardAttrs -> String
createBoardAttrs CreateBoardAttrs
attrs)

-- | Updates an existing issue board list. This call is used to change list position.
reorderBoardList ::
  -- | project
  Project ->
  -- | board
  IssueBoard ->
  -- | list ID
  Int ->
  -- | the position of the list
  Int ->
  GitLab (Either (Response BSL.ByteString) (Maybe BoardIssue))
reorderBoardList :: Project
-> IssueBoard
-> Int
-> Int
-> GitLab (Either (Response ByteString) (Maybe BoardIssue))
reorderBoardList Project
project IssueBoard
board =
  Int
-> Int
-> Int
-> Int
-> GitLab (Either (Response ByteString) (Maybe BoardIssue))
reorderBoardList' (Project -> Int
project_id Project
project) (IssueBoard -> Int
board_id IssueBoard
board)

-- | Updates an existing issue board list. This call is used to change list position.
reorderBoardList' ::
  -- | project ID
  Int ->
  -- | board ID
  Int ->
  -- | list ID
  Int ->
  -- | the position of the list
  Int ->
  GitLab (Either (Response BSL.ByteString) (Maybe BoardIssue))
reorderBoardList' :: Int
-> Int
-> Int
-> Int
-> GitLab (Either (Response ByteString) (Maybe BoardIssue))
reorderBoardList' Int
projectId Int
boardId Int
listId Int
newPosition =
  Text
-> Text -> GitLab (Either (Response ByteString) (Maybe BoardIssue))
forall b.
FromJSON b =>
Text -> Text -> GitLab (Either (Response ByteString) b)
gitlabPut Text
boardsAddr Text
T.empty
  where
    boardsAddr :: Text
    boardsAddr :: Text
boardsAddr =
      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
projectId)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/boards/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
boardId)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/lists/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
listId)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (String
"?position=" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
newPosition)

-- | Only for administrators and project owners. Deletes a board list.
deleteBoardList ::
  -- | project
  Project ->
  -- | board
  IssueBoard ->
  -- | list ID
  Int ->
  GitLab (Either (Response BSL.ByteString) ())
deleteBoardList :: Project
-> IssueBoard -> Int -> GitLab (Either (Response ByteString) ())
deleteBoardList Project
project IssueBoard
board =
  Int -> Int -> Int -> GitLab (Either (Response ByteString) ())
deleteBoardList' (Project -> Int
project_id Project
project) (IssueBoard -> Int
board_id IssueBoard
board)

-- | Only for administrators and project owners. Deletes a board list.
deleteBoardList' ::
  -- | project ID
  Int ->
  -- | board ID
  Int ->
  -- | list ID
  Int ->
  GitLab (Either (Response BSL.ByteString) ())
deleteBoardList' :: Int -> Int -> Int -> GitLab (Either (Response ByteString) ())
deleteBoardList' Int
projectId Int
boardId Int
listId =
  Text -> GitLab (Either (Response ByteString) ())
gitlabDelete Text
boardsAddr
  where
    boardsAddr :: Text
    boardsAddr :: Text
boardsAddr =
      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
projectId)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/boards/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
boardId)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/lists/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
listId)

data UpdateBoardAttrs = UpdateBoardAttrs
  { UpdateBoardAttrs -> Maybe String
updateBoard_new_name :: Maybe String,
    UpdateBoardAttrs -> Maybe Int
updateBoard_assignee_id :: Maybe Int,
    UpdateBoardAttrs -> Maybe Int
updateBoard_milestone_id :: Maybe Int,
    UpdateBoardAttrs -> Maybe String
updateBoard_labels :: Maybe String,
    UpdateBoardAttrs -> Maybe Int
updateBoard_weight :: Maybe Int
  }

-- | no attributes for board update.
noUpdateBoardAttrs :: UpdateBoardAttrs
noUpdateBoardAttrs :: UpdateBoardAttrs
noUpdateBoardAttrs =
  Maybe String
-> Maybe Int
-> Maybe Int
-> Maybe String
-> Maybe Int
-> UpdateBoardAttrs
UpdateBoardAttrs Maybe String
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing

updateBoardAttrs :: UpdateBoardAttrs -> String
updateBoardAttrs :: UpdateBoardAttrs -> String
updateBoardAttrs UpdateBoardAttrs
attrs =
  case [String]
attrsUrl of
    [] -> String
""
    (String
x : [String]
xs) -> String
"?" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
x String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (String -> String) -> [String] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Char
'&' Char -> String -> String
forall a. a -> [a] -> [a]
:) [String]
xs
  where
    attrsUrl :: [String]
attrsUrl =
      [Maybe String] -> [String]
forall a. [Maybe a] -> [a]
catMaybes
        [ (\String
s -> String -> Maybe String
forall a. a -> Maybe a
Just (String
"name=" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
s)) (String -> Maybe String) -> Maybe String -> Maybe String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< UpdateBoardAttrs -> Maybe String
updateBoard_new_name UpdateBoardAttrs
attrs,
          (\Int
i -> String -> Maybe String
forall a. a -> Maybe a
Just (String
"assignee_id=" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
i)) (Int -> Maybe String) -> Maybe Int -> Maybe String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< UpdateBoardAttrs -> Maybe Int
updateBoard_assignee_id UpdateBoardAttrs
attrs,
          (\Int
i -> String -> Maybe String
forall a. a -> Maybe a
Just (String
"milestone_id=" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
i)) (Int -> Maybe String) -> Maybe Int -> Maybe String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< UpdateBoardAttrs -> Maybe Int
updateBoard_milestone_id UpdateBoardAttrs
attrs,
          (\String
s -> String -> Maybe String
forall a. a -> Maybe a
Just (String
"labels=" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
s)) (String -> Maybe String) -> Maybe String -> Maybe String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< UpdateBoardAttrs -> Maybe String
updateBoard_labels UpdateBoardAttrs
attrs,
          (\Int
i -> String -> Maybe String
forall a. a -> Maybe a
Just (String
"weight=" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
i)) (Int -> Maybe String) -> Maybe Int -> Maybe String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< UpdateBoardAttrs -> Maybe Int
updateBoard_weight UpdateBoardAttrs
attrs
        ]

-- | exactly one parameter must be provided.
data CreateBoardAttrs = CreateBoardAttrs
  { CreateBoardAttrs -> Maybe Int
createBoard_label_id :: Maybe Int,
    CreateBoardAttrs -> Maybe Int
createBoard_assignee_id :: Maybe Int,
    CreateBoardAttrs -> Maybe Int
createBoard_milestone_id :: Maybe Int
  }

-- | no attributes for board creation.
noCreateBoardAttrs :: CreateBoardAttrs
noCreateBoardAttrs :: CreateBoardAttrs
noCreateBoardAttrs =
  Maybe Int -> Maybe Int -> Maybe Int -> CreateBoardAttrs
CreateBoardAttrs Maybe Int
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing

createBoardAttrs :: CreateBoardAttrs -> String
createBoardAttrs :: CreateBoardAttrs -> String
createBoardAttrs CreateBoardAttrs
attrs =
  case [String]
attrsUrl of
    [] -> String
""
    (String
x : [String]
xs) -> String
"?" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
x String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (String -> String) -> [String] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Char
'&' Char -> String -> String
forall a. a -> [a] -> [a]
:) [String]
xs
  where
    attrsUrl :: [String]
attrsUrl =
      [Maybe String] -> [String]
forall a. [Maybe a] -> [a]
catMaybes
        [ (\Int
i -> String -> Maybe String
forall a. a -> Maybe a
Just (String
"label_id=" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
i)) (Int -> Maybe String) -> Maybe Int -> Maybe String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CreateBoardAttrs -> Maybe Int
createBoard_label_id CreateBoardAttrs
attrs,
          (\Int
i -> String -> Maybe String
forall a. a -> Maybe a
Just (String
"assignee_id=" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
i)) (Int -> Maybe String) -> Maybe Int -> Maybe String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CreateBoardAttrs -> Maybe Int
createBoard_assignee_id CreateBoardAttrs
attrs,
          (\Int
i -> String -> Maybe String
forall a. a -> Maybe a
Just (String
"milestone_id=" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
i)) (Int -> Maybe String) -> Maybe Int -> Maybe String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CreateBoardAttrs -> Maybe Int
createBoard_milestone_id CreateBoardAttrs
attrs
        ]