Add pull request endpoints to Github.All

Github/All.hs

@@ -125,6 +125,29 @@ module Github.All (
     deleteTeamMembershipForR,
     listTeamsCurrentR,
 
+    -- * Pull Requests
+    -- | See <https://developer.github.com/v3/pulls/>
+    pullRequestsForR,
+    pullRequestR,
+    createPullRequestR,
+    updatePullRequestR,
+    pullRequestCommitsR,
+    pullRequestFilesR,
+    isPullRequestMergedR,
+    mergePullRequestR,
+
+    -- ** Review comments
+    -- | See <https://developer.github.com/v3/pulls/comments/>
+    --
+    -- Missing endpoints:
+    --
+    -- * List comments in a repository
+    -- * Create a comment
+    -- * Edit a comment
+    -- * Delete a comment
+    pullRequestReviewCommentsR,
+    pullRequestReviewCommentR,
+
     -- * Search
     -- | See <https://developer.github.com/v3/search/>
    --
@@ -172,6 +195,8 @@ import Github.Gists.Comments
 import Github.Organizations
 import Github.Organizations.Members
 import Github.Organizations.Teams
+import Github.PullRequests
+import Github.PullRequests.ReviewComments
 import Github.Search
 import Github.Users
 import Github.Users.Followers

Github/PullRequests.hs

@@ -1,126 +1,194 @@
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings, DataKinds #-}
 -- | The pull requests API as documented at
 -- <http://developer.github.com/v3/pulls/>.
 module Github.PullRequests (
- pullRequestsFor''
-,pullRequestsFor'
-,pullRequest'
-,pullRequestCommits'
-,pullRequestFiles'
-,pullRequestsFor
-,pullRequest
-,pullRequestCommits
-,pullRequestFiles
-,isPullRequestMerged
-,mergePullRequest
-,createPullRequest
-,updatePullRequest
-,module Github.Data
-) where
+    pullRequestsFor'',
+    pullRequestsFor',
+    pullRequestsFor,
+    pullRequestsForR,
+    pullRequest',
+    pullRequest,
+    pullRequestR,
+    createPullRequest,
+    createPullRequestR,
+    updatePullRequest,
+    updatePullRequestR,
+    pullRequestCommits',
+    pullRequestCommits,
+    pullRequestCommitsR,
+    pullRequestFiles',
+    pullRequestFiles,
+    pullRequestFilesR,
+    isPullRequestMerged,
+    isPullRequestMergedR,
+    mergePullRequest,
+    mergePullRequestR,
+    module Github.Data
+    ) where
 
+import Github.Auth
 import Github.Data
-import Github.Private
+import Github.Request
+
 import Network.HTTP.Types
-import qualified Data.Map as M
-import Network.HTTP.Conduit (RequestBody(RequestBodyLBS))
-import Data.Aeson
+import Data.Aeson.Compat (Value, encode, object, (.=))
 
 -- | All pull requests for the repo, by owner, repo name, and pull request state.
 -- | With authentification
 --
--- > pullRequestsFor' (Just ("github-username", "github-password")) "rails" "rails" (Just "open")
+-- > pullRequestsFor' (Just ("github-username", "github-password"))  (Just "open") "rails" "rails"
 --
 -- State can be one of @all@, @open@, or @closed@. Default is @open@.
 --
-pullRequestsFor'' :: Maybe GithubAuth -> Maybe String -> String -> String -> IO (Either Error [PullRequest])
-pullRequestsFor'' auth state userName reqRepoName =
-  githubGetWithQueryString' auth ["repos", userName, reqRepoName, "pulls"] $
-    maybe "" ("state=" ++) state
+pullRequestsFor'' :: Maybe GithubAuth -> Maybe String -> Name GithubOwner -> Name Repo -> IO (Either Error [PullRequest])
+pullRequestsFor'' auth state user repo =
+    executeRequestMaybe auth $ pullRequestsForR user repo state
 
 -- | All pull requests for the repo, by owner and repo name.
 -- | With authentification
 --
 -- > pullRequestsFor' (Just ("github-username", "github-password")) "rails" "rails"
-pullRequestsFor' :: Maybe GithubAuth -> String -> String -> IO (Either Error [PullRequest])
+pullRequestsFor' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error [PullRequest])
 pullRequestsFor' auth = pullRequestsFor'' auth Nothing
 
 -- | All pull requests for the repo, by owner and repo name.
 --
 -- > pullRequestsFor "rails" "rails"
