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 +1/−0
- gitlab-haskell.cabal +6/−1
- src/GitLab.hs +4/−0
- src/GitLab/API/Boards.hs +351/−0
- src/GitLab/API/Commits.hs +7/−5
- src/GitLab/API/Discussions.hs +44/−0
- src/GitLab/API/Groups.hs +19/−0
- src/GitLab/API/Issues.hs +270/−11
- src/GitLab/API/Projects.hs +2/−2
- src/GitLab/API/Tags.hs +38/−0
- src/GitLab/Types.hs +275/−10
- src/GitLab/WebRequests/GitLabWebCalls.hs +17/−7
- tests/API/BoardsTests.hs +79/−0
- tests/API/Common.hs +37/−0
- tests/Tests.hs +9/−2
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+ ] )