diff --git a/Github/All.hs b/Github/All.hs index 94a75564..8233a05f 100644 --- a/Github/All.hs +++ b/Github/All.hs @@ -3,6 +3,61 @@ -- This module re-exports all request constructrors and -- data definitions from this package. module Github.All ( + -- * Issues + -- | See + -- + -- Missing endpoints: + -- + -- * List issues + issueR, + issuesForRepoR, + createIssueR, + editIssueR, + + -- ** Comments + -- | See + -- + -- Missing endpoints: + -- + -- * Delete comment + commentR, + commentsR, + createCommentR, + editCommentR, + + -- ** Events + -- | See + -- + eventsForIssueR, + eventsForRepoR, + eventR, + + -- ** Labels + -- | See + -- + labelsOnRepoR, + labelR, + createLabelR, + updateLabelR, + deleteLabelR, + labelsOnIssueR, + addLabelsToIssueR, + removeLabelFromIssueR, + replaceAllLabelsForIssueR, + removeAllLabelsFromIssueR, + labelsOnMilestoneR, + + -- ** Milestone + -- | See + -- + -- Missing endpoints: + -- + -- * Create a milestone + -- * Update a milestone + -- * Delete a milestone + milestonesR, + milestoneR, + -- * Organizations -- | See -- @@ -18,6 +73,7 @@ module Github.All ( -- -- Missing endpoints: All except /Members List/ membersOfR, + -- ** Teams -- | See -- @@ -43,6 +99,7 @@ module Github.All ( -- * Get all users userInfoForR, userInfoCurrentR, + -- ** Followers -- | See -- @@ -60,6 +117,11 @@ module Github.All ( ) where import Github.Data +import Github.Issues +import Github.Issues.Comments +import Github.Issues.Events +import Github.Issues.Labels +import Github.Issues.Milestones import Github.Organizations import Github.Organizations.Members import Github.Organizations.Teams diff --git a/Github/Data/Issues.hs b/Github/Data/Issues.hs index 7679f32d..0bd4af77 100644 --- a/Github/Data/Issues.hs +++ b/Github/Data/Issues.hs @@ -1,6 +1,7 @@ {-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-} module Github.Data.Issues where +import Github.Data.Id import Github.Data.Definitions import Github.Data.PullRequests @@ -24,7 +25,7 @@ data Issue = Issue { ,issueCreatedAt :: GithubDate ,issueBody :: Maybe String ,issueState :: String - ,issueId :: Int + ,issueId :: Id Issue ,issueComments :: Int ,issueMilestone :: Maybe Milestone } deriving (Show, Data, Typeable, Eq, Ord, Generic) diff --git a/Github/Issues.hs b/Github/Issues.hs index 7076dfb5..a924f7d7 100644 --- a/Github/Issues.hs +++ b/Github/Issues.hs @@ -1,20 +1,27 @@ -{-# LANGUAGE CPP, OverloadedStrings, DeriveGeneric, DeriveDataTypeable #-} +{-# LANGUAGE CPP, OverloadedStrings, DeriveGeneric, DeriveDataTypeable, DataKinds #-} -- | The issues API as described on . module Github.Issues ( - issue -,issue' -,issuesForRepo -,issuesForRepo' -,IssueLimitation(..) -,createIssue -,newIssue -,editIssue -,editOfIssue -,module Github.Data -) where - + issue, + issue', + issueR, + issuesForRepo, + issuesForRepo', + issuesForRepoR, + IssueLimitation(..), + createIssue, + createIssueR, + newIssue, + editIssue, + editIssueR, + editOfIssue, + module Github.Data, + ) where + +import Github.Auth import Github.Data -import Github.Private +import Github.Request + +import Data.Aeson.Compat (encode) import Control.DeepSeq (NFData) import Data.List (intercalate) import Data.Data @@ -54,28 +61,45 @@ instance NFData IssueLimitation -- number.' -- -- > issue' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" "462" -issue' :: Maybe GithubAuth -> String -> String -> Int -> IO (Either Error Issue) +issue' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> Id Issue -> IO (Either Error Issue) issue' auth user reqRepoName reqIssueNumber = - githubGet' auth ["repos", user, reqRepoName, "issues", show reqIssueNumber] + executeRequestMaybe auth $ issueR user reqRepoName reqIssueNumber -- | Details on a specific issue, given the repo owner and name, and the issue -- number. -- --- > issue "thoughtbot" "paperclip" "462" -issue :: String -> String -> Int -> IO (Either Error Issue) +-- > issue "thoughtbot" "paperclip" (Id "462") +issue :: Name GithubOwner -> Name Repo -> Id Issue -> IO (Either Error Issue) issue = issue' Nothing +-- | Get a single issue. +-- See +issueR :: Name GithubOwner -> Name Repo -> Id Issue -> GithubRequest k Issue +issueR user reqRepoName reqIssueNumber = + GithubGet ["repos", untagName user, untagName reqRepoName, "issues", show $ untagId reqIssueNumber] "" + -- | All issues for a repo (given the repo owner and name), with optional -- restrictions as described in the @IssueLimitation@ data type. -- -- > issuesForRepo' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" [NoMilestone, OnlyClosed, Mentions "jyurek", Ascending] -issuesForRepo' :: Maybe GithubAuth -> String -> String -> [IssueLimitation] -> IO (Either Error [Issue]) +issuesForRepo' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> [IssueLimitation] -> IO (Either Error [Issue]) issuesForRepo' auth user reqRepoName issueLimitations = - githubGetWithQueryString' - auth - ["repos", user, reqRepoName, "issues"] - (queryStringFromLimitations issueLimitations) + executeRequestMaybe auth $ issuesForRepoR user reqRepoName issueLimitations + +-- | All issues for a repo (given the repo owner and name), with optional +-- restrictions as described in the @IssueLimitation@ data type. +-- +-- > issuesForRepo "thoughtbot" "paperclip" [NoMilestone, OnlyClosed, Mentions "jyurek", Ascending] +issuesForRepo :: Name GithubOwner -> Name Repo -> [IssueLimitation] -> IO (Either Error [Issue]) +issuesForRepo = issuesForRepo' Nothing + +-- | List issues for a repository. +-- See +issuesForRepoR :: Name GithubOwner -> Name Repo -> [IssueLimitation] -> GithubRequest k [Issue] +issuesForRepoR user reqRepoName issueLimitations = + GithubGet ["repos", untagName user, untagName reqRepoName, "issues"] qs where + qs = queryStringFromLimitations issueLimitations queryStringFromLimitations = intercalate "&" . map convert convert AnyMilestone = "milestone=*" @@ -94,29 +118,26 @@ issuesForRepo' auth user reqRepoName issueLimitations = convert (Since t) = "since=" ++ formatTime defaultTimeLocale "%FT%TZ" t --- | All issues for a repo (given the repo owner and name), with optional --- restrictions as described in the @IssueLimitation@ data type. --- --- > issuesForRepo "thoughtbot" "paperclip" [NoMilestone, OnlyClosed, Mentions "jyurek", Ascending] -issuesForRepo :: String -> String -> [IssueLimitation] -> IO (Either Error [Issue]) -issuesForRepo = issuesForRepo' Nothing - - -- Creating new issues. newIssue :: String -> NewIssue newIssue title = NewIssue title Nothing Nothing Nothing Nothing --- | --- Create a new issue. +-- | Create a new issue. -- -- > createIssue (GithubUser (user, password)) user repo -- > (newIssue "some_repo") {...} -createIssue :: GithubAuth -> String -> String -> NewIssue +createIssue :: GithubAuth -> Name GithubOwner -> Name Repo -> NewIssue -> IO (Either Error Issue) -createIssue auth user repo = githubPost auth ["repos", user, repo, "issues"] +createIssue auth user repo ni = + executeRequest auth $ createIssueR user repo ni +-- | Create an issue. +-- See +createIssueR :: Name GithubOwner -> Name Repo -> NewIssue -> GithubRequest 'True Issue +createIssueR user repo = + GithubPost Post ["repos", untagName user, untagName repo, "issues"] . encode -- Editing issues. @@ -124,12 +145,17 @@ editOfIssue :: EditIssue editOfIssue = EditIssue Nothing Nothing Nothing Nothing Nothing Nothing --- | --- Edit an issue. +-- | Edit an issue. -- -- > editIssue (GithubUser (user, password)) user repo issue -- > editOfIssue {...} -editIssue :: GithubAuth -> String -> String -> Int -> EditIssue +editIssue :: GithubAuth -> Name GithubOwner -> Name Repo -> Id Issue -> EditIssue -> IO (Either Error Issue) -editIssue auth user repo iss = - githubPatch auth ["repos", user, repo, "issues", show iss] +editIssue auth user repo iss edit = + executeRequest auth $ editIssueR user repo iss edit + +-- | Edit an issue. +-- See +editIssueR :: Name GithubOwner -> Name Repo -> Id Issue -> EditIssue -> GithubRequest 'True Issue +editIssueR user repo iss = + GithubPost Patch ["repos", untagName user, untagName repo, "issues", show $ untagId iss] . encode diff --git a/Github/Issues/Comments.hs b/Github/Issues/Comments.hs index 130e4291..4e263c11 100644 --- a/Github/Issues/Comments.hs +++ b/Github/Issues/Comments.hs @@ -1,59 +1,86 @@ +{-# LANGUAGE DataKinds #-} -- | The Github issue comments API from -- . module Github.Issues.Comments ( - comment -,comments -,comments' -,createComment -,editComment -,module Github.Data -) where + comment, + commentR, + comments, + commentsR, + comments', + createComment, + createCommentR, + editComment, + editCommentR, + module Github.Data, + ) where +import Data.Aeson.Compat (encode) +import Github.Auth import Github.Data -import Github.Private +import Github.Request -- | A specific comment, by ID. -- -- > comment "thoughtbot" "paperclip" 1468184 -comment :: String -> String -> Int -> IO (Either Error IssueComment) -comment user reqRepoName reqCommentId = - githubGet ["repos", user, reqRepoName, "issues", "comments", show reqCommentId] +comment :: Name GithubOwner -> Name Repo -> Id Comment -> IO (Either Error IssueComment) +comment user repo cid = + executeRequest' $ commentR user repo cid + +-- | Get a single comment. +-- See +commentR :: Name GithubOwner -> Name Repo -> Id Comment -> GithubRequest k IssueComment +commentR user repo cid = + GithubGet ["repos", untagName user, untagName repo, "issues", "comments", show $ untagId cid] "" -- | All comments on an issue, by the issue's number. -- -- > comments "thoughtbot" "paperclip" 635 -comments :: String -> String -> Int -> IO (Either Error [IssueComment]) -comments user reqRepoName reqIssueNumber = - githubGet ["repos", user, reqRepoName, "issues", show reqIssueNumber, "comments"] +comments :: Name GithubOwner -> Name Repo -> Id Issue -> IO (Either Error [IssueComment]) +comments = comments' Nothing -- | All comments on an issue, by the issue's number, using authentication. -- -- > comments' (GithubUser (user, password)) "thoughtbot" "paperclip" 635 -comments' :: Maybe GithubAuth -> String -> String -> Int -> IO (Either Error [IssueComment]) -comments' auth user reqRepoName reqIssueNumber = - githubGet' auth ["repos", user, reqRepoName, "issues", show reqIssueNumber, "comments"] - +comments' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> Id Issue -> IO (Either Error [IssueComment]) +comments' auth user repo iid = + executeRequestMaybe auth $ commentsR user repo iid +-- | List comments on an issue. +-- See +commentsR :: Name GithubOwner -> Name Repo -> Id Issue -> GithubRequest k [IssueComment] +commentsR user repo iid = + GithubGet ["repos", untagName user, untagName repo, "issues", show $ untagId iid, "comments"] "" --- | --- Create a new comment. +-- | Create a new comment. -- -- > createComment (GithubUser (user, password)) user repo issue -- > "some words" -createComment :: GithubAuth -> String -> String -> Int -> String +createComment :: GithubAuth -> Name GithubOwner -> Name Repo -> Id Issue -> String -> IO (Either Error Comment) createComment auth user repo iss body = - githubPost auth - ["repos", user, repo, "issues", show iss, "comments"] (NewComment body) + executeRequest auth $ createCommentR user repo iss body +-- | Create a comment. +-- See +createCommentR :: Name GithubOwner -> Name Repo -> Id Issue -> String -> GithubRequest 'True Comment +createCommentR user repo iss body = + GithubPost Post parts (encode $ NewComment body) + where + parts = ["repos", untagName user, untagName repo, "issues", show $ untagId iss, "comments"] --- | --- Edit a comment. +-- | Edit a comment. -- -- > editComment (GithubUser (user, password)) user repo commentid -- > "new words" -editComment :: GithubAuth -> String -> String -> Int -> String +editComment :: GithubAuth -> Name GithubOwner -> Name Repo -> Id Comment -> String -> IO (Either Error Comment) editComment auth user repo commid body = - githubPatch auth ["repos", user, repo, "issues", "comments", show commid] - (EditComment body) + executeRequest auth $ editCommentR user repo commid body + +-- | Edit a comment. +-- See +editCommentR :: Name GithubOwner -> Name Repo -> Id Comment -> String -> GithubRequest 'True Comment +editCommentR user repo commid body = + GithubPost Patch parts (encode $ EditComment body) + where + parts = ["repos", untagName user, untagName repo, "issues", "comments", show $ untagId commid] diff --git a/Github/Issues/Events.hs b/Github/Issues/Events.hs index fea21ef4..9c8c6691 100644 --- a/Github/Issues/Events.hs +++ b/Github/Issues/Events.hs @@ -1,56 +1,75 @@ -- | The Github issue events API, which is described on -- module Github.Issues.Events ( - eventsForIssue -,eventsForIssue' -,eventsForRepo -,eventsForRepo' -,event -,event' -,module Github.Data -) where + eventsForIssue, + eventsForIssue', + eventsForIssueR, + eventsForRepo, + eventsForRepo', + eventsForRepoR, + event, + event', + eventR, + module Github.Data, + ) where +import Github.Auth import Github.Data -import Github.Private +import Github.Request -- | All events that have happened on an issue. -- -- > eventsForIssue "thoughtbot" "paperclip" 49 -eventsForIssue :: String -> String -> Int -> IO (Either Error [Event]) -eventsForIssue user reqRepoName reqIssueNumber = - githubGet ["repos", user, reqRepoName, "issues", show reqIssueNumber, "events"] +eventsForIssue :: Name GithubOwner -> Name Repo -> Id Issue -> IO (Either Error [Event]) +eventsForIssue = eventsForIssue' Nothing -- | All events that have happened on an issue, using authentication. -- -- > eventsForIssue' (GithubUser (user, password)) "thoughtbot" "paperclip" 49 -eventsForIssue' :: Maybe GithubAuth -> String -> String -> Int -> IO (Either Error [Event]) -eventsForIssue' auth user reqRepoName reqIssueNumber = - githubGet' auth ["repos", user, reqRepoName, "issues", show reqIssueNumber, "events"] +eventsForIssue' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> Id Issue -> IO (Either Error [Event]) +eventsForIssue' auth user repo iid = + executeRequestMaybe auth $ eventsForIssueR user repo iid + +-- | List events for an issue. +-- See +eventsForIssueR :: Name GithubOwner -> Name Repo -> Id Issue -> GithubRequest k [Event] +eventsForIssueR user repo iid = + GithubGet ["repos", untagName user, untagName repo, "issues", show $ untagId iid, "events"] "" -- | All the events for all issues in a repo. -- -- > eventsForRepo "thoughtbot" "paperclip" -eventsForRepo :: String -> String -> IO (Either Error [Event]) -eventsForRepo user reqRepoName = - githubGet ["repos", user, reqRepoName, "issues", "events"] +eventsForRepo :: Name GithubOwner -> Name Repo -> IO (Either Error [Event]) +eventsForRepo = eventsForRepo' Nothing -- | All the events for all issues in a repo, using authentication. -- -- > eventsForRepo' (GithubUser (user, password)) "thoughtbot" "paperclip" -eventsForRepo' :: Maybe GithubAuth -> String -> String -> IO (Either Error [Event]) -eventsForRepo' auth user reqRepoName = - githubGet' auth ["repos", user, reqRepoName, "issues", "events"] +eventsForRepo' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error [Event]) +eventsForRepo' auth user repo = + executeRequestMaybe auth $ eventsForRepoR user repo + +-- | List events for a repository. +-- See +eventsForRepoR :: Name GithubOwner -> Name Repo -> GithubRequest k [Event] +eventsForRepoR user repo = + GithubGet ["repos", untagName user, untagName repo, "issues", "events"] "" -- | Details on a specific event, by the event's ID. -- -- > event "thoughtbot" "paperclip" 5335772 -event :: String -> String -> Int -> IO (Either Error Event) -event user reqRepoName reqEventId = - githubGet ["repos", user, reqRepoName, "issues", "events", show reqEventId] +event :: Name GithubOwner -> Name Repo -> Id Event -> IO (Either Error Event) +event = event' Nothing -- | Details on a specific event, by the event's ID, using authentication. -- -- > event' (GithubUser (user, password)) "thoughtbot" "paperclip" 5335772 -event' :: Maybe GithubAuth -> String -> String -> Int -> IO (Either Error Event) -event' auth user reqRepoName reqEventId = - githubGet' auth ["repos", user, reqRepoName, "issues", "events", show reqEventId] +event' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> Id Event -> IO (Either Error Event) +event' auth user repo eid = + executeRequestMaybe auth $ eventR user repo eid + +-- | Get a single event. +-- See +eventR :: Name GithubOwner -> Name Repo -> Id Event -> GithubRequest k Event +eventR user repo eid = + GithubGet ["repos", untagName user, untagName repo, "issues", "events", show eid] "" diff --git a/Github/Issues/Labels.hs b/Github/Issues/Labels.hs index 98b4e113..ca64b6ce 100644 --- a/Github/Issues/Labels.hs +++ b/Github/Issues/Labels.hs @@ -1,135 +1,254 @@ +{-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-} --- | The API for dealing with labels on Github issues, as described on +-- | The API for dealing with labels on Github issues as described on -- . module Github.Issues.Labels ( - labelsOnRepo -,labelsOnRepo' -,label -,label' -,createLabel -,updateLabel -,deleteLabel -,labelsOnIssue -,labelsOnIssue' -,addLabelsToIssue -,removeLabelFromIssue -,replaceAllLabelsForIssue -,removeAllLabelsFromIssue -,labelsOnMilestone -,labelsOnMilestone' -,module Github.Data -) where - -import Data.Aeson (object, (.=)) + labelsOnRepo, + labelsOnRepo', + labelsOnRepoR, + label, + label', + labelR, + createLabel, + createLabelR, + updateLabel, + updateLabelR, + deleteLabel, + deleteLabelR, + labelsOnIssue, + labelsOnIssue', + labelsOnIssueR, + addLabelsToIssue, + addLabelsToIssueR, + removeLabelFromIssue, + removeLabelFromIssueR, + replaceAllLabelsForIssue, + replaceAllLabelsForIssueR, + removeAllLabelsFromIssue, + removeAllLabelsFromIssueR, + labelsOnMilestone, + labelsOnMilestone', + labelsOnMilestoneR, + module Github.Data, + ) where + +import Prelude () +import Prelude.Compat + +import Data.Aeson.Compat (encode, object, (.=)) +import Data.Foldable (toList) +import Github.Auth import Github.Data -import Github.Private +import Github.Request -- | All the labels available to use on any issue in the repo. -- -- > labelsOnRepo "thoughtbot" "paperclip" -labelsOnRepo :: String -> String -> IO (Either Error [IssueLabel]) +labelsOnRepo :: Name GithubOwner -> Name Repo -> IO (Either Error [IssueLabel]) labelsOnRepo = labelsOnRepo' Nothing --- | All the labels available to use on any issue in the repo, using authentication. +-- | All the labels available to use on any issue in the repo using authentication. -- --- > labelsOnRepo' (Just (GithubUser (user, password))) "thoughtbot" "paperclip" -labelsOnRepo' :: Maybe GithubAuth -> String -> String -> IO (Either Error [IssueLabel]) -labelsOnRepo' auth user reqRepoName = - githubGet' auth ["repos", user, reqRepoName, "labels"] - --- | A label, by name. +-- > labelsOnRepo' (Just (GithubUser (user password))) "thoughtbot" "paperclip" +labelsOnRepo' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error [IssueLabel]) +labelsOnRepo' auth user repo = + executeRequestMaybe auth $ labelsOnRepoR user repo + +-- | List all labels for this repository. +-- See +labelsOnRepoR :: Name GithubOwner -> Name Repo -> GithubRequest k [IssueLabel] +labelsOnRepoR user repo = + GithubGet ["repos", untagName user, untagName repo, "labels"] "" + +-- | A label by name. -- -- > label "thoughtbot" "paperclip" "bug" -label :: String -> String -> String -> IO (Either Error IssueLabel) +label :: Name GithubOwner -> Name Repo -> Name IssueLabel -> IO (Either Error IssueLabel) label = label' Nothing --- | A label, by name, using authentication. +-- | A label by name using authentication. -- --- > label' (Just (GithubUser (user, password))) "thoughtbot" "paperclip" "bug" -label' :: Maybe GithubAuth -> String -> String -> String -> IO (Either Error IssueLabel) -label' auth user reqRepoName reqLabelName = - githubGet' auth ["repos", user, reqRepoName, "labels", reqLabelName] +-- > label' (Just (GithubUser (user password))) "thoughtbot" "paperclip" "bug" +label' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> Name IssueLabel -> IO (Either Error IssueLabel) +label' auth user repo lbl = + executeRequestMaybe auth $ labelR user repo lbl + +-- | Get a single label. +-- See +labelR :: Name GithubOwner -> Name Repo -> Name IssueLabel -> GithubRequest k IssueLabel +labelR user repo lbl = + GithubGet ["repos", untagName user, untagName repo, "labels", untagName lbl] "" -- | 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 +-- > createLabel (GithubUser (user password)) "thoughtbot" "paperclip" "bug" "f29513" +createLabel :: GithubAuth -> Name GithubOwner -> Name Repo -> Name IssueLabel -> String -> IO (Either Error IssueLabel) +createLabel auth user repo lbl color = + executeRequest auth $ createLabelR user repo lbl color + +-- | Create a label. +-- See +createLabelR :: Name GithubOwner -> Name Repo -> Name IssueLabel -> String -> GithubRequest 'True IssueLabel +createLabelR user repo lbl color = + GithubPost Post paths $ encode body where - paths = ["repos", reqUserName, reqRepoName, "labels"] - body = object ["name" .= reqLabelName, "color" .= reqLabelColor] + paths = ["repos", untagName user, untagName repo, "labels"] + body = object ["name" .= untagName lbl, "color" .= color] -- | 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 +-- > updateLabel (GithubUser (user password)) "thoughtbot" "paperclip" "bug" "new-bug" "ff1111" +updateLabel :: GithubAuth + -> Name GithubOwner + -> Name Repo + -> Name IssueLabel -- ^ old label name + -> Name IssueLabel -- ^ new label name + -> String -- ^ new color + -> IO (Either Error IssueLabel) +updateLabel auth user repo oldLbl newLbl color = + executeRequest auth $ updateLabelR user repo oldLbl newLbl color + +-- | Update a label. +-- See +updateLabelR :: Name GithubOwner + -> Name Repo + -> Name IssueLabel -- ^ old label name + -> Name IssueLabel -- ^ new label name + -> String -- ^ new color + -> GithubRequest 'True IssueLabel +updateLabelR user repo oldLbl newLbl color = + GithubPost Patch paths (encode body) where - paths = ["repos", reqUserName, reqRepoName, "labels", oldLabelName] - body = object ["name" .= newLabelName, "color" .= reqLabelColor] + paths = ["repos", untagName user, untagName repo, "labels", untagName oldLbl] + body = object ["name" .= untagName newLbl, "color" .= color] -- | 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] +-- > deleteLabel (GithubUser (user password)) "thoughtbot" "paperclip" "bug" +deleteLabel :: GithubAuth -> Name GithubOwner -> Name Repo -> Name IssueLabel -> IO (Either Error ()) +deleteLabel auth user repo lbl = + executeRequest auth $ deleteLabelR user repo lbl + +-- | Delete a label. +-- See +deleteLabelR :: Name GithubOwner -> Name Repo -> Name IssueLabel -> GithubRequest 'True () +deleteLabelR user repo lbl = + GithubDelete ["repos", untagName user, untagName repo, "labels", untagName lbl] -- | The labels on an issue in a repo. -- -- > labelsOnIssue "thoughtbot" "paperclip" 585 -labelsOnIssue :: String -> String -> Int -> IO (Either Error [IssueLabel]) +labelsOnIssue :: Name GithubOwner -> Name Repo -> Id Issue -> IO (Either Error [IssueLabel]) labelsOnIssue = labelsOnIssue' Nothing --- | The labels on an issue in a repo, using authentication. +-- | The labels on an issue in a repo using authentication. -- --- > labelsOnIssue' (Just (GithubUser (user, password))) "thoughtbot" "paperclip" 585 -labelsOnIssue' :: Maybe GithubAuth -> String -> String -> Int -> IO (Either Error [IssueLabel]) -labelsOnIssue' auth user reqRepoName reqIssueId = - githubGet' auth ["repos", user, reqRepoName, "issues", show reqIssueId, "labels"] +-- > labelsOnIssue' (Just (GithubUser (user password))) "thoughtbot" "paperclip" (Id 585) +labelsOnIssue' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> Id Issue -> IO (Either Error [IssueLabel]) +labelsOnIssue' auth user repo iid = + executeRequestMaybe auth $ labelsOnIssueR user repo iid + +-- | List labels on an issue. +-- See +labelsOnIssueR :: Name GithubOwner -> Name Repo -> Id Issue -> GithubRequest k [IssueLabel] +labelsOnIssueR user repo iid = + GithubGet ["repos", untagName user, untagName repo, "issues", show $ untagId iid, "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 +-- > addLabelsToIssue (GithubUser (user password)) "thoughtbot" "paperclip" (Id 585) ["Label1" "Label2"] +addLabelsToIssue :: Foldable f + => GithubAuth + -> Name GithubOwner + -> Name Repo + -> Id Issue + -> f (Name IssueLabel) + -> IO (Either Error [IssueLabel]) +addLabelsToIssue auth user repo iid lbls = + executeRequest auth $ addLabelsToIssueR user repo iid lbls + +-- | Add lables to an issue. +-- See +addLabelsToIssueR :: Foldable f + => Name GithubOwner + -> Name Repo + -> Id Issue + -> f (Name IssueLabel) + -> GithubRequest 'True [IssueLabel] +addLabelsToIssueR user repo iid lbls = + GithubPost Post paths (encode $ toList lbls) where - paths =["repos", user, reqRepoName, "issues", show reqIssueId, "labels"] + paths = ["repos", untagName user, untagName repo, "issues", show $ untagId iid, "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] +-- > removeLabelFromIssue (GithubUser (user password)) "thoughtbot" "paperclip" (Id 585) "bug" +removeLabelFromIssue :: GithubAuth -> Name GithubOwner -> Name Repo -> Id Issue -> Name IssueLabel -> IO (Either Error ()) +removeLabelFromIssue auth user repo iid lbl = + executeRequest auth $ removeLabelFromIssueR user repo iid lbl + +-- | Remove a label from an issue. +-- See +removeLabelFromIssueR :: Name GithubOwner -> Name Repo -> Id Issue -> Name IssueLabel -> GithubRequest 'True () +removeLabelFromIssueR user repo iid lbl = + GithubDelete ["repos", untagName user, untagName repo, "issues", show $ untagId iid, "labels", untagName lbl] -- | 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 +-- > replaceAllLabelsForIssue (GithubUser (user password)) "thoughtbot" "paperclip" (Id 585) ["Label1" "Label2"] +replaceAllLabelsForIssue :: Foldable f + => GithubAuth + -> Name GithubOwner + -> Name Repo + -> Id Issue + -> f (Name IssueLabel) + -> IO (Either Error [IssueLabel]) +replaceAllLabelsForIssue auth user repo iid lbls = + executeRequest auth $ replaceAllLabelsForIssueR user repo iid lbls + +-- | Replace all labels on an issue. +-- See +-- +-- Sending an empty list will remove all labels from the issue. +replaceAllLabelsForIssueR :: Foldable f + => Name GithubOwner + -> Name Repo + -> Id Issue + -> f (Name IssueLabel) + -> GithubRequest 'True [IssueLabel] +replaceAllLabelsForIssueR user repo iid lbls = + GithubPost Put paths (encode $ toList lbls) where - paths =["repos", user, reqRepoName, "issues", show reqIssueId, "labels"] + paths = ["repos", untagName user, untagName repo, "issues", show $ untagId iid, "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"] +-- > removeAllLabelsFromIssue (GithubUser (user password)) "thoughtbot" "paperclip" (Id 585) +removeAllLabelsFromIssue :: GithubAuth -> Name GithubOwner -> Name Repo -> Id Issue -> IO (Either Error ()) +removeAllLabelsFromIssue auth user repo iid = + executeRequest auth $ removeAllLabelsFromIssueR user repo iid + +-- | Remove all labels from an issue. +-- See +removeAllLabelsFromIssueR :: Name GithubOwner -> Name Repo -> Id Issue -> GithubRequest 'True () +removeAllLabelsFromIssueR user repo iid = + GithubDelete ["repos", untagName user, untagName repo, "issues", show $ untagId iid, "labels"] --- | All the labels on a repo's milestone, given the milestone ID. +-- | All the labels on a repo's milestone given the milestone ID. -- --- > labelsOnMilestone "thoughtbot" "paperclip" 2 -labelsOnMilestone :: String -> String -> Int -> IO (Either Error [IssueLabel]) +-- > labelsOnMilestone "thoughtbot" "paperclip" (Id 2) +labelsOnMilestone :: Name GithubOwner -> Name Repo -> Id Milestone -> IO (Either Error [IssueLabel]) labelsOnMilestone = labelsOnMilestone' Nothing --- | All the labels on a repo's milestone, given the milestone ID, using authentication. +-- | All the labels on a repo's milestone given the milestone ID using authentication. -- --- > labelsOnMilestone' (Just (GithubUser (user, password))) "thoughtbot" "paperclip" 2 -labelsOnMilestone' :: Maybe GithubAuth -> String -> String -> Int -> IO (Either Error [IssueLabel]) -labelsOnMilestone' auth user reqRepoName milestoneId = - githubGet' auth ["repos", user, reqRepoName, "milestones", show milestoneId, "labels"] +-- > labelsOnMilestone' (Just (GithubUser (user password))) "thoughtbot" "paperclip" (Id 2) +labelsOnMilestone' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> Id Milestone -> IO (Either Error [IssueLabel]) +labelsOnMilestone' auth user repo mid = + executeRequestMaybe auth $ labelsOnMilestoneR user repo mid + +-- | Get labels for every issue in a milestone. +-- See +labelsOnMilestoneR :: Name GithubOwner -> Name Repo -> Id Milestone -> GithubRequest k [IssueLabel] +labelsOnMilestoneR user repo mid = + GithubGet ["repos", untagName user, untagName repo, "milestones", show $ untagId mid, "labels"] "" diff --git a/Github/Issues/Milestones.hs b/Github/Issues/Milestones.hs index 737ef490..7200d833 100644 --- a/Github/Issues/Milestones.hs +++ b/Github/Issues/Milestones.hs @@ -1,30 +1,45 @@ -- | The milestones API as described on -- . module Github.Issues.Milestones ( - milestones -,milestones' -,milestone -,module Github.Data -) where + milestones, + milestones', + milestonesR, + milestone, + milestoneR, + module Github.Data, + ) where +import Github.Auth import Github.Data -import Github.Private +import Github.Request -- | All milestones in the repo. -- -- > milestones "thoughtbot" "paperclip" -milestones :: String -> String -> IO (Either Error [Milestone]) +milestones :: Name GithubOwner -> Name Repo -> IO (Either Error [Milestone]) milestones = milestones' Nothing -- | All milestones in the repo, using authentication. -- --- > milestones' (GithubUser (user, password)) "thoughtbot" "paperclip" -milestones' :: Maybe GithubAuth -> String -> String -> IO (Either Error [Milestone]) -milestones' auth user reqRepoName = githubGet' auth ["repos", user, reqRepoName, "milestones"] +-- > milestones' (GithubUser (user, passwordG) "thoughtbot" "paperclip" +milestones' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error [Milestone]) +milestones' auth user repo = + executeRequestMaybe auth $ milestonesR user repo + +-- | List milestones for a repository. +-- See +milestonesR :: Name GithubOwner -> Name Repo -> GithubRequest k [Milestone] +milestonesR user repo = GithubGet ["repos", untagName user, untagName repo, "milestones"] "" -- | Details on a specific milestone, given it's milestone number. -- --- > milestone "thoughtbot" "paperclip" 2 -milestone :: String -> String -> Int -> IO (Either Error Milestone) -milestone user reqRepoName reqMilestoneNumber = - githubGet ["repos", user, reqRepoName, "milestones", show reqMilestoneNumber] +-- > milestone "thoughtbot" "paperclip" (Id 2) +milestone :: Name GithubOwner -> Name Repo -> Id Milestone -> IO (Either Error Milestone) +milestone user repo mid = + executeRequest' $ milestoneR user repo mid + +-- | Get a single milestone. +-- See +milestoneR :: Name GithubOwner -> Name Repo -> Id Milestone -> GithubRequest k Milestone +milestoneR user repo mid = + GithubGet ["repos", untagName user, untagName repo, "milestones", show $ untagId mid] "" diff --git a/github.cabal b/github.cabal index addf27a7..5c8d4bae 100644 --- a/github.cabal +++ b/github.cabal @@ -157,6 +157,7 @@ Library -- Packages needed in order to build this package. Build-depends: base >= 4.0 && < 5.0, + base-compat, time >=1.4 && <1.6, aeson >= 0.6.1.0, attoparsec >= 0.10.3.0, diff --git a/spec/Github/SearchSpec.hs b/spec/Github/SearchSpec.hs index 2af7d67e..722920a4 100644 --- a/spec/Github/SearchSpec.hs +++ b/spec/Github/SearchSpec.hs @@ -9,6 +9,7 @@ import Data.Aeson.Compat (eitherDecodeStrict) import Data.FileEmbed (embedFile) import Test.Hspec (Spec, describe, it, shouldBe) +import Github.Data.Id (Id (..)) import Github.Data.Issues (Issue(..), SearchIssuesResult(..)) import Github.Search (searchIssues) @@ -27,13 +28,13 @@ spec = do length issues `shouldBe` 2 let issue1 = head issues - issueId issue1 `shouldBe` 123898390 + issueId issue1 `shouldBe` Id 123898390 issueNumber issue1 `shouldBe` 130 issueTitle issue1 `shouldBe` "Make test runner more robust" issueState issue1 `shouldBe` "closed" let issue2 = issues !! 1 - issueId issue2 `shouldBe` 119694665 + issueId issue2 `shouldBe` Id 119694665 issueNumber issue2 `shouldBe` 127 issueTitle issue2 `shouldBe` "Decouple request creation from execution" issueState issue2 `shouldBe` "open" @@ -42,4 +43,4 @@ spec = do let query = "q=Decouple in:title repo:phadej/github created:<=2015-12-01" issues <- searchIssuesIssues . fromRightS <$> searchIssues query length issues `shouldBe` 1 - issueId (head issues) `shouldBe` 119694665 + issueId (head issues) `shouldBe` Id 119694665