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

-- |
-- Module      : Discussions
-- Description : Queries about discussions, which are a set of related notes on snippets, issues, epics, merge requests and commits.
-- Copyright   : (c) Rob Stewart, Heriot-Watt University, 2021
-- License     : BSD3
-- Maintainer  : robstewart57@gmail.com
-- Stability   : stable
module GitLab.API.Discussions
  ( -- * Issues

    -- ** List project issue discussion items
    projectIssueDiscussions,

    -- ** Get single issue discussion item
    issueDiscussion,

    -- ** Create new issue thread
    createIssueThread,

    -- ** Add note to existing issue thread
    addNoteToIssueThread,

    -- ** Modify existing issue thread note
    modifyThreadNoteIssue,

    -- ** Delete an issue thread note
    deleteIssueThreadNote,

    -- * Snippets

    -- ** List project snippet discussion items
    snippetDiscussionItems,

    -- ** Get single snippet discussion item
    snippetDiscussionItem,

    -- ** Create new snippet thread
    createSnippetThread,

    -- ** Add note to existing snippet thread
    addNoteToSnippetThread,

    -- ** Modify existing snippet thread note
    modifySnippetThreadNote,

    -- ** Delete a snippet thread note
    deleteSnippetThreadNote,
    -- -- * Epics

    -- -- ** List group epic discussion items

    -- -- ** Get single epic discussion item

    -- -- ** Create new epic thread

    -- -- ** Add note to existing epic thread

    -- -- ** Modify existing epic thread note

    -- -- ** Delete an epic thread note

    -- * Merge requests

    -- ** List project merge request discussion items
    projectMergeRequestDiscussionItems,

    -- ** Get single merge request discussion item
    mergeRequestDiscussionItems,

    -- ** Create new merge request thread
    createMergeRequestThread,
    -- -- ** Create a new thread on the overview page

    -- -- ** Create a new thread in the merge request diff

    -- -- ** Parameters for multiline comments

    -- * Line code

    -- ** Resolve a merge request thread
    resolveMergeRequestThread,

    -- ** Add note to existing merge request thread
    addNoteToMergeRequestThread,

    -- ** Modify an existing merge request thread note
    modifyMergeRequestThreadNote,

    -- ** Delete a merge request thread note
    deleteMergeRequestThreadNote,

    -- * Commits

    -- ** List project commit discussion items
    projectCommitDiscussionItems,

    -- ** Get single commit discussion item
    projectCommitDiscussionItem,

    -- ** Create new commit thread
    createCommitThread,

    -- ** Add note to existing commit thread
    addNoteToCommitThread,

    -- ** Modify an existing commit thread note
    modifyCommityThreadNote,

    -- ** Delete a commit thread note
    deleteCommitThreadNote,

    -- * Types
    PositionReference (..),
  )
where

import qualified Data.ByteString.Lazy as BSL
import Data.Maybe
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 a list of all discussion items for a single issue.
projectIssueDiscussions ::
  -- | project
  Project ->
  -- | The IID of an issue
  Int ->
  GitLab (Either (Response BSL.ByteString) [Discussion])
projectIssueDiscussions :: Project
-> Int -> GitLab (Either (Response ByteString) [Discussion])
projectIssueDiscussions Project
prj Int
issueIid = do
  let urlPath :: Text
urlPath =
        String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$
          String
"/projects/"
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Project -> Int
project_id Project
prj)
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/issues/"
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
issueIid
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/discussions"
  Text
-> [GitLabParam]
-> GitLab (Either (Response ByteString) [Discussion])
forall a.
FromJSON a =>
Text -> [GitLabParam] -> GitLab (Either (Response ByteString) [a])
gitlabGetMany Text
urlPath []

-- | Returns a single discussion item for a specific project issue.
issueDiscussion ::
  -- | project
  Project ->
  -- | The IID of an issue
  Int ->
  -- | The ID of a discussion item
  Int ->
  GitLab (Either (Response BSL.ByteString) (Maybe Discussion))
