packages feed

gitlab-haskell 0.2.5 → 0.3.0

raw patch · 15 files changed

+1159/−38 lines, 15 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

- GitLab.API.Issues: projectOpenedIssues :: Project -> GitLab [Issue]
- GitLab.API.Issues: projectOpenedIssues' :: Int -> GitLab (Either Status [Issue])
+ GitLab.API.Boards: CreateBoardAttrs :: Maybe Int -> Maybe Int -> Maybe Int -> CreateBoardAttrs
+ GitLab.API.Boards: UpdateBoardAttrs :: Maybe String -> Maybe Int -> Maybe Int -> Maybe String -> Maybe Int -> UpdateBoardAttrs
+ GitLab.API.Boards: [createBoard_assignee_id] :: CreateBoardAttrs -> Maybe Int
+ GitLab.API.Boards: [createBoard_label_id] :: CreateBoardAttrs -> Maybe Int
+ GitLab.API.Boards: [createBoard_milestone_id] :: CreateBoardAttrs -> Maybe Int
+ GitLab.API.Boards: [updateBoard_assignee_id] :: UpdateBoardAttrs -> Maybe Int
+ GitLab.API.Boards: [updateBoard_labels] :: UpdateBoardAttrs -> Maybe String
+ GitLab.API.Boards: [updateBoard_milestone_id] :: UpdateBoardAttrs -> Maybe Int
+ GitLab.API.Boards: [updateBoard_new_name] :: UpdateBoardAttrs -> Maybe String
+ GitLab.API.Boards: [updateBoard_weight] :: UpdateBoardAttrs -> Maybe Int
+ GitLab.API.Boards: boardList :: Project -> IssueBoard -> Int -> GitLab (Maybe BoardIssue)
+ GitLab.API.Boards: boardList' :: Int -> Int -> Int -> GitLab (Either Status (Maybe BoardIssue))
+ GitLab.API.Boards: createBoardAttrs :: CreateBoardAttrs -> String
+ GitLab.API.Boards: createBoardList :: Project -> IssueBoard -> CreateBoardAttrs -> GitLab (Maybe BoardIssue)
+ GitLab.API.Boards: createBoardList' :: Int -> Int -> CreateBoardAttrs -> GitLab (Either Status (Maybe BoardIssue))
+ GitLab.API.Boards: createIssueBoard :: Project -> Text -> GitLab (Maybe IssueBoard)
+ GitLab.API.Boards: createIssueBoard' :: Int -> Text -> GitLab (Either Status (Maybe IssueBoard))
+ GitLab.API.Boards: data CreateBoardAttrs
+ GitLab.API.Boards: data UpdateBoardAttrs
+ GitLab.API.Boards: deleteBoardList :: Project -> IssueBoard -> Int -> GitLab (Either Status ())
+ GitLab.API.Boards: deleteBoardList' :: Int -> Int -> Int -> GitLab (Either Status ())
+ GitLab.API.Boards: deleteIssueBoard :: Project -> IssueBoard -> GitLab (Either Status ())
+ GitLab.API.Boards: deleteIssueBoard' :: Int -> Int -> GitLab (Either Status ())
+ GitLab.API.Boards: noCreateBoardAttrs :: CreateBoardAttrs
+ GitLab.API.Boards: noUpdateBoardAttrs :: UpdateBoardAttrs
+ GitLab.API.Boards: projectBoardLists :: Project -> IssueBoard -> GitLab [BoardIssue]
+ GitLab.API.Boards: projectBoardLists' :: Int -> Int -> GitLab (Either Status [BoardIssue])
+ GitLab.API.Boards: projectIssueBoard :: Project -> Int -> GitLab (Either Status (Maybe IssueBoard))
+ GitLab.API.Boards: projectIssueBoard' :: Int -> Int -> GitLab (Either Status (Maybe IssueBoard))
+ GitLab.API.Boards: projectIssueBoards :: Project -> GitLab [IssueBoard]
+ GitLab.API.Boards: projectIssueBoards' :: Int -> GitLab (Either Status [IssueBoard])
+ GitLab.API.Boards: reorderBoardList :: Project -> IssueBoard -> Int -> Int -> GitLab (Either Status (Maybe BoardIssue))
+ GitLab.API.Boards: reorderBoardList' :: Int -> Int -> Int -> Int -> GitLab (Either Status (Maybe BoardIssue))
+ GitLab.API.Boards: updateBoardAttrs :: UpdateBoardAttrs -> String
+ GitLab.API.Boards: updateIssueBoard' :: Int -> Int -> UpdateBoardAttrs -> GitLab (Either Status IssueBoard)
+ GitLab.API.Discussions: commitDiscussions :: Project -> Text -> GitLab (Either Status [Discussion])
+ GitLab.API.Discussions: commitDiscussions' :: Int -> Text -> GitLab (Either Status [Discussion])
+ GitLab.API.Groups: groupProjects :: Group -> GitLab (Either Status [Project])
+ GitLab.API.Groups: groupProjects' :: Int -> GitLab (Either Status [Project])
+ GitLab.API.Issues: All :: IssueScope
+ GitLab.API.Issues: Ascending :: IssueSortBy
+ GitLab.API.Issues: AssignedToMe :: IssueScope
+ GitLab.API.Issues: CreatedAt :: IssueOrderBy
+ GitLab.API.Issues: CreatedByMe :: IssueScope
+ GitLab.API.Issues: Descending :: IssueSortBy
+ GitLab.API.Issues: DueDate :: IssueOrderBy
+ GitLab.API.Issues: IssueAttrs :: Maybe Int -> Maybe String -> Maybe Int -> Maybe String -> Maybe Bool -> Maybe UTCTime -> Maybe UTCTime -> Maybe DueDate -> Maybe Int -> Maybe IssueSearchIn -> Maybe Int -> Maybe String -> Maybe String -> Maybe String -> Maybe String -> Maybe Bool -> Maybe IssueOrderBy -> Maybe IssueScope -> Maybe String -> Maybe IssueSortBy -> Maybe IssueState -> Maybe UTCTime -> Maybe UTCTime -> Maybe Bool -> IssueAttrs
+ GitLab.API.Issues: IssueClosed :: IssueState
+ GitLab.API.Issues: IssueOpen :: IssueState
+ GitLab.API.Issues: JustDescription :: IssueSearchIn
+ GitLab.API.Issues: JustTitle :: IssueSearchIn
+ GitLab.API.Issues: LabelPriority :: IssueOrderBy
+ GitLab.API.Issues: MilestoneDue :: IssueOrderBy
+ GitLab.API.Issues: Month :: DueDate
+ GitLab.API.Issues: NextMonthPreviousTwoWeeks :: DueDate
+ GitLab.API.Issues: NoDueDate :: DueDate
+ GitLab.API.Issues: Overdue :: DueDate
+ GitLab.API.Issues: Popularity :: IssueOrderBy
+ GitLab.API.Issues: Priority :: IssueOrderBy
+ GitLab.API.Issues: RelativePosition :: IssueOrderBy
+ GitLab.API.Issues: TitleAndDescription :: IssueSearchIn
+ GitLab.API.Issues: UpdatedAt :: IssueOrderBy
+ GitLab.API.Issues: Week :: DueDate
+ GitLab.API.Issues: Weight :: IssueOrderBy
+ GitLab.API.Issues: [issueFilter_assignee_id] :: IssueAttrs -> Maybe Int
+ GitLab.API.Issues: [issueFilter_assignee_username] :: IssueAttrs -> Maybe String
+ GitLab.API.Issues: [issueFilter_author_id] :: IssueAttrs -> Maybe Int
+ GitLab.API.Issues: [issueFilter_author_username] :: IssueAttrs -> Maybe String
+ GitLab.API.Issues: [issueFilter_confidential] :: IssueAttrs -> Maybe Bool
+ GitLab.API.Issues: [issueFilter_created_after] :: IssueAttrs -> Maybe UTCTime
+ GitLab.API.Issues: [issueFilter_created_before] :: IssueAttrs -> Maybe UTCTime
+ GitLab.API.Issues: [issueFilter_due_date] :: IssueAttrs -> Maybe DueDate
+ GitLab.API.Issues: [issueFilter_iids] :: IssueAttrs -> Maybe Int
+ GitLab.API.Issues: [issueFilter_in] :: IssueAttrs -> Maybe IssueSearchIn
+ GitLab.API.Issues: [issueFilter_iteration_id] :: IssueAttrs -> Maybe Int
+ GitLab.API.Issues: [issueFilter_iteration_title] :: IssueAttrs -> Maybe String
+ GitLab.API.Issues: [issueFilter_labels] :: IssueAttrs -> Maybe String
+ GitLab.API.Issues: [issueFilter_milestone] :: IssueAttrs -> Maybe String
+ GitLab.API.Issues: [issueFilter_my_reaction_emoji] :: IssueAttrs -> Maybe String
+ GitLab.API.Issues: [issueFilter_non_archived] :: IssueAttrs -> Maybe Bool
+ GitLab.API.Issues: [issueFilter_order_by] :: IssueAttrs -> Maybe IssueOrderBy
+ GitLab.API.Issues: [issueFilter_scope] :: IssueAttrs -> Maybe IssueScope
+ GitLab.API.Issues: [issueFilter_search] :: IssueAttrs -> Maybe String
+ GitLab.API.Issues: [issueFilter_sort] :: IssueAttrs -> Maybe IssueSortBy
+ GitLab.API.Issues: [issueFilter_state] :: IssueAttrs -> Maybe IssueState
+ GitLab.API.Issues: [issueFilter_updated_after] :: IssueAttrs -> Maybe UTCTime
+ GitLab.API.Issues: [issueFilter_updated_before] :: IssueAttrs -> Maybe UTCTime
+ GitLab.API.Issues: [issueFilter_with_labels_details] :: IssueAttrs -> Maybe Bool
+ GitLab.API.Issues: data DueDate
+ GitLab.API.Issues: data IssueAttrs
+ GitLab.API.Issues: data IssueOrderBy
+ GitLab.API.Issues: data IssueScope
+ GitLab.API.Issues: data IssueSearchIn
+ GitLab.API.Issues: data IssueSortBy
+ GitLab.API.Issues: data IssueState
+ GitLab.API.Issues: defaultIssueFilters :: IssueAttrs
+ GitLab.API.Issues: instance GHC.Show.Show GitLab.API.Issues.DueDate
+ GitLab.API.Issues: instance GHC.Show.Show GitLab.API.Issues.IssueOrderBy
+ GitLab.API.Issues: instance GHC.Show.Show GitLab.API.Issues.IssueScope
+ GitLab.API.Issues: instance GHC.Show.Show GitLab.API.Issues.IssueSearchIn
+ GitLab.API.Issues: instance GHC.Show.Show GitLab.API.Issues.IssueSortBy
+ GitLab.API.Issues: instance GHC.Show.Show GitLab.API.Issues.IssueState
+ GitLab.API.Issues: issueStatisticsGroup :: Group -> IssueAttrs -> GitLab IssueStatistics
+ GitLab.API.Issues: issueStatisticsGroup' :: Int -> IssueAttrs -> GitLab (Either Status (Maybe IssueStatistics))
+ GitLab.API.Issues: issueStatisticsProject :: Project -> IssueAttrs -> GitLab IssueStatistics
+ GitLab.API.Issues: issueStatisticsProject' :: Int -> IssueAttrs -> GitLab (Either Status (Maybe IssueStatistics))
+ GitLab.API.Issues: issueStatisticsUser :: IssueAttrs -> GitLab IssueStatistics
+ GitLab.API.Issues: projectIssues :: Project -> IssueAttrs -> GitLab [Issue]
+ GitLab.API.Issues: projectIssues' :: Int -> IssueAttrs -> GitLab (Either Status [Issue])
+ GitLab.API.Tags: tags :: Project -> GitLab [Tag]
+ GitLab.API.Tags: tags' :: Int -> GitLab (Either Status [Tag])
+ GitLab.Types: BoardIssue :: Int -> BoardIssueLabel -> Int -> Int -> Int -> Maybe Int -> BoardIssue
+ GitLab.Types: BoardIssueLabel :: Maybe Int -> Text -> Text -> Maybe Text -> BoardIssueLabel
+ GitLab.Types: Discussion :: Text -> Bool -> [Note] -> Discussion
+ GitLab.Types: IssueBoard :: Int -> Text -> ProjectBoard -> Maybe Milestone -> [BoardIssue] -> Maybe Text -> Maybe Owner -> Maybe [BoardIssueLabel] -> Maybe Int -> IssueBoard
+ GitLab.Types: IssueCounts :: Int -> Int -> Int -> IssueCounts
+ GitLab.Types: IssueStatistics :: IssueStats -> IssueStatistics
+ GitLab.Types: ProjectBoard :: Int -> Text -> Text -> Text -> Text -> Text -> Text -> ProjectBoard
+ GitLab.Types: Tag :: Commit -> Maybe Release -> Text -> Text -> Maybe Text -> Bool -> Tag
+ GitLab.Types: [board_assignee] :: IssueBoard -> Maybe Owner
+ GitLab.Types: [board_group] :: IssueBoard -> Maybe Text
+ GitLab.Types: [board_id] :: IssueBoard -> Int
+ GitLab.Types: [board_issue_id] :: BoardIssue -> Int
+ GitLab.Types: [board_issue_label] :: BoardIssue -> BoardIssueLabel
+ GitLab.Types: [board_issue_label_color] :: BoardIssueLabel -> Text
+ GitLab.Types: [board_issue_label_description] :: BoardIssueLabel -> Maybe Text
+ GitLab.Types: [board_issue_label_id] :: BoardIssueLabel -> Maybe Int
+ GitLab.Types: [board_issue_label_name] :: BoardIssueLabel -> Text
+ GitLab.Types: [board_issue_limit_metric] :: BoardIssue -> Maybe Int
+ GitLab.Types: [board_issue_max_issue_count] :: BoardIssue -> Int
+ GitLab.Types: [board_issue_max_issue_weight] :: BoardIssue -> Int
+ GitLab.Types: [board_issue_position] :: BoardIssue -> Int
+ GitLab.Types: [board_labels] :: IssueBoard -> Maybe [BoardIssueLabel]
+ GitLab.Types: [board_lists] :: IssueBoard -> [BoardIssue]
+ GitLab.Types: [board_milestone] :: IssueBoard -> Maybe Milestone
+ GitLab.Types: [board_name] :: IssueBoard -> Text
+ GitLab.Types: [board_project] :: IssueBoard -> ProjectBoard
+ GitLab.Types: [board_weight] :: IssueBoard -> Maybe Int
+ GitLab.Types: [discussion_id] :: Discussion -> Text
+ GitLab.Types: [discussion_individual_note] :: Discussion -> Bool
+ GitLab.Types: [discussion_notes] :: Discussion -> [Note]
+ GitLab.Types: [issues_all] :: IssueCounts -> Int
+ GitLab.Types: [issues_closed] :: IssueCounts -> Int
+ GitLab.Types: [issues_opened] :: IssueCounts -> Int
+ GitLab.Types: [issues_statistics] :: IssueStatistics -> IssueStats
+ GitLab.Types: [project_board_http_url_to_repo] :: ProjectBoard -> Text
+ GitLab.Types: [project_board_id] :: ProjectBoard -> Int
+ GitLab.Types: [project_board_name] :: ProjectBoard -> Text
+ GitLab.Types: [project_board_name_with_namespace] :: ProjectBoard -> Text
+ GitLab.Types: [project_board_path] :: ProjectBoard -> Text
+ GitLab.Types: [project_board_path_with_namespace] :: ProjectBoard -> Text
+ GitLab.Types: [project_board_web_url] :: ProjectBoard -> Text
+ GitLab.Types: [tag_commit] :: Tag -> Commit
+ GitLab.Types: [tag_message] :: Tag -> Maybe Text
+ GitLab.Types: [tag_name] :: Tag -> Text
+ GitLab.Types: [tag_protected] :: Tag -> Bool
+ GitLab.Types: [tag_release] :: Tag -> Maybe Release
+ GitLab.Types: [tag_target] :: Tag -> Text
+ GitLab.Types: data BoardIssue
+ GitLab.Types: data BoardIssueLabel
+ GitLab.Types: data Discussion
+ GitLab.Types: data IssueBoard
+ GitLab.Types: data IssueCounts
+ GitLab.Types: data ProjectBoard
+ GitLab.Types: data Tag
+ GitLab.Types: instance Data.Aeson.Types.FromJSON.FromJSON GitLab.Types.BoardIssue
+ GitLab.Types: instance Data.Aeson.Types.FromJSON.FromJSON GitLab.Types.BoardIssueLabel
+ GitLab.Types: instance Data.Aeson.Types.FromJSON.FromJSON GitLab.Types.Discussion
+ GitLab.Types: instance Data.Aeson.Types.FromJSON.FromJSON GitLab.Types.IssueBoard
+ GitLab.Types: instance Data.Aeson.Types.FromJSON.FromJSON GitLab.Types.IssueCounts
+ GitLab.Types: instance Data.Aeson.Types.FromJSON.FromJSON GitLab.Types.IssueStatistics
+ GitLab.Types: instance Data.Aeson.Types.FromJSON.FromJSON GitLab.Types.IssueStats
+ GitLab.Types: instance Data.Aeson.Types.FromJSON.FromJSON GitLab.Types.Note
+ GitLab.Types: instance Data.Aeson.Types.FromJSON.FromJSON GitLab.Types.ProjectBoard
+ GitLab.Types: instance Data.Aeson.Types.FromJSON.FromJSON GitLab.Types.Release
+ GitLab.Types: instance Data.Aeson.Types.FromJSON.FromJSON GitLab.Types.Tag
+ GitLab.Types: instance GHC.Classes.Eq GitLab.Types.BoardIssue
+ GitLab.Types: instance GHC.Classes.Eq GitLab.Types.BoardIssueLabel
+ GitLab.Types: instance GHC.Classes.Eq GitLab.Types.IssueBoard
+ GitLab.Types: instance GHC.Classes.Eq GitLab.Types.Milestone
+ GitLab.Types: instance GHC.Classes.Eq GitLab.Types.MilestoneState
+ GitLab.Types: instance GHC.Classes.Eq GitLab.Types.Owner
+ GitLab.Types: instance GHC.Classes.Eq GitLab.Types.ProjectBoard
+ GitLab.Types: instance GHC.Generics.Generic GitLab.Types.BoardIssue
+ GitLab.Types: instance GHC.Generics.Generic GitLab.Types.BoardIssueLabel
+ GitLab.Types: instance GHC.Generics.Generic GitLab.Types.Discussion
+ GitLab.Types: instance GHC.Generics.Generic GitLab.Types.IssueBoard
+ GitLab.Types: instance GHC.Generics.Generic GitLab.Types.IssueCounts
+ GitLab.Types: instance GHC.Generics.Generic GitLab.Types.IssueStatistics
+ GitLab.Types: instance GHC.Generics.Generic GitLab.Types.IssueStats
+ GitLab.Types: instance GHC.Generics.Generic GitLab.Types.Note
+ GitLab.Types: instance GHC.Generics.Generic GitLab.Types.ProjectBoard
+ GitLab.Types: instance GHC.Generics.Generic GitLab.Types.Release
+ GitLab.Types: instance GHC.Generics.Generic GitLab.Types.Tag
+ GitLab.Types: instance GHC.Show.Show GitLab.Types.BoardIssue
+ GitLab.Types: instance GHC.Show.Show GitLab.Types.BoardIssueLabel
+ GitLab.Types: instance GHC.Show.Show GitLab.Types.Discussion
+ GitLab.Types: instance GHC.Show.Show GitLab.Types.IssueBoard
+ GitLab.Types: instance GHC.Show.Show GitLab.Types.IssueCounts
+ GitLab.Types: instance GHC.Show.Show GitLab.Types.IssueStatistics
+ GitLab.Types: instance GHC.Show.Show GitLab.Types.IssueStats
+ GitLab.Types: instance GHC.Show.Show GitLab.Types.Note
+ GitLab.Types: instance GHC.Show.Show GitLab.Types.ProjectBoard
+ GitLab.Types: instance GHC.Show.Show GitLab.Types.Release
+ GitLab.Types: instance GHC.Show.Show GitLab.Types.Tag
+ GitLab.Types: newtype IssueStatistics
- GitLab.API.Commits: branchCommits :: Project -> Text -> GitLab (Either Status [Commit])
+ GitLab.API.Commits: branchCommits :: Project -> Text -> GitLab [Commit]
- GitLab.Types: Links :: Text -> Maybe Text -> Text -> Text -> Text -> Text -> Text -> Links
+ GitLab.Types: Links :: Text -> Maybe Text -> Maybe Text -> Text -> Text -> Text -> Text -> Links
- GitLab.Types: Milestone :: Maybe Int -> Maybe Int -> Text -> MilestoneState -> Maybe UTCTime -> Int -> Maybe UTCTime -> Text -> Int -> UTCTime -> URL -> Milestone
+ GitLab.Types: Milestone :: Maybe Int -> Maybe Int -> Maybe Text -> Maybe MilestoneState -> Maybe Text -> Maybe Int -> Maybe UTCTime -> Text -> Int -> Maybe UTCTime -> Maybe URL -> Milestone
- GitLab.Types: [merge_requests] :: Links -> Text
+ GitLab.Types: [merge_requests] :: Links -> Maybe Text
- GitLab.Types: [milestone_description] :: Milestone -> Text
+ GitLab.Types: [milestone_description] :: Milestone -> Maybe Text
- GitLab.Types: [milestone_due_date] :: Milestone -> Maybe UTCTime
+ GitLab.Types: [milestone_due_date] :: Milestone -> Maybe Text
- GitLab.Types: [milestone_iid] :: Milestone -> Int
+ GitLab.Types: [milestone_iid] :: Milestone -> Maybe Int
- GitLab.Types: [milestone_state] :: Milestone -> MilestoneState
+ GitLab.Types: [milestone_state] :: Milestone -> Maybe MilestoneState
- GitLab.Types: [milestone_updated_at] :: Milestone -> UTCTime
+ GitLab.Types: [milestone_updated_at] :: Milestone -> Maybe UTCTime
- GitLab.Types: [milestone_web_url] :: Milestone -> URL
+ GitLab.Types: [milestone_web_url] :: Milestone -> Maybe URL

