diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,9 @@ +Changes for 0.17.0 +- Add `Ord Request` instance +- Repository contents +- Repository starring endpoints +- Pull Request review endpoints + Changes for 0.16.0 - Add support for `mergeable_state = "blocked".` - Fix HTTP status code of merge PR diff --git a/github.cabal b/github.cabal --- a/github.cabal +++ b/github.cabal @@ -1,5 +1,5 @@ name: github -version: 0.16.0 +version: 0.17.0 synopsis: Access to the GitHub API, v3. description: The GitHub API provides programmatic access to the full @@ -84,6 +84,7 @@ GitHub.Data.Releases GitHub.Data.Repos GitHub.Data.Request + GitHub.Data.Reviews GitHub.Data.Search GitHub.Data.Teams GitHub.Data.URL @@ -107,11 +108,13 @@ GitHub.Endpoints.Organizations.Members GitHub.Endpoints.Organizations.Teams GitHub.Endpoints.PullRequests - GitHub.Endpoints.PullRequests.ReviewComments + GitHub.Endpoints.PullRequests.Reviews + GitHub.Endpoints.PullRequests.Comments GitHub.Endpoints.Repos GitHub.Endpoints.Repos.Collaborators GitHub.Endpoints.Repos.Comments GitHub.Endpoints.Repos.Commits + GitHub.Endpoints.Repos.Contents GitHub.Endpoints.Repos.DeployKeys GitHub.Endpoints.Repos.Forks GitHub.Endpoints.Repos.Releases @@ -171,6 +174,7 @@ GitHub.OrganizationsSpec GitHub.IssuesSpec GitHub.PullRequestsSpec + GitHub.PullRequestReviewsSpec GitHub.ReleasesSpec GitHub.ReposSpec GitHub.SearchSpec diff --git a/spec/GitHub/PullRequestReviewsSpec.hs b/spec/GitHub/PullRequestReviewsSpec.hs new file mode 100644 --- /dev/null +++ b/spec/GitHub/PullRequestReviewsSpec.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE OverloadedStrings #-} +module GitHub.PullRequestReviewsSpec where + +import qualified GitHub +import GitHub.Data.Id (Id(Id)) + +import Prelude () +import Prelude.Compat + +import Data.Either.Compat (isRight) +import Data.Foldable (for_) +import Data.String (fromString) +import System.Environment (lookupEnv) +import Test.Hspec (Spec, describe, it, pendingWith, shouldSatisfy) + +withAuth :: (GitHub.Auth -> IO ()) -> IO () +withAuth action = do + mtoken <- lookupEnv "GITHUB_TOKEN" + case mtoken of + Nothing -> pendingWith "no GITHUB_TOKEN" + Just token -> action (GitHub.OAuth $ fromString token) + +spec :: Spec +spec = do + describe "pullRequestReviewsR" $ do + it "works" $ withAuth $ \auth -> for_ prs $ \(owner, repo, prid) -> do + cs <- GitHub.executeRequest auth $ + GitHub.pullRequestReviewsR owner repo prid GitHub.FetchAll + cs `shouldSatisfy` isRight + where + prs = + [("phadej", "github", Id 268)] diff --git a/src/GitHub.hs b/src/GitHub.hs --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -25,12 +25,12 @@ -- Missing endpoints: -- -- * Check if you are starring a repository - -- * Star a repository - -- * Unstar a repository stargazersForR, reposStarredByR, myStarredR, myStarredAcceptStarR, + starRepoR, + unstarRepoR, -- ** Watching -- | See @@ -207,8 +207,27 @@ -- * Create a comment -- * Edit a comment -- * Delete a comment + pullRequestCommentsR, + pullRequestCommentR, + + -- ** Pull request reviews + -- | See + -- + -- Missing endpoints: + -- + -- * Delete a pending review + -- * Create a pull request review + -- * Submit a pull request review + -- * Dismiss a pull request review + pullRequestReviewsR, + pullRequestReviews, + pullRequestReviews', + pullRequestReviewR, + pullRequestReview, + pullRequestReview', pullRequestReviewCommentsR, - pullRequestReviewCommentR, + pullRequestReviewCommentsIO, + pullRequestReviewCommentsIO', -- * Repositories -- | See @@ -334,7 +353,8 @@ import GitHub.Endpoints.Organizations.Members import GitHub.Endpoints.Organizations.Teams import GitHub.Endpoints.PullRequests -import GitHub.Endpoints.PullRequests.ReviewComments +import GitHub.Endpoints.PullRequests.Reviews +import GitHub.Endpoints.PullRequests.Comments import GitHub.Endpoints.Repos import GitHub.Endpoints.Repos.Collaborators import GitHub.Endpoints.Repos.Comments diff --git a/src/GitHub/Data.hs b/src/GitHub/Data.hs --- a/src/GitHub/Data.hs +++ b/src/GitHub/Data.hs @@ -46,6 +46,7 @@ module GitHub.Data.Releases, module GitHub.Data.Repos, module GitHub.Data.Request, + module GitHub.Data.Reviews, module GitHub.Data.Search, module GitHub.Data.Teams, module GitHub.Data.URL, @@ -73,6 +74,7 @@ import GitHub.Data.Releases import GitHub.Data.Repos import GitHub.Data.Request +import GitHub.Data.Reviews import GitHub.Data.Search import GitHub.Data.Teams import GitHub.Data.URL diff --git a/src/GitHub/Data/Content.hs b/src/GitHub/Data/Content.hs --- a/src/GitHub/Data/Content.hs +++ b/src/GitHub/Data/Content.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE RecordWildCards #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -5,6 +6,9 @@ -- module GitHub.Data.Content where +import Data.Aeson.Types (Pair) +import Data.Maybe (maybe) +import GitHub.Data.GitData import GitHub.Data.URL import GitHub.Internal.Prelude import Prelude () @@ -55,6 +59,71 @@ instance NFData ContentInfo where rnf = genericRnf instance Binary ContentInfo +data ContentResultInfo = ContentResultInfo + { contentResultInfo :: !ContentInfo + , contentResultSize :: !Int + } deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData ContentResultInfo where rnf = genericRnf +instance Binary ContentResultInfo + +data ContentResult = ContentResult + { contentResultContent :: !ContentResultInfo + , contentResultCommit :: !GitCommit + } deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData ContentResult where rnf = genericRnf +instance Binary ContentResult + +data Author = Author + { authorName :: !Text + , authorEmail :: !Text + } + deriving (Eq, Ord, Show, Data, Typeable, Generic) + +instance NFData Author where rnf = genericRnf +instance Binary Author + +data CreateFile = CreateFile + { createFilePath :: !Text + , createFileMessage :: !Text + , createFileContent :: !Text + , createFileBranch :: !(Maybe Text) + , createFileAuthor :: !(Maybe Author) + , createFileCommitter :: !(Maybe Author) + } + deriving (Eq, Ord, Show, Data, Typeable, Generic) + +instance NFData CreateFile where rnf = genericRnf +instance Binary CreateFile + +data UpdateFile = UpdateFile + { updateFilePath :: !Text + , updateFileMessage :: !Text + , updateFileContent :: !Text + , updateFileSHA :: !Text + , updateFileBranch :: !(Maybe Text) + , updateFileAuthor :: !(Maybe Author) + , updateFileCommitter :: !(Maybe Author) + } + deriving (Eq, Ord, Show, Data, Typeable, Generic) + +instance NFData UpdateFile where rnf = genericRnf +instance Binary UpdateFile + +data DeleteFile = DeleteFile + { deleteFilePath :: !Text + , deleteFileMessage :: !Text + , deleteFileSHA :: !Text + , deleteFileBranch :: !(Maybe Text) + , deleteFileAuthor :: !(Maybe Author) + , deleteFileCommitter :: !(Maybe Author) + } + deriving (Eq, Ord, Show, Data, Typeable, Generic) + +instance NFData DeleteFile where rnf = genericRnf +instance Binary DeleteFile + instance FromJSON Content where parseJSON o@(Object _) = ContentFile <$> parseJSON o parseJSON (Array os) = ContentDirectory <$> traverse parseJSON os @@ -87,3 +156,53 @@ <*> o .: "url" <*> o .: "git_url" <*> o .: "html_url" + +instance FromJSON ContentResultInfo where + parseJSON = withObject "ContentResultInfo" $ \o -> + ContentResultInfo <$> parseJSON (Object o) + <*> o .: "size" + +instance FromJSON ContentResult where + parseJSON = withObject "ContentResult" $ \o -> + ContentResult <$> o .: "content" + <*> o .: "commit" + +instance ToJSON Author where + toJSON Author {..} = object + [ "name" .= authorName + , "email" .= authorEmail + ] + +instance ToJSON CreateFile where + toJSON CreateFile {..} = object $ + [ "path" .= createFilePath + , "message" .= createFileMessage + , "content" .= createFileContent + ] + ++ "branch" .=? createFileBranch + ++ "author" .=? createFileAuthor + ++ "committer" .=? createFileCommitter + +instance ToJSON UpdateFile where + toJSON UpdateFile {..} = object $ + [ "path" .= updateFilePath + , "message" .= updateFileMessage + , "content" .= updateFileContent + , "sha" .= updateFileSHA + ] + ++ "branch" .=? updateFileBranch + ++ "author" .=? updateFileAuthor + ++ "committer" .=? updateFileCommitter + +instance ToJSON DeleteFile where + toJSON DeleteFile {..} = object $ + [ "path" .= deleteFilePath + , "message" .= deleteFileMessage + , "sha" .= deleteFileSHA + ] + ++ "branch" .=? deleteFileBranch + ++ "author" .=? deleteFileAuthor + ++ "committer" .=? deleteFileCommitter + +(.=?) :: ToJSON v => Text -> Maybe v -> [Pair] +name .=? value = maybe [] (pure . (name .=)) value diff --git a/src/GitHub/Data/PullRequests.hs b/src/GitHub/Data/PullRequests.hs --- a/src/GitHub/Data/PullRequests.hs +++ b/src/GitHub/Data/PullRequests.hs @@ -26,6 +26,8 @@ import GitHub.Internal.Prelude import Prelude () +import qualified Data.Text as T + data SimplePullRequest = SimplePullRequest { simplePullRequestClosedAt :: !(Maybe UTCTime) , simplePullRequestCreatedAt :: !UTCTime @@ -160,6 +162,9 @@ | PullRequestUnassigned | PullRequestLabeled | PullRequestUnlabeled + | PullRequestReviewRequested + | PullRequestReviewRequestRemoved + | PullRequestEdited deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData PullRequestEventType where rnf = genericRnf @@ -284,6 +289,10 @@ parseJSON (String "unassigned") = pure PullRequestUnassigned parseJSON (String "labeled") = pure PullRequestLabeled parseJSON (String "unlabeled") = pure PullRequestUnlabeled + parseJSON (String "review_requested") = pure PullRequestReviewRequested + parseJSON (String "review_request_removed") = pure PullRequestReviewRequestRemoved + parseJSON (String "edited") = pure PullRequestEdited + parseJSON (String s) = fail $ "Unknown action type " <> T.unpack s parseJSON v = typeMismatch "Could not build a PullRequestEventType" v instance FromJSON PullRequestReference where diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -61,6 +61,7 @@ deriving (Typeable) deriving instance Eq (CommandMethod a) +deriving instance Ord (CommandMethod a) instance Show (CommandMethod a) where showsPrec _ Post = showString "Post" @@ -180,6 +181,9 @@ deriving instance Eq a => Eq (Request k a) deriving instance Eq a => Eq (SimpleRequest k a) + +deriving instance Ord a => Ord (Request k a) +deriving instance Ord a => Ord (SimpleRequest k a) instance Show (SimpleRequest k a) where showsPrec d r = showParen (d > appPrec) $ case r of diff --git a/src/GitHub/Data/Reviews.hs b/src/GitHub/Data/Reviews.hs new file mode 100644 --- /dev/null +++ b/src/GitHub/Data/Reviews.hs @@ -0,0 +1,97 @@ +module GitHub.Data.Reviews where + +import Data.Text (Text) +import GitHub.Data.Definitions (SimpleUser) +import GitHub.Data.Id (Id) +import GitHub.Data.URL (URL) +import GitHub.Internal.Prelude +import Prelude () + +data ReviewState + = ReviewStatePending + | ReviewStateApproved + | ReviewStateDismissed + | ReviewStateCommented + | ReviewStateChangesRequested + deriving (Show, Enum, Bounded, Eq, Ord, Generic) + +instance NFData ReviewState where + rnf = genericRnf + +instance Binary ReviewState + +instance FromJSON ReviewState where + parseJSON (String "APPROVED") = pure ReviewStateApproved + parseJSON (String "PENDING") = pure ReviewStatePending + parseJSON (String "DISMISSED") = pure ReviewStateDismissed + parseJSON (String "COMMENTED") = pure ReviewStateCommented + parseJSON (String "CHANGES_REQUESTED") = pure ReviewStateChangesRequested + parseJSON _ = fail "Unexpected ReviewState" + +data Review = Review + { reviewBody :: !Text + , reviewCommitId :: !Text + , reviewState :: ReviewState + , reviewSubmittedAt :: !UTCTime + , reviewPullRequestUrl :: !URL + , reviewHtmlUrl :: !Text + , reviewUser :: !SimpleUser + , reviewId :: !(Id Review) + } deriving (Show, Generic) + +instance NFData Review where + rnf = genericRnf + +instance Binary Review + +instance FromJSON Review where + parseJSON = + withObject "Review" $ \o -> + Review <$> o .: "body" <*> o .: "commit_id" <*> o .: "state" <*> + o .: "submitted_at" <*> + o .: "pull_request_url" <*> + o .: "html_url" <*> + o .: "user" <*> + o .: "id" + +data ReviewComment = ReviewComment + { reviewCommentId :: !(Id ReviewComment) + , reviewCommentUser :: !SimpleUser + , reviewCommentBody :: !Text + , reviewCommentUrl :: !URL + , reviewCommentPullRequestReviewId :: !(Id Review) + , reviewCommentDiffHunk :: !Text + , reviewCommentPath :: !Text + , reviewCommentPosition :: !Int + , reviewCommentOriginalPosition :: !Int + , reviewCommentCommitId :: !Text + , reviewCommentOriginalCommitId :: !Text + , reviewCommentCreatedAt :: !UTCTime + , reviewCommentUpdatedAt :: !UTCTime + , reviewCommentHtmlUrl :: !URL + , reviewCommentPullRequestUrl :: !URL + } deriving (Show, Generic) + +instance NFData ReviewComment where + rnf = genericRnf + +instance Binary ReviewComment + +instance FromJSON ReviewComment where + parseJSON = + withObject "ReviewComment" $ \o -> ReviewComment + <$> o .: "id" + <*> o .: "user" + <*> o .: "body" + <*> o .: "url" + <*> o .: "pull_request_review_id" + <*> o .: "diff_hunk" + <*> o .: "path" + <*> o .: "position" + <*> o .: "original_position" + <*> o .: "commit_id" + <*> o .: "original_commit_id" + <*> o .: "created_at" + <*> o .: "updated_at" + <*> o .: "html_url" + <*> o .: "pull_request_url" diff --git a/src/GitHub/Endpoints/Activity/Starring.hs b/src/GitHub/Endpoints/Activity/Starring.hs --- a/src/GitHub/Endpoints/Activity/Starring.hs +++ b/src/GitHub/Endpoints/Activity/Starring.hs @@ -14,6 +14,10 @@ myStarredR, myStarredAcceptStar, myStarredAcceptStarR, + starRepo, + starRepoR, + unstarRepo, + unstarRepoR, module GitHub.Data, ) where @@ -69,3 +73,25 @@ -- See myStarredAcceptStarR :: FetchCount -> Request 'RA (Vector RepoStarred) myStarredAcceptStarR = HeaderQuery [("Accept", "application/vnd.github.v3.star+json")] . PagedQuery ["user", "starred"] [] + +-- | Star a repo by the authenticated user. +starRepo :: Auth -> Name Owner -> Name Repo -> IO (Either Error ()) +starRepo auth user repo = executeRequest auth $ starRepoR user repo + +-- | Star a repo by the authenticated user. +-- See +starRepoR :: Name Owner -> Name Repo -> Request 'RW () +starRepoR user repo = command Put' paths mempty + where + paths = ["user", "starred", toPathPart user, toPathPart repo] + +-- | Unstar a repo by the authenticated user. +unstarRepo :: Auth -> Name Owner -> Name Repo -> IO (Either Error ()) +unstarRepo auth user repo = executeRequest auth $ unstarRepoR user repo + +-- | Unstar a repo by the authenticated user. +-- See +unstarRepoR :: Name Owner -> Name Repo -> Request 'RW () +unstarRepoR user repo = command Delete paths mempty + where + paths = ["user", "starred", toPathPart user, toPathPart repo] diff --git a/src/GitHub/Endpoints/PullRequests/Comments.hs b/src/GitHub/Endpoints/PullRequests/Comments.hs new file mode 100644 --- /dev/null +++ b/src/GitHub/Endpoints/PullRequests/Comments.hs @@ -0,0 +1,45 @@ +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +-- The pull request review comments API as described at +-- . +module GitHub.Endpoints.PullRequests.Comments ( + pullRequestCommentsIO, + pullRequestCommentsR, + pullRequestComment, + pullRequestCommentR, + module GitHub.Data, + ) where + +import GitHub.Data +import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () + +-- | All the comments on a pull request with the given ID. +-- +-- > pullRequestComments "thoughtbot" "factory_girl" (Id 256) +pullRequestCommentsIO :: Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector Comment)) +pullRequestCommentsIO user repo prid = + executeRequest' $ pullRequestCommentsR user repo prid FetchAll + +-- | List comments on a pull request. +-- See +pullRequestCommentsR :: Name Owner -> Name Repo -> Id PullRequest -> FetchCount -> Request k (Vector Comment) +pullRequestCommentsR user repo prid = + pagedQuery ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "comments"] [] + +-- | One comment on a pull request, by the comment's ID. +-- +-- > pullRequestComment "thoughtbot" "factory_girl" (Id 301819) +pullRequestComment :: Name Owner -> Name Repo -> Id Comment -> IO (Either Error Comment) +pullRequestComment user repo cid = + executeRequest' $ pullRequestCommentR user repo cid + +-- | Query a single comment. +-- See +pullRequestCommentR :: Name Owner -> Name Repo -> Id Comment -> Request k Comment +pullRequestCommentR user repo cid = + query ["repos", toPathPart user, toPathPart repo, "pulls", "comments", toPathPart cid] [] diff --git a/src/GitHub/Endpoints/PullRequests/ReviewComments.hs b/src/GitHub/Endpoints/PullRequests/ReviewComments.hs deleted file mode 100644 --- a/src/GitHub/Endpoints/PullRequests/ReviewComments.hs +++ /dev/null @@ -1,45 +0,0 @@ ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- --- The pull request review comments API as described at --- . -module GitHub.Endpoints.PullRequests.ReviewComments ( - pullRequestReviewCommentsIO, - pullRequestReviewCommentsR, - pullRequestReviewComment, - pullRequestReviewCommentR, - module GitHub.Data, - ) where - -import GitHub.Data -import GitHub.Internal.Prelude -import GitHub.Request -import Prelude () - --- | All the comments on a pull request with the given ID. --- --- > pullRequestReviewComments "thoughtbot" "factory_girl" (Id 256) -pullRequestReviewCommentsIO :: Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector Comment)) -pullRequestReviewCommentsIO user repo prid = - executeRequest' $ pullRequestReviewCommentsR user repo prid FetchAll - --- | List comments on a pull request. --- See -pullRequestReviewCommentsR :: Name Owner -> Name Repo -> Id PullRequest -> FetchCount -> Request k (Vector Comment) -pullRequestReviewCommentsR user repo prid = - pagedQuery ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "comments"] [] - --- | One comment on a pull request, by the comment's ID. --- --- > pullRequestReviewComment "thoughtbot" "factory_girl" (Id 301819) -pullRequestReviewComment :: Name Owner -> Name Repo -> Id Comment -> IO (Either Error Comment) -pullRequestReviewComment user repo cid = - executeRequest' $ pullRequestReviewCommentR user repo cid - --- | Query a single comment. --- See -pullRequestReviewCommentR :: Name Owner -> Name Repo -> Id Comment -> Request k Comment -pullRequestReviewCommentR user repo cid = - query ["repos", toPathPart user, toPathPart repo, "pulls", "comments", toPathPart cid] [] diff --git a/src/GitHub/Endpoints/PullRequests/Reviews.hs b/src/GitHub/Endpoints/PullRequests/Reviews.hs new file mode 100644 --- /dev/null +++ b/src/GitHub/Endpoints/PullRequests/Reviews.hs @@ -0,0 +1,165 @@ +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +-- The reviews API as described on . +module GitHub.Endpoints.PullRequests.Reviews + ( pullRequestReviewsR + , pullRequestReviews + , pullRequestReviews' + , pullRequestReviewR + , pullRequestReview + , pullRequestReview' + , pullRequestReviewCommentsR + , pullRequestReviewCommentsIO + , pullRequestReviewCommentsIO' + , module GitHub.Data + ) where + +import GitHub.Data +import GitHub.Data.Id (Id) +import GitHub.Internal.Prelude +import GitHub.Request + (Request, executeRequest', executeRequestMaybe) +import Prelude () + +-- | List reviews for a pull request. +-- See +pullRequestReviewsR + :: Name Owner + -> Name Repo + -> Id PullRequest + -> FetchCount + -> Request k (Vector Review) +pullRequestReviewsR owner repo prid = + pagedQuery + [ "repos" + , toPathPart owner + , toPathPart repo + , "pulls" + , toPathPart prid + , "reviews" + ] + [] + +-- | All reviews for a pull request given the repo owner, repo name and the pull +-- request id. +-- +-- > pullRequestReviews "thoughtbot" "paperclip" (Id 101) +pullRequestReviews + :: Name Owner + -> Name Repo + -> Id PullRequest + -> IO (Either Error (Vector Review)) +pullRequestReviews owner repo prid = + executeRequest' $ pullRequestReviewsR owner repo prid FetchAll + +-- | All reviews for a pull request given the repo owner, repo name and the pull +-- request id. With authentication. +-- +-- > pullRequestReviews' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" (Id 101) +pullRequestReviews' + :: Maybe Auth + -> Name Owner + -> Name Repo + -> Id PullRequest + -> IO (Either Error (Vector Review)) +pullRequestReviews' auth owner repo pr = + executeRequestMaybe auth $ pullRequestReviewsR owner repo pr FetchAll + +-- | Query a single pull request review. +-- see +pullRequestReviewR + :: Name Owner + -> Name Repo + -> Id PullRequest + -> Id Review + -> Request k Review +pullRequestReviewR owner repo prid rid = + query + [ "repos" + , toPathPart owner + , toPathPart repo + , "pulls" + , toPathPart prid + , "reviews" + , toPathPart rid + ] + [] + +-- | A detailed review on a pull request given the repo owner, repo name, pull +-- request id and review id. +-- +-- > pullRequestReview "thoughtbot" "factory_girl" (Id 301819) (Id 332) +pullRequestReview + :: Name Owner + -> Name Repo + -> Id PullRequest + -> Id Review + -> IO (Either Error Review) +pullRequestReview owner repo prid rid = + executeRequest' $ pullRequestReviewR owner repo prid rid + +-- | A detailed review on a pull request given the repo owner, repo name, pull +-- request id and review id. With authentication. +-- +-- > pullRequestReview' (Just ("github-username", "github-password")) +-- "thoughtbot" "factory_girl" (Id 301819) (Id 332) +pullRequestReview' + :: Maybe Auth + -> Name Owner + -> Name Repo + -> Id PullRequest + -> Id Review + -> IO (Either Error Review) +pullRequestReview' auth owner repo prid rid = + executeRequestMaybe auth $ pullRequestReviewR owner repo prid rid + +-- | Query the comments for a single pull request review. +-- see +pullRequestReviewCommentsR + :: Name Owner + -> Name Repo + -> Id PullRequest + -> Id Review + -> Request k [ReviewComment] +pullRequestReviewCommentsR owner repo prid rid = + query + [ "repos" + , toPathPart owner + , toPathPart repo + , "pulls" + , toPathPart prid + , "reviews" + , toPathPart rid + , "comments" + ] + [] + +-- | All comments for a review on a pull request given the repo owner, repo +-- name, pull request id and review id. +-- +-- > pullRequestReviewComments "thoughtbot" "factory_girl" (Id 301819) (Id 332) +pullRequestReviewCommentsIO + :: Name Owner + -> Name Repo + -> Id PullRequest + -> Id Review + -> IO (Either Error [ReviewComment]) +pullRequestReviewCommentsIO owner repo prid rid = + executeRequest' $ pullRequestReviewCommentsR owner repo prid rid + +-- | All comments for a review on a pull request given the repo owner, repo +-- name, pull request id and review id. With authentication. +-- +-- > pullRequestReviewComments' (Just ("github-username", "github-password")) "thoughtbot" "factory_girl" (Id 301819) (Id 332) +pullRequestReviewCommentsIO' + :: Maybe Auth + -> Name Owner + -> Name Repo + -> Id PullRequest + -> Id Review + -> IO (Either Error [ReviewComment]) +pullRequestReviewCommentsIO' auth owner repo prid rid = + executeRequestMaybe auth $ pullRequestReviewCommentsR owner repo prid rid diff --git a/src/GitHub/Endpoints/Repos.hs b/src/GitHub/Endpoints/Repos.hs --- a/src/GitHub/Endpoints/Repos.hs +++ b/src/GitHub/Endpoints/Repos.hs @@ -32,10 +32,6 @@ branchesFor, branchesFor', branchesForR, - contentsFor, - contentsFor', - readmeFor, - readmeFor', -- ** Create createRepo', @@ -61,8 +57,6 @@ import GitHub.Request import Prelude () -import qualified Data.Text.Encoding as TE - repoPublicityQueryString :: RepoPublicity -> QueryString repoPublicityQueryString RepoPublicityAll = [("type", Just "all")] repoPublicityQueryString RepoPublicityOwner = [("type", Just "owner")] @@ -322,49 +316,6 @@ branchesForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Branch) branchesForR user repo = pagedQuery ["repos", toPathPart user, toPathPart repo, "branches"] [] - --- | The contents of a file or directory in a repo, given the repo owner, name, and path to the file --- --- > contentsFor "thoughtbot" "paperclip" "README.md" -contentsFor :: Name Owner -> Name Repo -> Text -> Maybe Text -> IO (Either Error Content) -contentsFor = contentsFor' Nothing - --- | The contents of a file or directory in a repo, given the repo owner, name, and path to the file --- With Authentication --- --- > contentsFor' (Just (BasicAuth (user, password))) "thoughtbot" "paperclip" "README.md" Nothing -contentsFor' :: Maybe Auth -> Name Owner -> Name Repo -> Text -> Maybe Text -> IO (Either Error Content) -contentsFor' auth user repo path ref = - executeRequestMaybe auth $ contentsForR user repo path ref - -contentsForR - :: Name Owner - -> Name Repo - -> Text -- ^ file or directory - -> Maybe Text -- ^ Git commit - -> Request k Content -contentsForR user repo path ref = - query ["repos", toPathPart user, toPathPart repo, "contents", path] qs - where - qs = maybe [] (\r -> [("ref", Just . TE.encodeUtf8 $ r)]) ref - --- | The contents of a README file in a repo, given the repo owner and name --- --- > readmeFor "thoughtbot" "paperclip" -readmeFor :: Name Owner -> Name Repo -> IO (Either Error Content) -readmeFor = readmeFor' Nothing - --- | The contents of a README file in a repo, given the repo owner and name --- With Authentication --- --- > readmeFor' (Just (BasicAuth (user, password))) "thoughtbot" "paperclip" -readmeFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error Content) -readmeFor' auth user repo = - executeRequestMaybe auth $ readmeForR user repo - -readmeForR :: Name Owner -> Name Repo -> Request k Content -readmeForR user repo = - query ["repos", toPathPart user, toPathPart repo, "readme"] [] -- | Delete an existing repository. -- diff --git a/src/GitHub/Endpoints/Repos/Contents.hs b/src/GitHub/Endpoints/Repos/Contents.hs new file mode 100644 --- /dev/null +++ b/src/GitHub/Endpoints/Repos/Contents.hs @@ -0,0 +1,140 @@ +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +-- The Github Repo Contents API, as documented at +-- +module GitHub.Endpoints.Repos.Contents ( + -- * Querying contents + contentsFor, + contentsFor', + contentsForR, + readmeFor, + readmeFor', + readmeForR, + + -- ** Create + createFile, + createFileR, + + -- ** Update + updateFile, + updateFileR, + + -- ** Delete + deleteFile, + deleteFileR, + + module GitHub.Data + ) where + +import GitHub.Data +import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () + +import qualified Data.Text.Encoding as TE + +-- | The contents of a file or directory in a repo, given the repo owner, name, and path to the file +-- +-- > contentsFor "thoughtbot" "paperclip" "README.md" +contentsFor :: Name Owner -> Name Repo -> Text -> Maybe Text -> IO (Either Error Content) +contentsFor = contentsFor' Nothing + +-- | The contents of a file or directory in a repo, given the repo owner, name, and path to the file +-- With Authentication +-- +-- > contentsFor' (Just (BasicAuth (user, password))) "thoughtbot" "paperclip" "README.md" Nothing +contentsFor' :: Maybe Auth -> Name Owner -> Name Repo -> Text -> Maybe Text -> IO (Either Error Content) +contentsFor' auth user repo path ref = + executeRequestMaybe auth $ contentsForR user repo path ref + +contentsForR + :: Name Owner + -> Name Repo + -> Text -- ^ file or directory + -> Maybe Text -- ^ Git commit + -> Request k Content +contentsForR user repo path ref = + query ["repos", toPathPart user, toPathPart repo, "contents", path] qs + where + qs = maybe [] (\r -> [("ref", Just . TE.encodeUtf8 $ r)]) ref + +-- | The contents of a README file in a repo, given the repo owner and name +-- +-- > readmeFor "thoughtbot" "paperclip" +readmeFor :: Name Owner -> Name Repo -> IO (Either Error Content) +readmeFor = readmeFor' Nothing + +-- | The contents of a README file in a repo, given the repo owner and name +-- With Authentication +-- +-- > readmeFor' (Just (BasicAuth (user, password))) "thoughtbot" "paperclip" +readmeFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error Content) +readmeFor' auth user repo = + executeRequestMaybe auth $ readmeForR user repo + +readmeForR :: Name Owner -> Name Repo -> Request k Content +readmeForR user repo = + query ["repos", toPathPart user, toPathPart repo, "readme"] [] + +-- | Create a file. +createFile + :: Auth + -> Name Owner -- ^ owner + -> Name Repo -- ^ repository name + -> CreateFile + -> IO (Either Error ContentResult) +createFile auth user repo body = + executeRequest auth $ createFileR user repo body + +-- | Create a file. +-- See +createFileR + :: Name Owner + -> Name Repo + -> CreateFile + -> Request 'RW ContentResult +createFileR user repo body = + command Put ["repos", toPathPart user, toPathPart repo, "contents", createFilePath body] (encode body) + +-- | Update a file. +updateFile + :: Auth + -> Name Owner -- ^ owner + -> Name Repo -- ^ repository name + -> UpdateFile + -> IO (Either Error ContentResult) +updateFile auth user repo body = + executeRequest auth $ updateFileR user repo body + +-- | Update a file. +-- See +updateFileR + :: Name Owner + -> Name Repo + -> UpdateFile + -> Request 'RW ContentResult +updateFileR user repo body = + command Put ["repos", toPathPart user, toPathPart repo, "contents", updateFilePath body] (encode body) + +-- | Delete a file. +deleteFile + :: Auth + -> Name Owner -- ^ owner + -> Name Repo -- ^ repository name + -> DeleteFile + -> IO (Either Error ()) +deleteFile auth user repo body = + executeRequest auth $ deleteFileR user repo body + +-- | Delete a file. +-- See +deleteFileR + :: Name Owner + -> Name Repo + -> DeleteFile + -> Request 'RW () +deleteFileR user repo body = + command Delete ["repos", toPathPart user, toPathPart repo, "contents", deleteFilePath body] (encode body)