issueDiscussion :: Project
-> Int
-> Int
-> GitLab (Either (Response ByteString) (Maybe Discussion))
issueDiscussion Project
prj Int
issueIid Int
discussionId = do
  let urlPath :: Text
urlPath =
        String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$
          String
"/projects/"
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Project -> Int
project_id Project
prj)
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/issues/"
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
issueIid
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/discussions/"
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
discussionId
  Text
-> [GitLabParam]
-> GitLab (Either (Response ByteString) (Maybe Discussion))
forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabGetOne Text
urlPath []

-- | Creates a new thread to a single project issue. This is similar
-- to creating a note but other comments (replies) can be added to it
-- later.
createIssueThread ::
  -- | project
  Project ->
  -- | The IID of an issue
  Int ->
  -- | The content of the thread
  Text ->
  GitLab (Either (Response BSL.ByteString) (Maybe Discussion))
createIssueThread :: Project
-> Int
-> Text
-> GitLab (Either (Response ByteString) (Maybe Discussion))
createIssueThread Project
prj Int
issueIid Text
threadContent = do
  Text
-> [GitLabParam]
-> GitLab (Either (Response ByteString) (Maybe Discussion))
forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabPost Text
discussionAddr [(ByteString
"body", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 Text
threadContent))]
  where
    discussionAddr :: Text
    discussionAddr :: Text
discussionAddr =
      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 (Project -> Int
project_id Project
prj))
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/issues/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
issueIid)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/discussions"

-- | Adds a new note to the thread. This can also create a thread from
-- a single comment. Notes can be added to other items than comments,
-- such as system notes, making them threads.
addNoteToIssueThread ::
  -- | project
  Project ->
  -- | The IID of an issue
  Int ->
  -- | The ID of a thread
  Int ->
  -- -- | The ID of a thread note
  -- Int ->

  -- | The content of the note/reply
  Text ->
  GitLab (Either (Response BSL.ByteString) (Maybe Discussion))
addNoteToIssueThread :: Project
-> Int
-> Int
-> Text
-> GitLab (Either (Response ByteString) (Maybe Discussion))
addNoteToIssueThread Project
prj Int
issueIid Int
discussionId Text
content = do
  Text
-> [GitLabParam]
-> GitLab (Either (Response ByteString) (Maybe Discussion))
forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabPost Text
discussionAddr [(ByteString
"body", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 Text
content))]
  where
    discussionAddr :: Text
    discussionAddr :: Text
discussionAddr =
      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 (Project -> Int
project_id Project
prj))
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/issues/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
issueIid)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/discussions/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
discussionId)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/notes"

-- <> "/notes/"
-- <> T.pack (show noteId)

-- | Modify existing thread note of an issue.
modifyThreadNoteIssue ::
  -- | project
  Project ->
  -- | The IID of an issue
  Int ->
  -- | The ID of a thread
  Int ->
  -- | The ID of a thread note
  Int ->
  -- | The content of the note/reply
  Text ->
  GitLab (Either (Response BSL.ByteString) (Maybe Discussion))
modifyThreadNoteIssue :: Project
-> Int
-> Int
-> Int
-> Text
-> GitLab (Either (Response ByteString) (Maybe Discussion))
modifyThreadNoteIssue Project
prj Int
issueIid Int
discussionId Int
noteId Text
content = do
  Text
-> [GitLabParam]
-> GitLab (Either (Response ByteString) (Maybe Discussion))
forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabPut Text
noteAddr [(ByteString
"body", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 Text
content))]
  where
    noteAddr :: Text
    noteAddr :: Text
noteAddr =
      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 (Project -> Int
project_id Project
prj))
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/issues/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
issueIid)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/discussions/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
discussionId)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/notes/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
noteId)

-- | Deletes an existing thread note of an issue.
deleteIssueThreadNote ::
  -- | project
  Project ->
  -- | The IID of an issue
  Int ->
  -- | The ID of a discussion
  Int ->
  -- | The ID of a discussion note
  Int ->
  GitLab (Either (Response BSL.ByteString) (Maybe ()))