-pullRequestsFor :: String -> String -> IO (Either Error [PullRequest])
+pullRequestsFor :: Name GithubOwner -> Name Repo -> IO (Either Error [PullRequest])
 pullRequestsFor = pullRequestsFor'' Nothing Nothing
 
+-- | List pull requests.
+-- See <https://developer.github.com/v3/pulls/#list-pull-requests>
+pullRequestsForR :: Name GithubOwner -> Name Repo
+                 -> Maybe String  -- ^ State
+                 -> GithubRequest k [PullRequest]
+pullRequestsForR user repo state =
+    GithubGet ["repos", untagName user, untagName repo, "pulls"] $
+        maybe "" ("state=" ++) state
+
 -- | A detailed pull request, which has much more information. This takes the
 -- repo owner and name along with the number assigned to the pull request.
 -- | With authentification
 --
 -- > pullRequest' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" 562
-pullRequest' :: Maybe GithubAuth -> String -> String -> Int -> IO (Either Error DetailedPullRequest)
-pullRequest' auth userName reqRepoName number =
-  githubGet' auth ["repos", userName, reqRepoName, "pulls", show number]
+pullRequest' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> Id DetailedPullRequest -> IO (Either Error DetailedPullRequest)
+pullRequest' auth user repo prid =
+    executeRequestMaybe auth $ pullRequestR user repo prid
 
 -- | A detailed pull request, which has much more information. This takes the
 -- repo owner and name along with the number assigned to the pull request.
 --
 -- > pullRequest "thoughtbot" "paperclip" 562
-pullRequest :: String -> String -> Int -> IO (Either Error DetailedPullRequest)
+pullRequest :: Name GithubOwner -> Name Repo -> Id DetailedPullRequest -> IO (Either Error DetailedPullRequest)
 pullRequest = pullRequest' Nothing
 
+-- | Get a single pull request.
+-- See <https://developer.github.com/v3/pulls/#get-a-single-pull-request>
+pullRequestR :: Name GithubOwner -> Name Repo -> Id DetailedPullRequest -> GithubRequest k DetailedPullRequest
+pullRequestR user repo prid =
+    GithubGet ["repos", untagName user, untagName repo, "pulls", show $ untagId prid] ""
+
+createPullRequest :: GithubAuth
+                  -> Name GithubOwner
+                  -> Name Repo
+                  -> CreatePullRequest
+                  -> IO (Either Error DetailedPullRequest)
+createPullRequest auth user repo cpr =
+    executeRequest auth $ createPullRequestR user repo cpr
+
+-- | Create a pull request.
+-- See <https://developer.github.com/v3/pulls/#create-a-pull-request>
+createPullRequestR :: Name GithubOwner
+                   -> Name Repo
+                   -> CreatePullRequest
+                   -> GithubRequest 'True DetailedPullRequest
+createPullRequestR user repo cpr =
+    GithubPost Post ["repos", untagName user, untagName repo, "pulls"] (encode cpr)
+
+-- | Update a pull request
+updatePullRequest :: GithubAuth -> Name GithubOwner -> Name Repo -> Id DetailedPullRequest -> EditPullRequest -> IO (Either Error DetailedPullRequest)
+updatePullRequest auth user repo prid epr =
+    executeRequest auth $ updatePullRequestR user repo prid epr
+
+-- | Update a pull request.
+-- See <https://developer.github.com/v3/pulls/#update-a-pull-request>
+updatePullRequestR :: Name GithubOwner
+                   -> Name Repo
+                   -> Id DetailedPullRequest
+                   -> EditPullRequest
+                   -> GithubRequest 'True DetailedPullRequest
+updatePullRequestR user repo prid epr =
+    GithubPost Patch ["repos", untagName user, untagName repo, "pulls", show $ untagId prid] (encode epr)
+
 -- | All the commits on a pull request, given the repo owner, repo name, and
 -- the number of the pull request.
 -- | With authentification
 --
 -- > pullRequestCommits' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" 688
-pullRequestCommits' :: Maybe GithubAuth -> String -> String -> Int -> IO (Either Error [Commit])
-pullRequestCommits' auth userName reqRepoName number =
-  githubGet' auth ["repos", userName, reqRepoName, "pulls", show number, "commits"]
-
+pullRequestCommits' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> Id DetailedPullRequest -> IO (Either Error [Commit])
+pullRequestCommits' auth user repo prid =
+    executeRequestMaybe auth $ pullRequestCommitsR user repo prid
+  
 -- | All the commits on a pull request, given the repo owner, repo name, and
 -- the number of the pull request.
 --
 -- > pullRequestCommits "thoughtbot" "paperclip" 688
