From f3b837195513ac14c50a0919992b3db8801c1da1 Mon Sep 17 00:00:00 2001 From: Volodymyr Shatsky Date: Sun, 27 Dec 2015 01:04:10 +0200 Subject: [PATCH 1/3] Add missing functions to the Issues API. --- Github/Issues/Labels.hs | 134 ++++++++++++++++++++++++++++++++-------- 1 file changed, 109 insertions(+), 25 deletions(-) diff --git a/Github/Issues/Labels.hs b/Github/Issues/Labels.hs index 7adf8ed2..23694da4 100644 --- a/Github/Issues/Labels.hs +++ b/Github/Issues/Labels.hs @@ -2,30 +2,127 @@ -- | The API for dealing with labels on Github issues, as described on -- . module Github.Issues.Labels ( - label -,labelsOnRepo + labelsOnRepo +,labelsOnRepo' +,label +,label' +,createLabel +,updateLabel +,deleteLabel ,labelsOnIssue +,labelsOnIssue' +,addLabelsToIssue +,removeLabelFromIssue +,replaceAllLabelsForIssue +,removeAllLabelsFromIssue ,labelsOnMilestone -,createLabel +,labelsOnMilestone' ,module Github.Data ) where -import Data.Aeson (object, (.=)) -import Github.Data -import Github.Private +import Data.Aeson (object, (.=)) +import Github.Data +import Github.Private + -- | All the labels available to use on any issue in the repo. -- -- > labelsOnRepo "thoughtbot" "paperclip" labelsOnRepo :: String -> String -> IO (Either Error [IssueLabel]) labelsOnRepo user reqRepoName = githubGet ["repos", user, reqRepoName, "labels"] +-- | All the labels available to use on any issue in the repo, using authentication. +-- +-- > labelsOnRepo' (GithubUser (user, password)) "thoughtbot" "paperclip" +labelsOnRepo' :: GithubAuth -> String -> String -> IO (Either Error [IssueLabel]) +labelsOnRepo' auth user reqRepoName = + githubGet' (Just auth) ["repos", user, reqRepoName, "labels"] + +-- | A label, by name. +-- +-- > label "thoughtbot" "paperclip" "bug" +label :: String -> String -> String -> IO (Either Error IssueLabel) +label user reqRepoName reqLabelName = + githubGet ["repos", user, reqRepoName, "labels", reqLabelName] + +-- | A label, by name, using authentication. +-- +-- > label' (GithubUser (user, password)) "thoughtbot" "paperclip" "bug" +label' :: GithubAuth -> String -> String -> String -> IO (Either Error IssueLabel) +label' auth user reqRepoName reqLabelName = + githubGet' (Just auth) ["repos", user, reqRepoName, "labels", reqLabelName] + +-- | Create a label +-- +-- > createLabel (GithubUser (user, password)) "thoughtbot" "paperclip" "bug" "f29513" +createLabel :: GithubAuth -> String -> String -> String -> String -> IO (Either Error IssueLabel) +createLabel auth reqUserName reqRepoName reqLabelName reqLabelColor = githubPost auth paths body + where + paths = ["repos", reqUserName, reqRepoName, "labels"] + body = object ["name" .= reqLabelName, "color" .= reqLabelColor] + +-- | Update a label +-- +-- > updateLabel (GithubUser (user, password)) "thoughtbot" "paperclip" "bug" "new-bug" "ff1111" +updateLabel :: GithubAuth -> String -> String -> String -> String -> String -> IO (Either Error IssueLabel) +updateLabel auth reqUserName reqRepoName oldLabelName newLabelName reqLabelColor = githubPatch auth paths body + where + paths = ["repos", reqUserName, reqRepoName, "labels", oldLabelName] + body = object ["name" .= newLabelName, "color" .= reqLabelColor] + +-- | Delete a label +-- +-- > deleteLabel (GithubUser (user, password)) "thoughtbot" "paperclip" "bug" +deleteLabel :: GithubAuth -> String -> String -> String -> IO (Either Error ()) +deleteLabel auth reqUserName reqRepoName reqLabelName = githubDelete auth paths + where + paths = ["repos", reqUserName, reqRepoName, "labels", reqLabelName] + -- | The labels on an issue in a repo. -- -- > labelsOnIssue "thoughtbot" "paperclip" 585 -labelsOnIssue :: String -> String -> Int -> IO (Either Error [IssueLabel]) +labelsOnIssue :: String -> String -> Int -> IO (Either Error [IssueLabel]) labelsOnIssue user reqRepoName reqIssueId = githubGet ["repos", user, reqRepoName, "issues", show reqIssueId, "labels"] +-- | The labels on an issue in a repo, using authentication. +-- +-- > labelsOnIssue' (GithubUser (user, password)) "thoughtbot" "paperclip" 585 +labelsOnIssue' :: GithubAuth -> String -> String -> Int -> IO (Either Error [IssueLabel]) +labelsOnIssue' auth user reqRepoName reqIssueId = + githubGet' (Just auth) ["repos", user, reqRepoName, "issues", show reqIssueId, "labels"] + +-- | Add labels to an issue. +-- +-- > addLabelsToIssue (GithubUser (user, password)) "thoughtbot" "paperclip" 585 ["Label1", "Label2"] +addLabelsToIssue :: GithubAuth -> String -> String -> Int -> [String] -> IO (Either Error [IssueLabel]) +addLabelsToIssue auth user reqRepoName reqIssueId = githubPost auth paths + where + paths =["repos", user, reqRepoName, "issues", show reqIssueId, "labels"] + +-- | Remove a label from an issue. +-- +-- > removeLabelFromIssue (GithubUser (user, password)) "thoughtbot" "paperclip" 585 "bug" +removeLabelFromIssue :: GithubAuth -> String -> String -> Int -> String -> IO (Either Error ()) +removeLabelFromIssue auth user reqRepoName reqIssueId reqLabelName = githubDelete auth paths + where + paths =["repos", user, reqRepoName, "issues", show reqIssueId, "labels", reqLabelName] + +-- | Replace all labels on an issue. Sending an empty list will remove all labels from the issue. +-- +-- > replaceAllLabelsForIssue (GithubUser (user, password)) "thoughtbot" "paperclip" 585 ["Label1", "Label2"] +replaceAllLabelsForIssue :: GithubAuth -> String -> String -> Int -> [String] -> IO (Either Error [IssueLabel]) +replaceAllLabelsForIssue auth user reqRepoName reqIssueId = githubPut auth paths + where + paths =["repos", user, reqRepoName, "issues", show reqIssueId, "labels"] + +-- | Remove all labels from an issue. +-- +-- > removeAllLabelsFromIssue (GithubUser (user, password)) "thoughtbot" "paperclip" 585 +removeAllLabelsFromIssue :: GithubAuth -> String -> String -> Int -> IO (Either Error ()) +removeAllLabelsFromIssue auth user reqRepoName reqIssueId = githubDelete auth paths + where + paths =["repos", user, reqRepoName, "issues", show reqIssueId, "labels"] + -- | All the labels on a repo's milestone, given the milestone ID. -- -- > labelsOnMilestone "thoughtbot" "paperclip" 2 @@ -33,22 +130,9 @@ labelsOnMilestone :: String -> String -> Int -> IO (Either Error [IssueLabel]) labelsOnMilestone user reqRepoName milestoneId = githubGet ["repos", user, reqRepoName, "milestones", show milestoneId, "labels"] --- | A label, by name. +-- | All the labels on a repo's milestone, given the milestone ID, using authentication. -- --- > Github.label "thoughtbot" "paperclip" "bug" -label :: String -> String -> String -> IO (Either Error IssueLabel) -label user reqRepoName reqLabelName = - githubGet ["repos", user, reqRepoName, "labels", reqLabelName] --- | Create a label - -createLabel :: GithubAuth - -> String - -> String - -> String - -> String - -> IO (Either Error IssueLabel) -createLabel auth reqUserName reqRepoName reqLabelName reqLabelColor = githubPost auth paths body - where - paths = ["repos", reqUserName, reqRepoName, "labels"] - body = object ["name" .= reqLabelName - ,"color" .= reqLabelColor] +-- > labelsOnMilestone' (GithubUser (user, password)) "thoughtbot" "paperclip" 2 +labelsOnMilestone' :: GithubAuth -> String -> String -> Int -> IO (Either Error [IssueLabel]) +labelsOnMilestone' auth user reqRepoName milestoneId = + githubGet' (Just auth) ["repos", user, reqRepoName, "milestones", show milestoneId, "labels"] From 3defbac32aee3a2a136f3b910c35d93c46ec443e Mon Sep 17 00:00:00 2001 From: Volodymyr Shatsky Date: Sun, 27 Dec 2015 01:21:13 +0200 Subject: [PATCH 2/3] Use Maybe GithubAuth. --- Github/Issues/Labels.hs | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/Github/Issues/Labels.hs b/Github/Issues/Labels.hs index 23694da4..990d82b3 100644 --- a/Github/Issues/Labels.hs +++ b/Github/Issues/Labels.hs @@ -32,10 +32,10 @@ labelsOnRepo user reqRepoName = githubGet ["repos", user, reqRepoName, "labels"] -- | All the labels available to use on any issue in the repo, using authentication. -- --- > labelsOnRepo' (GithubUser (user, password)) "thoughtbot" "paperclip" -labelsOnRepo' :: GithubAuth -> String -> String -> IO (Either Error [IssueLabel]) +-- > labelsOnRepo' (Just (GithubUser (user, password))) "thoughtbot" "paperclip" +labelsOnRepo' :: Maybe GithubAuth -> String -> String -> IO (Either Error [IssueLabel]) labelsOnRepo' auth user reqRepoName = - githubGet' (Just auth) ["repos", user, reqRepoName, "labels"] + githubGet' auth ["repos", user, reqRepoName, "labels"] -- | A label, by name. -- @@ -46,10 +46,10 @@ label user reqRepoName reqLabelName = -- | A label, by name, using authentication. -- --- > label' (GithubUser (user, password)) "thoughtbot" "paperclip" "bug" -label' :: GithubAuth -> String -> String -> String -> IO (Either Error IssueLabel) +-- > label' (Just (GithubUser (user, password))) "thoughtbot" "paperclip" "bug" +label' :: Maybe GithubAuth -> String -> String -> String -> IO (Either Error IssueLabel) label' auth user reqRepoName reqLabelName = - githubGet' (Just auth) ["repos", user, reqRepoName, "labels", reqLabelName] + githubGet' auth ["repos", user, reqRepoName, "labels", reqLabelName] -- | Create a label -- @@ -86,10 +86,10 @@ labelsOnIssue user reqRepoName reqIssueId = -- | The labels on an issue in a repo, using authentication. -- --- > labelsOnIssue' (GithubUser (user, password)) "thoughtbot" "paperclip" 585 -labelsOnIssue' :: GithubAuth -> String -> String -> Int -> IO (Either Error [IssueLabel]) +-- > labelsOnIssue' (Just (GithubUser (user, password))) "thoughtbot" "paperclip" 585 +labelsOnIssue' :: Maybe GithubAuth -> String -> String -> Int -> IO (Either Error [IssueLabel]) labelsOnIssue' auth user reqRepoName reqIssueId = - githubGet' (Just auth) ["repos", user, reqRepoName, "issues", show reqIssueId, "labels"] + githubGet' auth ["repos", user, reqRepoName, "issues", show reqIssueId, "labels"] -- | Add labels to an issue. -- @@ -132,7 +132,7 @@ labelsOnMilestone user reqRepoName milestoneId = -- | All the labels on a repo's milestone, given the milestone ID, using authentication. -- --- > labelsOnMilestone' (GithubUser (user, password)) "thoughtbot" "paperclip" 2 -labelsOnMilestone' :: GithubAuth -> String -> String -> Int -> IO (Either Error [IssueLabel]) +-- > labelsOnMilestone' (Just (GithubUser (user, password))) "thoughtbot" "paperclip" 2 +labelsOnMilestone' :: Maybe GithubAuth -> String -> String -> Int -> IO (Either Error [IssueLabel]) labelsOnMilestone' auth user reqRepoName milestoneId = - githubGet' (Just auth) ["repos", user, reqRepoName, "milestones", show milestoneId, "labels"] + githubGet' auth ["repos", user, reqRepoName, "milestones", show milestoneId, "labels"] From 9893ca6fd3f074379fa430f46e548ea510d8c587 Mon Sep 17 00:00:00 2001 From: Volodymyr Shatsky Date: Sun, 27 Dec 2015 01:25:30 +0200 Subject: [PATCH 3/3] Use methods with a quote in regular methods. --- Github/Issues/Labels.hs | 11 ++++------- 1 file changed, 4 insertions(+), 7 deletions(-) diff --git a/Github/Issues/Labels.hs b/Github/Issues/Labels.hs index 990d82b3..98b4e113 100644 --- a/Github/Issues/Labels.hs +++ b/Github/Issues/Labels.hs @@ -28,7 +28,7 @@ import Github.Private -- -- > labelsOnRepo "thoughtbot" "paperclip" labelsOnRepo :: String -> String -> IO (Either Error [IssueLabel]) -labelsOnRepo user reqRepoName = githubGet ["repos", user, reqRepoName, "labels"] +labelsOnRepo = labelsOnRepo' Nothing -- | All the labels available to use on any issue in the repo, using authentication. -- @@ -41,8 +41,7 @@ labelsOnRepo' auth user reqRepoName = -- -- > label "thoughtbot" "paperclip" "bug" label :: String -> String -> String -> IO (Either Error IssueLabel) -label user reqRepoName reqLabelName = - githubGet ["repos", user, reqRepoName, "labels", reqLabelName] +label = label' Nothing -- | A label, by name, using authentication. -- @@ -81,8 +80,7 @@ deleteLabel auth reqUserName reqRepoName reqLabelName = githubDelete auth paths -- -- > labelsOnIssue "thoughtbot" "paperclip" 585 labelsOnIssue :: String -> String -> Int -> IO (Either Error [IssueLabel]) -labelsOnIssue user reqRepoName reqIssueId = - githubGet ["repos", user, reqRepoName, "issues", show reqIssueId, "labels"] +labelsOnIssue = labelsOnIssue' Nothing -- | The labels on an issue in a repo, using authentication. -- @@ -127,8 +125,7 @@ removeAllLabelsFromIssue auth user reqRepoName reqIssueId = githubDelete auth pa -- -- > labelsOnMilestone "thoughtbot" "paperclip" 2 labelsOnMilestone :: String -> String -> Int -> IO (Either Error [IssueLabel]) -labelsOnMilestone user reqRepoName milestoneId = - githubGet ["repos", user, reqRepoName, "milestones", show milestoneId, "labels"] +labelsOnMilestone = labelsOnMilestone' Nothing -- | All the labels on a repo's milestone, given the milestone ID, using authentication. --