deleteIssueThreadNote :: Project
-> Int
-> Int
-> Int
-> GitLab (Either (Response ByteString) (Maybe ()))
deleteIssueThreadNote Project
prj Int
issueIid Int
discussionId Int
noteId = do
  Text
-> [GitLabParam]
-> GitLab (Either (Response ByteString) (Maybe ()))
forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabDelete Text
noteAddr []
  where
    noteAddr :: Text
    noteAddr :: Text
noteAddr =
      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 (Project -> Int
project_id Project
prj))
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/issues/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
issueIid)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/discussions/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
discussionId)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/notes/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
noteId)

-- | Gets a list of all discussion items for a single snippet.
snippetDiscussionItems ::
  -- | project
  Project ->
  -- | snippet ID
  Int ->
  GitLab (Either (Response BSL.ByteString) [Discussion])
snippetDiscussionItems :: Project
-> Int -> GitLab (Either (Response ByteString) [Discussion])
snippetDiscussionItems Project
prj Int
snippetId =
  Text
-> [GitLabParam]
-> GitLab (Either (Response ByteString) [Discussion])
forall a.
FromJSON a =>
Text -> [GitLabParam] -> GitLab (Either (Response ByteString) [a])
gitlabGetMany Text
urlPath []
  where
    urlPath :: Text
urlPath =
      String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$
        String
"/projects/"
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Project -> Int
project_id Project
prj)
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/snippets/"
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
snippetId
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/discussions"

-- | Returns a single discussion item for a specific project snippet.
snippetDiscussionItem ::
  -- | project
  Project ->
  -- | snippet ID
  Int ->
  -- | discussion ID
  Int ->
  GitLab (Either (Response BSL.ByteString) (Maybe Discussion))
snippetDiscussionItem :: Project
-> Int
-> Int
-> GitLab (Either (Response ByteString) (Maybe Discussion))
snippetDiscussionItem Project
prj Int
snippetId Int
discussionId =
  Text
-> [GitLabParam]
-> GitLab (Either (Response ByteString) (Maybe Discussion))
forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabGetOne Text
urlPath []
  where
    urlPath :: Text
urlPath =
      String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$
        String
"/projects/"
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Project -> Int
project_id Project
prj)
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/snippets/"
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
snippetId
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/discussions/"
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
discussionId

-- | Creates a new thread to a single project snippet. This is similar
-- to creating a note but other comments (replies) can be added to it
-- later.
createSnippetThread ::
  -- | project
  Project ->
  -- | snippet ID
  Int ->
  -- | The content of a discussion
  Text ->
  GitLab (Either (Response BSL.ByteString) (Maybe Discussion))
createSnippetThread :: Project
-> Int
-> Text
-> GitLab (Either (Response ByteString) (Maybe Discussion))
createSnippetThread Project
prj Int
snippetId Text
content = do
  Text
-> [GitLabParam]
-> GitLab (Either (Response ByteString) (Maybe Discussion))
forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabPost Text
discussionAddr [(ByteString
"body", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 Text
content))]
  where
    discussionAddr :: Text
    discussionAddr :: Text
discussionAddr =
      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 (Project -> Int
project_id Project
prj))
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/snippets/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
snippetId)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/discussions"

-- | Adds a new note to the thread.
addNoteToSnippetThread ::
  -- | project
  Project ->
  -- | snippet ID
  Int ->
  -- | discussion ID
  Int ->
  -- -- | note ID
  -- Int ->

  -- | The content of the note/reply
  Text ->
  GitLab (Either (Response BSL.ByteString) (Maybe Discussion))
addNoteToSnippetThread :: Project
-> Int
-> Int
-> Text
-> GitLab (Either (Response ByteString) (Maybe Discussion))
addNoteToSnippetThread Project
prj Int
snippetId Int
discussionId Text
content =
  Text