-pullRequestCommits :: String -> String -> Int -> IO (Either Error [Commit])
+pullRequestCommits :: Name GithubOwner -> Name Repo -> Id DetailedPullRequest -> IO (Either Error [Commit])
 pullRequestCommits = pullRequestCommits' Nothing
 
+-- | List commits on a pull request.
+-- See <https://developer.github.com/v3/pulls/#list-commits-on-a-pull-request>
+pullRequestCommitsR :: Name GithubOwner -> Name Repo -> Id DetailedPullRequest -> GithubRequest k [Commit]
+pullRequestCommitsR user repo prid =
+    GithubGet ["repos", untagName user, untagName repo, "pulls", show $ untagId prid, "commits"] ""
+
 -- | The individual files that a pull request patches. Takes the repo owner and
 -- name, plus the number assigned to the pull request.
 -- | With authentification
 --
 -- > pullRequestFiles' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" 688
-pullRequestFiles' :: Maybe GithubAuth -> String -> String -> Int -> IO (Either Error [File])
-pullRequestFiles' auth userName reqRepoName number =
-  githubGet' auth ["repos", userName, reqRepoName, "pulls", show number, "files"]
+pullRequestFiles' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> Id DetailedPullRequest -> IO (Either Error [File])
+pullRequestFiles' auth user repo prid =
+    executeRequestMaybe auth $ pullRequestFilesR user repo prid
+
 -- | The individual files that a pull request patches. Takes the repo owner and
 -- name, plus the number assigned to the pull request.
 --
 -- > pullRequestFiles "thoughtbot" "paperclip" 688
-pullRequestFiles :: String -> String -> Int -> IO (Either Error [File])
+pullRequestFiles :: Name GithubOwner -> Name Repo -> Id DetailedPullRequest -> IO (Either Error [File])
 pullRequestFiles = pullRequestFiles' Nothing
 
+-- | List pull requests files.
+-- See <https://developer.github.com/v3/pulls/#list-pull-requests-files>
+pullRequestFilesR :: Name GithubOwner -> Name Repo -> Id DetailedPullRequest -> GithubRequest k [File]
+pullRequestFilesR user repo prid =
+    GithubGet ["repos", untagName user, untagName repo, "pulls", show $ untagId prid, "files"] ""
+
 -- | Check if pull request has been merged
-isPullRequestMerged :: GithubAuth -> String -> String -> Int -> IO(Either Error Status)
-isPullRequestMerged auth reqRepoOwner reqRepoName reqPullRequestNumber =
-  doHttpsStatus "GET" (buildPath ["repos", reqRepoOwner, reqRepoName, "pulls", (show reqPullRequestNumber), "merge"]) auth Nothing
+isPullRequestMerged :: GithubAuth -> Name GithubOwner -> Name Repo -> Id DetailedPullRequest -> IO (Either Error Status)
+isPullRequestMerged auth user repo prid =
+    executeRequest auth $ isPullRequestMergedR user repo prid
 
--- | Merge a pull request
-mergePullRequest :: GithubAuth -> String -> String -> Int -> Maybe String -> IO(Either Error Status)
-mergePullRequest auth reqRepoOwner reqRepoName reqPullRequestNumber commitMessage =
-  doHttpsStatus "PUT" (buildPath ["repos", reqRepoOwner, reqRepoName, "pulls", (show reqPullRequestNumber), "merge"]) auth (Just . RequestBodyLBS . encode . toJSON $ (buildCommitMessageMap commitMessage))
+-- | Get if a pull request has been merged.
+-- See <https://developer.github.com/v3/pulls/#get-if-a-pull-request-has-been-merged>
+isPullRequestMergedR :: Name GithubOwner -> Name Repo -> Id DetailedPullRequest -> GithubRequest k Status
+isPullRequestMergedR user repo prid = GithubStatus $
+    GithubGet ["repos", untagName user, untagName repo, "pulls", show $ untagId prid, "merge"] ""
 
--- | Update a pull request
-updatePullRequest :: GithubAuth -> String -> String -> Int -> EditPullRequest -> IO (Either Error DetailedPullRequest)
-updatePullRequest auth reqRepoOwner reqRepoName reqPullRequestNumber editPullRequest =
-  githubPatch auth ["repos", reqRepoOwner, reqRepoName, "pulls", show reqPullRequestNumber] editPullRequest
+-- | Merge a pull request.
+mergePullRequest :: GithubAuth -> Name GithubOwner -> Name Repo -> Id DetailedPullRequest -> Maybe String -> IO (Either Error Status)
+mergePullRequest auth user repo prid commitMessage =
+    executeRequest auth $ mergePullRequestR user repo prid commitMessage
 
