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

-- |
-- Module      : Issues
-- Description : Queries about issues created against projects
-- Copyright   : (c) Rob Stewart, Heriot-Watt University, 2019
-- License     : BSD3
-- Maintainer  : robstewart57@gmail.com
-- Stability   : stable
module GitLab.API.Issues where

import qualified Data.Aeson as J
import Data.Either
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Lazy
import qualified Data.Text.Lazy.Encoding
import GitLab.Types
import GitLab.WebRequests.GitLabWebCalls
import Network.HTTP.Types.Status

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

-- | returns all issues against a project given its project ID.
projectOpenedIssues' ::
  -- | the project ID
  Int ->
  GitLab (Either Status [Issue])
projectOpenedIssues' :: Int -> GitLab (Either Status [Issue])
projectOpenedIssues' Int
projectId = do
  let path :: Text
path = 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
projectId) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/issues"
  Text -> GitLab (Either Status [Issue])
forall a. FromJSON a => Text -> GitLab (Either Status [a])
gitlab Text
path

-- gitlabReq path "&state=opened"

-- | gets all issues create by a user.
userIssues ::
  -- | the user
  User ->
  GitLab [Issue]
userIssues :: User -> GitLab [Issue]
userIssues User
usr =
  Text -> Text -> GitLab [Issue]
forall a. FromJSON a => Text -> Text -> GitLab [a]
gitlabWithAttrsUnsafe Text
addr Text
attrs
  where
    addr :: Text
addr = Text
"/issues"
    attrs :: Text
attrs =
      [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$
        [Char]
"&author_id="
          [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. Show a => a -> [Char]
show (User -> Int
user_id User
usr)
          [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"&scope=all"

-- | create a new issue.
newIssue ::
  -- | project
  Project ->
  -- | issue title
  Text ->
  -- | issue description
  Text ->
  GitLab (Either Status (Maybe Issue))
newIssue :: Project -> Text -> Text -> GitLab (Either Status (Maybe Issue))
newIssue Project
project =
  Int -> Text -> Text -> GitLab (Either Status (Maybe Issue))
newIssue' (Project -> Int
project_id Project
project)

-- | create a new issue.
newIssue' ::
  -- | project ID
  Int ->
  -- | issue title
  Text ->
  -- | issue description
  Text ->
  GitLab (Either Status (Maybe Issue))
newIssue' :: Int -> Text -> Text -> GitLab (Either Status (Maybe Issue))
newIssue' Int
projectId Text
issueTitle Text
issueDescription =
  Text -> Text -> GitLab (Either Status (Maybe Issue))
forall b.
FromJSON b =>
Text -> Text -> GitLab (Either Status (Maybe b))
gitlabPost Text
addr Text
dataBody
  where
    dataBody :: Text
    dataBody :: Text
dataBody =
      Text
"title="
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
issueTitle
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"&description="
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
issueDescription
    addr :: Text
addr =
      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
projectId)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/issues"

-- | edits an issue. see <https://docs.gitlab.com/ee/api/issues.html#edit-issue>
editIssue ::
  ProjectId ->
  IssueId ->
  EditIssueReq ->
  GitLab (Either Status Issue)
editIssue :: Int -> Int -> EditIssueReq -> GitLab (Either Status Issue)
editIssue Int
projId Int
issueId EditIssueReq
editIssueReq = do
  let path :: Text
path =
        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
"/issues/"
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
issueId)
  Text -> Text -> GitLab (Either Status Issue)
forall b. FromJSON b => Text -> Text -> GitLab (Either Status b)
gitlabPut
    Text
path
    ( Text -> Text
Data.Text.Lazy.toStrict
        ( ByteString -> Text
Data.Text.Lazy.Encoding.decodeUtf8
            (EditIssueReq -> ByteString
forall a. ToJSON a => a -> ByteString
J.encode EditIssueReq
editIssueReq)
        )
    )