-> [GitLabParam]
-> GitLab (Either (Response ByteString) (Maybe Discussion))
forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabPost Text
discussionAddr [(ByteString
"body", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 Text
content))]
  where
    discussionAddr :: Text
    discussionAddr :: Text
discussionAddr =
      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 (Project -> Int
project_id Project
prj))
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/snippets/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
snippetId)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/discussions/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
discussionId)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/notes"

-- <> "/notes/"
-- <> T.pack (show noteId)

-- | Modify existing thread note of a snippet.
modifySnippetThreadNote ::
  -- | project
  Project ->
  -- | snippet ID
  Int ->
  -- | discussion ID
  Int ->
  -- | note ID
  Int ->
  -- | The content of the note/reply
  Text ->
  GitLab (Either (Response BSL.ByteString) (Maybe Discussion))
modifySnippetThreadNote :: Project
-> Int
-> Int
-> Int
-> Text
-> GitLab (Either (Response ByteString) (Maybe Discussion))
modifySnippetThreadNote Project
prj Int
snippetId Int
discussionId Int
noteId Text
content =
  Text
-> [GitLabParam]
-> GitLab (Either (Response ByteString) (Maybe Discussion))
forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabPut Text
noteAddr [(ByteString
"body", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 Text
content))]
  where
    noteAddr :: Text
    noteAddr :: Text
noteAddr =
      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 (Project -> Int
project_id Project
prj))
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/snippets/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
snippetId)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/discussions/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
discussionId)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/notes/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
noteId)

-- | Deletes an existing thread note of an issue.
deleteSnippetThreadNote ::
  -- | Project
  Project ->
  -- | snippet ID
  Int ->
  -- | discussion ID
  Int ->
  -- | note ID
  Int ->
  GitLab (Either (Response BSL.ByteString) (Maybe ()))
deleteSnippetThreadNote :: Project
-> Int
-> Int
-> Int
-> GitLab (Either (Response ByteString) (Maybe ()))
deleteSnippetThreadNote Project
prj Int
snippetId Int
discussionId Int
noteId = do
  Text
-> [GitLabParam]
-> GitLab (Either (Response ByteString) (Maybe ()))
forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabDelete Text
noteAddr []
  where
    noteAddr :: Text
    noteAddr :: Text
noteAddr =
      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 (Project -> Int
project_id Project
prj))
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/snippets/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
snippetId)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/discussions/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
discussionId)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/notes/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
noteId)

-- | Gets a list of all discussion items for a single merge request.
projectMergeRequestDiscussionItems ::
  -- | project
  Project ->
  -- | Merge request IID
  Int ->
  GitLab (Either (Response BSL.ByteString) [Discussion])
projectMergeRequestDiscussionItems :: Project
-> Int -> GitLab (Either (Response ByteString) [Discussion])
projectMergeRequestDiscussionItems Project
prj Int
mergeRequestIid = do
  Text
-> [GitLabParam]
-> GitLab (Either (Response ByteString) [Discussion])
forall a.
FromJSON a =>
Text -> [GitLabParam] -> GitLab (Either (Response ByteString) [a])
gitlabGetMany Text
urlPath []
  where
    urlPath :: Text
urlPath =
      String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$
        String
"/projects/"
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Project -> Int
project_id Project
prj)
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/merge_requests/"
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
mergeRequestIid
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/discussions"

-- | Gets a list of all discussion items for a single merge request.
mergeRequestDiscussionItems ::
  -- | project
  Project ->
  -- | Merge request IID
  Int ->
  -- | discussion ID
  Int ->
  GitLab (Either (Response BSL.ByteString) (Maybe Discussion))
mergeRequestDiscussionItems :: Project
-> Int
-> Int
-> GitLab (Either (Response ByteString) (Maybe Discussion))
mergeRequestDiscussionItems Project
prj Int
mergeRequestIid Int
discussionId = do
  Text
-> [GitLabParam]
-> GitLab (Either (Response ByteString) (Maybe Discussion))
forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabGetOne Text
urlPath []
  where
    urlPath :: Text