+-- | Merge a pull request (Merge Button)
+-- https://developer.github.com/v3/pulls/#merge-a-pull-request-merge-button
+mergePullRequestR :: Name GithubOwner -> Name Repo -> Id DetailedPullRequest -> Maybe String -> GithubRequest 'True Status
+mergePullRequestR user repo prid commitMessage = GithubStatus $
+    GithubPost Put paths (encode $ buildCommitMessageMap commitMessage)
+  where
+    paths = ["repos", untagName user, untagName repo, "pulls", show $ untagId prid, "merge"]
 
-buildCommitMessageMap :: Maybe String -> M.Map String String
-buildCommitMessageMap (Just commitMessage) = M.singleton "commit_message" commitMessage
-buildCommitMessageMap _ = M.empty
+    buildCommitMessageMap :: Maybe String -> Value
+    buildCommitMessageMap (Just msg) = object ["commit_message" .= msg ]
+    buildCommitMessageMap Nothing    = object []
 
-createPullRequest :: GithubAuth
-                  -> String
-                  -> String
-                  -> CreatePullRequest
-                  -> IO (Either Error DetailedPullRequest)
-createPullRequest auth reqUserName reqRepoName createPR =
-    githubPost auth ["repos", reqUserName, reqRepoName, "pulls"] createPR

Github/PullRequests/ReviewComments.hs

@@ -1,24 +1,38 @@
 -- | The pull request review comments API as described at
 -- <http://developer.github.com/v3/pulls/comments/>.
 module Github.PullRequests.ReviewComments (
- pullRequestReviewComments
-,pullRequestReviewComment
-,module Github.Data
-) where
+    pullRequestReviewComments,
+    pullRequestReviewCommentsR,
+    pullRequestReviewComment,
+    pullRequestReviewCommentR,
+    module Github.Data,
+    ) where
 
 import Github.Data
-import Github.Private
+import Github.Request
 
 -- | All the comments on a pull request with the given ID.
 --
--- > pullRequestReviewComments "thoughtbot" "factory_girl" 256
-pullRequestReviewComments :: String -> String -> Int -> IO (Either Error [Comment])
-pullRequestReviewComments userName repo number =
-  githubGet ["repos", userName, repo, "pulls", show number, "comments"]
+-- > pullRequestReviewComments "thoughtbot" "factory_girl" (Id 256)
+pullRequestReviewComments :: Name GithubOwner -> Name Repo -> Id PullRequest -> IO (Either Error [Comment])
+pullRequestReviewComments user repo prid =
+    executeRequest' $ pullRequestReviewCommentsR user repo prid
+
+-- | List comments on a pull request.
+-- See <https://developer.github.com/v3/pulls/comments/#list-comments-on-a-pull-request>
+pullRequestReviewCommentsR :: Name GithubOwner -> Name Repo -> Id PullRequest -> GithubRequest k [Comment]
+pullRequestReviewCommentsR user repo prid =
+    GithubGet ["repos", untagName user, untagName repo, "pulls", show $ untagId prid, "comments"] ""
 
 -- | One comment on a pull request, by the comment's ID.
 --
--- > pullRequestReviewComment "thoughtbot" "factory_girl" 301819
-pullRequestReviewComment :: String -> String -> Int -> IO (Either Error Comment)
-pullRequestReviewComment userName repo ident =
-  githubGet ["repos", userName, repo, "pulls", "comments", show ident]
+-- > pullRequestReviewComment "thoughtbot" "factory_girl" (Id 301819)
+pullRequestReviewComment :: Name GithubOwner -> Name Repo -> Id Comment -> IO (Either Error Comment)
+pullRequestReviewComment user repo cid =
+    executeRequest' $ pullRequestReviewCommentR user repo cid
+
+-- | Get a single comment.
+-- See <https://developer.github.com/v3/pulls/comments/#get-a-single-comment>
+pullRequestReviewCommentR :: Name GithubOwner -> Name Repo -> Id Comment -> GithubRequest k Comment
+pullRequestReviewCommentR user repo cid =
+    GithubGet ["repos", untagName user, untagName repo, "pulls", "comments", show $ untagId cid] ""