{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module      : Todos
-- Description : Queries about todos for users
-- Copyright   : (c) Rob Stewart, Heriot-Watt University, 2019
-- License     : BSD3
-- Maintainer  : robstewart57@gmail.com
-- Stability   : stable
module GitLab.API.Todos
  ( -- * Get a list of to-do items
    todos,

    -- * Mark a to-do item as done
    todoDone,

    -- * Mark all to-do items as done
    todosDone,

    -- * TODO's filters
    defaultTodoFilters,
    TodoAttrs (..),
  )
where

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

-- | returns all pending todos for the user, as defined by the access token.
todos :: TodoAttrs -> GitLab [Todo]
todos :: TodoAttrs -> GitLab [Todo]
todos TodoAttrs
attrs = forall a b. GitLab (Either a (Maybe b)) -> GitLab b
gitlabUnsafe (forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabGetOne Text
"/todos" [GitLabParam]
params)
  where
    params :: [GitLabParam]
    params :: [GitLabParam]
params = TodoAttrs -> [GitLabParam]
groupProjectAttrs TodoAttrs
attrs

-- | Attributes related to listing groups
data TodoAttrs = TodoAttrs
  { -- | The action to be filtered
    TodoAttrs -> Maybe TodoAction
todoFilter_action :: Maybe TodoAction,
    -- | The ID of an author
    TodoAttrs -> Maybe Int
todoFilter_author_id :: Maybe Int,
    -- | The ID of a project
    TodoAttrs -> Maybe Int
todoFilter_project_id :: Maybe Int,
    -- | The ID of a group
    TodoAttrs -> Maybe Int
todoFilter_group_id :: Maybe Int,
    -- | The state of the to-do item
    TodoAttrs -> Maybe TodoState
todoFilter_state :: Maybe TodoState,
    -- | The type of to-do item.
    TodoAttrs -> Maybe TodoType
todoFilter_type :: Maybe TodoType
  }

groupProjectAttrs :: TodoAttrs -> [GitLabParam]
groupProjectAttrs :: TodoAttrs -> [GitLabParam]
groupProjectAttrs TodoAttrs
filters =
  forall a. [Maybe a] -> [a]
catMaybes
    [ (\TodoAction
x -> forall a. a -> Maybe a
Just (ByteString
"action", Text -> Maybe ByteString
textToBS (String -> Text
T.pack (forall a. Show a => a -> String
show TodoAction
x)))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TodoAttrs -> Maybe TodoAction
todoFilter_action TodoAttrs
filters,
      (\Int
i -> forall a. a -> Maybe a
Just (ByteString
"author_id", Text -> Maybe ByteString
textToBS (String -> Text
T.pack (forall a. Show a => a -> String
show Int
i)))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TodoAttrs -> Maybe Int
todoFilter_author_id TodoAttrs
filters,
      (\Int
i -> forall a. a -> Maybe a
Just (ByteString
"project_id", Text -> Maybe ByteString
textToBS (String -> Text
T.pack (forall a. Show a => a -> String
show Int
i)))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TodoAttrs -> Maybe Int
todoFilter_project_id TodoAttrs
filters,
      (\Int
i -> forall a. a -> Maybe a
Just (ByteString
"group_id", Text -> Maybe ByteString
textToBS (String -> Text
T.pack (forall a. Show a => a -> String
show Int
i)))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TodoAttrs -> Maybe Int
todoFilter_group_id TodoAttrs
filters,
      (\TodoState
x -> forall a. a -> Maybe a
Just (ByteString
"state", Text -> Maybe ByteString
textToBS (String -> Text
T.pack (forall a. Show a => a -> String
show TodoState
x)))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TodoAttrs -> Maybe TodoState
todoFilter_state TodoAttrs
filters,
      (\TodoType
x -> forall a. a -> Maybe a
Just (ByteString
"type", Text -> Maybe ByteString
textToBS (String -> Text
T.pack (forall a. Show a => a -> String
show TodoType
x)))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TodoAttrs -> Maybe TodoType
todoFilter_type TodoAttrs
filters
    ]
  where
    textToBS :: Text -> Maybe ByteString
textToBS = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8

-- | No todo filters applied.
defaultTodoFilters :: TodoAttrs
defaultTodoFilters :: TodoAttrs
defaultTodoFilters =
  Maybe TodoAction
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe TodoState
-> Maybe TodoType
-> TodoAttrs
TodoAttrs forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing

-- | Marks a single pending to-do item given by its ID for the current
-- user as done.
todoDone ::
  -- | The ID of to-do item
  Int ->
  GitLab (Either (Response BSL.ByteString) (Maybe ()))
todoDone :: Int -> GitLab (Either (Response ByteString) (Maybe ()))
todoDone Int
todoId =
  forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabPost Text
addr []
  where
    addr :: Text
addr =
      String -> Text
T.pack forall a b. (a -> b) -> a -> b
$
        String
"/todos/"
          forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
todoId
          forall a. Semigroup a => a -> a -> a
<> String
"/mark_as_done"

-- | Marks all pending to-do items for the current user as done. It
-- returns the HTTP status code 204 with an empty response.
todosDone ::
  GitLab
    (Either (Response BSL.ByteString) (Maybe ()))
todosDone :: GitLab (Either (Response ByteString) (Maybe ()))
todosDone =
  forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabPost Text
addr []
  where
    addr :: Text
addr =
      String -> Text
T.pack forall a b. (a -> b) -> a -> b
$
        String
"/todos"
          forall a. Semigroup a => a -> a -> a
<> String
"/mark_as_done"