urlPath =
      String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$
        String
"/projects/"
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Project -> Int
project_id Project
prj)
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/merge_requests/"
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
mergeRequestIid
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/discussions/"
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
discussionId

-- | Position reference for an entry in a discussion.
data PositionReference = TextPos | ImagePos

instance Show PositionReference where
  show :: PositionReference -> String
show PositionReference
TextPos = String
"text"
  show PositionReference
ImagePos = String
"image"

-- | Creates a new thread to a single project merge request. This is
-- similar to creating a note but other comments (replies) can be
-- added to it later.  See the GitLab document:
-- https://docs.gitlab.com/ee/api/discussions.html#create-new-merge-request-thread
createMergeRequestThread ::
  -- | project
  Project ->
  -- | merge request ID
  Int ->
  -- | The content of the thread
  Text ->
  -- | Base commit SHA in the source branch
  Text ->
  -- | SHA referencing commit in target branch
  Text ->
  -- | SHA referencing HEAD of this merge request
  Text ->
  -- | Type of the position reference
  PositionReference ->
  -- | File path after change
  Text ->
  -- | File path before change
  Text ->
  GitLab (Either (Response BSL.ByteString) (Maybe Discussion))
createMergeRequestThread :: Project
-> Int
-> Text
-> Text
-> Text
-> Text
-> PositionReference
-> Text
-> Text
-> GitLab (Either (Response ByteString) (Maybe Discussion))
createMergeRequestThread Project
prj Int
mergeRequestIid Text
content Text
baseCommitShaSource Text
shaCommitTarget Text
shaHeadMR PositionReference
typePosRef Text
filePathAfter Text
filePathBefore =
  Text
-> [GitLabParam]
-> GitLab (Either (Response ByteString) (Maybe Discussion))
forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabPost
    Text
discussionAddr
    [ (ByteString
"body", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 Text
content)),
      (ByteString
"position[base_sha]", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 Text
baseCommitShaSource)),
      (ByteString
"position[start_sha]", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 Text
shaCommitTarget)),
      (ByteString
"position[head_sha]", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 Text
shaHeadMR)),
      (ByteString
"position[position_type]", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 (String -> Text
T.pack (PositionReference -> String
forall a. Show a => a -> String
show PositionReference
typePosRef)))),
      (ByteString
"position[new_path]", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 Text
filePathAfter)),
      (ByteString
"position[old_path]", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 Text
filePathBefore))
    ]
  where
    discussionAddr :: Text
    discussionAddr :: Text
discussionAddr =
      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 (Project -> Int
project_id Project
prj))
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/merge_requests/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
mergeRequestIid)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/discussions"

-- | Resolve/unresolve whole thread of a merge request.
resolveMergeRequestThread ::
  -- | project
  Project ->
  -- | merge request IID
  Int ->
  -- | discussion ID
  Int ->
  -- | Resolve/unresolve the discussion
  Bool ->
  GitLab (Either (Response BSL.ByteString) (Maybe Discussion))
resolveMergeRequestThread :: Project
-> Int
-> Int
-> Bool
-> GitLab (Either (Response ByteString) (Maybe Discussion))
resolveMergeRequestThread Project
prj Int
mergeRequestIid Int
discussionId Bool
resolved =
  Text
-> [GitLabParam]
-> GitLab (Either (Response ByteString) (Maybe Discussion))
forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabPut Text
noteAddr [(ByteString
"resolved", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 (Bool -> Text
forall p. IsString p => Bool -> p
resolvedStr Bool
resolved)))]
  where
    noteAddr :: Text
    noteAddr :: Text
noteAddr =
      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 (Project -> Int
project_id Project
prj))
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/merge_requests/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
mergeRequestIid)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/discussions/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
discussionId)
    resolvedStr :: Bool -> p
resolvedStr Bool
True = p
"true"
    resolvedStr Bool
False = p
"false"