Files

README.md view
@@ -15,6 +15,7 @@ * Repositories * Repository files * Users+* Discussions  The library parses JSON results into Haskell data types in the `GitLab.Types` module, allowing you to work with statically typed
gitlab-haskell.cabal view
@@ -1,7 +1,7 @@ cabal-version: 2.4 name:           gitlab-haskell category:       Git-version:        0.2.5+version:        0.3.0 synopsis:       A Haskell library for the GitLab web API description:             This Haskell library queries and updates the database of a GitLab instance using the GitLab web API: <https://docs.gitlab.com/ee/api/>@@ -74,9 +74,12 @@                 , GitLab.API.Repositories                 , GitLab.API.MergeRequests                 , GitLab.API.RepositoryFiles+                , GitLab.API.Tags                 , GitLab.API.Todos                 , GitLab.API.Version                 , GitLab.API.Notes+                , GitLab.API.Discussions+                , GitLab.API.Boards                 , GitLab.SystemHooks.Types                 , GitLab.SystemHooks.GitLabSystemHooks                 , GitLab.SystemHooks.Rules@@ -108,6 +111,8 @@   type:          exitcode-stdio-1.0   main-is:       Tests.hs   other-modules: SystemHookTests+               , API.BoardsTests+               , API.Common   hs-source-dirs: tests/   default-language: Haskell2010   build-depends: base >= 4.8.0.0 && < 6
src/GitLab.hs view
@@ -24,9 +24,11 @@     module GitLab.API.MergeRequests,     module GitLab.API.Repositories,     module GitLab.API.RepositoryFiles,+    module GitLab.API.Tags,     module GitLab.API.Todos,     module GitLab.API.Version,     module GitLab.API.Notes,+    module GitLab.API.Discussions,     module GitLab.SystemHooks.GitLabSystemHooks,     module GitLab.SystemHooks.Types,     module GitLab.SystemHooks.Rules,@@ -37,6 +39,7 @@ import Control.Monad.Trans.Reader import GitLab.API.Branches import GitLab.API.Commits+import GitLab.API.Discussions import GitLab.API.Groups import GitLab.API.Issues import GitLab.API.Jobs@@ -47,6 +50,7 @@ import GitLab.API.Projects import GitLab.API.Repositories import GitLab.API.RepositoryFiles+import GitLab.API.Tags import GitLab.API.Todos import GitLab.API.Users import GitLab.API.Version
+ src/GitLab/API/Boards.hs view
@@ -0,0 +1,351 @@+{-# 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 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.Types.Status++-- | returns all issue boards for a project.+projectIssueBoards ::+  -- | the project+  Project ->+  GitLab [IssueBoard]+projectIssueBoards project = do+  result <- projectIssueBoards' (project_id project)+  -- return an empty list if the repository could not be found.+  return (fromRight [] result)++-- | returns all issue boards for a project given its project ID.+projectIssueBoards' ::+  -- | project ID+  Int ->+  GitLab (Either Status [IssueBoard])+projectIssueBoards' projectId =+  gitlab (boardsAddr projectId)+  where+    boardsAddr :: Int -> Text+    boardsAddr projId =+      "/projects/" <> T.pack (show projId) <> "/boards"++-- | returns all issue boards for a project.+projectIssueBoard ::+  -- | the project+  Project ->+  -- | the board ID+  Int ->+  GitLab (Either Status (Maybe IssueBoard))+projectIssueBoard project = do+  projectIssueBoard' (project_id project)++-- | returns all issue boards for a project.+projectIssueBoard' ::+  -- | the project ID+  Int ->+  -- | the board ID+  Int ->+  GitLab (Either Status (Maybe IssueBoard))+projectIssueBoard' projectId boardId = do+  gitlabOne boardAddr+  where+    boardAddr :: Text+    boardAddr =+      "/projects/" <> T.pack (show projectId) <> "/boards/" <> T.pack (show boardId)++-- | Creates a project issue board.+createIssueBoard ::+  -- | the project+  Project ->+  -- | board name+  Text ->+  GitLab (Maybe IssueBoard)+createIssueBoard project boardName = do+  result <- createIssueBoard' (project_id project) boardName+  return (fromRight Nothing result)++-- | Creates a project issue board.+createIssueBoard' ::+  -- | the project ID+  Int ->+  -- | board name+  Text ->+  GitLab (Either Status (Maybe IssueBoard))+createIssueBoard' projectId boardName = do+  gitlabPost boardAddr T.empty+  where+    boardAddr :: Text+    boardAddr =+      "/projects/" <> T.pack (show projectId) <> "/boards/?name=" <> boardName++-- | Updates a project issue board.+updateIssueBoard' ::+  -- | the project ID+  Int ->+  -- | the board ID+  Int ->+  -- | attributes for updating boards+  UpdateBoardAttrs ->+  GitLab (Either Status IssueBoard)+updateIssueBoard' projectId boardId attrs = do+  gitlabPut boardAddr T.empty+  where+    boardAddr :: Text+    boardAddr =+      "/projects/"+        <> T.pack (show projectId)+        <> "/boards/"+        <> T.pack (show boardId)+        <> T.pack (updateBoardAttrs attrs)++-- | Deletes a project issue board.+deleteIssueBoard ::+  -- | the project+  Project ->+  -- | the board+  IssueBoard ->+  GitLab (Either Status ())+deleteIssueBoard project board = do+  deleteIssueBoard' (project_id project) (board_id board)++-- | Deletes a project issue board.+deleteIssueBoard' ::+  -- | the project ID+  Int ->+  -- | the board ID+  Int ->+  GitLab (Either Status ())+deleteIssueBoard' projectId boardId = do+  gitlabDelete boardAddr+  where+    boardAddr :: Text+    boardAddr =+      "/projects/"+        <> T.pack (show projectId)+        <> "/boards/"+        <> T.pack (show 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 board = do+  result <- projectBoardLists' (project_id project) (board_id board)+  -- return an empty list if the repository could not be found.+  return (fromRight [] 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 Status [BoardIssue])+projectBoardLists' projectId boardId =+  gitlab boardsAddr+  where+    boardsAddr :: Text+    boardsAddr =+      "/projects/" <> T.pack (show projectId) <> "/boards/" <> T.pack (show boardId) <> "/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 board listId = do+  result <- boardList' (project_id project) (board_id board) listId+  -- return an empty list if the repository could not be found.+  return (fromRight Nothing 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 Status (Maybe BoardIssue))+boardList' projectId boardId listId =+  gitlabOne boardsAddr+  where+    boardsAddr :: Text+    boardsAddr =+      "/projects/" <> T.pack (show projectId) <> "/boards/" <> T.pack (show boardId) <> "/lists/" <> T.pack (show listId)++-- | Creates a new issue board list.+createBoardList ::+  -- | the project+  Project ->+  -- | the board+  IssueBoard ->+  -- | attributes for creating boards+  CreateBoardAttrs ->+  GitLab (Maybe BoardIssue)+createBoardList project board attrs = do+  result <- createBoardList' (project_id project) (board_id board) attrs+  -- return an empty list if the repository could not be found.+  return (fromRight Nothing result)++-- | Creates a new issue board list.+createBoardList' ::+  -- | project ID+  Int ->+  -- | board ID+  Int ->+  -- | attributes for creating the board+  CreateBoardAttrs ->+  GitLab (Either Status (Maybe BoardIssue))+createBoardList' projectId boardId attrs =+  gitlabPost boardsAddr T.empty+  where+    boardsAddr :: Text+    boardsAddr =+      "/projects/"+        <> T.pack (show projectId)+        <> "/boards/"+        <> T.pack (show boardId)+        <> "/lists"+        <> T.pack (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 Status (Maybe BoardIssue))+reorderBoardList project board =+  reorderBoardList' (project_id project) (board_id 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 Status (Maybe BoardIssue))+reorderBoardList' projectId boardId listId newPosition =+  gitlabPut boardsAddr T.empty+  where+    boardsAddr :: Text+    boardsAddr =+      "/projects/"+        <> T.pack (show projectId)+        <> "/boards/"+        <> T.pack (show boardId)+        <> "/lists/"+        <> T.pack (show listId)+        <> T.pack ("?position=" <> show newPosition)++-- | Only for administrators and project owners. Deletes a board list.+deleteBoardList ::+  -- | project+  Project ->+  -- | board+  IssueBoard ->+  -- | list ID+  Int ->+  GitLab (Either Status ())+deleteBoardList project board =+  deleteBoardList' (project_id project) (board_id board)++-- | Only for administrators and project owners. Deletes a board list.+deleteBoardList' ::+  -- | project ID+  Int ->+  -- | board ID+  Int ->+  -- | list ID+  Int ->+  GitLab (Either Status ())+deleteBoardList' projectId boardId listId =+  gitlabDelete boardsAddr+  where+    boardsAddr :: Text+    boardsAddr =+      "/projects/"+        <> T.pack (show projectId)+        <> "/boards/"+        <> T.pack (show boardId)+        <> "/lists/"+        <> T.pack (show listId)++data UpdateBoardAttrs = UpdateBoardAttrs+  { updateBoard_new_name :: Maybe String,+    updateBoard_assignee_id :: Maybe Int,+    updateBoard_milestone_id :: Maybe Int,+    updateBoard_labels :: Maybe String,+    updateBoard_weight :: Maybe Int+  }++-- | no attributes for board update.+noUpdateBoardAttrs :: UpdateBoardAttrs+noUpdateBoardAttrs =+  UpdateBoardAttrs Nothing Nothing Nothing Nothing Nothing++updateBoardAttrs :: UpdateBoardAttrs -> String+updateBoardAttrs attrs =+  case attrsUrl of+    [] -> ""+    (x : xs) -> "?" <> x <> concatMap ('&' :) xs+  where+    attrsUrl =+      catMaybes+        [ (\s -> Just ("name=" <> s)) =<< updateBoard_new_name attrs,+          (\i -> Just ("assignee_id=" <> show i)) =<< updateBoard_assignee_id attrs,+          (\i -> Just ("milestone_id=" <> show i)) =<< updateBoard_milestone_id attrs,+          (\s -> Just ("labels=" <> s)) =<< updateBoard_labels attrs,+          (\i -> Just ("weight=" <> show i)) =<< updateBoard_weight attrs+        ]++-- | exactly one parameter must be provided.+data CreateBoardAttrs = CreateBoardAttrs+  { createBoard_label_id :: Maybe Int,+    createBoard_assignee_id :: Maybe Int,+    createBoard_milestone_id :: Maybe Int+  }++-- | no attributes for board creation.+noCreateBoardAttrs :: CreateBoardAttrs+noCreateBoardAttrs =+  CreateBoardAttrs Nothing Nothing Nothing++createBoardAttrs :: CreateBoardAttrs -> String+createBoardAttrs attrs =+  case attrsUrl of+    [] -> ""+    (x : xs) -> "?" <> x <> concatMap ('&' :) xs+  where+    attrsUrl =+      catMaybes+        [ (\i -> Just ("label_id=" <> show i)) =<< createBoard_label_id attrs,+          (\i -> Just ("assignee_id=" <> show i)) =<< createBoard_assignee_id attrs,+          (\i -> Just ("milestone_id=" <> show i)) =<< createBoard_milestone_id attrs+        ]
src/GitLab/API/Commits.hs view
@@ -23,7 +23,8 @@   GitLab [Commit] projectCommits project = do   result <- projectCommits' (project_id project)-  return (fromRight (error "projectCommits error") result)+  -- return an empty list if the repository could not be found.+  return (fromRight [] result)  -- | returns all commits for a project given its project ID. projectCommits' ::@@ -44,9 +45,10 @@   Project ->   -- | branch name   Text ->-  GitLab (Either Status [Commit])-branchCommits project =-  branchCommits' (project_id project)+  GitLab [Commit]+branchCommits project branchName = do+  result <- branchCommits' (project_id project) branchName+  return (fromRight [] result)  -- | returns all commits of a branch from a project -- given its project ID and the branch name.@@ -73,7 +75,7 @@   GitLab (Maybe Commit) commitDetails project theHash = do   result <- commitDetails' (project_id project) theHash-  return (fromRight (error "commitDetails error") result)+  return (fromRight Nothing result)  -- | returns a commit for the given project ID and commit hash, if -- such a commit exists.
+ src/GitLab/API/Discussions.hs view
@@ -0,0 +1,44 @@+{-# 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 where++import Data.Text (Text)+import qualified Data.Text as T+import GitLab.Types+import GitLab.WebRequests.GitLabWebCalls+import Network.HTTP.Types.Status++-- | gets all discussion for a commit for a project.+commitDiscussions ::+  -- | the project+  Project ->+  -- | commit hash+  Text ->+  GitLab (Either Status [Discussion])+commitDiscussions proj = commitDiscussions' (project_id proj)++-- | gets all discussion for a commit for a project given its project ID.+commitDiscussions' ::+  -- | the project ID+  Int ->+  -- | commit hash+  Text ->+  GitLab (Either Status [Discussion])+commitDiscussions' projId commitHash = do+  let urlPath =+        T.pack $+          "/projects/"+            <> show projId+            <> "/repository"+            <> "/commits/"+            <> T.unpack commitHash+            <> "/discussions"+  gitlab urlPath
src/GitLab/API/Groups.hs view
@@ -119,3 +119,22 @@ addUsersToGroup' groupName access usernames = do   users <- catMaybes <$> mapM searchUser usernames   mapM (addUserToGroup' groupName access . user_id) users++groupProjects ::+  -- | group+  Group ->+  GitLab (Either Status [Project])+groupProjects group = do+  groupProjects' (group_id group)++groupProjects' ::+  -- | group ID+  Int ->+  GitLab (Either Status [Project])+groupProjects' groupID = do+  let urlPath =+        T.pack $+          "/groups/"+            <> show groupID+            <> "/projects"+  gitlab urlPath
src/GitLab/API/Issues.hs view
@@ -8,38 +8,227 @@ -- License     : BSD3 -- Maintainer  : robstewart57@gmail.com -- Stability   : stable-module GitLab.API.Issues where+module GitLab.API.Issues+  ( defaultIssueFilters,+    IssueAttrs (..),+    DueDate (..),+    IssueSearchIn (..),+    IssueOrderBy (..),+    IssueScope (..),+    IssueSortBy (..),+    IssueState (..),+    projectIssues,+    projectIssues',+    issueStatisticsUser,+    issueStatisticsGroup,+    issueStatisticsGroup',+    issueStatisticsProject,+    issueStatisticsProject',+    userIssues,+    newIssue,+    newIssue',+    editIssue,+  )+where  import qualified Data.Aeson as J import Data.Either+import Data.Maybe import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Lazy import qualified Data.Text.Lazy.Encoding+import Data.Time.Clock+import Data.Time.Format.ISO8601 import GitLab.Types import GitLab.WebRequests.GitLabWebCalls import Network.HTTP.Types.Status --- | returns all issues against a project.-projectOpenedIssues ::+-- | No issue filters, thereby returning all issues. Default scope is "all".+defaultIssueFilters :: IssueAttrs+defaultIssueFilters =+  IssueAttrs Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing (Just All) Nothing Nothing Nothing Nothing Nothing Nothing++data DueDate+  = NoDueDate+  | Overdue+  | Week+  | Month+  | NextMonthPreviousTwoWeeks++instance Show DueDate where+  show NoDueDate = "0"+  show Overdue = "overdue"+  show Week = "week"+  show Month = "month"+  show NextMonthPreviousTwoWeeks = "next_month_and_previous_two_weeks"++data IssueSearchIn+  = JustTitle+  | JustDescription+  | TitleAndDescription++instance Show IssueSearchIn where+  show JustTitle = "title"+  show JustDescription = "description"+  show TitleAndDescription = "title,description"++data IssueOrderBy+  = CreatedAt+  | UpdatedAt+  | Priority+  | DueDate+  | RelativePosition+  | LabelPriority+  | MilestoneDue+  | Popularity+  | Weight++instance Show IssueOrderBy where+  show CreatedAt = "created_at"+  show UpdatedAt = "updated_at"+  show Priority = "priority"+  show DueDate = "due_date"+  show RelativePosition = "relative_position"+  show LabelPriority = "label_priority"+  show MilestoneDue = "milestone_due"+  show Popularity = "popularity"+  show Weight = "weight"++data IssueScope+  = CreatedByMe+  | AssignedToMe+  | All++instance Show IssueScope where+  show CreatedByMe = "created_by_me"+  show AssignedToMe = "assigned_to_me"+  show All = "all"++data IssueSortBy+  = Ascending+  | Descending++instance Show IssueSortBy where+  show Ascending = "asc"+  show Descending = "desc"++data IssueState+  = IssueOpen+  | IssueClosed++instance Show IssueState where+  show IssueOpen = "opened"+  show IssueClosed = "closed"++projectIssues ::   -- | the project   Project ->+  -- | filter the issues, see https://docs.gitlab.com/ee/api/issues.html#list-issues+  IssueAttrs ->+  -- the GitLab issues   GitLab [Issue]-projectOpenedIssues p = do-  result <- projectOpenedIssues' (project_id p)-  return (fromRight (error "projectOpenedIssues error") result)+projectIssues p filters = do+  result <- projectIssues' (project_id p) filters+  return (fromRight (error "projectIssues error") result) --- | returns all issues against a project given its project ID.-projectOpenedIssues' ::+projectIssues' ::   -- | the project ID   Int ->+  -- | filter the issues, see https://docs.gitlab.com/ee/api/issues.html#list-issues+  IssueAttrs ->+  -- | the GitLab issues   GitLab (Either Status [Issue])-projectOpenedIssues' projectId = do-  let path = "/projects/" <> T.pack (show projectId) <> "/issues"+projectIssues' projectId attrs =   gitlab path+  where+    path =+      T.pack $+        "/projects/"+          <> show projectId+          <> "/issues"+          <> issuesAttrs attrs --- gitlabReq path "&state=opened"+-- | Gets issues count statistics on all issues the authenticated user has access to.+issueStatisticsUser ::+  -- | filter the issues, see https://docs.gitlab.com/ee/api/issues_statistics.html#get-issues-statistics+  IssueAttrs ->+  -- | the issue statistics+  GitLab IssueStatistics+issueStatisticsUser attrs =+  gitlabOneUnsafe path+  where+    path =+      T.pack $+        "/issues_statistics"+          <> issuesAttrs attrs +-- | Gets issues count statistics for a given group.+issueStatisticsGroup ::+  -- | the group+  Group ->+  -- | filter the issues, see https://docs.gitlab.com/ee/api/issues_statistics.html#get-issues-statistics+  IssueAttrs ->+  -- | the issue statistics+  GitLab IssueStatistics+issueStatisticsGroup group filters = do+  result <- issueStatisticsGroup' (group_id group) filters+  case result of+    Left _s -> error "issueStatisticsGroup error"+    Right Nothing -> error "issueStatisticsGroup error"+    Right (Just stats) -> return stats++-- | Gets issues count statistics for a given group.+issueStatisticsGroup' ::+  -- | the group ID+  Int ->+  -- | filter the issues, see https://docs.gitlab.com/ee/api/issues_statistics.html#get-issues-statistics+  IssueAttrs ->+  -- | the issue statistics+  GitLab (Either Status (Maybe IssueStatistics))+issueStatisticsGroup' groupId attrs =+  gitlabOne path+  where+    path =+      T.pack $+        "/groups/"+          <> show groupId+          <> "/issues_statistics"+          <> issuesAttrs attrs++-- | Gets issues count statistics for a given group.+issueStatisticsProject ::+  -- | the project+  Project ->+  -- | filter the issues, see https://docs.gitlab.com/ee/api/issues_statistics.html#get-issues-statistics+  IssueAttrs ->+  -- | the issue statistics+  GitLab IssueStatistics+issueStatisticsProject proj filters = do+  result <- issueStatisticsGroup' (project_id proj) filters+  case result of+    Left _s -> error "issueStatisticsProject error"+    Right Nothing -> error "issueStatisticsProject error"+    Right (Just stats) -> return stats++-- | Gets issues count statistics for a given project.+issueStatisticsProject' ::+  -- | the project ID+  Int ->+  -- | filter the issues, see https://docs.gitlab.com/ee/api/issues_statistics.html#get-issues-statistics+  IssueAttrs ->+  -- | the issue statistics+  GitLab (Either Status (Maybe IssueStatistics))+issueStatisticsProject' projId attrs =+  gitlabOne path+  where+    path =+      T.pack $+        "/projects/"+          <> show projId+          <> "/issues_statistics"+          <> issuesAttrs attrs+ -- | gets all issues create by a user. userIssues ::   -- | the user@@ -108,3 +297,73 @@             (J.encode editIssueReq)         )     )++-------------------------------+-- Internal functions and types++data IssueAttrs = IssueAttrs+  { issueFilter_assignee_id :: Maybe Int,+    issueFilter_assignee_username :: Maybe String,+    issueFilter_author_id :: Maybe Int,+    issueFilter_author_username :: Maybe String,+    issueFilter_confidential :: Maybe Bool,+    issueFilter_created_after :: Maybe UTCTime,+    issueFilter_created_before :: Maybe UTCTime,+    issueFilter_due_date :: Maybe DueDate,+    issueFilter_iids :: Maybe Int,+    issueFilter_in :: Maybe IssueSearchIn,+    issueFilter_iteration_id :: Maybe Int,+    issueFilter_iteration_title :: Maybe String,+    issueFilter_milestone :: Maybe String,+    issueFilter_labels :: Maybe String,+    issueFilter_my_reaction_emoji :: Maybe String,+    issueFilter_non_archived :: Maybe Bool,+    issueFilter_order_by :: Maybe IssueOrderBy,+    issueFilter_scope :: Maybe IssueScope,+    issueFilter_search :: Maybe String,+    issueFilter_sort :: Maybe IssueSortBy,+    issueFilter_state :: Maybe IssueState,+    issueFilter_updated_after :: Maybe UTCTime,+    issueFilter_updated_before :: Maybe UTCTime,+    issueFilter_with_labels_details :: Maybe Bool+  }++issuesAttrs :: IssueAttrs -> String+issuesAttrs filters =+  case attrsUrl of+    [] -> ""+    (x : xs) -> "?" <> x <> concatMap ('&' :) xs+  where+    attrsUrl =+      catMaybes+        [ (\i -> Just ("assignee_id=" <> show i)) =<< issueFilter_assignee_id filters,+          (\t -> Just ("assignee_username=" <> t)) =<< issueFilter_assignee_username filters,+          (\i -> Just ("author_id=" <> show i)) =<< issueFilter_author_id filters,+          (\i -> Just ("author_username=" <> show i)) =<< issueFilter_author_username filters,+          (\b -> Just ("confidential=" <> showBool b)) =<< issueFilter_confidential filters,+          (\t -> Just ("created_after=" <> showTime t)) =<< issueFilter_created_after filters,+          (\t -> Just ("created_before=" <> showTime t)) =<< issueFilter_created_before filters,+          (\due -> Just ("due_date=" <> show due)) =<< issueFilter_due_date filters,+          (\iids -> Just ("iids[]=" <> show iids)) =<< issueFilter_iids filters,+          (\issueIn -> Just ("assignee_id=" <> show issueIn)) =<< issueFilter_in filters,+          (\i -> Just ("iteration_id=" <> show i)) =<< issueFilter_iteration_id filters,+          (\s -> Just ("iteration_title=" <> s)) =<< issueFilter_iteration_title filters,+          (\s -> Just ("milestone=" <> s)) =<< issueFilter_milestone filters,+          (\s -> Just ("labels=" <> s)) =<< issueFilter_labels filters,+          (\s -> Just ("my_reaction_emoji=" <> s)) =<< issueFilter_my_reaction_emoji filters,+          (\b -> Just ("non_archived=" <> showBool b)) =<< issueFilter_non_archived filters,+          (\x -> Just ("order_by=" <> show x)) =<< issueFilter_order_by filters,+          (\x -> Just ("scope=" <> show x)) =<< issueFilter_scope filters,+          (\s -> Just ("search=" <> s)) =<< issueFilter_search filters,+          (\x -> Just ("sort=" <> show x)) =<< issueFilter_sort filters,+          (\x -> Just ("state=" <> show x)) =<< issueFilter_state filters,+          (\t -> Just ("updated_after=" <> showTime t)) =<< issueFilter_updated_after filters,+          (\t -> Just ("updated_before=" <> showTime t)) =<< issueFilter_updated_before filters,+          (\b -> Just ("with_labels_details=" <> showBool b)) =<< issueFilter_with_labels_details filters+        ]+      where+        showBool :: Bool -> String+        showBool True = "true"+        showBool False = "false"+        showTime :: UTCTime -> String+        showTime = iso8601Show
src/GitLab/API/Projects.hs view
@@ -69,7 +69,7 @@  -- | gets a project with the given name for the given username. E.g. ----- > projectsNamespaceName "user1" "project1"+-- > projectsWithNameAndUser "user1" "project1" -- -- looks for "user1/project1" projectsWithNameAndUser :: Text -> Text -> GitLab (Either Status (Maybe Project))@@ -166,7 +166,7 @@       Project ->       GitLab (Project, [Issue], [User])     processProject proj = do-      (openIssues :: [Issue]) <- projectOpenedIssues proj+      (openIssues :: [Issue]) <- projectIssues proj defaultIssueFilters       let authors = map issue_author openIssues       return (proj, openIssues, authors) 
+ src/GitLab/API/Tags.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module      : Tags+-- Description : Queries about tags in repositories+-- Copyright   : (c) Jihyun Yu, 2021+-- License     : BSD3+-- Maintainer  : yjh0502@gmail.com+-- Stability   : stable+module GitLab.API.Tags where++import Data.Either+import Data.Text (Text)+import qualified Data.Text as T+import GitLab.Types+import GitLab.WebRequests.GitLabWebCalls+import Network.HTTP.Types.Status++-- | returns all commits with tags.+tags ::+  -- | project+  Project ->+  GitLab [Tag]+tags project = do+  result <- tags' (project_id project)+  return (fromRight [] result)++-- | returns all commits with tags from a project given its project ID.+tags' ::+  -- | project ID+  Int ->+  GitLab (Either Status [Tag])+tags' projectId = do+  gitlabWithAttrs (commitsAddr projectId) ""+  where+    commitsAddr :: Int -> Text+    commitsAddr projId =+      "/projects/" <> T.pack (show projId) <> "/repository" <> "/tags"
src/GitLab/Types.hs view
@@ -35,6 +35,7 @@     Commit (..),     CommitTodo (..),     CommitStats (..),+    Tag (..),     Diff (..),     Repository (..),     Job (..),@@ -52,6 +53,13 @@     Version (..),     URL,     EditIssueReq (..),+    Discussion (..),+    IssueStatistics (..),+    IssueCounts (..),+    IssueBoard (..),+    BoardIssue (..),+    BoardIssueLabel (..),+    ProjectBoard (..),   ) where @@ -159,7 +167,7 @@ data Links = Links   { self :: Text,     issues :: Maybe Text,-    merge_requests :: Text,+    merge_requests :: Maybe Text,     repo_branches :: Text,     link_labels :: Text,     link_events :: Text,@@ -176,7 +184,7 @@     owner_avatar_url :: Maybe Text,     owner_web_url :: Text   }-  deriving (Generic, Show)+  deriving (Generic, Show, Eq)  -- | permissions. data Permissions = Permissions@@ -262,7 +270,7 @@ data MilestoneState   = MSActive   | MSClosed-  deriving (Show)+  deriving (Show, Eq)  instance FromJSON MilestoneState where   parseJSON (String "active") = return MSActive@@ -273,17 +281,17 @@ data Milestone = Milestone   { milestone_project_id :: Maybe Int,     milestone_group_id :: Maybe Int,-    milestone_description :: Text,-    milestone_state :: MilestoneState,-    milestone_due_date :: Maybe UTCTime,-    milestone_iid :: Int,+    milestone_description :: Maybe Text,+    milestone_state :: Maybe MilestoneState,+    milestone_due_date :: Maybe Text,+    milestone_iid :: Maybe Int,     milestone_created_at :: Maybe UTCTime,     milestone_title :: Text,     milestone_id :: Int,-    milestone_updated_at :: UTCTime,-    milestone_web_url :: URL+    milestone_updated_at :: Maybe UTCTime,+    milestone_web_url :: Maybe URL   }-  deriving (Generic, Show)+  deriving (Generic, Show, Eq)  instance FromJSON Milestone where   parseJSON = genericParseJSON (defaultOptions {fieldLabelModifier = drop 10})@@ -379,6 +387,23 @@   }   deriving (Generic, Show) +-- | tags.+data Tag = Tag+  { tag_commit :: Commit,+    tag_release :: Maybe Release,+    tag_name :: Text,+    tag_target :: Text,+    tag_message :: Maybe Text,+    tag_protected :: Bool+  }+  deriving (Generic, Show)++data Release = Release+  { release_tag_name :: Text,+    release_description :: Text+  }+  deriving (Generic, Show)+ -- | diff between two commits. data Diff = Diff   { diff :: Text,@@ -654,6 +679,93 @@   }   deriving (Generic, Show) +-- | Discussions https://docs.gitlab.com/ee/api/discussions.html+data Discussion = Discussion+  { discussion_id :: Text,+    discussion_individual_note :: Bool,+    discussion_notes :: [Note]+  }+  deriving (Generic, Show)++-- | Notes+data Note = Note+  { note_id :: Int,+    -- https://docs.gitlab.com/ee/api/discussions.html#list-project-commit-discussion-items+    note_type :: Maybe Text, -- TODO create type for this, e.g. from "DiscussionNote"+    note_body :: Text,+    note_attachment :: Maybe Text,+    note_author :: Owner,+    --  -- TODO parse these as date type+    note_created_at :: Text,+    note_updated_at :: Text,+    note_system :: Bool,+    note_noteable_id :: Maybe Int,+    note_noteable_type :: Maybe Text, -- create type e.g. from "Commit"+    note_noteable_iid :: Maybe Int,+    note_resolvable :: Bool+  }+  deriving (Generic, Show)++newtype IssueStatistics = IssueStatistics+  { issues_statistics :: IssueStats+  }+  deriving (Generic, Show)++newtype IssueStats = IssueStats+  { issues_counts :: IssueCounts+  }+  deriving (Generic, Show)++data IssueCounts = IssueCounts+  { issues_all :: Int,+    issues_closed :: Int,+    issues_opened :: Int+  }+  deriving (Generic, Show)++data IssueBoard = IssueBoard+  { board_id :: Int,+    board_name :: Text,+    board_project :: ProjectBoard,+    board_milestone :: Maybe Milestone,+    board_lists :: [BoardIssue],+    board_group :: Maybe Text, -- not sure, documentation doesn't indicate type+    board_assignee :: Maybe Owner,+    board_labels :: Maybe [BoardIssueLabel],+    board_weight :: Maybe Int+  }+  deriving (Generic, Show, Eq)++data BoardIssue = BoardIssue+  { board_issue_id :: Int,+    board_issue_label :: BoardIssueLabel,+    board_issue_position :: Int,+    board_issue_max_issue_count :: Int,+    board_issue_max_issue_weight :: Int,+    -- TODO, the docs don't say what type this should be+    board_issue_limit_metric :: Maybe Int+  }+  deriving (Generic, Show, Eq)++data BoardIssueLabel = BoardIssueLabel+  { board_issue_label_id :: Maybe Int,+    board_issue_label_name :: Text,+    board_issue_label_color :: Text, -- parse into type from e.g. "#F0AD4E"+    board_issue_label_description :: Maybe Text+  }+  deriving (Generic, Show, Eq)++data ProjectBoard = ProjectBoard+  { project_board_id :: Int,+    project_board_name :: Text,+    project_board_name_with_namespace :: Text,+    project_board_path :: Text,+    project_board_path_with_namespace :: Text,+    project_board_http_url_to_repo :: Text,+    project_board_web_url :: Text+  }+  deriving (Generic, Show, Eq)+ ----------------------------- -- JSON GitLab parsers below -----------------------------@@ -804,9 +916,74 @@ bodyNoPrefix "job_tag" = "tag" bodyNoPrefix "job_web_url" = "web_url" bodyNoPrefix "job_user" = "user"+bodyNoPrefix "discussion_id" = "id"+bodyNoPrefix "discussion_individual_note" = "individual_note"+bodyNoPrefix "discussion_notes" = "notes"+bodyNoPrefix "note_id" = "id"+bodyNoPrefix "note_type" = "type"+bodyNoPrefix "note_body" = "body"+bodyNoPrefix "note_attachment" = "attachment"+bodyNoPrefix "note_author" = "author"+bodyNoPrefix "note_created_at" = "created_at"+bodyNoPrefix "note_updated_at" = "updated_at"+bodyNoPrefix "note_system" = "system"+bodyNoPrefix "note_noteable_id" = "noteable_id"+bodyNoPrefix "note_noteable_type" = "noteable_type"+bodyNoPrefix "note_noteable_iid" = "iid"+bodyNoPrefix "note_resolvable" = "resolvable" -- TODO field names for Issues data type bodyNoPrefix s = s +-- TODO refactor bodyNoPrefix function above into smaller+--    String -> String+-- functions like those below.++tagPrefix :: String -> String+tagPrefix "tag_commit" = "commit"+tagPrefix "tag_release" = "release"+tagPrefix "tag_name" = "name"+tagPrefix "tag_target" = "target"+tagPrefix "tag_message" = "message"+tagPrefix "tag_protected" = "protected"+tagPrefix s = s++releasePrefix :: String -> String+releasePrefix "release_tag_name" = "tag_name"+releasePrefix "release_description" = "description"+releasePrefix s = s++issueStatsPrefix :: String -> String+issueStatsPrefix "issues_all" = "all"+issueStatsPrefix "issues_closed" = "closed"+issueStatsPrefix "issues_opened" = "opened"+issueStatsPrefix "issues_statistics" = "statistics"+issueStatsPrefix "issues_counts" = "counts"+issueStatsPrefix s = s++boardsPrefix :: String -> String+boardsPrefix "board_id" = "id"+boardsPrefix "board_name" = "name"+boardsPrefix "board_project" = "project"+boardsPrefix "board_milestone" = "milestone"+boardsPrefix "board_lists" = "lists"+boardsPrefix "board_issue_id" = "id"+boardsPrefix "board_issue_label" = "label"+boardsPrefix "board_issue_position" = "position"+boardsPrefix "board_issue_max_issue_count" = "max_issue_count"+boardsPrefix "board_issue_max_issue_weight" = "max_issue_weight"+boardsPrefix "board_issue_limit_metric" = "limit_metric"+boardsPrefix "board_issue_label_name" = "name"+boardsPrefix "board_issue_label_color" = "color"+boardsPrefix "board_issue_label_description" = "description"+boardsPrefix "project_board_id" = "id"+boardsPrefix "project_board_name" = "name"+boardsPrefix "project_board_name_with_namespace" = "name_with_namespace"+boardsPrefix "project_board_path" = "path"+boardsPrefix "project_board_path_with_namespace" = "path_with_namespace"+boardsPrefix "project_board_http_url_to_repo" = "http_url_to_repo"+boardsPrefix "project_board_web_url" = "web_url"+boardsPrefix s = s+ instance FromJSON TimeStats where   parseJSON =     genericParseJSON@@ -847,6 +1024,22 @@           }       ) +instance FromJSON Tag where+  parseJSON =+    genericParseJSON+      ( defaultOptions+          { fieldLabelModifier = tagPrefix+          }+      )++instance FromJSON Release where+  parseJSON =+    genericParseJSON+      ( defaultOptions+          { fieldLabelModifier = releasePrefix+          }+      )+ instance FromJSON CommitStats where   parseJSON =     genericParseJSON@@ -1006,3 +1199,75 @@         { fieldLabelModifier = drop (T.length "edit_issue_"),           omitNothingFields = True         }++instance FromJSON Discussion where+  parseJSON =+    genericParseJSON+      ( defaultOptions+          { fieldLabelModifier = bodyNoPrefix+          }+      )++instance FromJSON Note where+  parseJSON =+    genericParseJSON+      ( defaultOptions+          { fieldLabelModifier = bodyNoPrefix+          }+      )++instance FromJSON IssueCounts where+  parseJSON =+    genericParseJSON+      ( defaultOptions+          { fieldLabelModifier = issueStatsPrefix+          }+      )++instance FromJSON IssueStats where+  parseJSON =+    genericParseJSON+      ( defaultOptions+          { fieldLabelModifier = issueStatsPrefix+          }+      )++instance FromJSON IssueStatistics where+  parseJSON =+    genericParseJSON+      ( defaultOptions+          { fieldLabelModifier = issueStatsPrefix+          }+      )++instance FromJSON IssueBoard where+  parseJSON =+    genericParseJSON+      ( defaultOptions+          { fieldLabelModifier = boardsPrefix+          }+      )++instance FromJSON BoardIssue where+  parseJSON =+    genericParseJSON+      ( defaultOptions+          { fieldLabelModifier = boardsPrefix+          }+      )++instance FromJSON BoardIssueLabel where+  parseJSON =+    genericParseJSON+      ( defaultOptions+          { fieldLabelModifier = boardsPrefix+          }+      )++instance FromJSON ProjectBoard where+  parseJSON =+    genericParseJSON+      ( defaultOptions+          { fieldLabelModifier = boardsPrefix+          }+      )
src/GitLab/WebRequests/GitLabWebCalls.hs view
@@ -5,13 +5,13 @@ module GitLab.WebRequests.GitLabWebCalls   ( gitlab,     gitlabUnsafe,+    gitlabOneUnsafe,     gitlabWithAttrs,     gitlabWithAttrsUnsafe,     gitlabOne,     -- gitlabOneIO,     gitlabWithAttrsOne,-    -- not currently used.-    -- gitlabWithAttrsOneUnsafe,+    gitlabWithAttrsOneUnsafe,     gitlabPost,     gitlabPut,     gitlabDelete,@@ -26,7 +26,7 @@ import Data.Aeson import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BSL-import Data.ByteString.Lazy.Char8 as C+import qualified Data.ByteString.Lazy.Char8 as C import Data.Either import Data.Text (Text) import qualified Data.Text as T@@ -278,6 +278,13 @@ gitlabOne :: (FromJSON a) => Text -> GitLab (Either Status (Maybe a)) gitlabOne addr = gitlabReqJsonOne addr "" +gitlabOneUnsafe :: (FromJSON a) => Text -> GitLab a+gitlabOneUnsafe addr = do+  result <- fromRight (error "gitlabOneUnsafe error") <$> gitlabOne addr+  case result of+    Nothing -> error "gitlabOneUnsafe error"+    Just value -> return value+ gitlabWithAttrs :: (FromJSON a) => Text -> Text -> GitLab (Either Status [a]) gitlabWithAttrs = gitlabReqJsonMany @@ -288,10 +295,13 @@ gitlabWithAttrsOne :: (FromJSON a) => Text -> Text -> GitLab (Either Status (Maybe a)) gitlabWithAttrsOne = gitlabReqJsonOne --- not currently used.--- gitlabWithAttrsOneUnsafe :: (MonadIO m, FromJSON a) => Text -> Text -> GitLab (Maybe a)--- gitlabWithAttrsOneUnsafe gitlabURL attrs =---   fromRight (error "gitlabWithAttrsUnsafe error") <$> gitlabReqJsonOne gitlabURL attrs+gitlabWithAttrsOneUnsafe :: (FromJSON a) => Text -> Text -> GitLab a+gitlabWithAttrsOneUnsafe gitlabURL attrs = do+  result <- gitlabReqJsonOne gitlabURL attrs+  case result of+    Left s -> error ("gitlabWithAttrsOneUnsafe: " <> show s)+    Right Nothing -> error ("gitlabWithAttrsOneUnsafe: could not parse JSON for " <> show attrs)+    Right (Just x) -> return x  totalPages :: Response a -> Int totalPages resp =
+ tests/API/BoardsTests.hs view
@@ -0,0 +1,79 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}++module API.BoardsTests (boardsTests) where++import API.Common+import Control.Monad.IO.Class+import Data.Aeson+import qualified Data.ByteString.Lazy.Char8 as BSL+import GitLab+import GitLab.SystemHooks.GitLabSystemHooks+import GitLab.SystemHooks.Types+import Test.Tasty+import Test.Tasty.HUnit++boardsTests :: [TestTree]+boardsTests =+  [ testCase+      "board-list-projects"+      ( gitlabParseTestMany+          listProjectHaskell+          "data/api/boards/list-project.json"+      ),+    testCase+      "board-new-board"+      ( gitlabParseTestOne+          newBoardHaskell+          "data/api/boards/create-board.json"+      ),+    testCase+      "board-update-board"+      ( gitlabParseTestOne+          updateBoardHaskell+          "data/api/boards/update-board.json"+      )+  ]++listProjectHaskell :: [IssueBoard]+listProjectHaskell =+  [ IssueBoard+      { board_id = 1,+        board_name = "board1",+        board_project = ProjectBoard {project_board_id = 5, project_board_name = "Diaspora Project Site", project_board_name_with_namespace = "Diaspora / Diaspora Project Site", project_board_path = "diaspora-project-site", project_board_path_with_namespace = "diaspora/diaspora-project-site", project_board_http_url_to_repo = "http://example.com/diaspora/diaspora-project-site.git", project_board_web_url = "http://example.com/diaspora/diaspora-project-site"},+        board_milestone = Just (Milestone {milestone_project_id = Nothing, milestone_group_id = Nothing, milestone_description = Nothing, milestone_state = Nothing, milestone_due_date = Nothing, milestone_iid = Nothing, milestone_created_at = Nothing, milestone_title = "10.0", milestone_id = 12, milestone_updated_at = Nothing, milestone_web_url = Nothing}),+        board_lists = [BoardIssue {board_issue_id = 1, board_issue_label = BoardIssueLabel {board_issue_label_id = Nothing, board_issue_label_name = "Testing", board_issue_label_color = "#F0AD4E", board_issue_label_description = Nothing}, board_issue_position = 1, board_issue_max_issue_count = 0, board_issue_max_issue_weight = 0, board_issue_limit_metric = Nothing}, BoardIssue {board_issue_id = 2, board_issue_label = BoardIssueLabel {board_issue_label_id = Nothing, board_issue_label_name = "Ready", board_issue_label_color = "#FF0000", board_issue_label_description = Nothing}, board_issue_position = 2, board_issue_max_issue_count = 0, board_issue_max_issue_weight = 0, board_issue_limit_metric = Nothing}, BoardIssue {board_issue_id = 3, board_issue_label = BoardIssueLabel {board_issue_label_id = Nothing, board_issue_label_name = "Production", board_issue_label_color = "#FF5F00", board_issue_label_description = Nothing}, board_issue_position = 3, board_issue_max_issue_count = 0, board_issue_max_issue_weight = 0, board_issue_limit_metric = Nothing}],+        board_group = Nothing,+        board_assignee = Nothing,+        board_labels = Nothing,+        board_weight = Nothing+      }+  ]++newBoardHaskell :: IssueBoard+newBoardHaskell =+  IssueBoard+    { board_id = 1,+      board_name = "newboard",+      board_project = ProjectBoard {project_board_id = 5, project_board_name = "Diaspora Project Site", project_board_name_with_namespace = "Diaspora / Diaspora Project Site", project_board_path = "diaspora-project-site", project_board_path_with_namespace = "diaspora/diaspora-project-site", project_board_http_url_to_repo = "http://example.com/diaspora/diaspora-project-site.git", project_board_web_url = "http://example.com/diaspora/diaspora-project-site"},+      board_milestone = Nothing,+      board_lists = [],+      board_group = Nothing,+      board_assignee = Nothing,+      board_labels = Nothing,+      board_weight = Nothing+    }++updateBoardHaskell :: IssueBoard+updateBoardHaskell =+  IssueBoard+    { board_id = 1,+      board_name = "new_name",+      board_project = ProjectBoard {project_board_id = 5, project_board_name = "Diaspora Project Site", project_board_name_with_namespace = "Diaspora / Diaspora Project Site", project_board_path = "diaspora-project-site", project_board_path_with_namespace = "diaspora/diaspora-project-site", project_board_http_url_to_repo = "http://example.com/diaspora/diaspora-project-site.git", project_board_web_url = "http://example.com/diaspora/diaspora-project-site"},+      board_milestone = Just (Milestone {milestone_project_id = Just 15, milestone_group_id = Nothing, milestone_description = Just "Milestone 1 desc", milestone_state = Just MSActive, milestone_due_date = Nothing, milestone_iid = Just 1, milestone_created_at = Just (read "2018-07-03 06:36:42.618 UTC"), milestone_title = "Milestone 1", milestone_id = 43, milestone_updated_at = Just (read "2018-07-03 06:36:42.618 UTC"), milestone_web_url = Just "http://example.com/root/board1/milestones/1"}),+      board_lists = [],+      board_group = Nothing,+      board_assignee = Nothing,+      board_labels = Nothing,+      board_weight = Nothing+    }
+ tests/API/Common.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}++module API.Common where++import Control.Monad.IO.Class+import Data.Aeson+import qualified Data.ByteString.Lazy.Char8 as BSL+import GitLab+import GitLab.SystemHooks.GitLabSystemHooks+import GitLab.SystemHooks.Types+import Test.Tasty+import Test.Tasty.HUnit++gitlabParseTestOne :: (FromJSON a, Eq a, Show a) => a -> String -> Assertion+gitlabParseTestOne expectedHaskellValue filename = do+  raw <- BSL.readFile filename+  result <- parseOne raw+  expectedHaskellValue @=? result++gitlabParseTestMany :: (FromJSON a, Eq a, Show a) => [a] -> String -> Assertion+gitlabParseTestMany expectedHaskellValue filename = do+  raw <- BSL.readFile filename+  result <- parseMany raw+  expectedHaskellValue @=? result++parseOne :: FromJSON a => BSL.ByteString -> IO a+parseOne bs =+  case eitherDecode bs of+    Left err -> assertFailure err+    Right xs -> return xs++parseMany :: FromJSON a => BSL.ByteString -> IO [a]+parseMany bs =+  case eitherDecode bs of+    Left err -> assertFailure err+    Right xs -> return xs
tests/Tests.hs view
@@ -3,6 +3,7 @@  module Main where +import API.BoardsTests import Data.Maybe (fromJust) import SystemHookTests import Test.Tasty@@ -11,6 +12,12 @@ main = do   defaultMain     ( testGroup-        "gitlab system hook tests"-        systemHookTests+        "gitlab-haskell"+        [ testGroup+            "gitlab system hook tests"+            systemHookTests,+          testGroup+            "api-boards"+            boardsTests+        ]     )