-- | Adds a new note to the thread. This can also create a thread from a single comment.
addNoteToMergeRequestThread ::
  -- | project
  Project ->
  -- | merge request ID
  Int ->
  -- | discussion ID
  Int ->
  -- -- | note ID
  -- Int ->

  -- | The content of the note/reply
  Text ->
  GitLab (Either (Response BSL.ByteString) (Maybe Discussion))
addNoteToMergeRequestThread :: Project
-> Int
-> Int
-> Text
-> GitLab (Either (Response ByteString) (Maybe Discussion))
addNoteToMergeRequestThread Project
prj Int
mergeRequestIid Int
discussionId Text
content =
  Text
-> [GitLabParam]
-> GitLab (Either (Response ByteString) (Maybe Discussion))
forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabPost
    Text
discussionAddr
    [ (ByteString
"body", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 Text
content))
    ]
  where
    discussionAddr :: Text
    discussionAddr :: Text
discussionAddr =
      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 (Project -> Int
project_id Project
prj))
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/merge_requests/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
mergeRequestIid)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/discussions/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
discussionId)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/notes"

-- | exactly one of body or resolved must be a 'Just' value
modifyMergeRequestThreadNote ::
  -- | project
  Project ->
  -- | merge request IID
  Int ->
  -- | discussion ID
  Int ->
  -- | note ID
  Int ->
  -- | The content of the note/reply
  Maybe Text ->
  -- | Resolve/unresolve the note
  Maybe Bool ->
  GitLab (Either (Response BSL.ByteString) (Maybe Discussion))
modifyMergeRequestThreadNote :: Project
-> Int
-> Int
-> Int
-> Maybe Text
-> Maybe Bool
-> GitLab (Either (Response ByteString) (Maybe Discussion))
modifyMergeRequestThreadNote Project
prj Int
mergeRequestIid Int
discussionId Int
noteId Maybe Text
content Maybe Bool
resolved =
  Text
-> [GitLabParam]
-> GitLab (Either (Response ByteString) (Maybe Discussion))
forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabPut
    Text
noteAddr
    ([Maybe GitLabParam] -> [GitLabParam]
forall a. [Maybe a] -> [a]
catMaybes [Maybe GitLabParam
contentAttr, Maybe GitLabParam
resolveAttr])
  where
    contentAttr :: Maybe GitLabParam
contentAttr =
      case Maybe Text
content of
        Maybe Text
Nothing -> Maybe GitLabParam
forall a. Maybe a
Nothing
        Just Text
x -> GitLabParam -> Maybe GitLabParam
forall a. a -> Maybe a
Just (ByteString
"body", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 Text
x))
    resolveAttr :: Maybe GitLabParam
resolveAttr =
      case Maybe Bool
resolved of
        Maybe Bool
Nothing -> Maybe GitLabParam
forall a. Maybe a
Nothing
        Just Bool
x ->
          if Bool
x
            then GitLabParam -> Maybe GitLabParam
forall a. a -> Maybe a
Just (ByteString
"resolved", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 Text
"true"))
            else GitLabParam -> Maybe GitLabParam
forall a. a -> Maybe a
Just (ByteString
"resolved", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 Text
"false"))
    noteAddr :: Text
    noteAddr :: Text
noteAddr =
      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 (Project -> Int
project_id Project
prj))
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/merge_requests/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
mergeRequestIid)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/discussions/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
discussionId)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/notes/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
noteId)

-- | Deletes an existing thread note of a merge request.
deleteMergeRequestThreadNote ::
  -- | project
  Project ->
  -- | merge request IID
  Int ->
  -- | discussion ID
  Int ->
  -- | note ID
  Int ->
  GitLab (Either (Response BSL.ByteString) (Maybe ()))
deleteMergeRequestThreadNote :: Project
-> Int
-> Int
-> Int
-> GitLab (Either (Response ByteString) (Maybe ()))
deleteMergeRequestThreadNote Project
prj Int
mergeRequestIid Int
discussionId Int
noteId = do
  Text
-> [GitLabParam]
-> GitLab (Either (Response ByteString) (Maybe ()))
forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabDelete Text
noteAddr []
  where
    noteAddr :: Text
    noteAddr :: Text
noteAddr =
      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 (Project -> Int
project_id Project
prj))
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/merge_requests/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
mergeRequestIid)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/discussions/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
discussionId)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/notes/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
noteId)

-- | Gets a list of all discussion items for a single commit.
projectCommitDiscussionItems ::
  -- | project
  Project ->
  -- | commit ID
  Int ->
  GitLab (Either (Response BSL.ByteString) [Discussion])
projectCommitDiscussionItems :: Project
-> Int -> GitLab (Either (Response ByteString) [Discussion])
projectCommitDiscussionItems Project
prj Int
commitId =
  Text
-> [GitLabParam]
-> GitLab (Either (Response ByteString) [Discussion])
forall a.
FromJSON a =>
Text -> [GitLabParam] -> GitLab (Either (Response ByteString) [a])
gitlabGetMany Text
urlPath []
  where
    urlPath :: Text
urlPath =
      String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$
        String
"/projects/"
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Project -> Int
project_id Project
prj)
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/commits/"
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
commitId
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/discussions"

-- | Returns a single discussion item for a specific project commit.
projectCommitDiscussionItem ::
  -- | project
  Project ->
  -- | commit ID
  Int ->
  -- | discussion ID
  Int ->
  GitLab (Either (Response BSL.ByteString) (Maybe Discussion))
projectCommitDiscussionItem :: Project
-> Int
-> Int
-> GitLab (Either (Response ByteString) (Maybe Discussion))
projectCommitDiscussionItem Project
prj Int
commitId Int
discussionId =
  Text
-> [GitLabParam]
-> GitLab (Either (Response ByteString) (Maybe Discussion))
forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabGetOne Text
urlPath []
  where
    urlPath :: Text
urlPath =
      String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$
        String
"/projects/"
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Project -> Int
project_id Project
prj)
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/commits/"
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
commitId
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/discussions/"
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
discussionId

-- | Creates a new thread to a single project commit. This is similar
-- to creating a note but other comments (replies) can be added to it
-- later.
createCommitThread ::
  -- | project
  Project ->
  -- | commit ID
  Int ->
  -- | The content of the thread
  Text ->
  -- | SHA of the parent commit
  Text ->
  -- | SHA of the parent commit (bug in GitLab document?)
  Text ->
  -- | The SHA of this commit
  Text ->
  -- | Type of the position reference
  PositionReference ->
  GitLab (Either (Response BSL.ByteString) (Maybe Discussion))
createCommitThread :: Project
-> Int
-> Text
-> Text
-> Text
-> Text
-> PositionReference
-> GitLab (Either (Response ByteString) (Maybe Discussion))
createCommitThread Project
prj Int
commitId Text
content Text
shaParent Text
shaStart Text
shaThisCommit PositionReference
typePosRef =
  Text
-> [GitLabParam]
-> GitLab (Either (Response ByteString) (Maybe Discussion))
forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabPost
    Text
discussionAddr
    [ (ByteString
"body", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 Text
content)),
      (ByteString
"position[base_sha]", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 Text
shaParent)),
      (ByteString
"position[start_sha]", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 Text
shaStart)),
      (ByteString
"position[head_sha]", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 Text
shaThisCommit)),
      (ByteString
"position[position_type]", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 (String -> Text
T.pack (PositionReference -> String
forall a. Show a => a -> String
show PositionReference
typePosRef))))
    ]
  where
    discussionAddr :: Text
    discussionAddr :: Text
discussionAddr =
      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 (Project -> Int
project_id Project
prj))
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/commits/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
commitId)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/discussions"

-- | Adds a new note to the thread.
addNoteToCommitThread ::
  -- | project
  Project ->
  -- | commit ID
  Int ->
  -- | discussion ID
  Int ->
  -- -- | note ID
  -- Int ->

  -- | The content of the note/reply
  Text ->
  GitLab (Either (Response BSL.ByteString) (Maybe Discussion))
addNoteToCommitThread :: Project
-> Int
-> Int
-> Text
-> GitLab (Either (Response ByteString) (Maybe Discussion))
addNoteToCommitThread Project
prj Int
commitId Int
discussionId Text
content =
  Text
-> [GitLabParam]
-> GitLab (Either (Response ByteString) (Maybe Discussion))
forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabPost
    Text
discussionAddr
    [ (ByteString
"body", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 Text
content))
    ]
  where
    discussionAddr :: Text
    discussionAddr :: Text
discussionAddr =
      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 (Project -> Int
project_id Project
prj))
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/commits/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
commitId)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/discussions/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
discussionId)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/notes"

-- | Adds a new note to the thread.
modifyCommityThreadNote ::
  -- | project
  Project ->
  -- | commit ID
  Int ->
  -- | discussion ID
  Int ->
  -- | note ID
  Int ->
  -- | The content of the note/reply
  Maybe Text ->
  -- | Resolve/unresolve the note
  Maybe Bool ->
  GitLab (Either (Response BSL.ByteString) (Maybe Discussion))
modifyCommityThreadNote :: Project
-> Int
-> Int
-> Int
-> Maybe Text
-> Maybe Bool
-> GitLab (Either (Response ByteString) (Maybe Discussion))
modifyCommityThreadNote Project
prj Int
commitId Int
discussionId Int
noteId Maybe Text
content Maybe Bool
resolved =
  Text
-> [GitLabParam]
-> GitLab (Either (Response ByteString) (Maybe Discussion))
forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabPut
    Text
noteAddr
    ([Maybe GitLabParam] -> [GitLabParam]
forall a. [Maybe a] -> [a]
catMaybes [Maybe GitLabParam
contentAttr, Maybe GitLabParam
resolveAttr])
  where
    contentAttr :: Maybe GitLabParam
contentAttr =
      case Maybe Text
content of
        Maybe Text
Nothing -> Maybe GitLabParam
forall a. Maybe a
Nothing
        Just Text
x -> GitLabParam -> Maybe GitLabParam
forall a. a -> Maybe a
Just (ByteString
"body", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 Text
x))
    resolveAttr :: Maybe GitLabParam
resolveAttr =
      case Maybe Bool
resolved of
        Maybe Bool
Nothing -> Maybe GitLabParam
forall a. Maybe a
Nothing
        Just Bool
x ->
          if Bool
x
            then GitLabParam -> Maybe GitLabParam
forall a. a -> Maybe a
Just (ByteString
"resolved", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 Text
"true"))
            else GitLabParam -> Maybe GitLabParam
forall a. a -> Maybe a
Just (ByteString
"resolved", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 Text
"false"))
    noteAddr :: Text
    noteAddr :: Text
noteAddr =
      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 (Project -> Int
project_id Project
prj))
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/commits/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
commitId)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/discussions/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
discussionId)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/notes/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
noteId)

-- | Deletes an existing thread note of a commit.
deleteCommitThreadNote ::
  -- | project
  Project ->
  -- | commit ID
  Int ->
  -- | discussion ID
  Int ->
  -- | The ID of a discussion note
  Int ->
  GitLab (Either (Response BSL.ByteString) (Maybe ()))
deleteCommitThreadNote :: Project
-> Int
-> Int
-> Int
-> GitLab (Either (Response ByteString) (Maybe ()))
deleteCommitThreadNote Project
prj Int
commitId Int
discussionId Int
noteId = do
  Text
-> [GitLabParam]
-> GitLab (Either (Response ByteString) (Maybe ()))
forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabDelete Text
noteAddr []
  where
    noteAddr :: Text
    noteAddr :: Text
noteAddr =
      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 (Project -> Int
project_id Project
prj))
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/commits/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
commitId)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/discussions/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
discussionId)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/notes/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
noteId)