From daea03cb4de23b88d4796764333482886d921337 Mon Sep 17 00:00:00 2001 From: Schell Scivally Date: Tue, 26 Nov 2013 19:29:49 -0800 Subject: [PATCH 001/510] Bumped aeson version, fixed typo. --- Github/Data.hs | 2 +- github.cabal | 10 +++++----- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/Github/Data.hs b/Github/Data.hs index 70a0ea0f..495c153c 100644 --- a/Github/Data.hs +++ b/Github/Data.hs @@ -534,7 +534,7 @@ obj `values` key = parseJSON $ Array $ V.fromList $ Map.elems children -- | Produce the value for the last key by traversing. -(<.:>) :: (FromJSON v) => Object => [T.Text] -> Parser v +(<.:>) :: (FromJSON v) => Object -> [T.Text] -> Parser v obj <.:> [key] = obj .: key obj <.:> (key:keys) = let (Object nextObj) = findWithDefault (Object Map.empty) key obj in diff --git a/github.cabal b/github.cabal index 9dbde7e8..305f50d4 100644 --- a/github.cabal +++ b/github.cabal @@ -142,7 +142,7 @@ Library -- Packages needed in order to build this package. Build-depends: base >= 4.0 && < 5.0, time, - aeson == 0.6.1.0, + aeson >= 0.6.1.0, attoparsec >= 0.10.3.0, bytestring, case-insensitive >= 0.4.0.4, @@ -159,11 +159,11 @@ Library data-default, vector, unordered-containers >= 0.2 && < 0.3 - + -- Modules not exported by this package. Other-modules: Github.Private - + -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source. - -- Build-tools: - + -- Build-tools: + GHC-Options: -Wall -fno-warn-orphans From 3084dc8dbe33bd016067db2e9fe376b7ca877eb3 Mon Sep 17 00:00:00 2001 From: Jeff Taggart Date: Sat, 30 Nov 2013 21:14:43 +0000 Subject: [PATCH 002/510] Added support for nullable emails --- Github/Data/Definitions.hs | 2 +- samples/Users/ShowUser.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/Github/Data/Definitions.hs b/Github/Data/Definitions.hs index ccf2add5..1f44b568 100644 --- a/Github/Data/Definitions.hs +++ b/Github/Data/Definitions.hs @@ -451,7 +451,7 @@ data DetailedOwner = DetailedUser { ,detailedOwnerName :: Maybe String ,detailedOwnerLocation :: Maybe String ,detailedOwnerCompany :: Maybe String - ,detailedOwnerEmail :: String + ,detailedOwnerEmail :: Maybe String ,detailedOwnerUrl :: String ,detailedOwnerId :: Int ,detailedOwnerHtmlUrl :: String diff --git a/samples/Users/ShowUser.hs b/samples/Users/ShowUser.hs index ae212fbe..fde62ec3 100644 --- a/samples/Users/ShowUser.hs +++ b/samples/Users/ShowUser.hs @@ -27,7 +27,7 @@ formatUser user@(Github.DetailedOrganization {}) = formatUser user@(Github.DetailedUser {}) = (formatName userName login) ++ "\t" ++ (fromMaybe "" company) ++ "\t" ++ (fromMaybe "" location) ++ "\n" ++ - (fromMaybe "" blog) ++ "\t" ++ "<" ++ email ++ ">" ++ "\n" ++ + (fromMaybe "" blog) ++ "\t" ++ "<" ++ (fromMaybe "" email) ++ ">" ++ "\n" ++ htmlUrl ++ "\t" ++ (formatDate createdAt) ++ "\n" ++ "hireable: " ++ (formatHireable isHireable) ++ "\n\n" ++ (fromMaybe "" bio) From 53150fa0c024498acb6664c65191665de8b38637 Mon Sep 17 00:00:00 2001 From: Jeff Taggart Date: Sat, 30 Nov 2013 21:27:00 +0000 Subject: [PATCH 003/510] Fix emails and hireable not being present --- Github/Data.hs | 4 ++-- Github/Data/Definitions.hs | 2 +- samples/Users/ShowUser.hs | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/Github/Data.hs b/Github/Data.hs index 70a0ea0f..dd3d0daa 100644 --- a/Github/Data.hs +++ b/Github/Data.hs @@ -504,7 +504,7 @@ instance FromJSON DetailedOwner where <*> o .: "avatar_url" <*> o .: "followers" <*> o .: "following" - <*> o .: "hireable" + <*> o .:? "hireable" <*> o .: "gravatar_id" <*> o .:? "blog" <*> o .:? "bio" @@ -512,7 +512,7 @@ instance FromJSON DetailedOwner where <*> o .:? "name" <*> o .:? "location" <*> o .:? "company" - <*> o .: "email" + <*> o .:? "email" <*> o .: "url" <*> o .: "id" <*> o .: "html_url" diff --git a/Github/Data/Definitions.hs b/Github/Data/Definitions.hs index 1f44b568..99496c25 100644 --- a/Github/Data/Definitions.hs +++ b/Github/Data/Definitions.hs @@ -443,7 +443,7 @@ data DetailedOwner = DetailedUser { ,detailedOwnerAvatarUrl :: String ,detailedOwnerFollowers :: Int ,detailedOwnerFollowing :: Int - ,detailedOwnerHireable :: Bool + ,detailedOwnerHireable :: Maybe Bool ,detailedOwnerGravatarId :: Maybe String ,detailedOwnerBlog :: Maybe String ,detailedOwnerBio :: Maybe String diff --git a/samples/Users/ShowUser.hs b/samples/Users/ShowUser.hs index fde62ec3..a33b805c 100644 --- a/samples/Users/ShowUser.hs +++ b/samples/Users/ShowUser.hs @@ -29,7 +29,7 @@ formatUser user@(Github.DetailedUser {}) = (fromMaybe "" location) ++ "\n" ++ (fromMaybe "" blog) ++ "\t" ++ "<" ++ (fromMaybe "" email) ++ ">" ++ "\n" ++ htmlUrl ++ "\t" ++ (formatDate createdAt) ++ "\n" ++ - "hireable: " ++ (formatHireable isHireable) ++ "\n\n" ++ + "hireable: " ++ (formatHireable (fromMaybe False isHireable)) ++ "\n\n" ++ (fromMaybe "" bio) where userName = Github.detailedOwnerName user From 3214fdd22925048fd2c52f8c472d619b27d5c1f6 Mon Sep 17 00:00:00 2001 From: John Wiegley Date: Mon, 2 Dec 2013 02:46:03 -0700 Subject: [PATCH 004/510] Bump version to 0.7.2 --- Github/Data.hs | 4 +++- github.cabal | 4 ++-- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/Github/Data.hs b/Github/Data.hs index 70a0ea0f..353f06c4 100644 --- a/Github/Data.hs +++ b/Github/Data.hs @@ -11,6 +11,7 @@ import Control.Applicative import Control.Monad import qualified Data.Text as T import Data.Aeson.Types +import Data.Monoid import System.Locale (defaultTimeLocale) import qualified Data.Vector as V import qualified Data.HashMap.Lazy as Map @@ -534,7 +535,8 @@ obj `values` key = parseJSON $ Array $ V.fromList $ Map.elems children -- | Produce the value for the last key by traversing. -(<.:>) :: (FromJSON v) => Object => [T.Text] -> Parser v +(<.:>) :: (FromJSON v, Monoid v) => Object => [T.Text] -> Parser v +_obj <.:> [] = pure mempty obj <.:> [key] = obj .: key obj <.:> (key:keys) = let (Object nextObj) = findWithDefault (Object Map.empty) key obj in diff --git a/github.cabal b/github.cabal index 9dbde7e8..72f29c5d 100644 --- a/github.cabal +++ b/github.cabal @@ -7,7 +7,7 @@ Name: github -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented. -Version: 0.7.1 +Version: 0.7.2 -- A short (one-line) description of the package. Synopsis: Access to the Github API, v3. @@ -142,7 +142,7 @@ Library -- Packages needed in order to build this package. Build-depends: base >= 4.0 && < 5.0, time, - aeson == 0.6.1.0, + aeson >= 0.6.1.0, attoparsec >= 0.10.3.0, bytestring, case-insensitive >= 0.4.0.4, From 260adbeac6ea17c5b98ca3c6f65fd67cad80c1fa Mon Sep 17 00:00:00 2001 From: John Wiegley Date: Fri, 20 Dec 2013 19:09:19 -0600 Subject: [PATCH 005/510] Remove signature for doHttps, bump to 0.7.3 Fixes #51 --- Github/Private.hs | 6 +++--- github.cabal | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/Github/Private.hs b/Github/Private.hs index 09cabf17..1a8b4a3e 100644 --- a/Github/Private.hs +++ b/Github/Private.hs @@ -104,9 +104,9 @@ githubAPI apimethod url auth body = do in Just (Data.List.takeWhile (/= '>') s') else Nothing -doHttps :: Method -> String -> Maybe GithubAuth - -> Maybe (RequestBody (ResourceT IO)) - -> IO (Either E.SomeException (Response LBS.ByteString)) +-- doHttps :: Method -> String -> Maybe GithubAuth +-- -> Maybe (RequestBody (ResourceT IO)) +-- -> IO (Either E.SomeException (Response LBS.ByteString)) doHttps reqMethod url auth body = do let reqBody = fromMaybe (RequestBodyBS $ BS.pack "") body reqHeaders = maybe [] getOAuth auth diff --git a/github.cabal b/github.cabal index 72f29c5d..3ebabe5f 100644 --- a/github.cabal +++ b/github.cabal @@ -7,7 +7,7 @@ Name: github -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented. -Version: 0.7.2 +Version: 0.7.3 -- A short (one-line) description of the package. Synopsis: Access to the Github API, v3. From 4a59d247a1d323f49ddf1e7a877585fc85190010 Mon Sep 17 00:00:00 2001 From: John Wiegley Date: Wed, 22 Jan 2014 05:49:47 -0600 Subject: [PATCH 006/510] Bump version to 0.7.4 --- Github/Private.hs | 2 +- github.cabal | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/Github/Private.hs b/Github/Private.hs index 1a8b4a3e..d5e9c903 100644 --- a/Github/Private.hs +++ b/Github/Private.hs @@ -116,7 +116,7 @@ doHttps reqMethod url auth body = do , port = 443 , requestBody = reqBody , requestHeaders = reqHeaders <> - [("User-Agent", "github.hs/0.7.0")] + [("User-Agent", "github.hs/0.7.4")] <> [("Accept", "application/vnd.github.preview")] , checkStatus = successOrMissing } diff --git a/github.cabal b/github.cabal index 1edac163..c23c1705 100644 --- a/github.cabal +++ b/github.cabal @@ -7,7 +7,7 @@ Name: github -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented. -Version: 0.7.3 +Version: 0.7.4 -- A short (one-line) description of the package. Synopsis: Access to the Github API, v3. From dac1673522d4d1425a61b52aab095f00ee058171 Mon Sep 17 00:00:00 2001 From: Yusuke Nomura Date: Mon, 27 Jan 2014 21:57:23 +0900 Subject: [PATCH 007/510] Change to allow null value in "milestoneDescription". --- Github/Data/Definitions.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Github/Data/Definitions.hs b/Github/Data/Definitions.hs index ccf2add5..9889b7ac 100644 --- a/Github/Data/Definitions.hs +++ b/Github/Data/Definitions.hs @@ -227,7 +227,7 @@ data Milestone = Milestone { ,milestoneOpenIssues :: Int ,milestoneNumber :: Int ,milestoneClosedIssues :: Int - ,milestoneDescription :: String + ,milestoneDescription :: Maybe String ,milestoneTitle :: String ,milestoneUrl :: String ,milestoneCreatedAt :: GithubDate From 632bb8fbd248cc83dcad20b4ac9860ae5e0d1613 Mon Sep 17 00:00:00 2001 From: Dmitry Andreevich Date: Sun, 6 Apr 2014 15:45:10 +0300 Subject: [PATCH 008/510] Fix code example in README --- README.md | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/README.md b/README.md index e300246a..dd411cf0 100644 --- a/README.md +++ b/README.md @@ -35,14 +35,17 @@ Each function has a sample written for it. All functions produce an `IO (Either Error a)`, where `a` is the actual thing you want. You must call the function using IO goodness, then dispatch on the possible error message. Here's an example from the samples: - import Github.Users.Followers + import qualified Github.Users.Followers as Github import Data.List (intercalate) + main = do - possibleUsers <- usersFollowing "mike-burns" - putStrLn $ either (\error -> "Error: " ++ $ show error) - (intercalate "\n" . map githubUserLogin) + possibleUsers <- Github.usersFollowing "mike-burns" + putStrLn $ either (("Error: "++) . show) + (intercalate "\n" . map formatUser) possibleUsers + formatUser = Github.githubOwnerLogin + Contributions ============= From 3c49867e40cb367216924d0e149b255c96963cf0 Mon Sep 17 00:00:00 2001 From: Romain Beaumont Date: Sat, 12 Apr 2014 01:25:15 +0200 Subject: [PATCH 009/510] fix error Module Data.Conduit does not export ResourceT --- Github/Private.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Github/Private.hs b/Github/Private.hs index d5e9c903..038d4952 100644 --- a/Github/Private.hs +++ b/Github/Private.hs @@ -14,7 +14,7 @@ import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as LBS import Network.HTTP.Types (Method, Status(..)) import Network.HTTP.Conduit -import Data.Conduit (ResourceT) +-- import Data.Conduit (ResourceT) import qualified Control.Exception as E import Data.Maybe (fromMaybe) From 1c2a2b17f7b212963cf9c41bd2eb662d9896fb5a Mon Sep 17 00:00:00 2001 From: "David L. L. Thomas" Date: Thu, 1 May 2014 06:07:53 -0700 Subject: [PATCH 010/510] Optional pull_request field Github doesn't seem to send this field (anymore?), so requiring it breaks things. Making it optional (with a Maybe in Issue) fixes all of my code, others may need to tweak things to deal with the Maybe. --- Github/Data.hs | 2 +- Github/Data/Definitions.hs | 2 +- github.cabal | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/Github/Data.hs b/Github/Data.hs index 706fde2f..f9da6c47 100644 --- a/Github/Data.hs +++ b/Github/Data.hs @@ -215,7 +215,7 @@ instance FromJSON Issue where <*> o .:? "assignee" <*> o .: "user" <*> o .: "title" - <*> o .: "pull_request" + <*> o .:? "pull_request" <*> o .: "url" <*> o .: "created_at" <*> o .: "body" diff --git a/Github/Data/Definitions.hs b/Github/Data/Definitions.hs index 9889b7ac..acf65e17 100644 --- a/Github/Data/Definitions.hs +++ b/Github/Data/Definitions.hs @@ -193,7 +193,7 @@ data Issue = Issue { ,issueAssignee :: Maybe GithubOwner ,issueUser :: GithubOwner ,issueTitle :: String - ,issuePullRequest :: PullRequestReference + ,issuePullRequest :: Maybe PullRequestReference ,issueUrl :: String ,issueCreatedAt :: GithubDate ,issueBody :: Maybe String diff --git a/github.cabal b/github.cabal index c23c1705..bee2421c 100644 --- a/github.cabal +++ b/github.cabal @@ -7,7 +7,7 @@ Name: github -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented. -Version: 0.7.4 +Version: 0.8 -- A short (one-line) description of the package. Synopsis: Access to the Github API, v3. From 959a00db16e685e17893edc9b0545089064d27f8 Mon Sep 17 00:00:00 2001 From: Matt Giles Date: Fri, 2 May 2014 17:28:40 -0700 Subject: [PATCH 011/510] More authorized functions for Github.Repos: languagesFor', tagsFor', branchesFor' --- Github/Repos.hs | 37 +++++++++++++++++++++++++++++++------ 1 file changed, 31 insertions(+), 6 deletions(-) diff --git a/Github/Repos.hs b/Github/Repos.hs index 614ec207..b0447a29 100644 --- a/Github/Repos.hs +++ b/Github/Repos.hs @@ -16,8 +16,11 @@ module Github.Repos ( ,contributors ,contributorsWithAnonymous ,languagesFor +,languagesFor' ,tagsFor +,tagsFor' ,branchesFor +,branchesFor' ,module Github.Data ,RepoPublicity(..) @@ -145,23 +148,45 @@ contributorsWithAnonymous userName reqRepoName = -- -- > languagesFor "mike-burns" "ohlaunch" languagesFor :: String -> String -> IO (Either Error [Language]) -languagesFor userName reqRepoName = do - result <- githubGet ["repos", userName, reqRepoName, "languages"] +languagesFor = languagesFor' Nothing + +-- | The programming languages used in a repo along with the number of +-- characters written in that language. Takes the repo owner and name. +-- | With authentication +-- +-- > languagesFor' (Just (GithubUser (user, password))) "mike-burns" "ohlaunch" +languagesFor' :: Maybe GithubAuth -> String -> String -> IO (Either Error [Language]) +languagesFor' auth userName reqRepoName = do + result <- githubGet' auth ["repos", userName, reqRepoName, "languages"] return $ either Left (Right . getLanguages) result -- | The git tags on a repo, given the repo owner and name. -- -- > tagsFor "thoughtbot" "paperclip" tagsFor :: String -> String -> IO (Either Error [Tag]) -tagsFor userName reqRepoName = - githubGet ["repos", userName, reqRepoName, "tags"] +tagsFor = tagsFor' Nothing + +-- | The git tags on a repo, given the repo owner and name. +-- | With authentication +-- +-- > tagsFor' (Just (GithubUser (user, password))) "thoughtbot" "paperclip" +tagsFor' :: Maybe GithubAuth -> String -> String -> IO (Either Error [Tag]) +tagsFor' auth userName reqRepoName = + githubGet' auth ["repos", userName, reqRepoName, "tags"] -- | The git branches on a repo, given the repo owner and name. -- -- > branchesFor "thoughtbot" "paperclip" branchesFor :: String -> String -> IO (Either Error [Branch]) -branchesFor userName reqRepoName = - githubGet ["repos", userName, reqRepoName, "branches"] +branchesFor = branchesFor' Nothing + +-- | The git branches on a repo, given the repo owner and name. +-- | With authentication +-- +-- > branchesFor' (Just (GithubUser (user, password)))"thoughtbot" "paperclip" +branchesFor' :: Maybe GithubAuth -> String -> String -> IO (Either Error [Branch]) +branchesFor' auth userName reqRepoName = + githubGet' auth ["repos", userName, reqRepoName, "branches"] data NewRepo = NewRepo { From 6e50ce1c85447a79a7c5d30dbfb86f039568c14e Mon Sep 17 00:00:00 2001 From: Matt Giles Date: Sat, 3 May 2014 18:13:38 -0700 Subject: [PATCH 012/510] More authorized functions for Github.Repos: contributors', contributorsWithAnonymous' --- Github/Repos.hs | 27 +++++++++++++++++++++++---- 1 file changed, 23 insertions(+), 4 deletions(-) diff --git a/Github/Repos.hs b/Github/Repos.hs index b0447a29..a728e103 100644 --- a/Github/Repos.hs +++ b/Github/Repos.hs @@ -14,7 +14,9 @@ module Github.Repos ( ,organizationRepo ,organizationRepo' ,contributors +,contributors' ,contributorsWithAnonymous +,contributorsWithAnonymous' ,languagesFor ,languagesFor' ,tagsFor @@ -129,8 +131,15 @@ userRepo' auth userName reqRepoName = githubGet' auth ["repos", userName, reqRep -- -- > contributors "thoughtbot" "paperclip" contributors :: String -> String -> IO (Either Error [Contributor]) -contributors userName reqRepoName = - githubGet ["repos", userName, reqRepoName, "contributors"] +contributors = contributors' Nothing + +-- | The contributors to a repo, given the owner and repo name. +-- | With authentication +-- +-- > contributors' (Just (GithubUser (user, password))) "thoughtbot" "paperclip" +contributors' :: Maybe GithubAuth -> String -> String -> IO (Either Error [Contributor]) +contributors' auth userName reqRepoName = + githubGet' auth ["repos", userName, reqRepoName, "contributors"] -- | The contributors to a repo, including anonymous contributors (such as -- deleted users or git commits with unknown email addresses), given the owner @@ -138,11 +147,21 @@ contributors userName reqRepoName = -- -- > contributorsWithAnonymous "thoughtbot" "paperclip" contributorsWithAnonymous :: String -> String -> IO (Either Error [Contributor]) -contributorsWithAnonymous userName reqRepoName = - githubGetWithQueryString +contributorsWithAnonymous = contributorsWithAnonymous' Nothing + +-- | The contributors to a repo, including anonymous contributors (such as +-- deleted users or git commits with unknown email addresses), given the owner +-- and repo name. +-- | With authentication +-- +-- > contributorsWithAnonymous' (Just (GithubUser (user, password))) "thoughtbot" "paperclip" +contributorsWithAnonymous' :: Maybe GithubAuth -> String -> String -> IO (Either Error [Contributor]) +contributorsWithAnonymous' auth userName reqRepoName = + githubGetWithQueryString' auth ["repos", userName, reqRepoName, "contributors"] "anon=true" + -- | The programming languages used in a repo along with the number of -- characters written in that language. Takes the repo owner and name. -- From b3304c19fa7ea41529b156ff6ddfa05b5c361dfc Mon Sep 17 00:00:00 2001 From: Matt Giles Date: Sat, 3 May 2014 18:26:00 -0700 Subject: [PATCH 013/510] Fix typo in Haddock comment --- Github/Repos.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Github/Repos.hs b/Github/Repos.hs index a728e103..f3f27570 100644 --- a/Github/Repos.hs +++ b/Github/Repos.hs @@ -202,7 +202,7 @@ branchesFor = branchesFor' Nothing -- | The git branches on a repo, given the repo owner and name. -- | With authentication -- --- > branchesFor' (Just (GithubUser (user, password)))"thoughtbot" "paperclip" +-- > branchesFor' (Just (GithubUser (user, password))) "thoughtbot" "paperclip" branchesFor' :: Maybe GithubAuth -> String -> String -> IO (Either Error [Branch]) branchesFor' auth userName reqRepoName = githubGet' auth ["repos", userName, reqRepoName, "branches"] From c87537bd953baaffe76a67d326302a0db975d06f Mon Sep 17 00:00:00 2001 From: Matt Giles Date: Sat, 3 May 2014 18:34:50 -0700 Subject: [PATCH 014/510] Fix up "| With authentication" comments --- Github/Repos.hs | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/Github/Repos.hs b/Github/Repos.hs index f3f27570..e813f7b5 100644 --- a/Github/Repos.hs +++ b/Github/Repos.hs @@ -73,7 +73,7 @@ userRepos :: String -> RepoPublicity -> IO (Either Error [Repo]) userRepos = userRepos' Nothing -- | The repos for a user, by their login. --- | With authentication, but note that private repos are currently not supported. +-- With authentication, but note that private repos are currently not supported. -- -- > userRepos' (Just (GithubUser (user, password))) "mike-burns" All userRepos' :: Maybe GithubAuth -> String -> RepoPublicity -> IO (Either Error [Repo]) @@ -95,7 +95,7 @@ organizationRepos :: String -> IO (Either Error [Repo]) organizationRepos = organizationRepos' Nothing -- | The repos for an organization, by the organization name. --- | With authentication +-- With authentication. -- -- > organizationRepos (Just (GithubUser (user, password))) "thoughtbot" organizationRepos' :: Maybe GithubAuth -> String -> IO (Either Error [Repo]) @@ -108,7 +108,7 @@ organizationRepo :: String -> String -> IO (Either Error Repo) organizationRepo = organizationRepo' Nothing -- | A specific organization repo, by the organization name. --- | With authentication +-- With authentication. -- -- > organizationRepo (Just (GithubUser (user, password))) "thoughtbot" "github" organizationRepo' :: Maybe GithubAuth -> String -> String -> IO (Either Error Repo) @@ -121,7 +121,7 @@ userRepo :: String -> String -> IO (Either Error Repo) userRepo = userRepo' Nothing -- | Details on a specific repo, given the owner and repo name. --- | With authentication +-- With authentication. -- -- > userRepo' (Just (GithubUser (user, password))) "mike-burns" "github" userRepo' :: Maybe GithubAuth -> String -> String -> IO (Either Error Repo) @@ -134,7 +134,7 @@ contributors :: String -> String -> IO (Either Error [Contributor]) contributors = contributors' Nothing -- | The contributors to a repo, given the owner and repo name. --- | With authentication +-- With authentication. -- -- > contributors' (Just (GithubUser (user, password))) "thoughtbot" "paperclip" contributors' :: Maybe GithubAuth -> String -> String -> IO (Either Error [Contributor]) @@ -152,7 +152,7 @@ contributorsWithAnonymous = contributorsWithAnonymous' Nothing -- | The contributors to a repo, including anonymous contributors (such as -- deleted users or git commits with unknown email addresses), given the owner -- and repo name. --- | With authentication +-- With authentication. -- -- > contributorsWithAnonymous' (Just (GithubUser (user, password))) "thoughtbot" "paperclip" contributorsWithAnonymous' :: Maybe GithubAuth -> String -> String -> IO (Either Error [Contributor]) @@ -171,7 +171,7 @@ languagesFor = languagesFor' Nothing -- | The programming languages used in a repo along with the number of -- characters written in that language. Takes the repo owner and name. --- | With authentication +-- With authentication. -- -- > languagesFor' (Just (GithubUser (user, password))) "mike-burns" "ohlaunch" languagesFor' :: Maybe GithubAuth -> String -> String -> IO (Either Error [Language]) @@ -186,7 +186,7 @@ tagsFor :: String -> String -> IO (Either Error [Tag]) tagsFor = tagsFor' Nothing -- | The git tags on a repo, given the repo owner and name. --- | With authentication +-- With authentication. -- -- > tagsFor' (Just (GithubUser (user, password))) "thoughtbot" "paperclip" tagsFor' :: Maybe GithubAuth -> String -> String -> IO (Either Error [Tag]) @@ -200,7 +200,7 @@ branchesFor :: String -> String -> IO (Either Error [Branch]) branchesFor = branchesFor' Nothing -- | The git branches on a repo, given the repo owner and name. --- | With authentication +-- With authentication. -- -- > branchesFor' (Just (GithubUser (user, password))) "thoughtbot" "paperclip" branchesFor' :: Maybe GithubAuth -> String -> String -> IO (Either Error [Branch]) From 7fc39185bc7f90065da8c6e5324fdfc31440d1db Mon Sep 17 00:00:00 2001 From: Matt Giles Date: Sun, 4 May 2014 21:21:18 -0700 Subject: [PATCH 015/510] Github.Repos: Replace 'GithubUser' in haddock examples with 'GithubBasicAuth' --- Github/Repos.hs | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/Github/Repos.hs b/Github/Repos.hs index e813f7b5..9e42d45b 100644 --- a/Github/Repos.hs +++ b/Github/Repos.hs @@ -75,7 +75,7 @@ userRepos = userRepos' Nothing -- | The repos for a user, by their login. -- With authentication, but note that private repos are currently not supported. -- --- > userRepos' (Just (GithubUser (user, password))) "mike-burns" All +-- > userRepos' (Just (GithubBasicAuth (user, password))) "mike-burns" All userRepos' :: Maybe GithubAuth -> String -> RepoPublicity -> IO (Either Error [Repo]) userRepos' auth userName All = githubGetWithQueryString' auth ["users", userName, "repos"] "type=all" @@ -97,7 +97,7 @@ organizationRepos = organizationRepos' Nothing -- | The repos for an organization, by the organization name. -- With authentication. -- --- > organizationRepos (Just (GithubUser (user, password))) "thoughtbot" +-- > organizationRepos (Just (GithubBasicAuth (user, password))) "thoughtbot" organizationRepos' :: Maybe GithubAuth -> String -> IO (Either Error [Repo]) organizationRepos' auth orgName = githubGet' auth ["orgs", orgName, "repos"] @@ -110,7 +110,7 @@ organizationRepo = organizationRepo' Nothing -- | A specific organization repo, by the organization name. -- With authentication. -- --- > organizationRepo (Just (GithubUser (user, password))) "thoughtbot" "github" +-- > organizationRepo (Just (GithubBasicAuth (user, password))) "thoughtbot" "github" organizationRepo' :: Maybe GithubAuth -> String -> String -> IO (Either Error Repo) organizationRepo' auth orgName reqRepoName = githubGet' auth ["orgs", orgName, reqRepoName] @@ -123,7 +123,7 @@ userRepo = userRepo' Nothing -- | Details on a specific repo, given the owner and repo name. -- With authentication. -- --- > userRepo' (Just (GithubUser (user, password))) "mike-burns" "github" +-- > userRepo' (Just (GithubBasicAuth (user, password))) "mike-burns" "github" userRepo' :: Maybe GithubAuth -> String -> String -> IO (Either Error Repo) userRepo' auth userName reqRepoName = githubGet' auth ["repos", userName, reqRepoName] @@ -136,7 +136,7 @@ contributors = contributors' Nothing -- | The contributors to a repo, given the owner and repo name. -- With authentication. -- --- > contributors' (Just (GithubUser (user, password))) "thoughtbot" "paperclip" +-- > contributors' (Just (GithubBasicAuth (user, password))) "thoughtbot" "paperclip" contributors' :: Maybe GithubAuth -> String -> String -> IO (Either Error [Contributor]) contributors' auth userName reqRepoName = githubGet' auth ["repos", userName, reqRepoName, "contributors"] @@ -154,7 +154,7 @@ contributorsWithAnonymous = contributorsWithAnonymous' Nothing -- and repo name. -- With authentication. -- --- > contributorsWithAnonymous' (Just (GithubUser (user, password))) "thoughtbot" "paperclip" +-- > contributorsWithAnonymous' (Just (GithubBasicAuth (user, password))) "thoughtbot" "paperclip" contributorsWithAnonymous' :: Maybe GithubAuth -> String -> String -> IO (Either Error [Contributor]) contributorsWithAnonymous' auth userName reqRepoName = githubGetWithQueryString' auth @@ -173,7 +173,7 @@ languagesFor = languagesFor' Nothing -- characters written in that language. Takes the repo owner and name. -- With authentication. -- --- > languagesFor' (Just (GithubUser (user, password))) "mike-burns" "ohlaunch" +-- > languagesFor' (Just (GithubBasicAuth (user, password))) "mike-burns" "ohlaunch" languagesFor' :: Maybe GithubAuth -> String -> String -> IO (Either Error [Language]) languagesFor' auth userName reqRepoName = do result <- githubGet' auth ["repos", userName, reqRepoName, "languages"] @@ -188,7 +188,7 @@ tagsFor = tagsFor' Nothing -- | The git tags on a repo, given the repo owner and name. -- With authentication. -- --- > tagsFor' (Just (GithubUser (user, password))) "thoughtbot" "paperclip" +-- > tagsFor' (Just (GithubBasicAuth (user, password))) "thoughtbot" "paperclip" tagsFor' :: Maybe GithubAuth -> String -> String -> IO (Either Error [Tag]) tagsFor' auth userName reqRepoName = githubGet' auth ["repos", userName, reqRepoName, "tags"] @@ -202,7 +202,7 @@ branchesFor = branchesFor' Nothing -- | The git branches on a repo, given the repo owner and name. -- With authentication. -- --- > branchesFor' (Just (GithubUser (user, password))) "thoughtbot" "paperclip" +-- > branchesFor' (Just (GithubBasicAuth (user, password))) "thoughtbot" "paperclip" branchesFor' :: Maybe GithubAuth -> String -> String -> IO (Either Error [Branch]) branchesFor' auth userName reqRepoName = githubGet' auth ["repos", userName, reqRepoName, "branches"] @@ -242,14 +242,14 @@ newRepo name = NewRepo name Nothing Nothing Nothing Nothing Nothing Nothing -- | -- Create a new repository. -- --- > createRepo (GithubUser (user, password)) (newRepo "some_repo") {newRepoHasIssues = Just False} +-- > createRepo (GithubBasicAuth (user, password)) (newRepo "some_repo") {newRepoHasIssues = Just False} createRepo :: GithubAuth -> NewRepo -> IO (Either Error Repo) createRepo auth = githubPost auth ["user", "repos"] -- | -- Create a new repository for an organization. -- --- > createOrganizationRepo (GithubUser (user, password)) "thoughtbot" (newRepo "some_repo") {newRepoHasIssues = Just False} +-- > createOrganizationRepo (GithubBasicAuth (user, password)) "thoughtbot" (newRepo "some_repo") {newRepoHasIssues = Just False} createOrganizationRepo :: GithubAuth -> String -> NewRepo -> IO (Either Error Repo) createOrganizationRepo auth org = githubPost auth ["orgs", org, "repos"] @@ -287,7 +287,7 @@ instance ToJSON Edit where -- | -- Edit an existing repository. -- --- > editRepo (GithubUser (user, password)) "some_user" "some_repo" def {editDescription = Just "some description"} +-- > editRepo (GithubBasicAuth (user, password)) "some_user" "some_repo" def {editDescription = Just "some description"} editRepo :: GithubAuth -> String -- ^ owner -> String -- ^ repository name @@ -301,7 +301,7 @@ editRepo auth user repo body = githubPatch auth ["repos", user, repo] b -- | -- Delete an existing repository. -- --- > deleteRepo (GithubUser (user, password)) "thoughtbot" "some_repo" +-- > deleteRepo (GithubBasicAuth (user, password)) "thoughtbot" "some_repo" deleteRepo :: GithubAuth -> String -- ^ owner -> String -- ^ repository name From dc17f79ce7c3cc0229aca373693328f7bb562e2d Mon Sep 17 00:00:00 2001 From: Maxwell Swadling Date: Mon, 26 May 2014 20:11:32 +1000 Subject: [PATCH 016/510] Added Github.Auth module --- Github/Auth.hs | 4 ++++ Github/Issues.hs | 6 ------ Github/Issues/Comments.hs | 6 ------ Github/Repos.hs | 11 ----------- Github/Search.hs | 1 - github.cabal | 3 ++- 6 files changed, 6 insertions(+), 25 deletions(-) create mode 100644 Github/Auth.hs diff --git a/Github/Auth.hs b/Github/Auth.hs new file mode 100644 index 00000000..fa630c7d --- /dev/null +++ b/Github/Auth.hs @@ -0,0 +1,4 @@ +-- | The Github auth data type +module Github.Auth (P.GithubAuth(..)) where + +import qualified Github.Private as P diff --git a/Github/Issues.hs b/Github/Issues.hs index c603ec65..88bea3fa 100644 --- a/Github/Issues.hs +++ b/Github/Issues.hs @@ -6,12 +6,6 @@ module Github.Issues ( ,issuesForRepo ,issuesForRepo' ,IssueLimitation(..) - --- * Modifying Issues --- | --- Only authenticated users may create and edit issues. -,GithubAuth(..) - ,createIssue ,newIssue ,editIssue diff --git a/Github/Issues/Comments.hs b/Github/Issues/Comments.hs index 2d893a86..130e4291 100644 --- a/Github/Issues/Comments.hs +++ b/Github/Issues/Comments.hs @@ -4,12 +4,6 @@ module Github.Issues.Comments ( comment ,comments ,comments' - --- * Modifying Comments --- | --- Only authenticated users may create and edit comments. -,GithubAuth(..) - ,createComment ,editComment ,module Github.Data diff --git a/Github/Repos.hs b/Github/Repos.hs index 614ec207..bab02ed0 100644 --- a/Github/Repos.hs +++ b/Github/Repos.hs @@ -21,17 +21,6 @@ module Github.Repos ( ,module Github.Data ,RepoPublicity(..) --- * Modifying repositories --- | --- Only authenticated users may modify repositories. -,GithubAuth(..) - --- ** Create -,createRepo -,createOrganizationRepo -,newRepo -,NewRepo(..) - -- ** Edit ,editRepo ,def diff --git a/Github/Search.hs b/Github/Search.hs index 03664c30..41fe84a3 100644 --- a/Github/Search.hs +++ b/Github/Search.hs @@ -4,7 +4,6 @@ module Github.Search( searchRepos' ,searchRepos ,module Github.Data -,GithubAuth(..) ) where import Github.Data diff --git a/github.cabal b/github.cabal index bee2421c..e9cfafd8 100644 --- a/github.cabal +++ b/github.cabal @@ -113,7 +113,8 @@ source-repository head Library -- Modules exported by the library. - Exposed-modules: Github.Data, + Exposed-modules: Github.Auth, + Github.Data, Github.Data.Definitions, Github.Gists, Github.Gists.Comments, From 0d7a62f40103c0582e91aab80c72e162732b08d6 Mon Sep 17 00:00:00 2001 From: Maxwell Swadling Date: Mon, 26 May 2014 20:11:43 +1000 Subject: [PATCH 017/510] Added sandbox gitignores --- .gitignore | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.gitignore b/.gitignore index 821dfe03..c2d6fb91 100644 --- a/.gitignore +++ b/.gitignore @@ -1,2 +1,4 @@ dist *swp +.cabal-sandbox +cabal.sandbox.config From 786cff9982ca151b050bc9131870079eeecbab3c Mon Sep 17 00:00:00 2001 From: Maxwell Swadling Date: Mon, 26 May 2014 20:11:53 +1000 Subject: [PATCH 018/510] cleanup warnings --- Github/Data.hs | 2 +- Github/Private.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/Github/Data.hs b/Github/Data.hs index f9da6c47..f5887ce2 100644 --- a/Github/Data.hs +++ b/Github/Data.hs @@ -11,7 +11,6 @@ import Control.Applicative import Control.Monad import qualified Data.Text as T import Data.Aeson.Types -import Data.Monoid import System.Locale (defaultTimeLocale) import qualified Data.Vector as V import qualified Data.HashMap.Lazy as Map @@ -540,6 +539,7 @@ obj <.:> [key] = obj .: key obj <.:> (key:keys) = let (Object nextObj) = findWithDefault (Object Map.empty) key obj in nextObj <.:> keys +_ <.:> [] = fail "must have a pair" -- | Produce the value for the given key, maybe. at :: Object -> T.Text -> Maybe Value diff --git a/Github/Private.hs b/Github/Private.hs index 038d4952..8f11554a 100644 --- a/Github/Private.hs +++ b/Github/Private.hs @@ -12,7 +12,7 @@ import Data.List import Data.CaseInsensitive (mk) import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as LBS -import Network.HTTP.Types (Method, Status(..)) +import Network.HTTP.Types (Status(..)) import Network.HTTP.Conduit -- import Data.Conduit (ResourceT) import qualified Control.Exception as E From 60aa95a0f2ab0a73f06e267e2ef19ae65b9923bd Mon Sep 17 00:00:00 2001 From: Maxwell Swadling Date: Mon, 26 May 2014 20:24:29 +1000 Subject: [PATCH 019/510] Re-added missing imports --- Github/Repos.hs | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/Github/Repos.hs b/Github/Repos.hs index bab02ed0..704f6c08 100644 --- a/Github/Repos.hs +++ b/Github/Repos.hs @@ -21,6 +21,12 @@ module Github.Repos ( ,module Github.Data ,RepoPublicity(..) +-- ** Create +,createRepo +,createOrganizationRepo +,newRepo +,NewRepo(..) + -- ** Edit ,editRepo ,def From 539fe2c7e5694d67e5e9a632fe445058da59f13c Mon Sep 17 00:00:00 2001 From: Maxwell Swadling Date: Mon, 26 May 2014 20:26:49 +1000 Subject: [PATCH 020/510] Added responseTimeout --- Github/Private.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/Github/Private.hs b/Github/Private.hs index 8f11554a..97e515b4 100644 --- a/Github/Private.hs +++ b/Github/Private.hs @@ -115,6 +115,7 @@ doHttps reqMethod url auth body = do , secure = True , port = 443 , requestBody = reqBody + , responseTimeout = Just 20000000 , requestHeaders = reqHeaders <> [("User-Agent", "github.hs/0.7.4")] <> [("Accept", "application/vnd.github.preview")] From 8c200e3a9d43c44e7229422e7720bb5f60ea93aa Mon Sep 17 00:00:00 2001 From: Gabe Mulley Date: Sun, 20 Jul 2014 17:28:39 -0400 Subject: [PATCH 021/510] Allow for the mergeable attribute to be null for detailed pull requests --- Github/Data.hs | 2 +- Github/Data/Definitions.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/Github/Data.hs b/Github/Data.hs index f5887ce2..31786823 100644 --- a/Github/Data.hs +++ b/Github/Data.hs @@ -382,7 +382,7 @@ instance FromJSON DetailedPullRequest where <*> o .: "base" <*> o .: "commits" <*> o .: "merged" - <*> o .: "mergeable" + <*> o .:? "mergeable" parseJSON _ = fail "Could not build a DetailedPullRequest" instance FromJSON PullRequestLinks where diff --git a/Github/Data/Definitions.hs b/Github/Data/Definitions.hs index acf65e17..64238bc4 100644 --- a/Github/Data/Definitions.hs +++ b/Github/Data/Definitions.hs @@ -351,7 +351,7 @@ data DetailedPullRequest = DetailedPullRequest { ,detailedPullRequestBase :: PullRequestCommit ,detailedPullRequestCommits :: Int ,detailedPullRequestMerged :: Bool - ,detailedPullRequestMergeable :: Bool + ,detailedPullRequestMergeable :: Maybe Bool } deriving (Show, Data, Typeable, Eq, Ord) data PullRequestLinks = PullRequestLinks { From 270dd22c37c3879c16aca45ab04c89eb16094d93 Mon Sep 17 00:00:00 2001 From: Calen Pennington Date: Tue, 22 Jul 2014 13:33:55 -0400 Subject: [PATCH 022/510] Parse PullRequestCommit objects --- Github/Data.hs | 8 ++++++-- Github/Data/Definitions.hs | 5 +++++ 2 files changed, 11 insertions(+), 2 deletions(-) diff --git a/Github/Data.hs b/Github/Data.hs index f5887ce2..c75fea44 100644 --- a/Github/Data.hs +++ b/Github/Data.hs @@ -394,8 +394,12 @@ instance FromJSON PullRequestLinks where parseJSON _ = fail "Could not build a PullRequestLinks" instance FromJSON PullRequestCommit where - parseJSON (Object _) = - return PullRequestCommit + parseJSON (Object o) = + PullRequestCommit <$> o .: "label" + <*> o .: "ref" + <*> o .: "sha" + <*> o .: "user" + <*> o .: "repo" parseJSON _ = fail "Could not build a PullRequestCommit" instance FromJSON SearchReposResult where diff --git a/Github/Data/Definitions.hs b/Github/Data/Definitions.hs index acf65e17..5ed41da1 100644 --- a/Github/Data/Definitions.hs +++ b/Github/Data/Definitions.hs @@ -362,6 +362,11 @@ data PullRequestLinks = PullRequestLinks { } deriving (Show, Data, Typeable, Eq, Ord) data PullRequestCommit = PullRequestCommit { + pullRequestCommitLabel :: String + ,pullRequestCommitRef :: String + ,pullRequestCommitSha :: String + ,pullRequestCommitUser :: GithubOwner + ,pullRequestCommitRepo :: Repo } deriving (Show, Data, Typeable, Eq, Ord) data SearchReposResult = SearchReposResult { From 87e737efe79962b93b994cfc5e78d98df30b7a86 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9sar=20L=C3=B3pez-Natar=C3=A9n?= Date: Sat, 14 Jun 2014 23:18:14 -0700 Subject: [PATCH 023/510] Implement the Webhooks API --- .gitignore | 5 + Github/Data.hs | 22 ++++ Github/Data/Definitions.hs | 21 ++++ Github/Private.hs | 23 ++++- Github/Repos/Webhooks.hs | 116 ++++++++++++++++++++++ github.cabal | 8 ++ samples/Repos/Webhooks/CreateWebhook.hs | 24 +++++ samples/Repos/Webhooks/DeleteWebhook.hs | 12 +++ samples/Repos/Webhooks/EditWebhook.hs | 23 +++++ samples/Repos/Webhooks/ListWebhook.hs | 16 +++ samples/Repos/Webhooks/ListWebhooks.hs | 17 ++++ samples/Repos/Webhooks/PingWebhook.hs | 12 +++ samples/Repos/Webhooks/TestPushWebhook.hs | 12 +++ 13 files changed, 310 insertions(+), 1 deletion(-) create mode 100644 Github/Repos/Webhooks.hs create mode 100644 samples/Repos/Webhooks/CreateWebhook.hs create mode 100644 samples/Repos/Webhooks/DeleteWebhook.hs create mode 100644 samples/Repos/Webhooks/EditWebhook.hs create mode 100644 samples/Repos/Webhooks/ListWebhook.hs create mode 100644 samples/Repos/Webhooks/ListWebhooks.hs create mode 100644 samples/Repos/Webhooks/PingWebhook.hs create mode 100644 samples/Repos/Webhooks/TestPushWebhook.hs diff --git a/.gitignore b/.gitignore index c2d6fb91..ad17ab3e 100644 --- a/.gitignore +++ b/.gitignore @@ -2,3 +2,8 @@ dist *swp .cabal-sandbox cabal.sandbox.config +*flymake* +*.#* +*~ +*.hi +*.o diff --git a/Github/Data.hs b/Github/Data.hs index 8033a37d..f42b78dd 100644 --- a/Github/Data.hs +++ b/Github/Data.hs @@ -437,6 +437,7 @@ instance FromJSON Repo where <*> o .:? "has_downloads" <*> o .:? "parent" <*> o .:? "source" + <*> o .: "hooks_url" parseJSON _ = fail "Could not build a Repo" instance FromJSON RepoRef where @@ -523,6 +524,27 @@ instance FromJSON DetailedOwner where <*> o .: "login" parseJSON _ = fail "Could not build a DetailedOwner" +instance FromJSON RepoWebhook where + parseJSON (Object o) = + RepoWebhook <$> o .: "url" + <*> o .: "test_url" + <*> o .: "id" + <*> o .: "name" + <*> o .: "active" + <*> o .: "events" + <*> o .: "config" + <*> o .: "last_response" + <*> o .: "updated_at" + <*> o .: "created_at" + parseJSON _ = fail "Could not build a RepoWebhook" + +instance FromJSON RepoWebhookResponse where + parseJSON (Object o) = + RepoWebhookResponse <$> o .: "code" + <*> o .: "status" + <*> o .: "message" + parseJSON _ = fail "Could not build a RepoWebhookResponse" + -- | A slightly more generic version of Aeson's @(.:?)@, using `mzero' instead -- of `Nothing'. diff --git a/Github/Data/Definitions.hs b/Github/Data/Definitions.hs index 2f92c0ad..0f5e28e6 100644 --- a/Github/Data/Definitions.hs +++ b/Github/Data/Definitions.hs @@ -5,6 +5,7 @@ module Github.Data.Definitions where import Data.Time import Data.Data import qualified Control.Exception as E +import qualified Data.Map as M -- | Errors have been tagged according to their source, so you can more easily -- dispatch and handle them. @@ -402,6 +403,7 @@ data Repo = Repo { ,repoHasDownloads :: Maybe Bool ,repoParent :: Maybe RepoRef ,repoSource :: Maybe RepoRef + ,repoHooksUrl :: String } deriving (Show, Data, Typeable, Eq, Ord) data RepoRef = RepoRef GithubOwner String -- Repo owner and name @@ -480,3 +482,22 @@ data DetailedOwner = DetailedUser { ,detailedOwnerHtmlUrl :: String ,detailedOwnerLogin :: String } deriving (Show, Data, Typeable, Eq, Ord) + +data RepoWebhook = RepoWebhook { + repoWebhookUrl :: String + ,repoWebhookTestUrl :: String + ,repoWebhookId :: Integer + ,repoWebhookName :: String + ,repoWebhookActive :: Bool + ,repoWebhookEvents :: [String] + ,repoWebhookConfig :: M.Map String String + ,repoWebhookLastResponse :: RepoWebhookResponse + ,repoWebhookUpdatedAt :: GithubDate + ,repoWebhookCreatedAt :: GithubDate +} deriving (Show, Data, Typeable, Eq, Ord) + +data RepoWebhookResponse = RepoWebhookResponse { + repoWebhookResponseCode :: Maybe Int + ,repoWebhookResponseStatus :: String + ,repoWebhookResponseMessage :: Maybe String +} deriving (Show, Data, Typeable, Eq, Ord) diff --git a/Github/Private.hs b/Github/Private.hs index 97e515b4..d448a1b7 100644 --- a/Github/Private.hs +++ b/Github/Private.hs @@ -12,7 +12,7 @@ import Data.List import Data.CaseInsensitive (mk) import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as LBS -import Network.HTTP.Types (Status(..)) +import Network.HTTP.Types (Status(..), notFound404) import Network.HTTP.Conduit -- import Data.Conduit (ResourceT) import qualified Control.Exception as E @@ -150,6 +150,27 @@ doHttps reqMethod url auth body = do | otherwise = Just $ E.toException $ StatusCodeException s hs #endif +doHttpsStatus :: BS.ByteString -> String -> GithubAuth -> Maybe RequestBody -> IO (Either Error Status) +doHttpsStatus reqMethod url auth payload = do + result <- doHttps reqMethod url (Just auth) payload + case result of + Left e -> return (Left (HTTPConnectionError e)) + Right resp -> + let status = responseStatus resp + headers = responseHeaders resp + in if status == notFound404 + -- doHttps silently absorbs 404 errors, but for this operation + -- we want the user to know if they've tried to delete a + -- non-existent repository + then return (Left (HTTPConnectionError + (E.toException + (StatusCodeException status headers +#if MIN_VERSION_http_conduit(1, 9, 0) + (responseCookieJar resp) +#endif + )))) + else return (Right status) + parseJsonRaw :: LBS.ByteString -> Either Error Value parseJsonRaw jsonString = let parsed = parse json jsonString in diff --git a/Github/Repos/Webhooks.hs b/Github/Repos/Webhooks.hs new file mode 100644 index 00000000..94bb0253 --- /dev/null +++ b/Github/Repos/Webhooks.hs @@ -0,0 +1,116 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE CPP #-} +-- | The webhooks API, as described at +-- +-- + +module Github.Repos.Webhooks ( + +-- * Querying repositories + webhooksFor' + ,webhookFor' + +-- ** Create + ,createRepoWebhook' + +-- ** Edit + ,editRepoWebhook' + +-- ** Test + ,testPushRepoWebhook' + ,pingRepoWebhook' + +-- ** Delete + ,deleteRepoWebhook' + ,NewRepoWebhook(..) + ,EditRepoWebhook(..) + ,RepoOwner + ,RepoName + ,RepoWebhookId +) where + +import Github.Data +import Github.Private +import qualified Data.Map as M +import Network.HTTP.Conduit +import Network.HTTP.Types +import Data.Aeson + +type RepoOwner = String +type RepoName = String +type RepoWebhookId = Int + +data NewRepoWebhook = NewRepoWebhook { + newRepoWebhookName :: String + ,newRepoWebhookConfig :: M.Map String String + ,newRepoWebhookEvents :: Maybe [String] + ,newRepoWebhookActive :: Maybe Bool +} deriving Show + +data EditRepoWebhook = EditRepoWebhook { + editRepoWebhookConfig :: Maybe (M.Map String String) + ,editRepoWebhookEvents :: Maybe [String] + ,editRepoWebhookAddEvents :: Maybe [String] + ,editRepoWebhookRemoveEvents :: Maybe [String] + ,editRepoWebhookActive :: Maybe Bool +} deriving Show + +instance ToJSON NewRepoWebhook where + toJSON (NewRepoWebhook { newRepoWebhookName = name + , newRepoWebhookConfig = config + , newRepoWebhookEvents = events + , newRepoWebhookActive = active + + }) = object + [ "name" .= name + , "config" .= config + , "events" .= events + , "active" .= active + ] + +instance ToJSON EditRepoWebhook where + toJSON (EditRepoWebhook { editRepoWebhookConfig = config + , editRepoWebhookEvents = events + , editRepoWebhookAddEvents = addEvents + , editRepoWebhookRemoveEvents = removeEvents + , editRepoWebhookActive = active + }) = object + [ "config" .= config + , "events" .= events + , "add_events" .= addEvents + , "remove_events" .= removeEvents + , "active" .= active + ] + +webhooksFor' :: GithubAuth -> RepoOwner -> RepoName -> IO (Either Error [RepoWebhook]) +webhooksFor' auth owner reqRepoName = + githubGet' (Just auth) ["repos", owner, reqRepoName, "hooks"] + +webhookFor' :: GithubAuth -> RepoOwner -> RepoName -> RepoWebhookId -> IO (Either Error RepoWebhook) +webhookFor' auth owner reqRepoName webhookId = + githubGet' (Just auth) ["repos", owner, reqRepoName, "hooks", (show webhookId)] + +createRepoWebhook' :: GithubAuth -> RepoOwner -> RepoName -> NewRepoWebhook -> IO (Either Error RepoWebhook) +createRepoWebhook' auth owner reqRepoName = githubPost auth ["repos", owner, reqRepoName, "hooks"] + +editRepoWebhook' :: GithubAuth -> RepoOwner -> RepoName -> RepoWebhookId -> EditRepoWebhook -> IO (Either Error RepoWebhook) +editRepoWebhook' auth owner reqRepoName webhookId edit = githubPatch auth ["repos", owner, reqRepoName, "hooks", (show webhookId)] edit + +testPushRepoWebhook' :: GithubAuth -> RepoOwner -> RepoName -> RepoWebhookId -> IO (Either Error Status) +testPushRepoWebhook' auth owner reqRepoName webhookId = + doHttpsStatus "POST" (createWebhookOpUrl owner reqRepoName webhookId (Just "tests")) auth (Just . RequestBodyLBS . encode $ (decode "{}" :: Maybe (M.Map String Int))) + +pingRepoWebhook' :: GithubAuth -> RepoOwner -> RepoName -> RepoWebhookId -> IO (Either Error Status) +pingRepoWebhook' auth owner reqRepoName webhookId = + doHttpsStatus "POST" (createWebhookOpUrl owner reqRepoName webhookId (Just "pings")) auth Nothing + +deleteRepoWebhook' :: GithubAuth -> RepoOwner -> RepoName -> RepoWebhookId -> IO (Either Error Status) +deleteRepoWebhook' auth owner reqRepoName webhookId = + doHttpsStatus "DELETE" (createWebhookOpUrl owner reqRepoName webhookId Nothing) auth Nothing + +createBaseWebhookUrl :: RepoOwner -> RepoName -> RepoWebhookId -> String +createBaseWebhookUrl owner reqRepoName webhookId = "https://api.github.com/repos/" ++ owner ++ "/" ++ reqRepoName ++ "/hooks/" ++ (show webhookId) + +createWebhookOpUrl :: RepoOwner -> RepoName -> RepoWebhookId -> Maybe String -> String +createWebhookOpUrl owner reqRepoName webhookId Nothing = createBaseWebhookUrl owner reqRepoName webhookId +createWebhookOpUrl owner reqRepoName webhookId (Just operation) = createBaseWebhookUrl owner reqRepoName webhookId ++ "/" ++ operation diff --git a/github.cabal b/github.cabal index e9cfafd8..dcdd5b93 100644 --- a/github.cabal +++ b/github.cabal @@ -98,6 +98,13 @@ Extra-source-files: README.md ,samples/Repos/Watching/ListWatched.hs ,samples/Repos/Watching/ListWatchers.hs ,samples/Repos/Starring/ListStarred.hs + ,samples/Repos/Webhooks/CreateWebhook.hs + ,samples/Repos/Webhooks/DeleteWebhook.hs + ,samples/Repos/Webhooks/EditWebhook.hs + ,samples/Repos/Webhooks/ListWebhook.hs + ,samples/Repos/Webhooks/ListWebhooks.hs + ,samples/Repos/Webhooks/PingWebhook.hs + ,samples/Repos/Webhooks/TestPushWebhook.hs ,samples/Users/Followers/ListFollowers.hs ,samples/Users/Followers/ListFollowing.hs ,samples/Users/ShowUser.hs @@ -136,6 +143,7 @@ Library Github.Repos.Forks, Github.Repos.Watching, Github.Repos.Starring, + Github.Repos.Webhooks Github.Users, Github.Users.Followers Github.Search diff --git a/samples/Repos/Webhooks/CreateWebhook.hs b/samples/Repos/Webhooks/CreateWebhook.hs new file mode 100644 index 00000000..cb100586 --- /dev/null +++ b/samples/Repos/Webhooks/CreateWebhook.hs @@ -0,0 +1,24 @@ +module CreateWebhook where + +import Github.Repos.Webhooks +import qualified Github.Auth as Auth +import Github.Data.Definitions +import qualified Data.Map as M + +main :: IO () +main = do + let auth = Auth.GithubOAuth "oauthtoken" + let config = M.fromList [("url", "https://foo3.io"), ("content_type", "application/json"), ("insecure_ssl", "1")] + let webhookDef = NewRepoWebhook { + newRepoWebhookName = "web", + newRepoWebhookConfig = config, + newRepoWebhookEvents = Just ["*"], + newRepoWebhookActive = Just True + } + newWebhook <- createRepoWebhook' auth "repoOwner" "repoName" webhookDef + case newWebhook of + (Left err) -> putStrLn $ "Error: " ++ (show err) + (Right webhook) -> putStrLn $ formatRepoWebhook webhook + +formatRepoWebhook :: RepoWebhook -> String +formatRepoWebhook (RepoWebhook _ _ _ name _ _ _ _ _ _) = show name diff --git a/samples/Repos/Webhooks/DeleteWebhook.hs b/samples/Repos/Webhooks/DeleteWebhook.hs new file mode 100644 index 00000000..aa525828 --- /dev/null +++ b/samples/Repos/Webhooks/DeleteWebhook.hs @@ -0,0 +1,12 @@ +module DeleteWebhook where + +import Github.Repos.Webhooks +import qualified Github.Auth as Auth + +main :: IO () +main = do + let auth = Auth.GithubOAuth "oauthtoken" + resp <- deleteRepoWebhook' auth "repoOwner" "repoName" 123 + case resp of + (Left err) -> putStrLn $ "Error: " ++ (show err) + (Right stat) -> putStrLn $ "Resp: " ++ (show stat) diff --git a/samples/Repos/Webhooks/EditWebhook.hs b/samples/Repos/Webhooks/EditWebhook.hs new file mode 100644 index 00000000..25844388 --- /dev/null +++ b/samples/Repos/Webhooks/EditWebhook.hs @@ -0,0 +1,23 @@ +module EditWebhook where + +import Github.Repos.Webhooks +import qualified Github.Auth as Auth +import Github.Data.Definitions + +main :: IO () +main = do + let auth = Auth.GithubOAuth "oauthtoken" + let editWebhookDef = EditRepoWebhook { + editRepoWebhookRemoveEvents = Just ["*"], + editRepoWebhookAddEvents = Just ["commit_comment"], + editRepoWebhookConfig = Nothing, + editRepoWebhookEvents = Nothing, + editRepoWebhookActive = Just True + } + newWebhook <- editRepoWebhook' auth "repoOwner" "repoName" 123 editWebhookDef + case newWebhook of + (Left err) -> putStrLn $ "Error: " ++ (show err) + (Right webhook) -> putStrLn $ formatRepoWebhook webhook + +formatRepoWebhook :: RepoWebhook -> String +formatRepoWebhook (RepoWebhook _ _ _ name _ _ _ _ _ _) = show name diff --git a/samples/Repos/Webhooks/ListWebhook.hs b/samples/Repos/Webhooks/ListWebhook.hs new file mode 100644 index 00000000..58ea3d9d --- /dev/null +++ b/samples/Repos/Webhooks/ListWebhook.hs @@ -0,0 +1,16 @@ +module ListWebhook where + +import qualified Github.Repos.Webhooks as W +import qualified Github.Auth as Auth +import qualified Github.Data.Definitions as Def + +main :: IO () +main = do + let auth = Auth.GithubOAuth "oauthtoken" + possibleWebhook <- W.webhookFor' auth "repoOwner" "repoName" 123 + case possibleWebhook of + (Left err) -> putStrLn $ "Error: " ++ (show err) + (Right webhook) -> putStrLn $ formatRepoWebhook webhook + +formatRepoWebhook :: Def.RepoWebhook -> String +formatRepoWebhook (Def.RepoWebhook _ _ _ name _ _ _ _ _ _) = show name diff --git a/samples/Repos/Webhooks/ListWebhooks.hs b/samples/Repos/Webhooks/ListWebhooks.hs new file mode 100644 index 00000000..9d34ab89 --- /dev/null +++ b/samples/Repos/Webhooks/ListWebhooks.hs @@ -0,0 +1,17 @@ +module ListWebhooks where + +import qualified Github.Repos.Webhooks as W +import qualified Github.Auth as Auth +import qualified Github.Data.Definitions as Def +import Data.List + +main :: IO () +main = do + let auth = Auth.GithubOAuth "oauthtoken" + possibleWebhooks <- W.webhooksFor' auth "repoOwner" "repoName" + case possibleWebhooks of + (Left err) -> putStrLn $ "Error: " ++ (show err) + (Right webhooks) -> putStrLn $ intercalate "\n" $ map formatRepoWebhook webhooks + +formatRepoWebhook :: Def.RepoWebhook -> String +formatRepoWebhook (Def.RepoWebhook _ _ _ name _ _ _ _ _ _) = show name diff --git a/samples/Repos/Webhooks/PingWebhook.hs b/samples/Repos/Webhooks/PingWebhook.hs new file mode 100644 index 00000000..3735f1d7 --- /dev/null +++ b/samples/Repos/Webhooks/PingWebhook.hs @@ -0,0 +1,12 @@ +module PingWebhook where + +import Github.Repos.Webhooks +import qualified Github.Auth as Auth + +main :: IO () +main = do + let auth = Auth.GithubOAuth "oauthtoken" + resp <- pingRepoWebhook' auth "repoOwner" "repoName" 123 + case resp of + (Left err) -> putStrLn $ "Error: " ++ (show err) + (Right stat) -> putStrLn $ "Resp: " ++ (show stat) diff --git a/samples/Repos/Webhooks/TestPushWebhook.hs b/samples/Repos/Webhooks/TestPushWebhook.hs new file mode 100644 index 00000000..00d65cd0 --- /dev/null +++ b/samples/Repos/Webhooks/TestPushWebhook.hs @@ -0,0 +1,12 @@ +module TestPushWebhook where + +import Github.Repos.Webhooks +import qualified Github.Auth as Auth + +main :: IO () +main = do + let auth = Auth.GithubOAuth "oauthtoken" + resp <- testPushRepoWebhook' auth "repoOwner" "repoName" 123 + case resp of + (Left err) -> putStrLn $ "Error: " ++ (show err) + (Right stat) -> putStrLn $ "Resp: " ++ (show stat) From efc079d409fa90eaca4cb97b8efc548585d44cce Mon Sep 17 00:00:00 2001 From: Hrushikesh Date: Sun, 30 Jun 2013 14:46:44 -0700 Subject: [PATCH 024/510] (minor) fix some links in README.md Conflicts: README.md --- README.md | 15 +++++++++++---- 1 file changed, 11 insertions(+), 4 deletions(-) diff --git a/README.md b/README.md index dd411cf0..a9212ee1 100644 --- a/README.md +++ b/README.md @@ -22,18 +22,22 @@ Or from the command line: Example Usage ============= -See the samples in the [samples/](https://github.com/fpco/github/tree/master/samples) directory. +See the samples in the +[samples/](https://github.com/fpco/github/tree/master/samples) directory. Documentation ============= For details see the reference documentation on Hackage. -Each module lines up with the hierarchy of [documentation from the Github API](http://developer.github.com/v3/). +Each module lines up with the hierarchy of +[documentation from the Github API](http://developer.github.com/v3/). Each function has a sample written for it. -All functions produce an `IO (Either Error a)`, where `a` is the actual thing you want. You must call the function using IO goodness, then dispatch on the possible error message. Here's an example from the samples: +All functions produce an `IO (Either Error a)`, where `a` is the actual thing +you want. You must call the function using IO goodness, then dispatch on the +possible error message. Here's an example from the samples: import qualified Github.Users.Followers as Github import Data.List (intercalate) @@ -49,11 +53,14 @@ All functions produce an `IO (Either Error a)`, where `a` is the actual thing yo Contributions ============= -Please see [CONTRIBUTING.md](https://github.com/fpco/github/blob/master/CONTRIBUTING.md) for details on how you can help. +Please see +[CONTRIBUTING.md](https://github.com/fpco/github/blob/master/CONTRIBUTING.md) +for details on how you can help. Copyright ========= Copyright 2011, 2012 Mike Burns. +Copyright 2013-2014 John Wiegley. Available under the BSD 3-clause license. From bf642048127d411cf29c75921b694edb1ae961e3 Mon Sep 17 00:00:00 2001 From: Gabe Mulley Date: Sat, 26 Jul 2014 14:12:36 -0400 Subject: [PATCH 025/510] Support webhook events --- Github/Data.hs | 23 +++++++++++++++++++++++ Github/Data/Definitions.hs | 21 +++++++++++++++++++++ Github/Events.hs | 13 +++++++++++++ github.cabal | 1 + 4 files changed, 58 insertions(+) create mode 100644 Github/Events.hs diff --git a/Github/Data.hs b/Github/Data.hs index 0847d5d1..03433c7b 100644 --- a/Github/Data.hs +++ b/Github/Data.hs @@ -402,6 +402,29 @@ instance FromJSON PullRequestCommit where <*> o .: "repo" parseJSON _ = fail "Could not build a PullRequestCommit" +instance FromJSON PullRequestEvent where + parseJSON (Object o) = + PullRequestEvent <$> o .: "action" + <*> o .: "number" + <*> o .: "pull_request" + <*> o .: "repository" + <*> o .: "sender" + parseJSON _ = fail "Could not build a PullRequestEvent" + +instance FromJSON PullRequestEventType where + parseJSON (String "opened") = pure PullRequestOpened + parseJSON (String "closed") = pure PullRequestClosed + parseJSON (String "synchronize") = pure PullRequestSynchronized + parseJSON (String "reopened") = pure PullRequestReopened + parseJSON _ = fail "Could not build a PullRequestEventType" + +instance FromJSON PingEvent where + parseJSON (Object o) = + PingEvent <$> o .: "zen" + <*> o .: "hook" + <*> o .: "hook_id" + parseJSON _ = fail "Could not build a PingEvent" + instance FromJSON SearchReposResult where parseJSON (Object o) = SearchReposResult <$> o .: "total_count" diff --git a/Github/Data/Definitions.hs b/Github/Data/Definitions.hs index a40c753d..a41c153c 100644 --- a/Github/Data/Definitions.hs +++ b/Github/Data/Definitions.hs @@ -501,3 +501,24 @@ data RepoWebhookResponse = RepoWebhookResponse { ,repoWebhookResponseStatus :: String ,repoWebhookResponseMessage :: Maybe String } deriving (Show, Data, Typeable, Eq, Ord) + +data PullRequestEvent = PullRequestEvent { + pullRequestEventAction :: PullRequestEventType + ,pullRequestEventNumber :: Int + ,pullRequestEventPullRequest :: DetailedPullRequest + ,pullRequestRepository :: Repo + ,pullRequestSender :: GithubOwner +} deriving (Show, Data, Typeable, Eq, Ord) + +data PullRequestEventType = + PullRequestOpened + | PullRequestClosed + | PullRequestSynchronized + | PullRequestReopened + deriving (Show, Data, Typeable, Eq, Ord) + +data PingEvent = PingEvent { + pingEventZen :: String + ,pingEventHook :: RepoWebhook + ,pingEventHookId :: Int +} deriving (Show, Data, Typeable, Eq, Ord) diff --git a/Github/Events.hs b/Github/Events.hs new file mode 100644 index 00000000..62e492d6 --- /dev/null +++ b/Github/Events.hs @@ -0,0 +1,13 @@ +module Github.Events ( + parseEvent +) where + +import qualified Data.ByteString.Lazy.Char8 as LBS + +import Data.Aeson (FromJSON) + +import Github.Data.Definitions (Error(..)) +import Github.Private (parseJson) + +parseEvent :: (FromJSON b, Show b) => LBS.ByteString -> Either Error b +parseEvent = parseJson diff --git a/github.cabal b/github.cabal index dcdd5b93..fc97563a 100644 --- a/github.cabal +++ b/github.cabal @@ -123,6 +123,7 @@ Library Exposed-modules: Github.Auth, Github.Data, Github.Data.Definitions, + Github.Events, Github.Gists, Github.Gists.Comments, Github.GitData.Commits, From dadd2ddc80d28ddacd3f070c5aba57eabfc9cd63 Mon Sep 17 00:00:00 2001 From: Calen Pennington Date: Sat, 26 Jul 2014 12:17:12 -0400 Subject: [PATCH 026/510] Add access to repo content api --- Github/Data.hs | 20 +++++++++++++++++++- Github/Data/Definitions.hs | 16 ++++++++++++++++ Github/Repos.hs | 18 ++++++++++++++++++ 3 files changed, 53 insertions(+), 1 deletion(-) diff --git a/Github/Data.hs b/Github/Data.hs index 0847d5d1..a348d265 100644 --- a/Github/Data.hs +++ b/Github/Data.hs @@ -544,7 +544,25 @@ instance FromJSON RepoWebhookResponse where <*> o .: "status" <*> o .: "message" parseJSON _ = fail "Could not build a RepoWebhookResponse" - + +instance FromJSON Content where + parseJSON o@(Object _) = ContentFile <$> parseJSON o + parseJSON (Array os) = ContentDirectory <$> (mapM parseJSON $ V.toList os) + parseJSON _ = fail "Could not build a Content" + +instance FromJSON ContentData where + parseJSON (Object o) = + ContentData <$> o .: "type" + <*> o .: "encoding" + <*> o .: "size" + <*> o .: "name" + <*> o .: "path" + <*> o .: "content" + <*> o .: "sha" + <*> o .: "url" + <*> o .: "git_url" + <*> o .: "html_url" + parseJSON _ = fail "Could not build a ContentData" -- | A slightly more generic version of Aeson's @(.:?)@, using `mzero' instead -- of `Nothing'. diff --git a/Github/Data/Definitions.hs b/Github/Data/Definitions.hs index a40c753d..afab8d78 100644 --- a/Github/Data/Definitions.hs +++ b/Github/Data/Definitions.hs @@ -409,6 +409,22 @@ data Repo = Repo { data RepoRef = RepoRef GithubOwner String -- Repo owner and name deriving (Show, Data, Typeable, Eq, Ord) +data Content = ContentFile ContentData | ContentDirectory [ContentData] + deriving (Show, Data, Typeable, Eq, Ord) + +data ContentData = ContentData { + contentType :: String + ,contentEncoding :: String + ,contentSize :: Int + ,contentName :: String + ,contentPath :: String + ,contentData :: String + ,contentSha :: String + ,contentUrl :: String + ,contentGitUrl :: String + ,contentHtmlUrl :: String +} deriving (Show, Data, Typeable, Eq, Ord) + data Contributor -- | An existing Github user, with their number of contributions, avatar -- URL, login, URL, ID, and Gravatar ID. diff --git a/Github/Repos.hs b/Github/Repos.hs index fc855770..110d00cb 100644 --- a/Github/Repos.hs +++ b/Github/Repos.hs @@ -23,6 +23,8 @@ module Github.Repos ( ,tagsFor' ,branchesFor ,branchesFor' +,contentsFor +,contentsFor' ,module Github.Data ,RepoPublicity(..) @@ -202,6 +204,22 @@ branchesFor' :: Maybe GithubAuth -> String -> String -> IO (Either Error [Branch branchesFor' auth userName reqRepoName = githubGet' auth ["repos", userName, reqRepoName, "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 :: String -> String -> String -> Maybe String -> 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 (GithubBasicAuth (user, password))) "thoughtbot" "paperclip" "README.md" +contentsFor' :: Maybe GithubAuth -> String -> String -> String -> Maybe String -> IO (Either Error Content) +contentsFor' auth userName repoName path ref = + githubGetWithQueryString' auth + ["repos", userName, repoName, "contents", path] $ + maybe "" ("ref="++) ref + data NewRepo = NewRepo { newRepoName :: String From d533d39ed80e24170451d340b6a39dd86d35aff5 Mon Sep 17 00:00:00 2001 From: John Wiegley Date: Thu, 31 Jul 2014 16:31:36 -0500 Subject: [PATCH 027/510] Bump version to 0.9 --- github.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/github.cabal b/github.cabal index fc97563a..52dda642 100644 --- a/github.cabal +++ b/github.cabal @@ -7,7 +7,7 @@ Name: github -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented. -Version: 0.8 +Version: 0.9 -- A short (one-line) description of the package. Synopsis: Access to the Github API, v3. From 2c02d1011063a1e516079791377082535b4d4960 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9sar=20L=C3=B3pez-Natar=C3=A9n?= Date: Thu, 31 Jul 2014 23:19:45 -0700 Subject: [PATCH 028/510] Implement merging a pull request --- Github/Private.hs | 8 +++++--- Github/PullRequests.hs | 21 +++++++++++++++++++++ Github/Repos.hs | 4 ++-- samples/Pulls/IsMergedPull.hs | 11 +++++++++++ samples/Pulls/MergePull.hs | 11 +++++++++++ 5 files changed, 50 insertions(+), 5 deletions(-) create mode 100644 samples/Pulls/IsMergedPull.hs create mode 100644 samples/Pulls/MergePull.hs diff --git a/Github/Private.hs b/Github/Private.hs index d448a1b7..3ede8800 100644 --- a/Github/Private.hs +++ b/Github/Private.hs @@ -104,9 +104,11 @@ githubAPI apimethod url auth body = do in Just (Data.List.takeWhile (/= '>') s') else Nothing --- doHttps :: Method -> String -> Maybe GithubAuth --- -> Maybe (RequestBody (ResourceT IO)) --- -> IO (Either E.SomeException (Response LBS.ByteString)) +doHttps :: BS.ByteString + -> [Char] + -> Maybe GithubAuth + -> Maybe RequestBody + -> IO (Either E.SomeException (Response LBS.ByteString)) doHttps reqMethod url auth body = do let reqBody = fromMaybe (RequestBodyBS $ BS.pack "") body reqHeaders = maybe [] getOAuth auth diff --git a/Github/PullRequests.hs b/Github/PullRequests.hs index b3cf400d..8f9efb45 100644 --- a/Github/PullRequests.hs +++ b/Github/PullRequests.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedStrings #-} -- | The pull requests API as documented at -- . module Github.PullRequests ( @@ -9,11 +10,17 @@ module Github.PullRequests ( ,pullRequest ,pullRequestCommits ,pullRequestFiles +,isPullRequestMerged +,mergePullRequest ,module Github.Data ) where import Github.Data import Github.Private +import Network.HTTP.Types +import qualified Data.Map as M +import Network.HTTP.Conduit (RequestBody(RequestBodyLBS)) +import Data.Aeson -- | All pull requests for the repo, by owner and repo name. -- | With authentification @@ -75,3 +82,17 @@ pullRequestFiles' auth userName reqRepoName number = -- > pullRequestFiles "thoughtbot" "paperclip" 688 pullRequestFiles :: String -> String -> Int -> IO (Either Error [File]) pullRequestFiles = pullRequestFiles' Nothing + +-- | Check if pull request has been merged +isPullRequestMerged :: GithubAuth -> String -> String -> Int -> IO(Either Error Status) +isPullRequestMerged auth reqRepoOwner reqRepoName reqPullRequestNumber = + doHttpsStatus "GET" (buildUrl ["repos", reqRepoOwner, reqRepoName, "pulls", (show reqPullRequestNumber), "merge"]) auth Nothing + +-- | Merge a pull request +mergePullRequest :: GithubAuth -> String -> String -> Int -> Maybe String -> IO(Either Error Status) +mergePullRequest auth reqRepoOwner reqRepoName reqPullRequestNumber commitMessage = + doHttpsStatus "PUT" (buildUrl ["repos", reqRepoOwner, reqRepoName, "pulls", (show reqPullRequestNumber), "merge"]) auth (Just . RequestBodyLBS . encode . toJSON $ (buildCommitMessageMap commitMessage)) + +buildCommitMessageMap :: Maybe String -> M.Map String String +buildCommitMessageMap (Just commitMessage) = M.singleton "commit_message" commitMessage +buildCommitMessageMap _ = M.empty diff --git a/Github/Repos.hs b/Github/Repos.hs index 110d00cb..543f16cd 100644 --- a/Github/Repos.hs +++ b/Github/Repos.hs @@ -215,9 +215,9 @@ contentsFor = contentsFor' Nothing -- -- > contentsFor' (Just (GithubBasicAuth (user, password))) "thoughtbot" "paperclip" "README.md" contentsFor' :: Maybe GithubAuth -> String -> String -> String -> Maybe String -> IO (Either Error Content) -contentsFor' auth userName repoName path ref = +contentsFor' auth userName reqRepoName reqContentPath ref = githubGetWithQueryString' auth - ["repos", userName, repoName, "contents", path] $ + ["repos", userName, reqRepoName, "contents", reqContentPath] $ maybe "" ("ref="++) ref diff --git a/samples/Pulls/IsMergedPull.hs b/samples/Pulls/IsMergedPull.hs new file mode 100644 index 00000000..8dce2bec --- /dev/null +++ b/samples/Pulls/IsMergedPull.hs @@ -0,0 +1,11 @@ +module CheckIfPullMerged where + +import qualified Github.PullRequests as Github +import Github.Auth + +main :: IO () +main = do + mergeResult <- Github.isPullRequestMerged (GithubOAuth "authtoken") "thoughtbot" "paperclip" 575 + case mergeResult of + (Left err) -> putStrLn $ "Error: " ++ (show err) + (Right stat) -> putStrLn $ (show stat) diff --git a/samples/Pulls/MergePull.hs b/samples/Pulls/MergePull.hs new file mode 100644 index 00000000..556512d8 --- /dev/null +++ b/samples/Pulls/MergePull.hs @@ -0,0 +1,11 @@ +module MergePullRequest where + +import qualified Github.PullRequests as Github +import Github.Auth + +main :: IO () +main = do + mergeResult <- Github.mergePullRequest (GithubOAuth "authtoken") "thoughtbot" "paperclip" 575 (Just "Merge message") + case mergeResult of + (Left err) -> putStrLn $ "Error: " ++ (show err) + (Right stat) -> putStrLn $ (show stat) From 859aab8b60f1099274b274315dfe5c4c8789247b Mon Sep 17 00:00:00 2001 From: Charles O'Farrell Date: Sun, 20 Jul 2014 00:13:49 +1000 Subject: [PATCH 029/510] Fix GitTree parsing on submodule paths --- Github/Data.hs | 2 +- Github/Data/Definitions.hs | 3 ++- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/Github/Data.hs b/Github/Data.hs index f5887ce2..9351c09b 100644 --- a/Github/Data.hs +++ b/Github/Data.hs @@ -48,7 +48,7 @@ instance FromJSON GitTree where parseJSON (Object o) = GitTree <$> o .: "type" <*> o .: "sha" - <*> o .: "url" + <*> o .:? "url" <*> o .:? "size" <*> o .: "path" <*> o .: "mode" diff --git a/Github/Data/Definitions.hs b/Github/Data/Definitions.hs index acf65e17..4dc01450 100644 --- a/Github/Data/Definitions.hs +++ b/Github/Data/Definitions.hs @@ -39,7 +39,8 @@ data Tree = Tree { data GitTree = GitTree { gitTreeType :: String ,gitTreeSha :: String - ,gitTreeUrl :: String + -- Can be empty for submodule + ,gitTreeUrl :: Maybe String ,gitTreeSize :: Maybe Int ,gitTreePath :: String ,gitTreeMode :: String From b5c749e496708fc28e0c9fb98c50c7d757000af4 Mon Sep 17 00:00:00 2001 From: Charles O'Farrell Date: Sat, 2 Aug 2014 07:28:47 +1000 Subject: [PATCH 030/510] Add extra auth functions for Trees --- Github/GitData/Trees.hs | 22 +++++++++++++++++----- 1 file changed, 17 insertions(+), 5 deletions(-) diff --git a/Github/GitData/Trees.hs b/Github/GitData/Trees.hs index ce7d04c2..6f54e92a 100644 --- a/Github/GitData/Trees.hs +++ b/Github/GitData/Trees.hs @@ -9,17 +9,29 @@ module Github.GitData.Trees ( import Github.Data import Github.Private +-- | A tree for a SHA1. +-- +-- > tree (Just ("github-username", "github-password")) "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844" +tree' :: Maybe GithubAuth -> String -> String -> String -> IO (Either Error Tree) +tree' auth user reqRepoName sha = + githubGet' auth ["repos", user, reqRepoName, "git", "trees", sha] + -- | A tree for a SHA1. -- -- > tree "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844" tree :: String -> String -> String -> IO (Either Error Tree) -tree user reqRepoName sha = - githubGet ["repos", user, reqRepoName, "git", "trees", sha] +tree = tree' Nothing + +-- | A recursively-nested tree for a SHA1. +-- +-- > nestedTree' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844" +nestedTree' :: Maybe GithubAuth -> String -> String -> String -> IO (Either Error Tree) +nestedTree' auth user reqRepoName sha = + githubGetWithQueryString' auth ["repos", user, reqRepoName, "git", "trees", sha] + "recursive=1" -- | A recursively-nested tree for a SHA1. -- -- > nestedTree "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844" nestedTree :: String -> String -> String -> IO (Either Error Tree) -nestedTree user reqRepoName sha = - githubGetWithQueryString ["repos", user, reqRepoName, "git", "trees", sha] - "recursive=1" +nestedTree = nestedTree' Nothing From da9ec301b7a15e132988f6bcff3d0ef4e8462f23 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9sar=20L=C3=B3pez-Natar=C3=A9n?= Date: Sat, 2 Aug 2014 16:50:35 -0700 Subject: [PATCH 031/510] Add the missing actions --- Github/Data.hs | 4 ++++ Github/Data/Definitions.hs | 4 ++++ 2 files changed, 8 insertions(+) diff --git a/Github/Data.hs b/Github/Data.hs index 8b428d19..e7c83210 100644 --- a/Github/Data.hs +++ b/Github/Data.hs @@ -416,6 +416,10 @@ instance FromJSON PullRequestEventType where parseJSON (String "closed") = pure PullRequestClosed parseJSON (String "synchronize") = pure PullRequestSynchronized parseJSON (String "reopened") = pure PullRequestReopened + parseJSON (String "assigned") = pure PullRequestAssigned + parseJSON (String "unassigned") = pure PullRequestUnassigned + parseJSON (String "labeled") = pure PullRequestLabeled + parseJSON (String "unlabeled") = pure PullRequestUnlabeled parseJSON _ = fail "Could not build a PullRequestEventType" instance FromJSON PingEvent where diff --git a/Github/Data/Definitions.hs b/Github/Data/Definitions.hs index 702cff12..3cd62af7 100644 --- a/Github/Data/Definitions.hs +++ b/Github/Data/Definitions.hs @@ -532,6 +532,10 @@ data PullRequestEventType = | PullRequestClosed | PullRequestSynchronized | PullRequestReopened + | PullRequestAssigned + | PullRequestUnassigned + | PullRequestLabeled + | PullRequestUnlabeled deriving (Show, Data, Typeable, Eq, Ord) data PingEvent = PingEvent { From f17fd1ac1ba2acd7a925c1f0925912563f1cd2db Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9sar=20L=C3=B3pez-Natar=C3=A9n?= Date: Sun, 10 Aug 2014 19:53:47 -0700 Subject: [PATCH 032/510] Comment's commit_id is an optional value, so mark it and deserialize it as such. Same thing for path --- Github/Data.hs | 4 ++-- Github/Data/Definitions.hs | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/Github/Data.hs b/Github/Data.hs index e7c83210..5970670e 100644 --- a/Github/Data.hs +++ b/Github/Data.hs @@ -112,12 +112,12 @@ instance FromJSON Comment where Comment <$> o .:? "position" <*> o .:? "line" <*> o .: "body" - <*> o .: "commit_id" + <*> o .:? "commit_id" <*> o .: "updated_at" <*> o .:? "html_url" <*> o .: "url" <*> o .: "created_at" - <*> o .: "path" + <*> o .:? "path" <*> o .: "user" <*> o .: "id" parseJSON _ = fail "Could not build a Comment" diff --git a/Github/Data/Definitions.hs b/Github/Data/Definitions.hs index 3cd62af7..7f8dd4da 100644 --- a/Github/Data/Definitions.hs +++ b/Github/Data/Definitions.hs @@ -99,7 +99,7 @@ data Comment = Comment { commentPosition :: Maybe Int ,commentLine :: Maybe Int ,commentBody :: String - ,commentCommitId :: String + ,commentCommitId :: Maybe String ,commentUpdatedAt :: UTCTime ,commentHtmlUrl :: Maybe String ,commentUrl :: String From 2dfb1402f5aee1cea2b4a936337be84cf16b1e23 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9sar=20L=C3=B3pez-Natar=C3=A9n?= Date: Mon, 11 Aug 2014 20:39:18 -0700 Subject: [PATCH 033/510] Implement update pull request --- Github/Data.hs | 10 ++++++++++ Github/Data/Definitions.hs | 11 +++++++++++ Github/PullRequests.hs | 7 +++++++ samples/Pulls/UpdatePull.hs | 11 +++++++++++ 4 files changed, 39 insertions(+) create mode 100644 samples/Pulls/UpdatePull.hs diff --git a/Github/Data.hs b/Github/Data.hs index 5970670e..96f0ce8b 100644 --- a/Github/Data.hs +++ b/Github/Data.hs @@ -353,6 +353,16 @@ instance FromJSON PullRequest where <*> o .: "id" parseJSON _ = fail "Could not build a PullRequest" +instance ToJSON EditPullRequestState where + toJSON (EditPullRequestStateOpen) = String "open" + toJSON (EditPullRequestStateClosed) = String "closed" + +instance ToJSON EditPullRequest where + toJSON (EditPullRequest t b s) = + object $ filter notNull [ "title" .= t, "body" .= b, "state" .= s ] + where notNull (_, Null) = False + notNull (_, _) = True + instance FromJSON DetailedPullRequest where parseJSON (Object o) = DetailedPullRequest diff --git a/Github/Data/Definitions.hs b/Github/Data/Definitions.hs index 7f8dd4da..eb69de31 100644 --- a/Github/Data/Definitions.hs +++ b/Github/Data/Definitions.hs @@ -356,6 +356,12 @@ data DetailedPullRequest = DetailedPullRequest { ,detailedPullRequestMergeable :: Maybe Bool } deriving (Show, Data, Typeable, Eq, Ord) +data EditPullRequest = EditPullRequest { + editPullRequestTitle :: Maybe String + ,editPullRequestBody :: Maybe String + ,editPullRequestState :: Maybe EditPullRequestState +} deriving (Show) + data PullRequestLinks = PullRequestLinks { pullRequestLinksReviewComments :: String ,pullRequestLinksComments :: String @@ -543,3 +549,8 @@ data PingEvent = PingEvent { ,pingEventHook :: RepoWebhook ,pingEventHookId :: Int } deriving (Show, Data, Typeable, Eq, Ord) + +data EditPullRequestState = + EditPullRequestStateOpen + | EditPullRequestStateClosed + deriving Show diff --git a/Github/PullRequests.hs b/Github/PullRequests.hs index 8f9efb45..f38dcebc 100644 --- a/Github/PullRequests.hs +++ b/Github/PullRequests.hs @@ -12,6 +12,7 @@ module Github.PullRequests ( ,pullRequestFiles ,isPullRequestMerged ,mergePullRequest +,updatePullRequest ,module Github.Data ) where @@ -93,6 +94,12 @@ mergePullRequest :: GithubAuth -> String -> String -> Int -> Maybe String -> IO( mergePullRequest auth reqRepoOwner reqRepoName reqPullRequestNumber commitMessage = doHttpsStatus "PUT" (buildUrl ["repos", reqRepoOwner, reqRepoName, "pulls", (show reqPullRequestNumber), "merge"]) auth (Just . RequestBodyLBS . encode . toJSON $ (buildCommitMessageMap commitMessage)) +-- | 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 + + buildCommitMessageMap :: Maybe String -> M.Map String String buildCommitMessageMap (Just commitMessage) = M.singleton "commit_message" commitMessage buildCommitMessageMap _ = M.empty diff --git a/samples/Pulls/UpdatePull.hs b/samples/Pulls/UpdatePull.hs new file mode 100644 index 00000000..ffd19b8f --- /dev/null +++ b/samples/Pulls/UpdatePull.hs @@ -0,0 +1,11 @@ +module MergePullRequest where + +import qualified Github.PullRequests as Github +import Github.Auth + +main :: IO () +main = do + mergeResult <- Github.updatePullRequest (GithubOAuth "authtoken") "repoOwner" "repoName" 22 (EditPullRequest { editPullRequestTitle = Just "Brand new title", editPullRequestBody = Nothing, editPullRequestState = Just EditPullRequestStateClosed }) + case mergeResult of + (Left err) -> putStrLn $ "Error: " ++ (show err) + (Right dpr) -> putStrLn . show $ dpr From eb1b61ce1722488d3c451744b9332d4543455d54 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9sar=20L=C3=B3pez-Natar=C3=A9n?= Date: Thu, 14 Aug 2014 21:20:35 -0700 Subject: [PATCH 034/510] Use variant type for the webhook events. --- Github/Data.hs | 45 +++++++++++++++++++++++++ Github/Data/Definitions.hs | 25 +++++++++++++- Github/Repos/Webhooks.hs | 10 +++--- samples/Repos/Webhooks/CreateWebhook.hs | 2 +- samples/Repos/Webhooks/EditWebhook.hs | 4 +-- 5 files changed, 77 insertions(+), 9 deletions(-) diff --git a/Github/Data.hs b/Github/Data.hs index 96f0ce8b..be76f859 100644 --- a/Github/Data.hs +++ b/Github/Data.hs @@ -432,6 +432,51 @@ instance FromJSON PullRequestEventType where parseJSON (String "unlabeled") = pure PullRequestUnlabeled parseJSON _ = fail "Could not build a PullRequestEventType" +instance FromJSON RepoWebhookEvent where + parseJSON (String "*") = pure WebhookWildcardEvent + parseJSON (String "commit_comment") = pure WebhookCommitCommentEvent + parseJSON (String "create") = pure WebhookCreateEvent + parseJSON (String "delete") = pure WebhookDeleteEvent + parseJSON (String "deployment") = pure WebhookDeploymentEvent + parseJSON (String "deployment_status") = pure WebhookDeploymentStatusEvent + parseJSON (String "fork") = pure WebhookForkEvent + parseJSON (String "gollum") = pure WebhookGollumEvent + parseJSON (String "issue_comment") = pure WebhookIssueCommentEvent + parseJSON (String "issues") = pure WebhookIssuesEvent + parseJSON (String "member") = pure WebhookMemberEvent + parseJSON (String "page_build") = pure WebhookPageBuildEvent + parseJSON (String "public") = pure WebhookPublicEvent + parseJSON (String "pull_request_review_comment") = pure WebhookPullRequestReviewCommentEvent + parseJSON (String "pull_request") = pure WebhookPullRequestEvent + parseJSON (String "push") = pure WebhookPushEvent + parseJSON (String "release") = pure WebhookReleaseEvent + parseJSON (String "status") = pure WebhookStatusEvent + parseJSON (String "team_add") = pure WebhookTeamAddEvent + parseJSON (String "watch") = pure WebhookWatchEvent + parseJSON _ = fail "Could not build a Webhook event" + +instance ToJSON RepoWebhookEvent where + toJSON (WebhookWildcardEvent) = String "*" + toJSON (WebhookCommitCommentEvent) = String "commit_comment" + toJSON (WebhookCreateEvent) = String "create" + toJSON (WebhookDeleteEvent) = String "delete" + toJSON (WebhookDeploymentEvent) = String "deployment" + toJSON (WebhookDeploymentStatusEvent) = String "deployment_status" + toJSON (WebhookForkEvent) = String "fork" + toJSON (WebhookGollumEvent) = String "gollum" + toJSON (WebhookIssueCommentEvent) = String "issue_comment" + toJSON (WebhookIssuesEvent) = String "issues" + toJSON (WebhookMemberEvent) = String "member" + toJSON (WebhookPageBuildEvent) = String "page_build" + toJSON (WebhookPublicEvent) = String "public" + toJSON (WebhookPullRequestReviewCommentEvent) = String "pull_request_review_comment" + toJSON (WebhookPullRequestEvent) = String "pull_request" + toJSON (WebhookPushEvent) = String "push" + toJSON (WebhookReleaseEvent) = String "release" + toJSON (WebhookStatusEvent) = String "status" + toJSON (WebhookTeamAddEvent) = String "team_add" + toJSON (WebhookWatchEvent) = String "watch" + instance FromJSON PingEvent where parseJSON (Object o) = PingEvent <$> o .: "zen" diff --git a/Github/Data/Definitions.hs b/Github/Data/Definitions.hs index eb69de31..478c5fb3 100644 --- a/Github/Data/Definitions.hs +++ b/Github/Data/Definitions.hs @@ -512,13 +512,36 @@ data RepoWebhook = RepoWebhook { ,repoWebhookId :: Integer ,repoWebhookName :: String ,repoWebhookActive :: Bool - ,repoWebhookEvents :: [String] + ,repoWebhookEvents :: [RepoWebhookEvent] ,repoWebhookConfig :: M.Map String String ,repoWebhookLastResponse :: RepoWebhookResponse ,repoWebhookUpdatedAt :: GithubDate ,repoWebhookCreatedAt :: GithubDate } deriving (Show, Data, Typeable, Eq, Ord) +data RepoWebhookEvent = + WebhookWildcardEvent + | WebhookCommitCommentEvent + | WebhookCreateEvent + | WebhookDeleteEvent + | WebhookDeploymentEvent + | WebhookDeploymentStatusEvent + | WebhookForkEvent + | WebhookGollumEvent + | WebhookIssueCommentEvent + | WebhookIssuesEvent + | WebhookMemberEvent + | WebhookPageBuildEvent + | WebhookPublicEvent + | WebhookPullRequestReviewCommentEvent + | WebhookPullRequestEvent + | WebhookPushEvent + | WebhookReleaseEvent + | WebhookStatusEvent + | WebhookTeamAddEvent + | WebhookWatchEvent + deriving (Show, Data, Typeable, Eq, Ord) + data RepoWebhookResponse = RepoWebhookResponse { repoWebhookResponseCode :: Maybe Int ,repoWebhookResponseStatus :: String diff --git a/Github/Repos/Webhooks.hs b/Github/Repos/Webhooks.hs index 94bb0253..5998d08a 100644 --- a/Github/Repos/Webhooks.hs +++ b/Github/Repos/Webhooks.hs @@ -39,19 +39,19 @@ import Data.Aeson type RepoOwner = String type RepoName = String type RepoWebhookId = Int - + data NewRepoWebhook = NewRepoWebhook { newRepoWebhookName :: String ,newRepoWebhookConfig :: M.Map String String - ,newRepoWebhookEvents :: Maybe [String] + ,newRepoWebhookEvents :: Maybe [RepoWebhookEvent] ,newRepoWebhookActive :: Maybe Bool } deriving Show data EditRepoWebhook = EditRepoWebhook { editRepoWebhookConfig :: Maybe (M.Map String String) - ,editRepoWebhookEvents :: Maybe [String] - ,editRepoWebhookAddEvents :: Maybe [String] - ,editRepoWebhookRemoveEvents :: Maybe [String] + ,editRepoWebhookEvents :: Maybe [RepoWebhookEvent] + ,editRepoWebhookAddEvents :: Maybe [RepoWebhookEvent] + ,editRepoWebhookRemoveEvents :: Maybe [RepoWebhookEvent] ,editRepoWebhookActive :: Maybe Bool } deriving Show diff --git a/samples/Repos/Webhooks/CreateWebhook.hs b/samples/Repos/Webhooks/CreateWebhook.hs index cb100586..fc4e55ec 100644 --- a/samples/Repos/Webhooks/CreateWebhook.hs +++ b/samples/Repos/Webhooks/CreateWebhook.hs @@ -12,7 +12,7 @@ main = do let webhookDef = NewRepoWebhook { newRepoWebhookName = "web", newRepoWebhookConfig = config, - newRepoWebhookEvents = Just ["*"], + newRepoWebhookEvents = Just [WebhookWildcardEvent], newRepoWebhookActive = Just True } newWebhook <- createRepoWebhook' auth "repoOwner" "repoName" webhookDef diff --git a/samples/Repos/Webhooks/EditWebhook.hs b/samples/Repos/Webhooks/EditWebhook.hs index 25844388..4496e485 100644 --- a/samples/Repos/Webhooks/EditWebhook.hs +++ b/samples/Repos/Webhooks/EditWebhook.hs @@ -8,8 +8,8 @@ main :: IO () main = do let auth = Auth.GithubOAuth "oauthtoken" let editWebhookDef = EditRepoWebhook { - editRepoWebhookRemoveEvents = Just ["*"], - editRepoWebhookAddEvents = Just ["commit_comment"], + editRepoWebhookRemoveEvents = Just [WebhookWildcardEvent], + editRepoWebhookAddEvents = Just [WebhookCommitCommentEvent, WebhookGollumEvent], editRepoWebhookConfig = Nothing, editRepoWebhookEvents = Nothing, editRepoWebhookActive = Just True From 952016014bb964ee39da8ed1255ec5f7c2ffdb8d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9sar=20L=C3=B3pez-Natar=C3=A9n?= Date: Sat, 16 Aug 2014 12:01:39 -0700 Subject: [PATCH 035/510] Add missing event types --- Github/Data.hs | 11 +++++++++++ Github/Data/Definitions.hs | 11 +++++++++++ github.cabal | 2 +- 3 files changed, 23 insertions(+), 1 deletion(-) diff --git a/Github/Data.hs b/Github/Data.hs index be76f859..7b66ce1b 100644 --- a/Github/Data.hs +++ b/Github/Data.hs @@ -207,6 +207,7 @@ instance FromJSON Issue where parseJSON (Object o) = Issue <$> o .:? "closed_at" <*> o .: "updated_at" + <*> o .: "events_url" <*> o .: "html_url" <*> o .:? "closed_by" <*> o .: "labels" @@ -302,6 +303,16 @@ instance FromJSON EventType where parseJSON (String "mentioned") = pure Mentioned parseJSON (String "assigned") = pure Assigned parseJSON (String "unsubscribed") = pure Unsubscribed + parseJSON (String "unassigned") = pure ActorUnassigned + parseJSON (String "labeled") = pure Labeled + parseJSON (String "unlabeled") = pure Unlabeled + parseJSON (String "milestoned") = pure Milestoned + parseJSON (String "demilestoned") = pure Demilestoned + parseJSON (String "renamed") = pure Renamed + parseJSON (String "locked") = pure Locked + parseJSON (String "unlocked") = pure Unlocked + parseJSON (String "head_ref_deleted") = pure HeadRefDeleted + parseJSON (String "head_ref_restored") = pure HeadRefRestored parseJSON _ = fail "Could not build an EventType" instance FromJSON SimpleOrganization where diff --git a/Github/Data/Definitions.hs b/Github/Data/Definitions.hs index 478c5fb3..3a0eb35a 100644 --- a/Github/Data/Definitions.hs +++ b/Github/Data/Definitions.hs @@ -188,6 +188,7 @@ data GitObject = GitObject { data Issue = Issue { issueClosedAt :: Maybe GithubDate ,issueUpdatedAt :: GithubDate + ,issueEventsUrl :: String ,issueHtmlUrl :: Maybe String ,issueClosedBy :: Maybe GithubOwner ,issueLabels :: [IssueLabel] @@ -267,6 +268,16 @@ data EventType = | Assigned -- ^ The issue was assigned to the actor. | Closed -- ^ The issue was closed by the actor. When the commit_id is present, it identifies the commit that closed the issue using “closes / fixes #NN” syntax. | Reopened -- ^ The issue was reopened by the actor. + | ActorUnassigned -- ^ The issue was unassigned to the actor + | Labeled -- ^ A label was added to the issue. + | Unlabeled -- ^ A label was removed from the issue. + | Milestoned -- ^ The issue was added to a milestone. + | Demilestoned -- ^ The issue was removed from a milestone. + | Renamed -- ^ The issue title was changed. + | Locked -- ^ The issue was locked by the actor. + | Unlocked -- ^ The issue was unlocked by the actor. + | HeadRefDeleted -- ^ The pull request’s branch was deleted. + | HeadRefRestored -- ^ The pull request’s branch was restored. deriving (Show, Data, Typeable, Eq, Ord) data Event = Event { diff --git a/github.cabal b/github.cabal index 52dda642..58dabe57 100644 --- a/github.cabal +++ b/github.cabal @@ -7,7 +7,7 @@ Name: github -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented. -Version: 0.9 +Version: 0.10.0 -- A short (one-line) description of the package. Synopsis: Access to the Github API, v3. From c61f101992e4af8663068c38b714acdc0311985f Mon Sep 17 00:00:00 2001 From: Pablo Lamela Seijas Date: Sat, 23 Aug 2014 13:27:56 +0100 Subject: [PATCH 036/510] Implemented code search --- Github/Data.hs | 41 +++++++++++++++++++-------- Github/Data/Definitions.hs | 41 ++++++++++++++++++--------- Github/Search.hs | 19 ++++++++++++- github.cabal | 2 +- samples/Repos/Forks/ListForks.hs | 5 +++- samples/Repos/ListOrgRepos.hs | 5 ++-- samples/Repos/ListUserRepos.hs | 5 ++-- samples/Repos/Starring/ListStarred.hs | 5 ++-- samples/Repos/Watching/ListWatched.hs | 5 ++-- samples/Search/SearchCode.hs | 34 ++++++++++++++++++++++ samples/Search/SearchRepos.hs | 2 +- 11 files changed, 127 insertions(+), 37 deletions(-) create mode 100644 samples/Search/SearchCode.hs diff --git a/Github/Data.hs b/Github/Data.hs index 7b66ce1b..b8cb3aa5 100644 --- a/Github/Data.hs +++ b/Github/Data.hs @@ -503,28 +503,28 @@ instance FromJSON SearchReposResult where instance FromJSON Repo where parseJSON (Object o) = - Repo <$> o .: "ssh_url" + Repo <$> o .:? "ssh_url" <*> o .: "description" - <*> o .: "created_at" + <*> o .:? "created_at" <*> o .: "html_url" - <*> o .: "svn_url" - <*> o .: "forks" + <*> o .:? "svn_url" + <*> o .:? "forks" <*> o .:? "homepage" <*> o .: "fork" - <*> o .: "git_url" + <*> o .:? "git_url" <*> o .: "private" - <*> o .: "clone_url" - <*> o .: "size" - <*> o .: "updated_at" - <*> o .: "watchers" + <*> o .:? "clone_url" + <*> o .:? "size" + <*> o .:? "updated_at" + <*> o .:? "watchers" <*> o .: "owner" <*> o .: "name" - <*> o .: "language" + <*> o .:? "language" <*> o .:? "master_branch" - <*> o .: "pushed_at" + <*> o .:? "pushed_at" <*> o .: "id" <*> o .: "url" - <*> o .: "open_issues" + <*> o .:? "open_issues" <*> o .:? "has_wiki" <*> o .:? "has_issues" <*> o .:? "has_downloads" @@ -533,6 +533,23 @@ instance FromJSON Repo where <*> o .: "hooks_url" parseJSON _ = fail "Could not build a Repo" +instance FromJSON SearchCodeResult where + parseJSON (Object o) = + SearchCodeResult <$> o .: "total_count" + <*> o .:< "items" + parseJSON _ = fail "Could not build a SearchCodeResult" + +instance FromJSON Code where + parseJSON (Object o ) = + Code <$> o .: "name" + <*> o .: "path" + <*> o .: "sha" + <*> o .: "url" + <*> o .: "git_url" + <*> o .: "html_url" + <*> o .: "repository" + parseJSON _ = fail "Could not build a Code" + instance FromJSON RepoRef where parseJSON (Object o) = RepoRef <$> o .: "owner" diff --git a/Github/Data/Definitions.hs b/Github/Data/Definitions.hs index 3a0eb35a..c3ea56ab 100644 --- a/Github/Data/Definitions.hs +++ b/Github/Data/Definitions.hs @@ -103,7 +103,7 @@ data Comment = Comment { ,commentUpdatedAt :: UTCTime ,commentHtmlUrl :: Maybe String ,commentUrl :: String - ,commentCreatedAt :: UTCTime + ,commentCreatedAt :: Maybe UTCTime ,commentPath :: Maybe String ,commentUser :: GithubOwner ,commentId :: Int @@ -390,24 +390,24 @@ data PullRequestCommit = PullRequestCommit { data SearchReposResult = SearchReposResult { searchReposTotalCount :: Int - ,searchReposRepos :: [ Repo ] + ,searchReposRepos :: [Repo] } deriving (Show, Data, Typeable, Eq, Ord) data Repo = Repo { - repoSshUrl :: String + repoSshUrl :: Maybe String ,repoDescription :: Maybe String - ,repoCreatedAt :: GithubDate + ,repoCreatedAt :: Maybe GithubDate ,repoHtmlUrl :: String - ,repoSvnUrl :: String - ,repoForks :: Int + ,repoSvnUrl :: Maybe String + ,repoForks :: Maybe Int ,repoHomepage :: Maybe String - ,repoFork :: Bool - ,repoGitUrl :: String + ,repoFork :: Maybe Bool + ,repoGitUrl :: Maybe String ,repoPrivate :: Bool - ,repoCloneUrl :: String - ,repoSize :: Int - ,repoUpdatedAt :: GithubDate - ,repoWatchers :: Int + ,repoCloneUrl :: Maybe String + ,repoSize :: Maybe Int + ,repoUpdatedAt :: Maybe GithubDate + ,repoWatchers :: Maybe Int ,repoOwner :: GithubOwner ,repoName :: String ,repoLanguage :: Maybe String @@ -415,7 +415,7 @@ data Repo = Repo { ,repoPushedAt :: Maybe GithubDate -- ^ this is Nothing for new repositories ,repoId :: Int ,repoUrl :: String - ,repoOpenIssues :: Int + ,repoOpenIssues :: Maybe Int ,repoHasWiki :: Maybe Bool ,repoHasIssues :: Maybe Bool ,repoHasDownloads :: Maybe Bool @@ -427,6 +427,21 @@ data Repo = Repo { data RepoRef = RepoRef GithubOwner String -- Repo owner and name deriving (Show, Data, Typeable, Eq, Ord) +data SearchCodeResult = SearchCodeResult { + searchCodeTotalCount :: Int + ,searchCodeCodes :: [Code] +} deriving (Show, Data, Typeable, Eq, Ord) + +data Code = Code { + codeName :: String + ,codePath :: String + ,codeSha :: String + ,codeUrl :: String + ,codeGitUrl :: String + ,codeHtmlUrl :: String + ,codeRepo :: Repo +} deriving (Show, Data, Typeable, Eq, Ord) + data Content = ContentFile ContentData | ContentDirectory [ContentData] deriving (Show, Data, Typeable, Eq, Ord) diff --git a/Github/Search.hs b/Github/Search.hs index 41fe84a3..88036073 100644 --- a/Github/Search.hs +++ b/Github/Search.hs @@ -3,6 +3,8 @@ module Github.Search( searchRepos' ,searchRepos +,searchCode' +,searchCode ,module Github.Data ) where @@ -14,7 +16,7 @@ import Github.Private -- -- > searchRepos' (Just $ GithubBasicAuth "github-username" "github-password') "q=a in%3Aname language%3Ahaskell created%3A>2013-10-01&per_page=100" searchRepos' :: Maybe GithubAuth -> String -> IO (Either Error SearchReposResult) -searchRepos' auth queryString = githubGetWithQueryString' auth ["search/repositories"] queryString +searchRepos' auth queryString = githubGetWithQueryString' auth ["search", "repositories"] queryString -- | Perform a repository search. -- | Without authentication. @@ -23,3 +25,18 @@ searchRepos' auth queryString = githubGetWithQueryString' auth ["search/reposito searchRepos :: String -> IO (Either Error SearchReposResult) searchRepos = searchRepos' Nothing +-- | Perform a code search. +-- | With authentication. +-- +-- > searchCode' (Just $ GithubBasicAuth "github-username" "github-password') "q=a in%3Aname language%3Ahaskell created%3A>2013-10-01&per_page=100" +searchCode' :: Maybe GithubAuth -> String -> IO (Either Error SearchCodeResult) +searchCode' auth queryString = githubGetWithQueryString' auth ["search", "code"] queryString + +-- | Perform a code search. +-- | Without authentication. +-- +-- > searchCode "q=addClass+in:file+language:js+repo:jquery/jquery" +searchCode :: String -> IO (Either Error SearchCodeResult) +searchCode = searchCode' Nothing + + diff --git a/github.cabal b/github.cabal index 58dabe57..b26aa680 100644 --- a/github.cabal +++ b/github.cabal @@ -7,7 +7,7 @@ Name: github -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented. -Version: 0.10.0 +Version: 0.11.0 -- A short (one-line) description of the package. Synopsis: Access to the Github API, v3. diff --git a/samples/Repos/Forks/ListForks.hs b/samples/Repos/Forks/ListForks.hs index 6543844f..13ea670e 100644 --- a/samples/Repos/Forks/ListForks.hs +++ b/samples/Repos/Forks/ListForks.hs @@ -12,7 +12,10 @@ main = do formatFork fork = (Github.githubOwnerLogin $ Github.repoOwner fork) ++ "\t" ++ (formatPushedAt $ Github.repoPushedAt fork) ++ "\n" ++ - (Github.repoCloneUrl fork) + (formatCloneUrl $ Github.repoCloneUrl fork) formatPushedAt Nothing = "" formatPushedAt (Just pushedAt) = show $ Github.fromGithubDate pushedAt + +formatCloneUrl Nothing = "" +formatCloneUrl (Just cloneUrl) = cloneUrl diff --git a/samples/Repos/ListOrgRepos.hs b/samples/Repos/ListOrgRepos.hs index 17793a06..ce19985d 100644 --- a/samples/Repos/ListOrgRepos.hs +++ b/samples/Repos/ListOrgRepos.hs @@ -14,13 +14,14 @@ formatRepo repo = (Github.repoName repo) ++ "\t" ++ (fromMaybe "" $ Github.repoDescription repo) ++ "\n" ++ (Github.repoHtmlUrl repo) ++ "\n" ++ - (Github.repoCloneUrl repo) ++ "\t" ++ + (fromMaybe "" $ Github.repoCloneUrl repo) ++ "\t" ++ (formatDate $ Github.repoUpdatedAt repo) ++ "\n" ++ formatLanguage (Github.repoLanguage repo) ++ "watchers: " ++ (show $ Github.repoWatchers repo) ++ "\t" ++ "forks: " ++ (show $ Github.repoForks repo) -formatDate = show . Github.fromGithubDate +formatDate (Just date) = show . Github.fromGithubDate $ date +formatDate Nothing = "????" formatLanguage (Just language) = "language: " ++ language ++ "\t" formatLanguage Nothing = "" diff --git a/samples/Repos/ListUserRepos.hs b/samples/Repos/ListUserRepos.hs index 09ab1d80..928e20e0 100644 --- a/samples/Repos/ListUserRepos.hs +++ b/samples/Repos/ListUserRepos.hs @@ -14,13 +14,14 @@ formatRepo repo = (Github.repoName repo) ++ "\t" ++ (fromMaybe "" $ Github.repoDescription repo) ++ "\n" ++ (Github.repoHtmlUrl repo) ++ "\n" ++ - (Github.repoCloneUrl repo) ++ "\t" ++ + (fromMaybe "" $ Github.repoCloneUrl repo) ++ "\t" ++ (formatDate $ Github.repoUpdatedAt repo) ++ "\n" ++ formatLanguage (Github.repoLanguage repo) ++ "watchers: " ++ (show $ Github.repoWatchers repo) ++ "\t" ++ "forks: " ++ (show $ Github.repoForks repo) -formatDate = show . Github.fromGithubDate +formatDate (Just date) = show . Github.fromGithubDate $ date +formatDate Nothing = "" formatLanguage (Just language) = "language: " ++ language ++ "\t" formatLanguage Nothing = "" diff --git a/samples/Repos/Starring/ListStarred.hs b/samples/Repos/Starring/ListStarred.hs index fec084ac..522b809b 100644 --- a/samples/Repos/Starring/ListStarred.hs +++ b/samples/Repos/Starring/ListStarred.hs @@ -14,11 +14,12 @@ formatRepo repo = (Github.repoName repo) ++ "\t" ++ (fromMaybe "" $ Github.repoDescription repo) ++ "\n" ++ (Github.repoHtmlUrl repo) ++ "\n" ++ - (Github.repoCloneUrl repo) ++ "\t" ++ + (fromMaybe "" $ Github.repoCloneUrl repo) ++ "\t" ++ (formatDate $ Github.repoUpdatedAt repo) ++ "\n" ++ formatLanguage (Github.repoLanguage repo) -formatDate = show . Github.fromGithubDate +formatDate (Just date) = show . Github.fromGithubDate $ date +formatDate Nothing = "" formatLanguage (Just language) = "language: " ++ language ++ "\t" formatLanguage Nothing = "" diff --git a/samples/Repos/Watching/ListWatched.hs b/samples/Repos/Watching/ListWatched.hs index c2f1f8ba..1691906a 100644 --- a/samples/Repos/Watching/ListWatched.hs +++ b/samples/Repos/Watching/ListWatched.hs @@ -14,13 +14,14 @@ formatRepo repo = (Github.repoName repo) ++ "\t" ++ (fromMaybe "" $ Github.repoDescription repo) ++ "\n" ++ (Github.repoHtmlUrl repo) ++ "\n" ++ - (Github.repoCloneUrl repo) ++ "\t" ++ + (fromMaybe "" $ Github.repoCloneUrl repo) ++ "\t" ++ (formatDate $ Github.repoUpdatedAt repo) ++ "\n" ++ formatLanguage (Github.repoLanguage repo) ++ "watchers: " ++ (show $ Github.repoWatchers repo) ++ "\t" ++ "forks: " ++ (show $ Github.repoForks repo) -formatDate = show . Github.fromGithubDate +formatDate (Just date) = show . Github.fromGithubDate $ date +formatDate Nothing = "" formatLanguage (Just language) = "language: " ++ language ++ "\t" formatLanguage Nothing = "" diff --git a/samples/Search/SearchCode.hs b/samples/Search/SearchCode.hs new file mode 100644 index 00000000..68a73c96 --- /dev/null +++ b/samples/Search/SearchCode.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE OverloadedStrings #-} +module SearchCode where + +import qualified Github.Search as Github +import qualified Github.Data as Github +import Control.Monad (forM,forM_) +import Data.Maybe (fromMaybe) +import Data.List (intercalate) + +main = do + let query = "q=Code repo:jwiegley/github&per_page=100" + let auth = Nothing + result <- Github.searchCode' auth query + case result of + Left e -> putStrLn $ "Error: " ++ show e + Right r -> do forM_ (Github.searchCodeCodes r) (\r -> do + putStrLn $ formatCode r + putStrLn "" + ) + putStrLn $ "Count: " ++ show n ++ " matches for the query: \"" ++ query ++ "\"" + where n = Github.searchCodeTotalCount r + +formatCode :: Github.Code -> String +formatCode r = + let fields = [ ("Name", Github.codeName) + ,("Path", Github.codePath) + ,("Sha", Github.codeSha) + ,("URL", Github.codeHtmlUrl) + ] + in intercalate "\n" $ map fmt fields + where fmt (s,f) = fill 12 (s ++ ":") ++ " " ++ f r + fill n s = s ++ replicate n' ' ' + where n' = max 0 (n - length s) + diff --git a/samples/Search/SearchRepos.hs b/samples/Search/SearchRepos.hs index cd3dcd36..6c937941 100644 --- a/samples/Search/SearchRepos.hs +++ b/samples/Search/SearchRepos.hs @@ -42,7 +42,7 @@ formatRepo r = let fields = [ ("Name", Github.repoName) ,("URL", Github.repoHtmlUrl) ,("Description", orEmpty . Github.repoDescription) - ,("Created-At", formatDate . Github.repoCreatedAt) + ,("Created-At", formatMaybeDate . Github.repoCreatedAt) ,("Pushed-At", formatMaybeDate . Github.repoPushedAt) ] in intercalate "\n" $ map fmt fields From 990c995812a03a34d4e61f190cd79762ec82044c Mon Sep 17 00:00:00 2001 From: Petr Pudlak Date: Sat, 6 Sep 2014 16:09:02 +0200 Subject: [PATCH 037/510] Add a function for validating payloads from GitHub webhooks Given a GitHub secret, a payload and the signature delivered with the payload in `X-Hub-Signature`, verifies if the signature is valid or not. See issue #76. --- Github/Repos/Webhooks/Validate.hs | 26 ++++++++++++++++++++++++++ github.cabal | 4 +++- 2 files changed, 29 insertions(+), 1 deletion(-) create mode 100644 Github/Repos/Webhooks/Validate.hs diff --git a/Github/Repos/Webhooks/Validate.hs b/Github/Repos/Webhooks/Validate.hs new file mode 100644 index 00000000..0cdebc82 --- /dev/null +++ b/Github/Repos/Webhooks/Validate.hs @@ -0,0 +1,26 @@ +-- | Verification of incomming webhook payloads, as described at +-- + +module Github.Repos.Webhooks.Validate ( + isValidPayload +) where + +import Crypto.Hash +import qualified Data.ByteString.Char8 as BS + + +-- | Validates a given payload against a given HMAC hexdigest using a given +-- secret. +-- Returns 'True' iff the given hash is non-empty and it's a valid signature of +-- the payload. +isValidPayload + :: String -- ^ the secret + -> Maybe String -- ^ the hash provided by the remote party + -- in @X-Hub-Signature@ (if any), + -- including the 'sha1=...' prefix + -> BS.ByteString -- ^ the body + -> Bool +isValidPayload secret shaOpt payload = Just sign == shaOpt + where + hm = hmac (BS.pack secret) payload :: HMAC SHA1 + sign = "sha1=" ++ (show . hmacGetDigest $ hm) diff --git a/github.cabal b/github.cabal index b26aa680..0fbc1a78 100644 --- a/github.cabal +++ b/github.cabal @@ -145,6 +145,7 @@ Library Github.Repos.Watching, Github.Repos.Starring, Github.Repos.Webhooks + Github.Repos.Webhooks.Validate, Github.Users, Github.Users.Followers Github.Search @@ -168,7 +169,8 @@ Library http-types, data-default, vector, - unordered-containers >= 0.2 && < 0.3 + unordered-containers >= 0.2 && < 0.3, + cryptohash >= 0.11 -- Modules not exported by this package. Other-modules: Github.Private From f3cd67cee1001f5cea18907558dc433262d280b2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9sar=20L=C3=B3pez-Natar=C3=A9n?= Date: Sun, 7 Sep 2014 13:50:49 -0700 Subject: [PATCH 038/510] Pump the version --- github.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/github.cabal b/github.cabal index 0fbc1a78..a07a43b0 100644 --- a/github.cabal +++ b/github.cabal @@ -7,7 +7,7 @@ Name: github -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented. -Version: 0.11.0 +Version: 0.11.1 -- A short (one-line) description of the package. Synopsis: Access to the Github API, v3. From f3bebfb9caea872a850b116d8674319f47cc9f62 Mon Sep 17 00:00:00 2001 From: Niklas Hambuechen Date: Wed, 5 Nov 2014 18:21:31 +0100 Subject: [PATCH 039/510] Validation: Guard against timing attacks. Improves #76 and #77. From https://developer.github.com/webhooks/securing: Using a plain == operator is **not advised**. A method like `secure_compare` performs a "constant time" string comparison, which renders it safe from certain timing attacks against regular equality operators. --- Github/Repos/Webhooks/Validate.hs | 13 +++++++++++-- github.cabal | 4 +++- 2 files changed, 14 insertions(+), 3 deletions(-) diff --git a/Github/Repos/Webhooks/Validate.hs b/Github/Repos/Webhooks/Validate.hs index 0cdebc82..23d835ac 100644 --- a/Github/Repos/Webhooks/Validate.hs +++ b/Github/Repos/Webhooks/Validate.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE OverloadedStrings #-} + -- | Verification of incomming webhook payloads, as described at -- @@ -5,8 +7,12 @@ module Github.Repos.Webhooks.Validate ( isValidPayload ) where +import Control.Applicative import Crypto.Hash import qualified Data.ByteString.Char8 as BS +import Data.Byteable (constEqBytes, toBytes) +import qualified Data.ByteString.Base16 as Hex +import Data.Monoid -- | Validates a given payload against a given HMAC hexdigest using a given @@ -20,7 +26,10 @@ isValidPayload -- including the 'sha1=...' prefix -> BS.ByteString -- ^ the body -> Bool -isValidPayload secret shaOpt payload = Just sign == shaOpt +isValidPayload secret shaOpt payload = maybe False (constEqBytes sign) shaOptBS where + shaOptBS = BS.pack <$> shaOpt + hexDigest = Hex.encode . toBytes . hmacGetDigest + hm = hmac (BS.pack secret) payload :: HMAC SHA1 - sign = "sha1=" ++ (show . hmacGetDigest $ hm) + sign = "sha1=" <> hexDigest hm diff --git a/github.cabal b/github.cabal index a07a43b0..93657700 100644 --- a/github.cabal +++ b/github.cabal @@ -170,7 +170,9 @@ Library data-default, vector, unordered-containers >= 0.2 && < 0.3, - cryptohash >= 0.11 + cryptohash >= 0.11, + byteable >= 0.1.0, + base16-bytestring >= 0.1.1.6 -- Modules not exported by this package. Other-modules: Github.Private From 0be6c43a4bb46198820b6b51fbd3d7e76ad0ab0b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9sar=20L=C3=B3pez-Natar=C3=A9n?= Date: Sat, 8 Nov 2014 20:34:17 -0800 Subject: [PATCH 040/510] Bump the version --- github.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/github.cabal b/github.cabal index 93657700..de456613 100644 --- a/github.cabal +++ b/github.cabal @@ -7,7 +7,7 @@ Name: github -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented. -Version: 0.11.1 +Version: 0.12 -- A short (one-line) description of the package. Synopsis: Access to the Github API, v3. From e44d1b8605083be840be3b08d3c2986ddc55128f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9sar=20L=C3=B3pez-Natar=C3=A9n?= Date: Sat, 8 Nov 2014 23:30:37 -0800 Subject: [PATCH 041/510] Add createReference function Bump the version Add createReference sample program --- Github/Data.hs | 3 +++ Github/Data/Definitions.hs | 5 +++++ Github/GitData/References.hs | 5 +++++ github.cabal | 3 ++- .../GitData/References/GitCreateReference.hs | 19 +++++++++++++++++++ 5 files changed, 34 insertions(+), 1 deletion(-) create mode 100644 samples/GitData/References/GitCreateReference.hs diff --git a/Github/Data.hs b/Github/Data.hs index b8cb3aa5..d70cf855 100644 --- a/Github/Data.hs +++ b/Github/Data.hs @@ -189,6 +189,9 @@ instance FromJSON Blob where <*> o .: "size" parseJSON _ = fail "Could not build a Blob" +instance ToJSON NewGitReference where + toJSON (NewGitReference r s) = object [ "ref" .= r, "sha" .= s ] + instance FromJSON GitReference where parseJSON (Object o) = GitReference <$> o .: "object" diff --git a/Github/Data/Definitions.hs b/Github/Data/Definitions.hs index c3ea56ab..230fadb9 100644 --- a/Github/Data/Definitions.hs +++ b/Github/Data/Definitions.hs @@ -173,6 +173,11 @@ data Blob = Blob { ,blobSize :: Int } deriving (Show, Data, Typeable, Eq, Ord) +data NewGitReference = NewGitReference { + newGitReferenceRef :: String + ,newGitReferenceSha :: String +} deriving (Show, Data, Typeable, Eq, Ord) + data GitReference = GitReference { gitReferenceObject :: GitObject ,gitReferenceUrl :: String diff --git a/Github/GitData/References.hs b/Github/GitData/References.hs index 0dff891d..6cd4cf94 100644 --- a/Github/GitData/References.hs +++ b/Github/GitData/References.hs @@ -4,6 +4,7 @@ module Github.GitData.References ( reference ,references +,createReference ,namespacedReferences ,module Github.Data ) where @@ -25,6 +26,10 @@ references :: String -> String -> IO (Either Error [GitReference]) references user reqRepoName = githubGet ["repos", user, reqRepoName, "git", "refs"] +createReference :: GithubAuth -> String -> String -> NewGitReference -> IO (Either Error GitReference) +createReference auth owner reqRepoName newRef = + githubPost auth ["repos", owner, reqRepoName, "git", "refs"] newRef + -- | Limited references by a namespace. -- -- > namespacedReferences "thoughtbot" "paperclip" "tags" diff --git a/github.cabal b/github.cabal index de456613..48900b01 100644 --- a/github.cabal +++ b/github.cabal @@ -7,7 +7,7 @@ Name: github -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented. -Version: 0.12 +Version: 0.13 -- A short (one-line) description of the package. Synopsis: Access to the Github API, v3. @@ -50,6 +50,7 @@ Extra-source-files: README.md ,samples/Gists/ListGists.hs ,samples/Gists/ShowGist.hs ,samples/GitData/Commits/GitShow.hs + ,samples/GitData/References/GitCreateReference.hs ,samples/GitData/References/GitLsRemote.hs ,samples/GitData/References/GitLsRemoteTags.hs ,samples/GitData/References/GitLsRemoteWithRef.hs diff --git a/samples/GitData/References/GitCreateReference.hs b/samples/GitData/References/GitCreateReference.hs new file mode 100644 index 00000000..b9f5007f --- /dev/null +++ b/samples/GitData/References/GitCreateReference.hs @@ -0,0 +1,19 @@ +module GitCreateRef where + +import qualified Github.Auth as Auth +import Github.GitData.References + +main :: IO () +main = do + let auth = Auth.GithubOAuth "oauthtoken" + newlyCreatedGitRef <- createReference auth "myrepo" "myowner" NewGitReference { + newGitReferenceRef = "refs/heads/fav_tag" + ,newGitReferenceSha = "aa218f56b14c9653891f9e74264a383fa43fefbd" + } + case newlyCreatedGitRef of + (Left err) -> putStrLn $ "Error: " ++ show err + (Right newRef) -> putStrLn . formatReference $ newRef + +formatReference :: GitReference -> String +formatReference ref = + (gitObjectSha $ gitReferenceObject ref) ++ "\t" ++ (gitReferenceRef ref) From 83f69d7520a522dc1378e4890f146d883f354519 Mon Sep 17 00:00:00 2001 From: Ricky Elrod Date: Thu, 27 Nov 2014 15:12:25 -0500 Subject: [PATCH 042/510] Add basic (readonly) repo subscription endpoints Closes #82. Signed-off-by: Ricky Elrod --- Github/Repos/Subscribing.hs | 39 +++++++++++++++++++++++++++++++++++++ github.cabal | 1 + 2 files changed, 40 insertions(+) create mode 100644 Github/Repos/Subscribing.hs diff --git a/Github/Repos/Subscribing.hs b/Github/Repos/Subscribing.hs new file mode 100644 index 00000000..8f848b7d --- /dev/null +++ b/Github/Repos/Subscribing.hs @@ -0,0 +1,39 @@ +-- | The repo subscribing API as described on +-- . +module Github.Repos.Subscribing ( + subscribersFor +,subscribersFor' +,reposSubscribedToBy +,reposSubscribedToBy' +,module Github.Data +) where + +import Github.Data +import Github.Private + +-- | The list of users that are subscribed to the specified Github repo. +-- +-- > subscribersFor "thoughtbot" "paperclip" +subscribersFor :: String -> String -> IO (Either Error [GithubOwner]) +subscribersFor = subscribersFor' Nothing + +-- | The list of users that are subscribed to the specified Github repo. +-- | With authentication +-- +-- > subscribersFor' (Just (GithubUser (user, password))) "thoughtbot" "paperclip" +subscribersFor' :: Maybe GithubAuth -> String -> String -> IO (Either Error [GithubOwner]) +subscribersFor' auth userName reqRepoName = + githubGet' auth ["repos", userName, reqRepoName, "subscribers"] + +-- | All the public repos subscribed to by the specified user. +-- +-- > reposSubscribedToBy "croaky" +reposSubscribedToBy :: String -> IO (Either Error [Repo]) +reposSubscribedToBy = reposSubscribedToBy' Nothing + +-- | All the public repos subscribed to by the specified user. +-- | With authentication +-- +-- > reposSubscribedToBy' (Just (GithubUser (user, password))) "croaky" +reposSubscribedToBy' :: Maybe GithubAuth -> String -> IO (Either Error [Repo]) +reposSubscribedToBy' auth userName = githubGet' auth ["users", userName, "subscriptions"] diff --git a/github.cabal b/github.cabal index 48900b01..525cb30a 100644 --- a/github.cabal +++ b/github.cabal @@ -145,6 +145,7 @@ Library Github.Repos.Forks, Github.Repos.Watching, Github.Repos.Starring, + Github.Repos.Subscribing, Github.Repos.Webhooks Github.Repos.Webhooks.Validate, Github.Users, From 8cf7e2619e35165b50b136a0bd4f4a36a1de1829 Mon Sep 17 00:00:00 2001 From: Ricky Elrod Date: Sun, 30 Nov 2014 18:30:45 -0500 Subject: [PATCH 043/510] bump version in cabal file Signed-off-by: Ricky Elrod --- github.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/github.cabal b/github.cabal index 525cb30a..ae650867 100644 --- a/github.cabal +++ b/github.cabal @@ -7,7 +7,7 @@ Name: github -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented. -Version: 0.13 +Version: 0.13.1 -- A short (one-line) description of the package. Synopsis: Access to the Github API, v3. From e8e658a6a19bcdffdc8c100683ac3fc74b0bff19 Mon Sep 17 00:00:00 2001 From: Nicolas DI PRIMA Date: Sun, 18 Jan 2015 12:19:20 -0800 Subject: [PATCH 044/510] CreatePullRequest: add the interface command to create a pull request * create a pull request refering an issue * create a pull request from scratch --- Github/Data.hs | 6 ++++++ Github/Data/Definitions.hs | 14 ++++++++++++++ Github/PullRequests.hs | 9 +++++++++ 3 files changed, 29 insertions(+) diff --git a/Github/Data.hs b/Github/Data.hs index d70cf855..26926da7 100644 --- a/Github/Data.hs +++ b/Github/Data.hs @@ -377,6 +377,12 @@ instance ToJSON EditPullRequest where where notNull (_, Null) = False notNull (_, _) = True +instance ToJSON CreatePullRequest where + toJSON (CreatePullRequest t b headPR basePR) = + object [ "title" .= t, "body" .= b, "head" .= headPR, "base" .= basePR ] + toJSON (CreatePullRequestIssue issueNum headPR basePR) = + object [ "issue" .= issueNum, "head" .= headPR, "base" .= basePR] + instance FromJSON DetailedPullRequest where parseJSON (Object o) = DetailedPullRequest diff --git a/Github/Data/Definitions.hs b/Github/Data/Definitions.hs index 230fadb9..ab135cca 100644 --- a/Github/Data/Definitions.hs +++ b/Github/Data/Definitions.hs @@ -378,6 +378,20 @@ data EditPullRequest = EditPullRequest { ,editPullRequestState :: Maybe EditPullRequestState } deriving (Show) +data CreatePullRequest = + CreatePullRequest + { createPullRequestTitle :: String + , createPullRequestBody :: String + , createPullRequestHead :: String + , createPullRequestBase :: String + } + | CreatePullRequestIssue + { createPullRequestIssueNum :: Int + , createPullRequestHead :: String + , createPullRequestBase :: String + } + deriving (Show) + data PullRequestLinks = PullRequestLinks { pullRequestLinksReviewComments :: String ,pullRequestLinksComments :: String diff --git a/Github/PullRequests.hs b/Github/PullRequests.hs index f38dcebc..bc505b82 100644 --- a/Github/PullRequests.hs +++ b/Github/PullRequests.hs @@ -12,6 +12,7 @@ module Github.PullRequests ( ,pullRequestFiles ,isPullRequestMerged ,mergePullRequest +,createPullRequest ,updatePullRequest ,module Github.Data ) where @@ -103,3 +104,11 @@ updatePullRequest auth reqRepoOwner reqRepoName reqPullRequestNumber editPullReq buildCommitMessageMap :: Maybe String -> M.Map String String buildCommitMessageMap (Just commitMessage) = M.singleton "commit_message" commitMessage buildCommitMessageMap _ = M.empty + +createPullRequest :: GithubAuth + -> String + -> String + -> CreatePullRequest + -> IO (Either Error DetailedPullRequest) +createPullRequest auth reqUserName reqRepoName createPR = + githubPost auth ["repos", reqUserName, reqRepoName, "pulls"] createPR From b94dbae903ab560dd810eb90cb5d595d88e0f563 Mon Sep 17 00:00:00 2001 From: Yuriy Syrovetskiy Date: Tue, 27 Jan 2015 18:10:30 +0300 Subject: [PATCH 045/510] [b] CONTRIBUTING: * Find all samples that use the data structure and make sure they run. --- github.cabal | 1 + samples/Issues/CreateIssue.hs | 1 + samples/Issues/EditIssue.hs | 1 + samples/Issues/IssueReport/Issues.hs | 8 ++++---- samples/Pulls/UpdatePull.hs | 1 + samples/Repos/ShowRepo.hs | 4 ++-- 6 files changed, 10 insertions(+), 6 deletions(-) diff --git a/github.cabal b/github.cabal index ae650867..043cf97c 100644 --- a/github.cabal +++ b/github.cabal @@ -139,6 +139,7 @@ Library Github.Organizations, Github.Organizations.Members, Github.PullRequests, + Github.PullRequests.ReviewComments, Github.Repos, Github.Repos.Collaborators, Github.Repos.Commits, diff --git a/samples/Issues/CreateIssue.hs b/samples/Issues/CreateIssue.hs index d1565a55..efd3d1bc 100644 --- a/samples/Issues/CreateIssue.hs +++ b/samples/Issues/CreateIssue.hs @@ -1,6 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} module CreateIssue where +import qualified Github.Auth as Github import qualified Github.Issues as Github main = do diff --git a/samples/Issues/EditIssue.hs b/samples/Issues/EditIssue.hs index c6f6f019..5d5d8a6f 100644 --- a/samples/Issues/EditIssue.hs +++ b/samples/Issues/EditIssue.hs @@ -1,6 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} module EditIssue where +import qualified Github.Auth as Github import qualified Github.Issues as Github main = do diff --git a/samples/Issues/IssueReport/Issues.hs b/samples/Issues/IssueReport/Issues.hs index 089a499f..f60f9808 100644 --- a/samples/Issues/IssueReport/Issues.hs +++ b/samples/Issues/IssueReport/Issues.hs @@ -1,15 +1,15 @@ {-# LANGUAGE OverloadedStrings #-} module Main where +import qualified Github.Auth as Github import qualified Github.Issues as Github -import qualified Data.ByteString as B import Report -- The example requires wl-pprint module "The Wadler/Leijen Pretty Printer" -import Text.PrettyPrint.Leijen +import Text.PrettyPrint.ANSI.Leijen -auth :: Maybe (B.ByteString, B.ByteString) -auth = Just ("yourgithub id", "somepassword") +auth :: Maybe Github.GithubAuth +auth = Just $ Github.GithubBasicAuth "yourgithub id" "somepassword" mkIssue :: ReportedIssue -> Doc mkIssue (Issue n t h) = hsep [ diff --git a/samples/Pulls/UpdatePull.hs b/samples/Pulls/UpdatePull.hs index ffd19b8f..68e22fd6 100644 --- a/samples/Pulls/UpdatePull.hs +++ b/samples/Pulls/UpdatePull.hs @@ -2,6 +2,7 @@ module MergePullRequest where import qualified Github.PullRequests as Github import Github.Auth +import Github.Data main :: IO () main = do diff --git a/samples/Repos/ShowRepo.hs b/samples/Repos/ShowRepo.hs index 8274224b..7ac0df4b 100644 --- a/samples/Repos/ShowRepo.hs +++ b/samples/Repos/ShowRepo.hs @@ -14,8 +14,8 @@ formatRepo repo = (Github.repoName repo) ++ "\t" ++ (fromMaybe "" $ Github.repoDescription repo) ++ "\n" ++ (Github.repoHtmlUrl repo) ++ "\n" ++ - (Github.repoCloneUrl repo) ++ "\t" ++ - (formatDate $ Github.repoUpdatedAt repo) ++ "\n" ++ + (fromMaybe "" $ Github.repoCloneUrl repo) ++ "\t" ++ + (fromMaybe "" $ formatDate `fmap` Github.repoUpdatedAt repo) ++ "\n" ++ formatLanguage (Github.repoLanguage repo) ++ "watchers: " ++ (show $ Github.repoWatchers repo) ++ "\t" ++ "forks: " ++ (show $ Github.repoForks repo) From 35180ad2bf5de58df90f2c32a50b7c845f5f4b12 Mon Sep 17 00:00:00 2001 From: Yuriy Syrovetskiy Date: Tue, 27 Jan 2015 18:59:08 +0300 Subject: [PATCH 046/510] [+] Github Enterprise --- Github/Private.hs | 29 ++++++----- Github/PullRequests.hs | 4 +- Github/Repos.hs | 7 +-- Github/Repos/Collaborators.hs | 10 ++-- Github/Repos/Webhooks.hs | 16 +++---- .../Issues/IssueReport/IssuesEnterprise.hs | 48 +++++++++++++++++++ samples/Repos/Collaborators/IsCollaborator.hs | 2 +- 7 files changed, 86 insertions(+), 30 deletions(-) create mode 100644 samples/Issues/IssueReport/IssuesEnterprise.hs diff --git a/Github/Private.hs b/Github/Private.hs index 3ede8800..467dd73a 100644 --- a/Github/Private.hs +++ b/Github/Private.hs @@ -20,7 +20,10 @@ import Data.Maybe (fromMaybe) -- | user/password for HTTP basic access authentication data GithubAuth = GithubBasicAuth BS.ByteString BS.ByteString - | GithubOAuth String + | GithubOAuth String -- ^ token + | GithubEnterpriseOAuth String -- ^ custom API endpoint without + -- trailing slash + String -- ^ token deriving (Show, Data, Typeable, Eq, Ord) githubGet :: (FromJSON b, Show b) => [String] -> IO (Either Error b) @@ -29,7 +32,7 @@ githubGet = githubGet' Nothing githubGet' :: (FromJSON b, Show b) => Maybe GithubAuth -> [String] -> IO (Either Error b) githubGet' auth paths = githubAPI (BS.pack "GET") - (buildUrl paths) + (buildPath paths) auth (Nothing :: Maybe Value) @@ -39,31 +42,35 @@ githubGetWithQueryString = githubGetWithQueryString' Nothing githubGetWithQueryString' :: (FromJSON b, Show b) => Maybe GithubAuth -> [String] -> String -> IO (Either Error b) githubGetWithQueryString' auth paths qs = githubAPI (BS.pack "GET") - (buildUrl paths ++ "?" ++ qs) + (buildPath paths ++ "?" ++ qs) auth (Nothing :: Maybe Value) githubPost :: (ToJSON a, Show a, FromJSON b, Show b) => GithubAuth -> [String] -> a -> IO (Either Error b) githubPost auth paths body = githubAPI (BS.pack "POST") - (buildUrl paths) + (buildPath paths) (Just auth) (Just body) githubPatch :: (ToJSON a, Show a, FromJSON b, Show b) => GithubAuth -> [String] -> a -> IO (Either Error b) githubPatch auth paths body = githubAPI (BS.pack "PATCH") - (buildUrl paths) + (buildPath paths) (Just auth) (Just body) -buildUrl :: [String] -> String -buildUrl paths = "https://api.github.com/" ++ intercalate "/" paths +apiEndpoint :: Maybe GithubAuth -> String +apiEndpoint (Just (GithubEnterpriseOAuth endpoint _)) = endpoint +apiEndpoint _ = "https://api.github.com" + +buildPath :: [String] -> String +buildPath paths = '/' : intercalate "/" paths githubAPI :: (ToJSON a, Show a, FromJSON b, Show b) => BS.ByteString -> String -> Maybe GithubAuth -> Maybe a -> IO (Either Error b) -githubAPI apimethod url auth body = do - result <- doHttps apimethod url auth (encodeBody body) +githubAPI apimethod path auth body = do + result <- doHttps apimethod (apiEndpoint auth ++ path) auth (encodeBody body) case result of Left e -> return (Left (HTTPConnectionError e)) Right resp -> either Left (\x -> jsonResultToE (LBS.pack (show x)) @@ -153,8 +160,8 @@ doHttps reqMethod url auth body = do #endif doHttpsStatus :: BS.ByteString -> String -> GithubAuth -> Maybe RequestBody -> IO (Either Error Status) -doHttpsStatus reqMethod url auth payload = do - result <- doHttps reqMethod url (Just auth) payload +doHttpsStatus reqMethod path auth payload = do + result <- doHttps reqMethod (apiEndpoint (Just auth) ++ path) (Just auth) payload case result of Left e -> return (Left (HTTPConnectionError e)) Right resp -> diff --git a/Github/PullRequests.hs b/Github/PullRequests.hs index bc505b82..1b20f7dd 100644 --- a/Github/PullRequests.hs +++ b/Github/PullRequests.hs @@ -88,12 +88,12 @@ pullRequestFiles = pullRequestFiles' Nothing -- | Check if pull request has been merged isPullRequestMerged :: GithubAuth -> String -> String -> Int -> IO(Either Error Status) isPullRequestMerged auth reqRepoOwner reqRepoName reqPullRequestNumber = - doHttpsStatus "GET" (buildUrl ["repos", reqRepoOwner, reqRepoName, "pulls", (show reqPullRequestNumber), "merge"]) auth Nothing + doHttpsStatus "GET" (buildPath ["repos", reqRepoOwner, reqRepoName, "pulls", (show reqPullRequestNumber), "merge"]) auth Nothing -- | Merge a pull request mergePullRequest :: GithubAuth -> String -> String -> Int -> Maybe String -> IO(Either Error Status) mergePullRequest auth reqRepoOwner reqRepoName reqPullRequestNumber commitMessage = - doHttpsStatus "PUT" (buildUrl ["repos", reqRepoOwner, reqRepoName, "pulls", (show reqPullRequestNumber), "merge"]) auth (Just . RequestBodyLBS . encode . toJSON $ (buildCommitMessageMap commitMessage)) + doHttpsStatus "PUT" (buildPath ["repos", reqRepoOwner, reqRepoName, "pulls", (show reqPullRequestNumber), "merge"]) auth (Just . RequestBodyLBS . encode . toJSON $ (buildCommitMessageMap commitMessage)) -- | Update a pull request updatePullRequest :: GithubAuth -> String -> String -> Int -> EditPullRequest -> IO (Either Error DetailedPullRequest) diff --git a/Github/Repos.hs b/Github/Repos.hs index 543f16cd..6ba435ec 100644 --- a/Github/Repos.hs +++ b/Github/Repos.hs @@ -320,7 +320,10 @@ deleteRepo :: GithubAuth -> String -- ^ repository name -> IO (Either Error ()) deleteRepo auth owner repo = do - result <- doHttps "DELETE" url (Just auth) Nothing + result <- doHttps "DELETE" + (apiEndpoint (Just auth) ++ buildPath ["repos", owner, repo]) + (Just auth) + Nothing case result of Left e -> return (Left (HTTPConnectionError e)) Right resp -> @@ -338,5 +341,3 @@ deleteRepo auth owner repo = do #endif )))) else return (Right ()) - where - url = "https://api.github.com/repos/" ++ owner ++ "/" ++ repo diff --git a/Github/Repos/Collaborators.hs b/Github/Repos/Collaborators.hs index 6cca521b..78ee1042 100644 --- a/Github/Repos/Collaborators.hs +++ b/Github/Repos/Collaborators.hs @@ -23,12 +23,12 @@ collaboratorsOn userName reqRepoName = -- | Whether the user is collaborating on a repo. Takes the user in question, -- the user who owns the repo, and the repo name. -- --- > isCollaboratorOn "mike-burns" "thoughtbot" "paperclip" --- > isCollaboratorOn "johnson" "thoughtbot" "paperclip" -isCollaboratorOn :: String -> String -> String -> IO (Either Error Bool) -isCollaboratorOn userName repoOwnerName reqRepoName = do +-- > isCollaboratorOn Nothing "mike-burns" "thoughtbot" "paperclip" +-- > isCollaboratorOn Nothing "johnson" "thoughtbot" "paperclip" +isCollaboratorOn :: Maybe GithubAuth -> String -> String -> String -> IO (Either Error Bool) +isCollaboratorOn auth userName repoOwnerName reqRepoName = do result <- doHttps (pack "GET") - (buildUrl ["repos", repoOwnerName, reqRepoName, "collaborators", userName]) + (apiEndpoint auth ++ buildPath ["repos", repoOwnerName, reqRepoName, "collaborators", userName]) Nothing Nothing return $ either (Left . HTTPConnectionError) diff --git a/Github/Repos/Webhooks.hs b/Github/Repos/Webhooks.hs index 5998d08a..4d441637 100644 --- a/Github/Repos/Webhooks.hs +++ b/Github/Repos/Webhooks.hs @@ -98,19 +98,19 @@ editRepoWebhook' auth owner reqRepoName webhookId edit = githubPatch auth ["repo testPushRepoWebhook' :: GithubAuth -> RepoOwner -> RepoName -> RepoWebhookId -> IO (Either Error Status) testPushRepoWebhook' auth owner reqRepoName webhookId = - doHttpsStatus "POST" (createWebhookOpUrl owner reqRepoName webhookId (Just "tests")) auth (Just . RequestBodyLBS . encode $ (decode "{}" :: Maybe (M.Map String Int))) + doHttpsStatus "POST" (createWebhookOpPath owner reqRepoName webhookId (Just "tests")) auth (Just . RequestBodyLBS . encode $ (decode "{}" :: Maybe (M.Map String Int))) pingRepoWebhook' :: GithubAuth -> RepoOwner -> RepoName -> RepoWebhookId -> IO (Either Error Status) pingRepoWebhook' auth owner reqRepoName webhookId = - doHttpsStatus "POST" (createWebhookOpUrl owner reqRepoName webhookId (Just "pings")) auth Nothing + doHttpsStatus "POST" (createWebhookOpPath owner reqRepoName webhookId (Just "pings")) auth Nothing deleteRepoWebhook' :: GithubAuth -> RepoOwner -> RepoName -> RepoWebhookId -> IO (Either Error Status) deleteRepoWebhook' auth owner reqRepoName webhookId = - doHttpsStatus "DELETE" (createWebhookOpUrl owner reqRepoName webhookId Nothing) auth Nothing + doHttpsStatus "DELETE" (createWebhookOpPath owner reqRepoName webhookId Nothing) auth Nothing -createBaseWebhookUrl :: RepoOwner -> RepoName -> RepoWebhookId -> String -createBaseWebhookUrl owner reqRepoName webhookId = "https://api.github.com/repos/" ++ owner ++ "/" ++ reqRepoName ++ "/hooks/" ++ (show webhookId) +createBaseWebhookPath :: RepoOwner -> RepoName -> RepoWebhookId -> String +createBaseWebhookPath owner reqRepoName webhookId = buildPath ["repos", owner, reqRepoName, "hooks", show webhookId] -createWebhookOpUrl :: RepoOwner -> RepoName -> RepoWebhookId -> Maybe String -> String -createWebhookOpUrl owner reqRepoName webhookId Nothing = createBaseWebhookUrl owner reqRepoName webhookId -createWebhookOpUrl owner reqRepoName webhookId (Just operation) = createBaseWebhookUrl owner reqRepoName webhookId ++ "/" ++ operation +createWebhookOpPath :: RepoOwner -> RepoName -> RepoWebhookId -> Maybe String -> String +createWebhookOpPath owner reqRepoName webhookId Nothing = createBaseWebhookPath owner reqRepoName webhookId +createWebhookOpPath owner reqRepoName webhookId (Just operation) = createBaseWebhookPath owner reqRepoName webhookId ++ "/" ++ operation diff --git a/samples/Issues/IssueReport/IssuesEnterprise.hs b/samples/Issues/IssueReport/IssuesEnterprise.hs new file mode 100644 index 00000000..3dc8719e --- /dev/null +++ b/samples/Issues/IssueReport/IssuesEnterprise.hs @@ -0,0 +1,48 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main where + +import qualified Github.Auth as Github +import qualified Github.Issues as Github +import Report + +-- The example requires wl-pprint module "The Wadler/Leijen Pretty Printer" +import Text.PrettyPrint.ANSI.Leijen + +auth :: Maybe Github.GithubAuth +auth = Just $ Github.GithubEnterpriseOAuth + "https://github.example.com/api" + "1a79a4d60de6718e8e5b326e338ae533" + +mkIssue :: ReportedIssue -> Doc +mkIssue (Issue n t h) = hsep [ + fill 5 (text ("#" ++ (show n))), + fill 50 (text t), + fill 5 (text (show h))] + +vissues :: ([Doc], [Doc], [Doc]) -> Doc +vissues (x, y, z) = hsep [(vcat x), align (vcat y), align (vcat z)] + +mkDoc :: Report -> Doc +mkDoc (Report issues total) = vsep [ + text "Report for the milestone", + (vsep . map mkIssue) issues, + text ("Total hours : " ++ (show total) ++" hours") + ] + +mkFullDoc :: [Github.Issue] -> Doc +mkFullDoc = mkDoc . prepareReport + +-- The public repo is used as private are quite sensitive for this report +-- +-- The main idea is to use labels like 1h, 2h etc for man-hour estimation of issues +-- on private repos for development "on hire" +-- +-- This tool is used to generate report on work done for the customer +-- +main :: IO () +main = do + let limitations = [Github.OnlyClosed, Github.MilestoneId 4] + possibleIssues <- Github.issuesForRepo' auth "paulrzcz" "hquantlib" limitations + case possibleIssues of + (Left err) -> putStrLn $ "Error: " ++ show err + (Right issues) -> putDoc $ mkFullDoc issues diff --git a/samples/Repos/Collaborators/IsCollaborator.hs b/samples/Repos/Collaborators/IsCollaborator.hs index 865744d8..1b891c55 100644 --- a/samples/Repos/Collaborators/IsCollaborator.hs +++ b/samples/Repos/Collaborators/IsCollaborator.hs @@ -5,7 +5,7 @@ import Data.List main = do let userName = "ubuwaits" - possiblyIsCollaborator <- Github.isCollaboratorOn userName "thoughtbot" "paperclip" + possiblyIsCollaborator <- Github.isCollaboratorOn Nothing userName "thoughtbot" "paperclip" case possiblyIsCollaborator of (Left error) -> putStrLn $ "Error: " ++ (show error) (Right True) -> From dc0b9b23d55f02e88ce5c841b722f5e4f6f46a9d Mon Sep 17 00:00:00 2001 From: Justin Leitgeb Date: Wed, 4 Feb 2015 17:38:58 -0500 Subject: [PATCH 047/510] Add initial hspec test --- github.cabal | 32 ++++++++++++++++++++++++++++++++ spec/Github/UsersSpec.hs | 17 +++++++++++++++++ spec/Spec.hs | 1 + 3 files changed, 50 insertions(+) create mode 100644 spec/Github/UsersSpec.hs create mode 100644 spec/Spec.hs diff --git a/github.cabal b/github.cabal index ae650867..da76af0d 100644 --- a/github.cabal +++ b/github.cabal @@ -183,3 +183,35 @@ Library -- Build-tools: GHC-Options: -Wall -fno-warn-orphans + + +test-suite github-test + type: exitcode-stdio-1.0 + hs-source-dirs: spec, . + main-is: Spec.hs + build-depends: base >= 4.0 && < 5.0, + time, + aeson >= 0.6.1.0, + attoparsec >= 0.10.3.0, + bytestring, + case-insensitive >= 0.4.0.4, + containers, + hashable, + text, + old-locale, + HTTP, + network, + http-conduit >= 1.8, + conduit, + failure, + http-types, + data-default, + vector, + unordered-containers >= 0.2 && < 0.3, + cryptohash >= 0.11, + byteable >= 0.1.0, + base16-bytestring >= 0.1.1.6 + + , hspec + + ghc-options: -Wall -fno-warn-orphans diff --git a/spec/Github/UsersSpec.hs b/spec/Github/UsersSpec.hs new file mode 100644 index 00000000..fff5e529 --- /dev/null +++ b/spec/Github/UsersSpec.hs @@ -0,0 +1,17 @@ +module Github.UsersSpec where + +import Github.Users (userInfoFor) +import Github.Data.Definitions (DetailedOwner(..)) + +import Test.Hspec (it, describe, shouldBe, Spec) + +fromRight :: Either a b -> b +fromRight (Right b) = b +fromRight (Left _) = error "Expected a Right and got a Left" + +spec :: Spec +spec = + describe "userInfoFor" $ do + it "returns information about the user" $ do + userInfo <- userInfoFor "mike-burns" + detailedOwnerLogin (fromRight userInfo) `shouldBe` "mike-burns" diff --git a/spec/Spec.hs b/spec/Spec.hs new file mode 100644 index 00000000..a824f8c3 --- /dev/null +++ b/spec/Spec.hs @@ -0,0 +1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} From f2760a43036ed363d2e762456576034c947bb548 Mon Sep 17 00:00:00 2001 From: Lally Singh Date: Wed, 4 Mar 2015 10:41:18 -0500 Subject: [PATCH 048/510] Added OAuth to events api. --- Github/Issues/Events.hs | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) diff --git a/Github/Issues/Events.hs b/Github/Issues/Events.hs index 68f75bdd..fea21ef4 100644 --- a/Github/Issues/Events.hs +++ b/Github/Issues/Events.hs @@ -2,8 +2,11 @@ -- module Github.Issues.Events ( eventsForIssue +,eventsForIssue' ,eventsForRepo +,eventsForRepo' ,event +,event' ,module Github.Data ) where @@ -17,6 +20,13 @@ eventsForIssue :: String -> String -> Int -> IO (Either Error [Event]) eventsForIssue user reqRepoName reqIssueNumber = githubGet ["repos", user, reqRepoName, "issues", show reqIssueNumber, "events"] +-- | 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"] + -- | All the events for all issues in a repo. -- -- > eventsForRepo "thoughtbot" "paperclip" @@ -24,9 +34,23 @@ eventsForRepo :: String -> String -> IO (Either Error [Event]) eventsForRepo user reqRepoName = githubGet ["repos", user, reqRepoName, "issues", "events"] +-- | 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"] + -- | 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] + +-- | 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] From d0315da143f49bb763d0a7b97e8574c7711f88cd Mon Sep 17 00:00:00 2001 From: mrb Date: Tue, 17 Mar 2015 23:24:26 -0400 Subject: [PATCH 049/510] Add stargazers_count to repo data --- Github/Data.hs | 5 +++-- Github/Data/Definitions.hs | 1 + samples/Search/SearchRepos.hs | 2 +- 3 files changed, 5 insertions(+), 3 deletions(-) diff --git a/Github/Data.hs b/Github/Data.hs index 26926da7..72742bb3 100644 --- a/Github/Data.hs +++ b/Github/Data.hs @@ -537,9 +537,10 @@ instance FromJSON Repo where <*> o .:? "has_wiki" <*> o .:? "has_issues" <*> o .:? "has_downloads" - <*> o .:? "parent" - <*> o .:? "source" + <*> o .:? "parent" + <*> o .:? "source" <*> o .: "hooks_url" + <*> o .: "stargazers_count" parseJSON _ = fail "Could not build a Repo" instance FromJSON SearchCodeResult where diff --git a/Github/Data/Definitions.hs b/Github/Data/Definitions.hs index ab135cca..1824c4f9 100644 --- a/Github/Data/Definitions.hs +++ b/Github/Data/Definitions.hs @@ -441,6 +441,7 @@ data Repo = Repo { ,repoParent :: Maybe RepoRef ,repoSource :: Maybe RepoRef ,repoHooksUrl :: String + ,repoStargazersCount :: Int } deriving (Show, Data, Typeable, Eq, Ord) data RepoRef = RepoRef GithubOwner String -- Repo owner and name diff --git a/samples/Search/SearchRepos.hs b/samples/Search/SearchRepos.hs index 6c937941..9961e690 100644 --- a/samples/Search/SearchRepos.hs +++ b/samples/Search/SearchRepos.hs @@ -44,6 +44,7 @@ formatRepo r = ,("Description", orEmpty . Github.repoDescription) ,("Created-At", formatMaybeDate . Github.repoCreatedAt) ,("Pushed-At", formatMaybeDate . Github.repoPushedAt) + ,("Stars", show . Github.repoStargazersCount) ] in intercalate "\n" $ map fmt fields where fmt (s,f) = fill 12 (s ++ ":") ++ " " ++ f r @@ -52,5 +53,4 @@ formatRepo r = where n' = max 0 (n - length s) formatMaybeDate = maybe "???" formatDate - formatDate = show . Github.fromGithubDate From 29ccce6265e50f86bc8e6c46d29e346eebc33bf3 Mon Sep 17 00:00:00 2001 From: mrb Date: Thu, 19 Mar 2015 11:02:10 -0400 Subject: [PATCH 050/510] Get a repo README --- Github/Repos.hs | 17 +++++++++++++++++ samples/Repos/GetReadme.hs | 11 +++++++++++ 2 files changed, 28 insertions(+) create mode 100644 samples/Repos/GetReadme.hs diff --git a/Github/Repos.hs b/Github/Repos.hs index 543f16cd..cdf3c0b2 100644 --- a/Github/Repos.hs +++ b/Github/Repos.hs @@ -25,6 +25,8 @@ module Github.Repos ( ,branchesFor' ,contentsFor ,contentsFor' +,readmeFor +,readmeFor' ,module Github.Data ,RepoPublicity(..) @@ -220,6 +222,21 @@ contentsFor' auth userName reqRepoName reqContentPath ref = ["repos", userName, reqRepoName, "contents", reqContentPath] $ maybe "" ("ref="++) ref +-- | The contents of a README file in a repo, given the repo owner and name +-- +-- > readmeFor "thoughtbot" "paperclip" +readmeFor :: String -> String -> 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 (GithubBasicAuth (user, password))) "thoughtbot" "paperclip" +readmeFor' :: Maybe GithubAuth -> String -> String -> IO (Either Error Content) +readmeFor' auth userName reqRepoName = + githubGetWithQueryString' auth + ["repos", userName, reqRepoName, "readme"] $ + "" data NewRepo = NewRepo { newRepoName :: String diff --git a/samples/Repos/GetReadme.hs b/samples/Repos/GetReadme.hs new file mode 100644 index 00000000..353e226a --- /dev/null +++ b/samples/Repos/GetReadme.hs @@ -0,0 +1,11 @@ +module GetReadme where + +import qualified Github.Repos as Github +import Data.List +import Data.Maybe + +main = do + possibleReadme <- Github.readmeFor "jwiegley" "github" + case possibleReadme of + (Left error) -> putStrLn $ "Error: " ++ (show error) + (Right (Github.ContentFile cd)) -> putStrLn $ (show cd) From b158582b14d1467fc97e2560e4868bb517f7865e Mon Sep 17 00:00:00 2001 From: Jacob Errington Date: Sun, 1 Feb 2015 00:33:26 -0500 Subject: [PATCH 051/510] Add authenticated versions of every function in Repos.Commits --- Github/Repos/Commits.hs | 65 +++++++++++++++++++++++++++++++++++------ 1 file changed, 56 insertions(+), 9 deletions(-) diff --git a/Github/Repos/Commits.hs b/Github/Repos/Commits.hs index acab907a..6cb98554 100644 --- a/Github/Repos/Commits.hs +++ b/Github/Repos/Commits.hs @@ -2,11 +2,17 @@ -- . module Github.Repos.Commits ( commitsFor +,commitsFor' ,commit +,commit' ,commentsFor +,commentsFor' ,commitCommentsFor +,commitCommentsFor' ,commitCommentFor +,commitCommentFor' ,diff +,diff' ,module Github.Data ) where @@ -17,37 +23,78 @@ import Github.Private -- -- > commitsFor "mike-burns" "github" commitsFor :: String -> String -> IO (Either Error [Commit]) -commitsFor user repo = githubGet ["repos", user, repo, "commits"] +commitsFor = commitsFor' Nothing + +-- | The commit history for a repo. +-- With authentication. +-- +-- > commitsFor' (Just (GithubBasicAuth (user, password))) "mike-burns" "github" +commitsFor' :: Maybe GithubAuth -> String -> String -> IO (Either Error [Commit]) +commitsFor' auth user repo = githubGet' auth ["repos", user, repo, "commits"] -- | Details on a specific SHA1 for a repo. -- -- > commit "mike-burns" "github" "9d1a9a361266c3c890b1108ad2fdf52f824b1b81" commit :: String -> String -> String -> IO (Either Error Commit) -commit user repo sha1 = githubGet ["repos", user, repo, "commits", sha1] +commit = commit' Nothing + +-- | Details on a specific SHA1 for a repo. +-- With authentication. +-- +-- > commit (Just $ GithubBasicAuth (username, password)) "mike-burns" "github" "9d1a9a361266c3c890b1108ad2fdf52f824b1b81" +commit' :: Maybe GithubAuth -> String -> String -> String -> IO (Either Error Commit) +commit' auth user repo sha1 = githubGet' auth ["repos", user, repo, "commits", sha1] + -- | All the comments on a Github repo. -- -- > commentsFor "thoughtbot" "paperclip" commentsFor :: String -> String -> IO (Either Error [Comment]) -commentsFor user repo = githubGet ["repos", user, repo, "comments"] +commentsFor = commentsFor' Nothing + +-- | All the comments on a Github repo. +-- With authentication. +-- +-- > commentsFor "thoughtbot" "paperclip" +commentsFor' :: Maybe GithubAuth -> String -> String -> IO (Either Error [Comment]) +commentsFor' auth user repo = githubGet' auth ["repos", user, repo, "comments"] -- | Just the comments on a specific SHA for a given Github repo. -- -- > commitCommentsFor "thoughtbot" "paperclip" "41f685f6e01396936bb8cd98e7cca517e2c7d96b" commitCommentsFor :: String -> String -> String -> IO (Either Error [Comment]) -commitCommentsFor user repo sha1 = - githubGet ["repos", user, repo, "commits", sha1, "comments"] +commitCommentsFor = commitCommentsFor' Nothing + +-- | Just the comments on a specific SHA for a given Github repo. +-- With authentication. +-- +-- > commitCommentsFor "thoughtbot" "paperclip" "41f685f6e01396936bb8cd98e7cca517e2c7d96b" +commitCommentsFor' :: Maybe GithubAuth -> String -> String -> String -> IO (Either Error [Comment]) +commitCommentsFor' auth user repo sha1 = + githubGet' auth ["repos", user, repo, "commits", sha1, "comments"] -- | A comment, by its ID, relative to the Github repo. -- -- > commitCommentFor "thoughtbot" "paperclip" "669575" commitCommentFor :: String -> String -> String -> IO (Either Error Comment) -commitCommentFor user repo reqCommentId = - githubGet ["repos", user, repo, "comments", reqCommentId] +commitCommentFor = commitCommentFor' Nothing + +-- | A comment, by its ID, relative to the Github repo. +-- +-- > commitCommentFor "thoughtbot" "paperclip" "669575" +commitCommentFor' :: Maybe GithubAuth -> String -> String -> String -> IO (Either Error Comment) +commitCommentFor' auth user repo reqCommentId = + githubGet' auth ["repos", user, repo, "comments", reqCommentId] -- | The diff between two treeishes on a repo. -- -- > diff "thoughtbot" "paperclip" "41f685f6e01396936bb8cd98e7cca517e2c7d96b" "HEAD" diff :: String -> String -> String -> String -> IO (Either Error Diff) -diff user repo base headref = - githubGet ["repos", user, repo, "compare", base ++ "..." ++ headref] +diff = diff' Nothing + +-- | The diff between two treeishes on a repo. +-- +-- > diff "thoughtbot" "paperclip" "41f685f6e01396936bb8cd98e7cca517e2c7d96b" "HEAD" +diff' :: Maybe GithubAuth -> String -> String -> String -> String -> IO (Either Error Diff) +diff' auth user repo base headref = + githubGet' auth ["repos", user, repo, "compare", base ++ "..." ++ headref] From 071ddbac9fb28f7deba742aabf06ed495de19f40 Mon Sep 17 00:00:00 2001 From: Jacob Errington Date: Thu, 2 Apr 2015 00:27:17 -0400 Subject: [PATCH 052/510] update to the newest time library --- Github/Data.hs | 2 +- Github/Issues.hs | 2 +- github.cabal | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/Github/Data.hs b/Github/Data.hs index 26926da7..294d3443 100644 --- a/Github/Data.hs +++ b/Github/Data.hs @@ -11,7 +11,7 @@ import Control.Applicative import Control.Monad import qualified Data.Text as T import Data.Aeson.Types -import System.Locale (defaultTimeLocale) +import Data.Time (defaultTimeLocale) import qualified Data.Vector as V import qualified Data.HashMap.Lazy as Map import Data.Hashable (Hashable) diff --git a/Github/Issues.hs b/Github/Issues.hs index 88bea3fa..c3d49473 100644 --- a/Github/Issues.hs +++ b/Github/Issues.hs @@ -17,8 +17,8 @@ import Github.Data import Github.Private import Data.List (intercalate) import Data.Time.Format (formatTime) -import System.Locale (defaultTimeLocale) import Data.Time.Clock (UTCTime(..)) +import Data.Time (defaultTimeLocale) -- | A data structure for describing how to filter issues. This is used by -- @issuesForRepo@. diff --git a/github.cabal b/github.cabal index da76af0d..e04e849f 100644 --- a/github.cabal +++ b/github.cabal @@ -154,7 +154,7 @@ Library -- Packages needed in order to build this package. Build-depends: base >= 4.0 && < 5.0, - time, + time >=1.5 && <1.6, aeson >= 0.6.1.0, attoparsec >= 0.10.3.0, bytestring, From 1447844965ef534028bc9f977af4c7bcb3eda582 Mon Sep 17 00:00:00 2001 From: Jacob Errington Date: Thu, 2 Apr 2015 00:30:21 -0400 Subject: [PATCH 053/510] implement a way to query commits with options Github's API for querying commits allows many options such as a maximum date in the past, an author, etc. --- Github/Data/Definitions.hs | 8 ++++++++ Github/Repos/Commits.hs | 40 +++++++++++++++++++++++++++++++++++++- 2 files changed, 47 insertions(+), 1 deletion(-) diff --git a/Github/Data/Definitions.hs b/Github/Data/Definitions.hs index ab135cca..97e20c01 100644 --- a/Github/Data/Definitions.hs +++ b/Github/Data/Definitions.hs @@ -7,6 +7,14 @@ import Data.Data import qualified Control.Exception as E import qualified Data.Map as M +-- | The options for querying commits. +data CommitQueryOption = CommitQuerySha String + | CommitQueryPath String + | CommitQueryAuthor String + | CommitQuerySince GithubDate + | CommitQueryUntil GithubDate + deriving (Show, Eq, Ord) + -- | Errors have been tagged according to their source, so you can more easily -- dispatch and handle them. data Error = diff --git a/Github/Repos/Commits.hs b/Github/Repos/Commits.hs index 6cb98554..f6dab652 100644 --- a/Github/Repos/Commits.hs +++ b/Github/Repos/Commits.hs @@ -1,8 +1,10 @@ -- | The repo commits API as described on -- . module Github.Repos.Commits ( - commitsFor + CommitQueryOption(..) +,commitsFor ,commitsFor' +,commitsWithOptionsFor' ,commit ,commit' ,commentsFor @@ -19,6 +21,22 @@ module Github.Repos.Commits ( import Github.Data import Github.Private +import Data.Time.Format (iso8601DateFormat, formatTime) +import Data.Time (defaultTimeLocale) +import Data.List (intercalate) + +githubFormat :: GithubDate -> String +githubFormat = formatTime defaultTimeLocale (iso8601DateFormat $ Just "%H:%M:%S") . fromGithubDate + +renderCommitQueryOption :: CommitQueryOption -> String +renderCommitQueryOption (CommitQuerySha sha) = "sha=" ++ sha +renderCommitQueryOption (CommitQueryPath path) = "path=" ++ path +renderCommitQueryOption (CommitQueryAuthor author) = "author=" ++ author +renderCommitQueryOption (CommitQuerySince date) = "since=" ++ ds ++ "Z" + where ds = show $ githubFormat date +renderCommitQueryOption (CommitQueryUntil date) = "until=" ++ ds ++ "Z" + where ds = show $ githubFormat date + -- | The commit history for a repo. -- -- > commitsFor "mike-burns" "github" @@ -32,6 +50,18 @@ commitsFor = commitsFor' Nothing commitsFor' :: Maybe GithubAuth -> String -> String -> IO (Either Error [Commit]) commitsFor' auth user repo = githubGet' auth ["repos", user, repo, "commits"] +commitsWithOptionsFor :: String -> String -> [CommitQueryOption] -> IO (Either Error [Commit]) +commitsWithOptionsFor = commitsWithOptionsFor' Nothing + +-- | The commit history for a repo, with commits filtered to satisfy a list of +-- query options. +-- With authentication. +-- +-- > commitsWithOptionsFor' (Just (GithubBasicAuth (user, password))) "mike-burns" "github" [CommitQueryAuthor "djeik"] +commitsWithOptionsFor' :: Maybe GithubAuth -> String -> String -> [CommitQueryOption] -> IO (Either Error [Commit]) +commitsWithOptionsFor' auth user repo opts = githubGetWithQueryString' auth ["repos", user, repo, "commits"] qs + where qs = intercalate "&" $ map renderCommitQueryOption opts + -- | Details on a specific SHA1 for a repo. -- -- > commit "mike-burns" "github" "9d1a9a361266c3c890b1108ad2fdf52f824b1b81" @@ -46,6 +76,14 @@ commit' :: Maybe GithubAuth -> String -> String -> String -> IO (Either Error Co commit' auth user repo sha1 = githubGet' auth ["repos", user, repo, "commits", sha1] +-- | Details on a specific SHA1 for a repo. +-- With authentication. +-- +-- > commit (Just $ GithubBasicAuth (username, password)) "mike-burns" "github" "9d1a9a361266c3c890b1108ad2fdf52f824b1b81" +commit' :: Maybe GithubAuth -> String -> String -> String -> IO (Either Error Commit) +commit' auth user repo sha1 = githubGet' auth ["repos", user, repo, "commits", sha1] + + -- | All the comments on a Github repo. -- -- > commentsFor "thoughtbot" "paperclip" From 815d23c848eab0cb86168d994b7f0785e24724b1 Mon Sep 17 00:00:00 2001 From: Scott Murphy Date: Fri, 24 Apr 2015 18:43:02 -0500 Subject: [PATCH 054/510] added create label to api --- Github/Issues/Labels.hs | 21 ++++++++++++++++++--- github.cabal | 3 ++- samples/Issues/CreateIssue.hs | 2 +- samples/Issues/Labels/CreateLabels.hs | 16 ++++++++++++++++ samples/Issues/Labels/ShowRepoLabels.hs | 2 +- 5 files changed, 38 insertions(+), 6 deletions(-) create mode 100644 samples/Issues/Labels/CreateLabels.hs diff --git a/Github/Issues/Labels.hs b/Github/Issues/Labels.hs index 44db680e..7adf8ed2 100644 --- a/Github/Issues/Labels.hs +++ b/Github/Issues/Labels.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedStrings #-} -- | The API for dealing with labels on Github issues, as described on -- . module Github.Issues.Labels ( @@ -5,12 +6,13 @@ module Github.Issues.Labels ( ,labelsOnRepo ,labelsOnIssue ,labelsOnMilestone +,createLabel ,module Github.Data ) where -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" @@ -37,3 +39,16 @@ labelsOnMilestone user reqRepoName milestoneId = 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] diff --git a/github.cabal b/github.cabal index da76af0d..6252968e 100644 --- a/github.cabal +++ b/github.cabal @@ -65,6 +65,7 @@ Extra-source-files: README.md ,samples/Issues/Labels/ShowLabel.hs ,samples/Issues/Labels/ShowMilestoneLabels.hs ,samples/Issues/Labels/ShowRepoLabels.hs + ,samples/Issues/Labels/CreateLabels.hs ,samples/Issues/Milestones/ShowMilestone.hs ,samples/Issues/Milestones/ShowMilestones.hs ,samples/Issues/ShowIssue.hs @@ -134,7 +135,7 @@ Library Github.Issues, Github.Issues.Comments, Github.Issues.Events, - Github.Issues.Labels, + Github.Issues.Labels, Github.Issues.Milestones, Github.Organizations, Github.Organizations.Members, diff --git a/samples/Issues/CreateIssue.hs b/samples/Issues/CreateIssue.hs index d1565a55..510e874c 100644 --- a/samples/Issues/CreateIssue.hs +++ b/samples/Issues/CreateIssue.hs @@ -1,8 +1,8 @@ {-# LANGUAGE OverloadedStrings #-} module CreateIssue where +import qualified Github.Auth as Github import qualified Github.Issues as Github - main = do let auth = Github.GithubBasicAuth "user" "password" newiss = (Github.newIssue "A new issue") { diff --git a/samples/Issues/Labels/CreateLabels.hs b/samples/Issues/Labels/CreateLabels.hs new file mode 100644 index 00000000..2519fc83 --- /dev/null +++ b/samples/Issues/Labels/CreateLabels.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE OverloadedStrings #-} +module CreateLabels where + +import Data.List (intercalate) +import qualified Github.Auth as Github +import qualified Github.Issues.Labels as Github +main = do + let auth = Github.GithubBasicAuth "user" "password" + possibleLabel <- Github.createLabel auth "thoughtbot" "papperclip" "sample label" "ff00ff" + case possibleLabel of + (Left error) -> putStrLn $ "Error: " ++ show error + (Right label) -> putStrLn . formatLabel $ label + +formatLabel label = Github.labelName label ++ + ", colored " ++ + Github.labelColor label diff --git a/samples/Issues/Labels/ShowRepoLabels.hs b/samples/Issues/Labels/ShowRepoLabels.hs index 1c96d399..ae574283 100644 --- a/samples/Issues/Labels/ShowRepoLabels.hs +++ b/samples/Issues/Labels/ShowRepoLabels.hs @@ -1,7 +1,7 @@ module ShowRepoLabels where +import Data.List (intercalate) import qualified Github.Issues.Labels as Github -import Data.List (intercalate) main = do possibleLabels <- Github.labelsOnRepo "thoughtbot" "paperclip" From d1859b4eb90aed4895a57537fd8e23ee8d349b9e Mon Sep 17 00:00:00 2001 From: Peter Harpending Date: Sat, 25 Apr 2015 16:22:27 -0600 Subject: [PATCH 055/510] Fix https://github.com/jwiegley/github/issues/99 --- Github/Data.hs | 1 - Github/Issues.hs | 2 +- Github/Private.hs | 2 +- 3 files changed, 2 insertions(+), 3 deletions(-) diff --git a/Github/Data.hs b/Github/Data.hs index 26926da7..ff39529a 100644 --- a/Github/Data.hs +++ b/Github/Data.hs @@ -11,7 +11,6 @@ import Control.Applicative import Control.Monad import qualified Data.Text as T import Data.Aeson.Types -import System.Locale (defaultTimeLocale) import qualified Data.Vector as V import qualified Data.HashMap.Lazy as Map import Data.Hashable (Hashable) diff --git a/Github/Issues.hs b/Github/Issues.hs index 88bea3fa..9934f004 100644 --- a/Github/Issues.hs +++ b/Github/Issues.hs @@ -16,8 +16,8 @@ module Github.Issues ( import Github.Data import Github.Private import Data.List (intercalate) +import Data.Time (defaultTimeLocale) import Data.Time.Format (formatTime) -import System.Locale (defaultTimeLocale) import Data.Time.Clock (UTCTime(..)) -- | A data structure for describing how to filter issues. This is used by diff --git a/Github/Private.hs b/Github/Private.hs index 3ede8800..ebb296fd 100644 --- a/Github/Private.hs +++ b/Github/Private.hs @@ -1,5 +1,5 @@ {-# LANGUAGE OverloadedStrings, StandaloneDeriving, DeriveDataTypeable #-} -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP, FlexibleContexts #-} module Github.Private where import Github.Data From 90a28e4a2b5d76e2ec2335bbae91735527776352 Mon Sep 17 00:00:00 2001 From: Peter Harpending Date: Sat, 25 Apr 2015 16:33:38 -0600 Subject: [PATCH 056/510] Use CPP for backward compatibility. --- Github/Data.hs | 10 ++++++++-- Github/Issues.hs | 7 ++++++- 2 files changed, 14 insertions(+), 3 deletions(-) diff --git a/Github/Data.hs b/Github/Data.hs index ff39529a..f9d24c8c 100644 --- a/Github/Data.hs +++ b/Github/Data.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveDataTypeable, OverloadedStrings #-} +{-# LANGUAGE CPP, DeriveDataTypeable, OverloadedStrings #-} -- | This module re-exports the @Github.Data.Definitions@ module, adding -- instances of @FromJSON@ to it. If you wish to use the data without the @@ -6,7 +6,6 @@ module Github.Data (module Github.Data.Definitions) where -import Data.Time import Control.Applicative import Control.Monad import qualified Data.Text as T @@ -15,6 +14,13 @@ import qualified Data.Vector as V import qualified Data.HashMap.Lazy as Map import Data.Hashable (Hashable) +#if MIN_VERSION_base(4,8,0) +import Data.Time +#else +import Data.Time +import System.Locale (defaultTimeLocale) +#endif + import Github.Data.Definitions instance FromJSON GithubDate where diff --git a/Github/Issues.hs b/Github/Issues.hs index 9934f004..6bd03bcc 100644 --- a/Github/Issues.hs +++ b/Github/Issues.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE CPP, OverloadedStrings #-} -- | The issues API as described on . module Github.Issues ( issue @@ -16,7 +16,12 @@ module Github.Issues ( import Github.Data import Github.Private import Data.List (intercalate) +#if MIN_VERSION_base(4, 8, 0) import Data.Time (defaultTimeLocale) +#else +import System.Locale (defaultTimeLocale) +#endif + import Data.Time.Format (formatTime) import Data.Time.Clock (UTCTime(..)) From 5c720f5183f1aeb58073fa258d7e3dafb5d25f6e Mon Sep 17 00:00:00 2001 From: Peter Harpending Date: Sat, 25 Apr 2015 18:26:47 -0600 Subject: [PATCH 057/510] Bump up version number --- github.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/github.cabal b/github.cabal index da76af0d..494a04f2 100644 --- a/github.cabal +++ b/github.cabal @@ -7,7 +7,7 @@ Name: github -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented. -Version: 0.13.1 +Version: 0.13.2 -- A short (one-line) description of the package. Synopsis: Access to the Github API, v3. From f3c193217442534f71a16bd4ae4aab970fc7fd5f Mon Sep 17 00:00:00 2001 From: Piotr Bogdan Date: Sun, 3 May 2015 20:25:11 +0100 Subject: [PATCH 058/510] OAuth support for fetching references. --- Github/GitData/References.hs | 23 +++++++++++++++++++---- 1 file changed, 19 insertions(+), 4 deletions(-) diff --git a/Github/GitData/References.hs b/Github/GitData/References.hs index 6cd4cf94..a29f3be5 100644 --- a/Github/GitData/References.hs +++ b/Github/GitData/References.hs @@ -3,7 +3,9 @@ -- these. API documentation at . module Github.GitData.References ( reference +,reference' ,references +,references' ,createReference ,namespacedReferences ,module Github.Data @@ -12,19 +14,32 @@ module Github.GitData.References ( import Github.Data import Github.Private +-- | A single reference by the ref name. +-- +-- > reference' (Just ("github-username", "github-password")) "mike-burns" "github" "heads/master" +reference' :: Maybe GithubAuth -> String -> String -> String -> IO (Either Error GitReference) +reference' auth user reqRepoName ref = + githubGet' auth ["repos", user, reqRepoName, "git", "refs", ref] + -- | A single reference by the ref name. -- -- > reference "mike-burns" "github" "heads/master" reference :: String -> String -> String -> IO (Either Error GitReference) -reference user reqRepoName ref = - githubGet ["repos", user, reqRepoName, "git", "refs", ref] +reference = reference' Nothing + +-- | The history of references for a repo. +-- +-- > references "mike-burns" "github" +references' :: Maybe GithubAuth -> String -> String -> IO (Either Error [GitReference]) +references' auth user reqRepoName = + githubGet' auth ["repos", user, reqRepoName, "git", "refs"] -- | The history of references for a repo. -- -- > references "mike-burns" "github" references :: String -> String -> IO (Either Error [GitReference]) -references user reqRepoName = - githubGet ["repos", user, reqRepoName, "git", "refs"] +references = references' Nothing + createReference :: GithubAuth -> String -> String -> NewGitReference -> IO (Either Error GitReference) createReference auth owner reqRepoName newRef = From e31bf5ff889353cbb14037f70167e698112ae313 Mon Sep 17 00:00:00 2001 From: Piotr Bogdan Date: Sun, 3 May 2015 20:25:33 +0100 Subject: [PATCH 059/510] Export OAuth variants for retrieving trees. --- Github/GitData/Trees.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/Github/GitData/Trees.hs b/Github/GitData/Trees.hs index 6f54e92a..56ea062a 100644 --- a/Github/GitData/Trees.hs +++ b/Github/GitData/Trees.hs @@ -2,7 +2,9 @@ -- described on . module Github.GitData.Trees ( tree +,tree' ,nestedTree +,nestedTree' ,module Github.Data ) where From 89b80c606140aad91f6dc93be100d413e0124d94 Mon Sep 17 00:00:00 2001 From: Harry Garrood Date: Sun, 15 Mar 2015 01:34:02 +0000 Subject: [PATCH 060/510] Fix data declarations for Content results Previously, the declarations made the assumption that every `ContentData` has an encoding, size, and data. However, only files (not directories) have this information. Additionally, you only get this additional file information when you specifically request a file; not when a file is in a directory listing from getting the contents of a directory. Having read the GitHub api docs, it seems there are three types of things we want to differentiate: * When you get the contents of a file - those contents * When you get the contents of a directory - a file which is in that directory * When you get the contents of a directory - a subdirectory This commit fixes the data declarations to align better with the API. It adds a few new types: * ContentInfo, which is common to all three of the above things * ContentFileData, the first one * ContentItem, which covers the second and third * ContentItemType, which allows you to tell the difference between the second and third It also removes ContentData, which is subsumed by these new types. I've tested all three cases in the REPL (on a public repo only) and this appears to work. Updates to samples are soon to come. --- Github/Data.hs | 29 ++++++++++++++++++++++------- Github/Data/Definitions.hs | 29 ++++++++++++++++++++++------- 2 files changed, 44 insertions(+), 14 deletions(-) diff --git a/Github/Data.hs b/Github/Data.hs index f9d24c8c..a382f276 100644 --- a/Github/Data.hs +++ b/Github/Data.hs @@ -674,19 +674,34 @@ instance FromJSON Content where parseJSON (Array os) = ContentDirectory <$> (mapM parseJSON $ V.toList os) parseJSON _ = fail "Could not build a Content" -instance FromJSON ContentData where +instance FromJSON ContentFileData where parseJSON (Object o) = - ContentData <$> o .: "type" - <*> o .: "encoding" - <*> o .: "size" - <*> o .: "name" + ContentFileData <$> parseJSON (Object o) + <*> o .: "encoding" + <*> o .: "size" + <*> o .: "content" + parseJSON _ = fail "Could not build a ContentFileData" + +instance FromJSON ContentItem where + parseJSON (Object o) = + ContentItem <$> o .: "type" + <*> parseJSON (Object o) + parseJSON _ = fail "Could not build a ContentItem" + +instance FromJSON ContentItemType where + parseJSON (String "file") = return ItemFile + parseJSON (String "dir") = return ItemDir + parseJSON _ = fail "Could not build a ContentItemType" + +instance FromJSON ContentInfo where + parseJSON (Object o) = + ContentInfo <$> o .: "name" <*> o .: "path" - <*> o .: "content" <*> o .: "sha" <*> o .: "url" <*> o .: "git_url" <*> o .: "html_url" - parseJSON _ = fail "Could not build a ContentData" + parseJSON _ = fail "Could not build a ContentInfo" -- | A slightly more generic version of Aeson's @(.:?)@, using `mzero' instead -- of `Nothing'. diff --git a/Github/Data/Definitions.hs b/Github/Data/Definitions.hs index ab135cca..7585c739 100644 --- a/Github/Data/Definitions.hs +++ b/Github/Data/Definitions.hs @@ -461,16 +461,31 @@ data Code = Code { ,codeRepo :: Repo } deriving (Show, Data, Typeable, Eq, Ord) -data Content = ContentFile ContentData | ContentDirectory [ContentData] +data Content + = ContentFile ContentFileData + | ContentDirectory [ContentItem] deriving (Show, Data, Typeable, Eq, Ord) -data ContentData = ContentData { - contentType :: String - ,contentEncoding :: String - ,contentSize :: Int - ,contentName :: String +data ContentFileData = ContentFileData { + contentFileInfo :: ContentInfo + ,contentFileEncoding :: String + ,contentFileSize :: Int + ,contentFileContent :: String +} deriving (Show, Data, Typeable, Eq, Ord) + +-- | An item in a directory listing. +data ContentItem = ContentItem { + contentItemType :: ContentItemType + ,contentItemInfo :: ContentInfo +} deriving (Show, Data, Typeable, Eq, Ord) + +data ContentItemType = ItemFile | ItemDir + deriving (Show, Data, Typeable, Eq, Ord) + +-- | Information common to both kinds of Content: files and directories. +data ContentInfo = ContentInfo { + contentName :: String ,contentPath :: String - ,contentData :: String ,contentSha :: String ,contentUrl :: String ,contentGitUrl :: String From ad3d86c41d6630f3ed09a003031c88f292d96f9c Mon Sep 17 00:00:00 2001 From: Harry Garrood Date: Sun, 15 Mar 2015 05:44:17 +0000 Subject: [PATCH 061/510] Add contents sample --- samples/Repos/Contents.hs | 46 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 46 insertions(+) create mode 100644 samples/Repos/Contents.hs diff --git a/samples/Repos/Contents.hs b/samples/Repos/Contents.hs new file mode 100644 index 00000000..2b3c1cb6 --- /dev/null +++ b/samples/Repos/Contents.hs @@ -0,0 +1,46 @@ +module GetContents where + +import qualified Github.Repos as Github +import Data.List +import Prelude hiding (truncate, getContents) + +main = do + putStrLn "Root" + putStrLn "====" + getContents "" + + putStrLn "LICENSE" + putStrLn "=======" + getContents "LICENSE" + +getContents path = do + contents <- Github.contentsFor "mike-burns" "ohlaunch" path Nothing + putStrLn $ either (("Error: " ++) . show) formatContents contents + +formatContents (Github.ContentFile fileData) = + formatContentInfo (Github.contentFileInfo fileData) ++ + unlines + [ show (Github.contentFileSize fileData) ++ " bytes" + , "encoding: " ++ Github.contentFileEncoding fileData + , "data: " ++ truncate (Github.contentFileContent fileData) + ] + +formatContents (Github.ContentDirectory items) = + intercalate "\n\n" $ map formatItem items + +formatContentInfo contentInfo = + unlines + [ "name: " ++ Github.contentName contentInfo + , "path: " ++ Github.contentPath contentInfo + , "sha: " ++ Github.contentSha contentInfo + , "url: " ++ Github.contentUrl contentInfo + , "git url: " ++ Github.contentGitUrl contentInfo + , "html url: " ++ Github.contentHtmlUrl contentInfo + ] + +formatItem item = + "type: " ++ show (Github.contentItemType item) ++ "\n" ++ + formatContentInfo (Github.contentItemInfo item) + + +truncate str = take 40 str ++ "... (truncated)" From 5f7bf75094e51acbe5a56799677051fae3222a0e Mon Sep 17 00:00:00 2001 From: Piotr Bogdan Date: Thu, 7 May 2015 22:48:23 +0100 Subject: [PATCH 062/510] OAuth support for fetching blobs. --- Github/GitData/Blobs.hs | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/Github/GitData/Blobs.hs b/Github/GitData/Blobs.hs index b7ba0cc0..f1868668 100644 --- a/Github/GitData/Blobs.hs +++ b/Github/GitData/Blobs.hs @@ -2,15 +2,23 @@ -- . module Github.GitData.Blobs ( blob +,blob' ,module Github.Data ) where import Github.Data import Github.Private +-- | Get a blob by SHA1. +-- +-- > blob' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" "bc5c51d1ece1ee45f94b056a0f5a1674d7e8cba9" +blob' :: Maybe GithubAuth -> String -> String -> String -> IO (Either Error Blob) +blob' auth user reqRepoName sha = + githubGet' auth ["repos", user, reqRepoName, "git", "blobs", sha] + + -- | Get a blob by SHA1. -- -- > blob "thoughtbot" "paperclip" "bc5c51d1ece1ee45f94b056a0f5a1674d7e8cba9" blob :: String -> String -> String -> IO (Either Error Blob) -blob user reqRepoName sha = - githubGet ["repos", user, reqRepoName, "git", "blobs", sha] +blob = blob' Nothing From d76d7a4f531eff90e9139ac7f51d83005cdc5462 Mon Sep 17 00:00:00 2001 From: Lars Kuhtz Date: Fri, 15 May 2015 09:40:36 -0700 Subject: [PATCH 063/510] Add issueCommentHtmlUrl field to IssueComment --- Github/Data.hs | 1 + Github/Data/Definitions.hs | 1 + 2 files changed, 2 insertions(+) diff --git a/Github/Data.hs b/Github/Data.hs index f9d24c8c..b30bcb87 100644 --- a/Github/Data.hs +++ b/Github/Data.hs @@ -286,6 +286,7 @@ instance FromJSON IssueComment where IssueComment <$> o .: "updated_at" <*> o .: "user" <*> o .: "url" + <*> o .: "html_url" <*> o .: "created_at" <*> o .: "body" <*> o .: "id" diff --git a/Github/Data/Definitions.hs b/Github/Data/Definitions.hs index ab135cca..2c373b09 100644 --- a/Github/Data/Definitions.hs +++ b/Github/Data/Definitions.hs @@ -258,6 +258,7 @@ data IssueComment = IssueComment { issueCommentUpdatedAt :: GithubDate ,issueCommentUser :: GithubOwner ,issueCommentUrl :: String + ,issueCommentHtmlUrl :: String ,issueCommentCreatedAt :: GithubDate ,issueCommentBody :: String ,issueCommentId :: Int From 945ffb8bdc8d614e857f62c3dcc9e23f0feef263 Mon Sep 17 00:00:00 2001 From: Lars Kuhtz Date: Fri, 15 May 2015 09:44:24 -0700 Subject: [PATCH 064/510] Add function pullRequestsFor'' which allows to query closed pull requests, too --- Github/PullRequests.hs | 20 ++++++++++++++++---- 1 file changed, 16 insertions(+), 4 deletions(-) diff --git a/Github/PullRequests.hs b/Github/PullRequests.hs index bc505b82..3f62dcb9 100644 --- a/Github/PullRequests.hs +++ b/Github/PullRequests.hs @@ -2,7 +2,8 @@ -- | The pull requests API as documented at -- . module Github.PullRequests ( - pullRequestsFor' + pullRequestsFor'' +,pullRequestsFor' ,pullRequest' ,pullRequestCommits' ,pullRequestFiles' @@ -24,19 +25,30 @@ import qualified Data.Map as M import Network.HTTP.Conduit (RequestBody(RequestBodyLBS)) import Data.Aeson +-- | 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") +-- +-- 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 + -- | 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' auth userName reqRepoName = - githubGet' auth ["repos", userName, reqRepoName, "pulls"] +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 = pullRequestsFor' Nothing +pullRequestsFor = pullRequestsFor'' Nothing Nothing -- | 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. From c3f43c55b8ffd031f785de1bf2d9b9cd0f0a7920 Mon Sep 17 00:00:00 2001 From: Lars Kuhtz Date: Fri, 15 May 2015 10:15:28 -0700 Subject: [PATCH 065/510] expose Github.Private --- Github/Private.hs | 8 ++++++++ github.cabal | 6 +++--- 2 files changed, 11 insertions(+), 3 deletions(-) diff --git a/Github/Private.hs b/Github/Private.hs index ebb296fd..c34c246b 100644 --- a/Github/Private.hs +++ b/Github/Private.hs @@ -1,5 +1,13 @@ {-# LANGUAGE OverloadedStrings, StandaloneDeriving, DeriveDataTypeable #-} {-# LANGUAGE CPP, FlexibleContexts #-} + +-- | This module is /private/. It is exposed to facilitate customization +-- and extension of the /public/ API of this package without explicitely +-- forking the package. +-- +-- This module is not part of the /public/ API and as such changes in this +-- module may not be reflected in the version of the package. +-- module Github.Private where import Github.Data diff --git a/github.cabal b/github.cabal index 66a81840..de6b0c0b 100644 --- a/github.cabal +++ b/github.cabal @@ -153,6 +153,9 @@ Library Github.Users.Followers Github.Search + -- Private + Github.Private + -- Packages needed in order to build this package. Build-depends: base >= 4.0 && < 5.0, time, @@ -177,9 +180,6 @@ Library byteable >= 0.1.0, base16-bytestring >= 0.1.1.6 - -- Modules not exported by this package. - Other-modules: Github.Private - -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source. -- Build-tools: From d1d2299b179f07725e363e99af8e862a8dff8b50 Mon Sep 17 00:00:00 2001 From: Lars Kuhtz Date: Fri, 15 May 2015 15:29:11 -0700 Subject: [PATCH 066/510] Fix build for time>=1.5 and base<4.8 --- Github/Data.hs | 2 +- Github/Issues.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/Github/Data.hs b/Github/Data.hs index f9d24c8c..d2d01050 100644 --- a/Github/Data.hs +++ b/Github/Data.hs @@ -14,7 +14,7 @@ import qualified Data.Vector as V import qualified Data.HashMap.Lazy as Map import Data.Hashable (Hashable) -#if MIN_VERSION_base(4,8,0) +#if MIN_VERSION_time(1,5,0) import Data.Time #else import Data.Time diff --git a/Github/Issues.hs b/Github/Issues.hs index 6bd03bcc..c1384206 100644 --- a/Github/Issues.hs +++ b/Github/Issues.hs @@ -16,7 +16,7 @@ module Github.Issues ( import Github.Data import Github.Private import Data.List (intercalate) -#if MIN_VERSION_base(4, 8, 0) +#if MIN_VERSION_time(1,5,0) import Data.Time (defaultTimeLocale) #else import System.Locale (defaultTimeLocale) From b7de3f92a60c0696bff76156ad2a64ef9cc04410 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Wed, 24 Jun 2015 13:42:15 +0300 Subject: [PATCH 067/510] Add NFData instances --- Github/Data/Definitions.hs | 229 ++++++++++++++++++++++++++++--------- Github/Issues.hs | 8 +- Github/Private.hs | 8 +- Github/Repos.hs | 17 ++- Github/Repos/Webhooks.hs | 15 ++- github.cabal | 1 + 6 files changed, 211 insertions(+), 67 deletions(-) diff --git a/Github/Data/Definitions.hs b/Github/Data/Definitions.hs index 2c373b09..97ba1e41 100644 --- a/Github/Data/Definitions.hs +++ b/Github/Data/Definitions.hs @@ -1,9 +1,11 @@ -{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-} +{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving, DeriveGeneric #-} module Github.Data.Definitions where +import Control.DeepSeq (NFData) import Data.Time import Data.Data +import GHC.Generics (Generic) import qualified Control.Exception as E import qualified Data.Map as M @@ -18,7 +20,9 @@ data Error = -- | A date in the Github format, which is a special case of ISO-8601. newtype GithubDate = GithubDate { fromGithubDate :: UTCTime } - deriving (Show, Data, Typeable, Eq, Ord) + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData GithubDate data Commit = Commit { commitSha :: String @@ -31,11 +35,15 @@ data Commit = Commit { ,commitStats :: Maybe Stats } deriving (Show, Data, Typeable, Eq, Ord) +instance NFData Commit + data Tree = Tree { treeSha :: String ,treeUrl :: String ,treeGitTrees :: [GitTree] -} deriving (Show, Data, Typeable, Eq, Ord) +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Tree data GitTree = GitTree { gitTreeType :: String @@ -45,7 +53,9 @@ data GitTree = GitTree { ,gitTreeSize :: Maybe Int ,gitTreePath :: String ,gitTreeMode :: String -} deriving (Show, Data, Typeable, Eq, Ord) +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData GitTree data GitCommit = GitCommit { gitCommitMessage :: String @@ -55,7 +65,9 @@ data GitCommit = GitCommit { ,gitCommitTree :: Tree ,gitCommitSha :: Maybe String ,gitCommitParents :: [Tree] -} deriving (Show, Data, Typeable, Eq, Ord) +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData GitCommit data GithubOwner = GithubUser { githubOwnerAvatarUrl :: String @@ -69,13 +81,17 @@ data GithubOwner = GithubUser { ,githubOwnerLogin :: String ,githubOwnerUrl :: String ,githubOwnerId :: Int -} deriving (Show, Data, Typeable, Eq, Ord) +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData GithubOwner data GitUser = GitUser { gitUserName :: String ,gitUserEmail :: String ,gitUserDate :: GithubDate -} deriving (Show, Data, Typeable, Eq, Ord) +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData GitUser data File = File { fileBlobUrl :: String @@ -87,13 +103,17 @@ data File = File { ,filePatch :: String ,fileFilename :: String ,fileDeletions :: Int -} deriving (Show, Data, Typeable, Eq, Ord) +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData File data Stats = Stats { statsAdditions :: Int ,statsTotal :: Int ,statsDeletions :: Int -} deriving (Show, Data, Typeable, Eq, Ord) +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Stats data Comment = Comment { commentPosition :: Maybe Int @@ -107,15 +127,21 @@ data Comment = Comment { ,commentPath :: Maybe String ,commentUser :: GithubOwner ,commentId :: Int -} deriving (Show, Data, Typeable, Eq, Ord) +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Comment data NewComment = NewComment { newCommentBody :: String -} deriving (Show, Data, Typeable, Eq, Ord) +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData NewComment data EditComment = EditComment { editCommentBody :: String -} deriving (Show, Data, Typeable, Eq, Ord) +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData EditComment data Diff = Diff { diffStatus :: String @@ -130,7 +156,9 @@ data Diff = Diff { ,diffAheadBy :: Int ,diffDiffUrl :: String ,diffPermalinkUrl :: String -} deriving (Show, Data, Typeable, Eq, Ord) +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Diff data Gist = Gist { gistUser :: GithubOwner @@ -145,7 +173,9 @@ data Gist = Gist { ,gistId :: String ,gistFiles :: [GistFile] ,gistGitPullUrl :: String -} deriving (Show, Data, Typeable, Eq, Ord) +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Gist data GistFile = GistFile { gistFileType :: String @@ -154,7 +184,9 @@ data GistFile = GistFile { ,gistFileLanguage :: Maybe String ,gistFileFilename :: String ,gistFileContent :: Maybe String -} deriving (Show, Data, Typeable, Eq, Ord) +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData GistFile data GistComment = GistComment { gistCommentUser :: GithubOwner @@ -163,7 +195,9 @@ data GistComment = GistComment { ,gistCommentBody :: String ,gistCommentUpdatedAt :: GithubDate ,gistCommentId :: Int -} deriving (Show, Data, Typeable, Eq, Ord) +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData GistComment data Blob = Blob { blobUrl :: String @@ -171,24 +205,32 @@ data Blob = Blob { ,blobContent :: String ,blobSha :: String ,blobSize :: Int -} deriving (Show, Data, Typeable, Eq, Ord) +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Blob data NewGitReference = NewGitReference { newGitReferenceRef :: String ,newGitReferenceSha :: String -} deriving (Show, Data, Typeable, Eq, Ord) +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData NewGitReference data GitReference = GitReference { gitReferenceObject :: GitObject ,gitReferenceUrl :: String ,gitReferenceRef :: String -} deriving (Show, Data, Typeable, Eq, Ord) +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData GitReference data GitObject = GitObject { gitObjectType :: String ,gitObjectSha :: String ,gitObjectUrl :: String -} deriving (Show, Data, Typeable, Eq, Ord) +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData GitObject data Issue = Issue { issueClosedAt :: Maybe GithubDate @@ -209,7 +251,9 @@ data Issue = Issue { ,issueId :: Int ,issueComments :: Int ,issueMilestone :: Maybe Milestone -} deriving (Show, Data, Typeable, Eq, Ord) +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Issue data NewIssue = NewIssue { newIssueTitle :: String @@ -217,7 +261,9 @@ data NewIssue = NewIssue { , newIssueAssignee :: Maybe String , newIssueMilestone :: Maybe Int , newIssueLabels :: Maybe [String] -} deriving (Show, Data, Typeable, Eq, Ord) +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData NewIssue data EditIssue = EditIssue { editIssueTitle :: Maybe String @@ -226,8 +272,9 @@ data EditIssue = EditIssue { , editIssueState :: Maybe String , editIssueMilestone :: Maybe Int , editIssueLabels :: Maybe [String] -} deriving (Show, Data, Typeable, Eq, Ord) +} deriving (Show, Data, Typeable, Eq, Ord, Generic) +instance NFData EditIssue data Milestone = Milestone { milestoneCreator :: GithubOwner @@ -240,19 +287,25 @@ data Milestone = Milestone { ,milestoneUrl :: String ,milestoneCreatedAt :: GithubDate ,milestoneState :: String -} deriving (Show, Data, Typeable, Eq, Ord) +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Milestone data IssueLabel = IssueLabel { labelColor :: String ,labelUrl :: String ,labelName :: String -} deriving (Show, Data, Typeable, Eq, Ord) +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData IssueLabel data PullRequestReference = PullRequestReference { pullRequestReferenceHtmlUrl :: Maybe String ,pullRequestReferencePatchUrl :: Maybe String ,pullRequestReferenceDiffUrl :: Maybe String -} deriving (Show, Data, Typeable, Eq, Ord) +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData PullRequestReference data IssueComment = IssueComment { issueCommentUpdatedAt :: GithubDate @@ -262,7 +315,9 @@ data IssueComment = IssueComment { ,issueCommentCreatedAt :: GithubDate ,issueCommentBody :: String ,issueCommentId :: Int -} deriving (Show, Data, Typeable, Eq, Ord) +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData IssueComment -- | Data describing an @Event@. data EventType = @@ -284,7 +339,9 @@ data EventType = | Unlocked -- ^ The issue was unlocked by the actor. | HeadRefDeleted -- ^ The pull request’s branch was deleted. | HeadRefRestored -- ^ The pull request’s branch was restored. - deriving (Show, Data, Typeable, Eq, Ord) + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData EventType data Event = Event { eventActor :: GithubOwner @@ -294,14 +351,18 @@ data Event = Event { ,eventCreatedAt :: GithubDate ,eventId :: Int ,eventIssue :: Maybe Issue -} deriving (Show, Data, Typeable, Eq, Ord) +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Event data SimpleOrganization = SimpleOrganization { simpleOrganizationUrl :: String ,simpleOrganizationAvatarUrl :: String ,simpleOrganizationId :: Int ,simpleOrganizationLogin :: String -} deriving (Show, Data, Typeable, Eq, Ord) +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData SimpleOrganization data Organization = Organization { organizationType :: String @@ -320,7 +381,9 @@ data Organization = Organization { ,organizationCreatedAt :: GithubDate ,organizationName :: Maybe String ,organizationId :: Int -} deriving (Show, Data, Typeable, Eq, Ord) +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Organization data PullRequest = PullRequest { pullRequestClosedAt :: Maybe GithubDate @@ -339,7 +402,9 @@ data PullRequest = PullRequest { ,pullRequestMergedAt :: Maybe GithubDate ,pullRequestTitle :: String ,pullRequestId :: Int -} deriving (Show, Data, Typeable, Eq, Ord) +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData PullRequest data DetailedPullRequest = DetailedPullRequest { -- this is a duplication of a PullRequest @@ -371,7 +436,9 @@ data DetailedPullRequest = DetailedPullRequest { ,detailedPullRequestCommits :: Int ,detailedPullRequestMerged :: Bool ,detailedPullRequestMergeable :: Maybe Bool -} deriving (Show, Data, Typeable, Eq, Ord) +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData DetailedPullRequest data EditPullRequest = EditPullRequest { editPullRequestTitle :: Maybe String @@ -379,6 +446,8 @@ data EditPullRequest = EditPullRequest { ,editPullRequestState :: Maybe EditPullRequestState } deriving (Show) +instance NFData EditPullRequest + data CreatePullRequest = CreatePullRequest { createPullRequestTitle :: String @@ -393,12 +462,16 @@ data CreatePullRequest = } deriving (Show) +instance NFData CreatePullRequest + data PullRequestLinks = PullRequestLinks { pullRequestLinksReviewComments :: String ,pullRequestLinksComments :: String ,pullRequestLinksHtml :: String ,pullRequestLinksSelf :: String -} deriving (Show, Data, Typeable, Eq, Ord) +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData PullRequestLinks data PullRequestCommit = PullRequestCommit { pullRequestCommitLabel :: String @@ -406,12 +479,16 @@ data PullRequestCommit = PullRequestCommit { ,pullRequestCommitSha :: String ,pullRequestCommitUser :: GithubOwner ,pullRequestCommitRepo :: Repo -} deriving (Show, Data, Typeable, Eq, Ord) +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData PullRequestCommit data SearchReposResult = SearchReposResult { searchReposTotalCount :: Int ,searchReposRepos :: [Repo] -} deriving (Show, Data, Typeable, Eq, Ord) +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData SearchReposResult data Repo = Repo { repoSshUrl :: Maybe String @@ -442,15 +519,21 @@ data Repo = Repo { ,repoParent :: Maybe RepoRef ,repoSource :: Maybe RepoRef ,repoHooksUrl :: String -} deriving (Show, Data, Typeable, Eq, Ord) +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Repo data RepoRef = RepoRef GithubOwner String -- Repo owner and name - deriving (Show, Data, Typeable, Eq, Ord) + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData RepoRef data SearchCodeResult = SearchCodeResult { - searchCodeTotalCount :: Int + searchCodeTotalCount :: Int ,searchCodeCodes :: [Code] -} deriving (Show, Data, Typeable, Eq, Ord) +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData SearchCodeResult data Code = Code { codeName :: String @@ -460,10 +543,14 @@ data Code = Code { ,codeGitUrl :: String ,codeHtmlUrl :: String ,codeRepo :: Repo -} deriving (Show, Data, Typeable, Eq, Ord) +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Code data Content = ContentFile ContentData | ContentDirectory [ContentData] - deriving (Show, Data, Typeable, Eq, Ord) + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Content data ContentData = ContentData { contentType :: String @@ -476,7 +563,9 @@ data ContentData = ContentData { ,contentUrl :: String ,contentGitUrl :: String ,contentHtmlUrl :: String -} deriving (Show, Data, Typeable, Eq, Ord) +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData ContentData data Contributor -- | An existing Github user, with their number of contributions, avatar @@ -484,33 +573,45 @@ data Contributor = KnownContributor Int String String String Int String -- | An unknown Github user with their number of contributions and recorded name. | AnonymousContributor Int String - deriving (Show, Data, Typeable, Eq, Ord) + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Contributor -- | This is only used for the FromJSON instance. data Languages = Languages { getLanguages :: [Language] } - deriving (Show, Data, Typeable, Eq, Ord) + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Languages -- | A programming language with the name and number of characters written in -- it. data Language = Language String Int - deriving (Show, Data, Typeable, Eq, Ord) + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Language data Tag = Tag { tagName :: String ,tagZipballUrl :: String ,tagTarballUrl :: String ,tagCommit :: BranchCommit -} deriving (Show, Data, Typeable, Eq, Ord) +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Tag data Branch = Branch { branchName :: String ,branchCommit :: BranchCommit -} deriving (Show, Data, Typeable, Eq, Ord) +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Branch data BranchCommit = BranchCommit { branchCommitSha :: String ,branchCommitUrl :: String -} deriving (Show, Data, Typeable, Eq, Ord) +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData BranchCommit data DetailedOwner = DetailedUser { detailedOwnerCreatedAt :: GithubDate @@ -550,7 +651,9 @@ data DetailedOwner = DetailedUser { ,detailedOwnerId :: Int ,detailedOwnerHtmlUrl :: String ,detailedOwnerLogin :: String -} deriving (Show, Data, Typeable, Eq, Ord) +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData DetailedOwner data RepoWebhook = RepoWebhook { repoWebhookUrl :: String @@ -563,7 +666,9 @@ data RepoWebhook = RepoWebhook { ,repoWebhookLastResponse :: RepoWebhookResponse ,repoWebhookUpdatedAt :: GithubDate ,repoWebhookCreatedAt :: GithubDate -} deriving (Show, Data, Typeable, Eq, Ord) +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData RepoWebhook data RepoWebhookEvent = WebhookWildcardEvent @@ -586,13 +691,17 @@ data RepoWebhookEvent = | WebhookStatusEvent | WebhookTeamAddEvent | WebhookWatchEvent - deriving (Show, Data, Typeable, Eq, Ord) + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData RepoWebhookEvent data RepoWebhookResponse = RepoWebhookResponse { repoWebhookResponseCode :: Maybe Int ,repoWebhookResponseStatus :: String ,repoWebhookResponseMessage :: Maybe String -} deriving (Show, Data, Typeable, Eq, Ord) +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData RepoWebhookResponse data PullRequestEvent = PullRequestEvent { pullRequestEventAction :: PullRequestEventType @@ -600,7 +709,9 @@ data PullRequestEvent = PullRequestEvent { ,pullRequestEventPullRequest :: DetailedPullRequest ,pullRequestRepository :: Repo ,pullRequestSender :: GithubOwner -} deriving (Show, Data, Typeable, Eq, Ord) +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData PullRequestEvent data PullRequestEventType = PullRequestOpened @@ -611,15 +722,21 @@ data PullRequestEventType = | PullRequestUnassigned | PullRequestLabeled | PullRequestUnlabeled - deriving (Show, Data, Typeable, Eq, Ord) + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData PullRequestEventType data PingEvent = PingEvent { pingEventZen :: String ,pingEventHook :: RepoWebhook ,pingEventHookId :: Int -} deriving (Show, Data, Typeable, Eq, Ord) +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData PingEvent data EditPullRequestState = EditPullRequestStateOpen | EditPullRequestStateClosed deriving Show + +instance NFData EditPullRequestState diff --git a/Github/Issues.hs b/Github/Issues.hs index c1384206..7076dfb5 100644 --- a/Github/Issues.hs +++ b/Github/Issues.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP, OverloadedStrings #-} +{-# LANGUAGE CPP, OverloadedStrings, DeriveGeneric, DeriveDataTypeable #-} -- | The issues API as described on . module Github.Issues ( issue @@ -15,16 +15,20 @@ module Github.Issues ( import Github.Data import Github.Private +import Control.DeepSeq (NFData) import Data.List (intercalate) +import Data.Data #if MIN_VERSION_time(1,5,0) import Data.Time (defaultTimeLocale) #else import System.Locale (defaultTimeLocale) #endif +import GHC.Generics (Generic) import Data.Time.Format (formatTime) import Data.Time.Clock (UTCTime(..)) + -- | A data structure for describing how to filter issues. This is used by -- @issuesForRepo@. data IssueLimitation = @@ -42,7 +46,9 @@ data IssueLimitation = | Descending -- ^ Sort descending. [default] | Since UTCTime -- ^ Only issues created since the specified date and time. | PerPage Int -- ^ Download this many issues per query + deriving (Eq, Ord, Show, Typeable, Data, Generic) +instance NFData IssueLimitation -- | Details on a specific issue, given the repo owner and name, and the issue -- number.' diff --git a/Github/Private.hs b/Github/Private.hs index c34c246b..22c587bf 100644 --- a/Github/Private.hs +++ b/Github/Private.hs @@ -1,5 +1,5 @@ {-# LANGUAGE OverloadedStrings, StandaloneDeriving, DeriveDataTypeable #-} -{-# LANGUAGE CPP, FlexibleContexts #-} +{-# LANGUAGE CPP, FlexibleContexts, DeriveGeneric #-} -- | This module is /private/. It is exposed to facilitate customization -- and extension of the /public/ API of this package without explicitely @@ -11,6 +11,7 @@ module Github.Private where import Github.Data +import Control.DeepSeq (NFData) import Data.Aeson import Data.Attoparsec.ByteString.Lazy import Data.Data @@ -20,6 +21,7 @@ import Data.List import Data.CaseInsensitive (mk) import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as LBS +import GHC.Generics (Generic) import Network.HTTP.Types (Status(..), notFound404) import Network.HTTP.Conduit -- import Data.Conduit (ResourceT) @@ -29,7 +31,9 @@ import Data.Maybe (fromMaybe) -- | user/password for HTTP basic access authentication data GithubAuth = GithubBasicAuth BS.ByteString BS.ByteString | GithubOAuth String - deriving (Show, Data, Typeable, Eq, Ord) + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData GithubAuth githubGet :: (FromJSON b, Show b) => [String] -> IO (Either Error b) githubGet = githubGet' Nothing diff --git a/Github/Repos.hs b/Github/Repos.hs index 543f16cd..86cafe8c 100644 --- a/Github/Repos.hs +++ b/Github/Repos.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings, DeriveGeneric, DeriveDataTypeable #-} {-# LANGUAGE CPP #-} -- | The Github Repos API, as documented at -- @@ -43,12 +43,15 @@ module Github.Repos ( ,deleteRepo ) where +import Data.Data import Data.Default import Data.Aeson.Types import Github.Data import Github.Private +import GHC.Generics (Generic) import Network.HTTP.Conduit import Control.Applicative +import Control.DeepSeq (NFData) import qualified Control.Exception as E import Network.HTTP.Types @@ -59,7 +62,9 @@ data RepoPublicity = | Public -- ^ Only public repos. | Private -- ^ Only private repos. | Member -- ^ Only repos to which the user is a member but not an owner. - deriving (Show, Eq) + deriving (Show, Eq, Ord, Typeable, Data, Generic) + +instance NFData RepoPublicity -- | The repos for a user, by their login. Can be restricted to just repos they -- own, are a member of, or publicize. Private repos are currently not @@ -229,7 +234,9 @@ data NewRepo = NewRepo { , newRepoHasIssues :: (Maybe Bool) , newRepoHasWiki :: (Maybe Bool) , newRepoAutoInit :: (Maybe Bool) -} deriving Show +} deriving (Eq, Ord, Show, Data, Typeable, Generic) + +instance NFData NewRepo instance ToJSON NewRepo where toJSON (NewRepo { newRepoName = name @@ -274,7 +281,9 @@ data Edit = Edit { , editHasIssues :: Maybe Bool , editHasWiki :: Maybe Bool , editHasDownloads :: Maybe Bool -} deriving Show +} deriving (Eq, Ord, Show, Data, Typeable, Generic) + +instance NFData Edit instance Default Edit where def = Edit def def def def def def def diff --git a/Github/Repos/Webhooks.hs b/Github/Repos/Webhooks.hs index 5998d08a..c2210560 100644 --- a/Github/Repos/Webhooks.hs +++ b/Github/Repos/Webhooks.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings, DeriveGeneric, DeriveDataTypeable #-} {-# LANGUAGE CPP #-} -- | The webhooks API, as described at -- @@ -31,10 +31,13 @@ module Github.Repos.Webhooks ( import Github.Data import Github.Private +import Control.DeepSeq (NFData) +import Data.Data import qualified Data.Map as M import Network.HTTP.Conduit import Network.HTTP.Types import Data.Aeson +import GHC.Generics (Generic) type RepoOwner = String type RepoName = String @@ -45,7 +48,9 @@ data NewRepoWebhook = NewRepoWebhook { ,newRepoWebhookConfig :: M.Map String String ,newRepoWebhookEvents :: Maybe [RepoWebhookEvent] ,newRepoWebhookActive :: Maybe Bool -} deriving Show +} deriving (Eq, Ord, Show, Typeable, Data, Generic) + +instance NFData NewRepoWebhook data EditRepoWebhook = EditRepoWebhook { editRepoWebhookConfig :: Maybe (M.Map String String) @@ -53,8 +58,10 @@ data EditRepoWebhook = EditRepoWebhook { ,editRepoWebhookAddEvents :: Maybe [RepoWebhookEvent] ,editRepoWebhookRemoveEvents :: Maybe [RepoWebhookEvent] ,editRepoWebhookActive :: Maybe Bool -} deriving Show - +} deriving (Eq, Ord, Show, Typeable, Data, Generic) + +instance NFData EditRepoWebhook + instance ToJSON NewRepoWebhook where toJSON (NewRepoWebhook { newRepoWebhookName = name , newRepoWebhookConfig = config diff --git a/github.cabal b/github.cabal index de6b0c0b..e527d384 100644 --- a/github.cabal +++ b/github.cabal @@ -164,6 +164,7 @@ Library bytestring, case-insensitive >= 0.4.0.4, containers, + deepseq, hashable, text, old-locale, From 69c19a5832026811081f0cb97370681f9c76d3e2 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Wed, 24 Jun 2015 13:53:44 +0300 Subject: [PATCH 068/510] Add travis support --- .travis.yml | 54 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 54 insertions(+) create mode 100644 .travis.yml diff --git a/.travis.yml b/.travis.yml new file mode 100644 index 00000000..204d3f05 --- /dev/null +++ b/.travis.yml @@ -0,0 +1,54 @@ +# NB: don't set `language: haskell` here + +# See also https://github.com/hvr/multi-ghc-travis for more information +# Keep this in sync with the Stackage LTS which provides cabal.config below. +env: +# - GHCVER=7.6.3 CABALVER=1.16 + - GHCVER=7.8.4 CABALVER=1.18 STACKAGEURL=https://www.stackage.org/lts/cabal.config + - GHCVER=7.10.1 CABALVER=1.22 STACKAGEURL=https://www.stackage.org/nightly/cabal.config + - GHCVER=head CABALVER=head STACKAGEURL=https://www.stackage.org/nightly/cabal.config + +matrix: + allow_failures: + - env: GHCVER=head CABALVER=head STACKAGEURL=https://www.stackage.org/nightly/cabal.config + +# Note: the distinction between `before_install` and `install` is not +# important. +before_install: + - travis_retry sudo add-apt-repository -y ppa:hvr/ghc + - travis_retry sudo apt-get update + - travis_retry sudo apt-get install cabal-install-$CABALVER ghc-$GHCVER + - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH + - cabal --version + +install: + - wget $STACKAGEURL + - travis_retry cabal update + - cabal install --only-dependencies --enable-tests + +# Here starts the actual work to be performed for the package under +# test; any command which exits with a non-zero exit code causes the +# build to fail. +script: + # -v2 provides useful information for debugging + - cabal configure -v2 --enable-tests + + # this builds all libraries and executables + # (including tests/benchmarks) + - cabal build + - cabal test + + # tests that a source-distribution can be generated + - cabal sdist + + # check that the generated source-distribution can be built & installed + - export SRC_TGZ=$(cabal info . | awk '{print $2 ".tar.gz";exit}') ; + cd dist/; + if [ -f "$SRC_TGZ" ]; then + cabal install --force-reinstalls "$SRC_TGZ"; + else + echo "expected '$SRC_TGZ' not found"; + exit 1; + fi + +# EOF From 128234556f384cd36a4dd9157ff9fb1e2c08aecd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20D=C3=ADaz?= Date: Fri, 26 Jun 2015 11:51:57 -0400 Subject: [PATCH 069/510] Authorized version of commitsFor. --- Github/Repos/Commits.hs | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/Github/Repos/Commits.hs b/Github/Repos/Commits.hs index acab907a..03f3a330 100644 --- a/Github/Repos/Commits.hs +++ b/Github/Repos/Commits.hs @@ -2,6 +2,7 @@ -- . module Github.Repos.Commits ( commitsFor +,commitsFor' ,commit ,commentsFor ,commitCommentsFor @@ -17,7 +18,13 @@ import Github.Private -- -- > commitsFor "mike-burns" "github" commitsFor :: String -> String -> IO (Either Error [Commit]) -commitsFor user repo = githubGet ["repos", user, repo, "commits"] +commitsFor = commitsFor' Nothing + +-- | The commit history for a repo, with authorization. +-- +-- > commitsFor "mike-burns" "github" +commitsFor' :: Maybe GithubAuth -> String -> String -> IO (Either Error [Commit]) +commitsFor' auth user repo = githubGet' auth ["repos", user, repo, "commits"] -- | Details on a specific SHA1 for a repo. -- From b51adcb15051e7ee2ece8154ed27a9e91b33e104 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20D=C3=ADaz?= Date: Fri, 26 Jun 2015 11:56:38 -0400 Subject: [PATCH 070/510] Fixed example of commitsFor'. --- Github/Repos/Commits.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Github/Repos/Commits.hs b/Github/Repos/Commits.hs index 03f3a330..a2b8d051 100644 --- a/Github/Repos/Commits.hs +++ b/Github/Repos/Commits.hs @@ -22,7 +22,7 @@ commitsFor = commitsFor' Nothing -- | The commit history for a repo, with authorization. -- --- > commitsFor "mike-burns" "github" +-- > commitsFor' (Just ("github-username", "github-password")) "mike-burns" "github" commitsFor' :: Maybe GithubAuth -> String -> String -> IO (Either Error [Commit]) commitsFor' auth user repo = githubGet' auth ["repos", user, repo, "commits"] From 8888a6329fd99fedcc8731541a2f66f99bb8aebb Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 30 Jun 2015 13:04:57 +0300 Subject: [PATCH 071/510] Remove unused dependencies --- github.cabal | 10 +--------- 1 file changed, 1 insertion(+), 9 deletions(-) diff --git a/github.cabal b/github.cabal index de6b0c0b..4799e7ff 100644 --- a/github.cabal +++ b/github.cabal @@ -135,7 +135,7 @@ Library Github.Issues, Github.Issues.Comments, Github.Issues.Events, - Github.Issues.Labels, + Github.Issues.Labels, Github.Issues.Milestones, Github.Organizations, Github.Organizations.Members, @@ -167,11 +167,7 @@ Library hashable, text, old-locale, - HTTP, - network, http-conduit >= 1.8, - conduit, - failure, http-types, data-default, vector, @@ -200,11 +196,7 @@ test-suite github-test hashable, text, old-locale, - HTTP, - network, http-conduit >= 1.8, - conduit, - failure, http-types, data-default, vector, From d47697873b7bf9adff2ec4000dcc37208db452dd Mon Sep 17 00:00:00 2001 From: John Wiegley Date: Tue, 14 Jul 2015 19:40:24 -0400 Subject: [PATCH 072/510] Update default.nix and github.cabal --- default.nix | 26 ++++++++++++++++++++++++++ github.cabal | 14 ++++++++------ 2 files changed, 34 insertions(+), 6 deletions(-) create mode 100644 default.nix diff --git a/default.nix b/default.nix new file mode 100644 index 00000000..54050509 --- /dev/null +++ b/default.nix @@ -0,0 +1,26 @@ +{ mkDerivation, aeson, attoparsec, base, base16-bytestring +, byteable, bytestring, case-insensitive, conduit, containers +, cryptohash, data-default, failure, hashable, hspec, HTTP +, http-conduit, http-types, network, old-locale, stdenv, text, time +, unordered-containers, vector +}: +mkDerivation { + pname = "github"; + version = "0.13.2"; + src = ./.; + buildDepends = [ + aeson attoparsec base base16-bytestring byteable bytestring + case-insensitive conduit containers cryptohash data-default failure + hashable HTTP http-conduit http-types network old-locale text time + unordered-containers vector + ]; + testDepends = [ + aeson attoparsec base base16-bytestring byteable bytestring + case-insensitive conduit containers cryptohash data-default failure + hashable hspec HTTP http-conduit http-types network old-locale text + time unordered-containers vector + ]; + homepage = "https://github.com/fpco/github"; + description = "Access to the Github API, v3"; + license = stdenv.lib.licenses.bsd3; +} diff --git a/github.cabal b/github.cabal index de6b0c0b..7d032c3e 100644 --- a/github.cabal +++ b/github.cabal @@ -18,7 +18,7 @@ Description: The Github API provides programmatic access to the full like references and trees. This library wraps all of that, exposing a basic but Haskell-friendly set of functions and data structures. . - For more of an overview please see the README: + For more of an overview please see the README: -- The license under which the package is released. License: BSD3 @@ -31,12 +31,12 @@ Author: Mike Burns, John Wiegley -- An email address to which users can send suggestions, bug reports, -- and patches. -Maintainer: johnw@fpcomplete.com +Maintainer: johnw@newartisans.com -Homepage: https://github.com/fpco/github +Homepage: https://github.com/jwiegley/github -- A copyright notice. -Copyright: Copyright 2012-2013 Mike Burns, Copyright 2013 John Wiegley +Copyright: Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley Category: Network APIs @@ -114,14 +114,15 @@ Extra-source-files: README.md -- Constraint on the version of Cabal needed to build this package. -Cabal-version: >=1.6 +Cabal-version: >=1.10 source-repository head type: git - location: git://github.com/fpco/github.git + location: git://github.com/jwiegley/github.git Library -- Modules exported by the library. + Default-Language: Haskell2010 Exposed-modules: Github.Auth, Github.Data, Github.Data.Definitions, @@ -187,6 +188,7 @@ Library test-suite github-test + default-language: Haskell2010 type: exitcode-stdio-1.0 hs-source-dirs: spec, . main-is: Spec.hs From 3d60c2fac12e74026656734d955b2d7572e46d3a Mon Sep 17 00:00:00 2001 From: John Wiegley Date: Tue, 25 Aug 2015 10:47:52 -0700 Subject: [PATCH 073/510] Minor fixes, bump working version number --- Github/Data/Definitions.hs | 8 ++++---- default.nix | 2 +- github.cabal | 3 ++- 3 files changed, 7 insertions(+), 6 deletions(-) diff --git a/Github/Data/Definitions.hs b/Github/Data/Definitions.hs index 97ba1e41..aa968d7d 100644 --- a/Github/Data/Definitions.hs +++ b/Github/Data/Definitions.hs @@ -33,7 +33,7 @@ data Commit = Commit { ,commitAuthor :: Maybe GithubOwner ,commitFiles :: [File] ,commitStats :: Maybe Stats -} deriving (Show, Data, Typeable, Eq, Ord) +} deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Commit @@ -444,7 +444,7 @@ data EditPullRequest = EditPullRequest { editPullRequestTitle :: Maybe String ,editPullRequestBody :: Maybe String ,editPullRequestState :: Maybe EditPullRequestState -} deriving (Show) +} deriving (Show, Generic) instance NFData EditPullRequest @@ -460,7 +460,7 @@ data CreatePullRequest = , createPullRequestHead :: String , createPullRequestBase :: String } - deriving (Show) + deriving (Show, Generic) instance NFData CreatePullRequest @@ -737,6 +737,6 @@ instance NFData PingEvent data EditPullRequestState = EditPullRequestStateOpen | EditPullRequestStateClosed - deriving Show + deriving (Show, Generic) instance NFData EditPullRequestState diff --git a/default.nix b/default.nix index 54050509..4b04872b 100644 --- a/default.nix +++ b/default.nix @@ -6,7 +6,7 @@ }: mkDerivation { pname = "github"; - version = "0.13.2"; + version = "0.14.0"; src = ./.; buildDepends = [ aeson attoparsec base base16-bytestring byteable bytestring diff --git a/github.cabal b/github.cabal index 6c6a2508..b37bda6a 100644 --- a/github.cabal +++ b/github.cabal @@ -7,7 +7,7 @@ Name: github -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented. -Version: 0.13.2 +Version: 0.14.0 -- A short (one-line) description of the package. Synopsis: Access to the Github API, v3. @@ -203,6 +203,7 @@ test-suite github-test http-types, data-default, vector, + deepseq, unordered-containers >= 0.2 && < 0.3, cryptohash >= 0.11, byteable >= 0.1.0, From 9d4c8725fcfb829321f2d0d2474e4053d3247394 Mon Sep 17 00:00:00 2001 From: John Wiegley Date: Tue, 25 Aug 2015 10:59:15 -0700 Subject: [PATCH 074/510] Remove two tab characters --- Github/Data.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Github/Data.hs b/Github/Data.hs index 5d9dba88..afe5da96 100644 --- a/Github/Data.hs +++ b/Github/Data.hs @@ -543,8 +543,8 @@ instance FromJSON Repo where <*> o .:? "has_wiki" <*> o .:? "has_issues" <*> o .:? "has_downloads" - <*> o .:? "parent" - <*> o .:? "source" + <*> o .:? "parent" + <*> o .:? "source" <*> o .: "hooks_url" parseJSON _ = fail "Could not build a Repo" From 492524fa784628e9fece8e14a34d2cfd0588ef37 Mon Sep 17 00:00:00 2001 From: John Wiegley Date: Tue, 25 Aug 2015 11:16:30 -0700 Subject: [PATCH 075/510] Corrections to the last merge --- Github/Issues.hs | 1 - Github/Private.hs | 8 ++++---- Github/PullRequests/ReviewComments.hs | 8 ++++---- Github/Repos/Commits.hs | 9 +-------- 4 files changed, 9 insertions(+), 17 deletions(-) diff --git a/Github/Issues.hs b/Github/Issues.hs index f246145c..7076dfb5 100644 --- a/Github/Issues.hs +++ b/Github/Issues.hs @@ -27,7 +27,6 @@ import GHC.Generics (Generic) import Data.Time.Format (formatTime) import Data.Time.Clock (UTCTime(..)) -import Data.Time (defaultTimeLocale) -- | A data structure for describing how to filter issues. This is used by diff --git a/Github/Private.hs b/Github/Private.hs index 23103dc3..fcb6ddca 100644 --- a/Github/Private.hs +++ b/Github/Private.hs @@ -81,8 +81,8 @@ buildPath paths = '/' : intercalate "/" paths githubAPI :: (ToJSON a, Show a, FromJSON b, Show b) => BS.ByteString -> String -> Maybe GithubAuth -> Maybe a -> IO (Either Error b) -githubAPI apimethod path auth body = do - result <- doHttps apimethod (apiEndpoint auth ++ path) auth (encodeBody body) +githubAPI apimethod p auth body = do + result <- doHttps apimethod (apiEndpoint auth ++ p) auth (encodeBody body) case result of Left e -> return (Left (HTTPConnectionError e)) Right resp -> either Left (\x -> jsonResultToE (LBS.pack (show x)) @@ -172,8 +172,8 @@ doHttps reqMethod url auth body = do #endif doHttpsStatus :: BS.ByteString -> String -> GithubAuth -> Maybe RequestBody -> IO (Either Error Status) -doHttpsStatus reqMethod path auth payload = do - result <- doHttps reqMethod (apiEndpoint (Just auth) ++ path) (Just auth) payload +doHttpsStatus reqMethod p auth payload = do + result <- doHttps reqMethod (apiEndpoint (Just auth) ++ p) (Just auth) payload case result of Left e -> return (Left (HTTPConnectionError e)) Right resp -> diff --git a/Github/PullRequests/ReviewComments.hs b/Github/PullRequests/ReviewComments.hs index 45946819..cd7de72f 100644 --- a/Github/PullRequests/ReviewComments.hs +++ b/Github/PullRequests/ReviewComments.hs @@ -13,12 +13,12 @@ import Github.Private -- -- > pullRequestReviewComments "thoughtbot" "factory_girl" 256 pullRequestReviewComments :: String -> String -> Int -> IO (Either Error [Comment]) -pullRequestReviewComments userName repoName number = - githubGet ["repos", userName, repoName, "pulls", show number, "comments"] +pullRequestReviewComments userName repo number = + githubGet ["repos", userName, repo, "pulls", show number, "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 repoName id = - githubGet ["repos", userName, repoName, "pulls", "comments", show id] +pullRequestReviewComment userName repo ident = + githubGet ["repos", userName, repo, "pulls", "comments", show ident] diff --git a/Github/Repos/Commits.hs b/Github/Repos/Commits.hs index f6dab652..d9e63cea 100644 --- a/Github/Repos/Commits.hs +++ b/Github/Repos/Commits.hs @@ -4,6 +4,7 @@ module Github.Repos.Commits ( CommitQueryOption(..) ,commitsFor ,commitsFor' +,commitsWithOptionsFor ,commitsWithOptionsFor' ,commit ,commit' @@ -76,14 +77,6 @@ commit' :: Maybe GithubAuth -> String -> String -> String -> IO (Either Error Co commit' auth user repo sha1 = githubGet' auth ["repos", user, repo, "commits", sha1] --- | Details on a specific SHA1 for a repo. --- With authentication. --- --- > commit (Just $ GithubBasicAuth (username, password)) "mike-burns" "github" "9d1a9a361266c3c890b1108ad2fdf52f824b1b81" -commit' :: Maybe GithubAuth -> String -> String -> String -> IO (Either Error Commit) -commit' auth user repo sha1 = githubGet' auth ["repos", user, repo, "commits", sha1] - - -- | All the comments on a Github repo. -- -- > commentsFor "thoughtbot" "paperclip" From a78fbd6abeb725f4cbdff9c55ba6e3c22220f855 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Wed, 26 Aug 2015 08:42:52 +0300 Subject: [PATCH 076/510] Resolve merge conflicts, and add missing NFData instances --- Github/Data/Definitions.hs | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/Github/Data/Definitions.hs b/Github/Data/Definitions.hs index 29e3443f..a719b0b3 100644 --- a/Github/Data/Definitions.hs +++ b/Github/Data/Definitions.hs @@ -568,16 +568,22 @@ data ContentFileData = ContentFileData { ,contentFileEncoding :: String ,contentFileSize :: Int ,contentFileContent :: String -} deriving (Show, Data, Typeable, Eq, Ord) +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData ContentFileData -- | An item in a directory listing. data ContentItem = ContentItem { contentItemType :: ContentItemType ,contentItemInfo :: ContentInfo -} deriving (Show, Data, Typeable, Eq, Ord) +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData ContentItem data ContentItemType = ItemFile | ItemDir - deriving (Show, Data, Typeable, Eq, Ord) + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData ContentItemType -- | Information common to both kinds of Content: files and directories. data ContentInfo = ContentInfo { @@ -589,7 +595,7 @@ data ContentInfo = ContentInfo { ,contentHtmlUrl :: String } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData ContentData +instance NFData ContentInfo data Contributor -- | An existing Github user, with their number of contributions, avatar From 98ca2256303decd2af15e89b814d6a551dd39a41 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Wed, 26 Aug 2015 08:52:23 +0300 Subject: [PATCH 077/510] Update .travis.yml --- .travis.yml | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/.travis.yml b/.travis.yml index 204d3f05..cfbd0e97 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,16 +1,17 @@ # NB: don't set `language: haskell` here # See also https://github.com/hvr/multi-ghc-travis for more information -# Keep this in sync with the Stackage LTS which provides cabal.config below. env: -# - GHCVER=7.6.3 CABALVER=1.16 - - GHCVER=7.8.4 CABALVER=1.18 STACKAGEURL=https://www.stackage.org/lts/cabal.config - - GHCVER=7.10.1 CABALVER=1.22 STACKAGEURL=https://www.stackage.org/nightly/cabal.config - - GHCVER=head CABALVER=head STACKAGEURL=https://www.stackage.org/nightly/cabal.config + - GHCVER=7.8.4 CABALVER=1.18 + - GHCVER=7.10.2 CABALVER=1.22 + # github isn't buildable with lts-2.22 (needs at least time>=1.5) + - GHCVER=7.10.2 CABALVER=1.22 STACKAGEURL=https://www.stackage.org/lts-3/cabal.config + - GHCVER=7.10.2 CABALVER=1.22 STACKAGEURL=https://www.stackage.org/nightly/cabal.config + - GHCVER=head CABALVER=head matrix: allow_failures: - - env: GHCVER=head CABALVER=head STACKAGEURL=https://www.stackage.org/nightly/cabal.config + - env: GHCVER=head CABALVER=head # Note: the distinction between `before_install` and `install` is not # important. @@ -22,7 +23,7 @@ before_install: - cabal --version install: - - wget $STACKAGEURL + - if [ -n "$STACKAGEURL" ]; then wget $STACKAGEURL; fi - travis_retry cabal update - cabal install --only-dependencies --enable-tests From 046de79d07bdc6ff499fe41fd8ea2a7fc55ed80f Mon Sep 17 00:00:00 2001 From: Andrew Darqui Date: Thu, 27 Aug 2015 09:29:44 -0400 Subject: [PATCH 078/510] Adds the ability to retrieve detailed info about a user without specifying a username. Instead, we rely on the supplied GithubAuth and query /user. --- Github/Users.hs | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/Github/Users.hs b/Github/Users.hs index e25a950a..50cbd254 100644 --- a/Github/Users.hs +++ b/Github/Users.hs @@ -3,6 +3,7 @@ module Github.Users ( userInfoFor ,userInfoFor' +,userInfoCurrent' ,module Github.Data ) where @@ -21,3 +22,9 @@ userInfoFor' auth userName = githubGet' auth ["users", userName] -- > userInfoFor "mike-burns" userInfoFor :: String -> IO (Either Error DetailedOwner) userInfoFor = userInfoFor' Nothing + +-- | Retrieve information about the user associated with the supplied authentication. +-- +-- > userInfoCurrent' (GithubOAuth "...") +userInfoCurrent' :: Maybe GithubAuth -> IO (Either Error DetailedOwner) +userInfoCurrent' auth = githubGet' auth ["user"] From 0dfc9872743a7513ef0175c458ad5c7b18583f6d Mon Sep 17 00:00:00 2001 From: Chris Allen Date: Sun, 6 Sep 2015 23:38:32 -0500 Subject: [PATCH 079/510] Getting a little more detail in place --- README.md | 90 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 90 insertions(+) diff --git a/README.md b/README.md index a9212ee1..8932fec5 100644 --- a/README.md +++ b/README.md @@ -50,6 +50,96 @@ possible error message. Here's an example from the samples: formatUser = Github.githubOwnerLogin +API -> Module +============ + + + +## Gists + +[Gists module](https://github.com/jwiegley/github/blob/master/Github/Gists.hs) + +- Comments on gist by gist id +- Specific comment by comment id + +## Git Data + +[Git Data](https://github.com/jwiegley/github/tree/master/Github/GitData) + +- Blobs + - user/repo and commit sha +- Commits + - user/repo and commit sha +- References + - single reference by ref name + - history of references for a user/repo + - references by user/repo, limited by namespace (you can get tags by specifying "tags" here) +- Trees + +## Issues + +[Issues](https://github.com/jwiegley/github/blob/master/Github/Issues.hs) + +- Create issue +- Edit issue +- Get issues for repo + +## Organizations + +[Orgs](https://github.com/jwiegley/github/tree/master/Github/Organizations) + +- get members by organization + +## Pull Requests + +[Pull Requests](https://github.com/jwiegley/github/tree/master/Github/PullRequests) + +- Review Comments by PR id or comment id + + +## Repositories + +[Repos](https://github.com/jwiegley/github/tree/master/Github/Repos) + +- repos by user +- repos by organization + +## Search + +[Search](https://github.com/jwiegley/github/blob/master/Github/Search.hs) + +- Repo search w/ authentication +- Repo search w/o auth +- Code search w/ auth +- Code search w/o auth + +## Users + +[Users](https://github.com/jwiegley/github/blob/master/Github/Users.hs) + +- by name, with auth +- by name, with password +- by name, public info + +See `DetailedOwner` to know what data could be provided. + + Contributions ============= From 734e20b566b747d4fa851501aea72d319d4f266b Mon Sep 17 00:00:00 2001 From: John Wiegley Date: Wed, 16 Sep 2015 15:17:54 -0700 Subject: [PATCH 080/510] Add some missing instances --- Github/Data/Definitions.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Github/Data/Definitions.hs b/Github/Data/Definitions.hs index a719b0b3..211544de 100644 --- a/Github/Data/Definitions.hs +++ b/Github/Data/Definitions.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving, DeriveGeneric #-} +{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-} module Github.Data.Definitions where From a49cc9200ea012d5999c31420d3a411fa4b76154 Mon Sep 17 00:00:00 2001 From: John Wiegley Date: Thu, 17 Sep 2015 16:20:52 -0700 Subject: [PATCH 081/510] Allow building with GHC 7.8.4 --- Github/Repos/Commits.hs | 13 ++++++++++++- github.cabal | 2 +- 2 files changed, 13 insertions(+), 2 deletions(-) diff --git a/Github/Repos/Commits.hs b/Github/Repos/Commits.hs index d9e63cea..ed4093a8 100644 --- a/Github/Repos/Commits.hs +++ b/Github/Repos/Commits.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + -- | The repo commits API as described on -- . module Github.Repos.Commits ( @@ -22,12 +24,21 @@ module Github.Repos.Commits ( import Github.Data import Github.Private -import Data.Time.Format (iso8601DateFormat, formatTime) +import Data.Time.Format (formatTime) +#if MIN_VERSION_time (1,5,0) +import Data.Time.Format (iso8601DateFormat) import Data.Time (defaultTimeLocale) +#else +import System.Locale (defaultTimeLocale) +#endif import Data.List (intercalate) githubFormat :: GithubDate -> String +#if MIN_VERSION_time (1,5,0) githubFormat = formatTime defaultTimeLocale (iso8601DateFormat $ Just "%H:%M:%S") . fromGithubDate +#else +githubFormat = formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S" . fromGithubDate +#endif renderCommitQueryOption :: CommitQueryOption -> String renderCommitQueryOption (CommitQuerySha sha) = "sha=" ++ sha diff --git a/github.cabal b/github.cabal index 19e28b4d..0a31d886 100644 --- a/github.cabal +++ b/github.cabal @@ -160,7 +160,7 @@ Library -- Packages needed in order to build this package. Build-depends: base >= 4.0 && < 5.0, - time >=1.5 && <1.6, + time >=1.4 && <1.6, aeson >= 0.6.1.0, attoparsec >= 0.10.3.0, bytestring, From 57015c5c9cad400f114fed880520e1024df66822 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sun, 20 Sep 2015 09:48:33 +0300 Subject: [PATCH 082/510] Add lts-2.22 travis job --- .travis.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index cfbd0e97..0358f72b 100644 --- a/.travis.yml +++ b/.travis.yml @@ -3,8 +3,8 @@ # See also https://github.com/hvr/multi-ghc-travis for more information env: - GHCVER=7.8.4 CABALVER=1.18 + - GHCVER=7.8.4 CABALVER=1.18 STACKAGEURL=https://www.stackage.org/lts-2.22/cabal.config - GHCVER=7.10.2 CABALVER=1.22 - # github isn't buildable with lts-2.22 (needs at least time>=1.5) - GHCVER=7.10.2 CABALVER=1.22 STACKAGEURL=https://www.stackage.org/lts-3/cabal.config - GHCVER=7.10.2 CABALVER=1.22 STACKAGEURL=https://www.stackage.org/nightly/cabal.config - GHCVER=head CABALVER=head From 342a4e50ca801e0cc1cd6537a6c8340eaaf3cdde Mon Sep 17 00:00:00 2001 From: Andrew Darqui Date: Tue, 22 Sep 2015 22:34:21 -0400 Subject: [PATCH 083/510] This commit implements most of the "teams api".Some requests marked deprecated were not implemented. A few new functions were created to support these requests: githubPut, githubDelete. All of the samples have been tested and are working at the time of this commit. A few requests were not implemented because they depend on a specific header being set: application/vnd.github.ironman-preview+json; this header is needed until the v3 api becomes the law of the land, apparently. Teams API reference: https://developer.github.com/v3/orgs/teams --- Github/Data.hs | 116 ++++++++++++++++++ Github/Data/Definitions.hs | 95 +++++++++++++- Github/Organizations/Teams.hs | 24 ++++ Github/Private.hs | 42 ++++++- Github/Teams.hs | 64 ++++++++++ Github/Teams/Memberships.hs | 38 ++++++ github.cabal | 12 ++ samples/Organizations/Teams/CreateTeamFor.hs | 21 ++++ .../Teams/ListTeamsForOrganization.hs | 17 +++ samples/Organizations/Teams/skipped-for-now | 2 - samples/Teams/DeleteTeam.hs | 16 +++ samples/Teams/EditTeam.hs | 21 ++++ samples/Teams/ListTeamsCurrent.hs | 16 +++ .../Teams/Memberships/AddTeamMembershipFor.hs | 18 +++ .../Memberships/DeleteTeamMembershipFor.hs | 18 +++ .../Memberships/TeamMembershipInfoFor.hs | 20 +++ samples/Teams/TeamInfoFor.hs | 17 +++ 17 files changed, 553 insertions(+), 4 deletions(-) create mode 100644 Github/Organizations/Teams.hs create mode 100644 Github/Teams.hs create mode 100644 Github/Teams/Memberships.hs create mode 100644 samples/Organizations/Teams/CreateTeamFor.hs create mode 100644 samples/Organizations/Teams/ListTeamsForOrganization.hs delete mode 100644 samples/Organizations/Teams/skipped-for-now create mode 100644 samples/Teams/DeleteTeam.hs create mode 100644 samples/Teams/EditTeam.hs create mode 100644 samples/Teams/ListTeamsCurrent.hs create mode 100644 samples/Teams/Memberships/AddTeamMembershipFor.hs create mode 100644 samples/Teams/Memberships/DeleteTeamMembershipFor.hs create mode 100644 samples/Teams/Memberships/TeamMembershipInfoFor.hs create mode 100644 samples/Teams/TeamInfoFor.hs diff --git a/Github/Data.hs b/Github/Data.hs index 65fa7370..544928aa 100644 --- a/Github/Data.hs +++ b/Github/Data.hs @@ -650,6 +650,122 @@ instance FromJSON DetailedOwner where <*> o .: "login" parseJSON _ = fail "Could not build a DetailedOwner" +instance FromJSON Privacy where + parseJSON (String attr) = + case attr of + "secret" -> return PrivacySecret + "closed" -> return PrivacyClosed + _ -> fail "Unknown Privacy Attribute" + parseJSON _ = fail "Could not build Privacy" + +instance ToJSON Privacy where + toJSON attr = + String $ + case attr of + PrivacySecret -> "secret" + PrivacyClosed -> "closed" + +instance FromJSON Permission where + parseJSON (String attr) = + case attr of + "pull" -> return PermissionPull + "push" -> return PermissionPush + "admin" -> return PermissionAdmin + _ -> fail "Unknown Permission Attribute" + parseJSON _ = fail "Could not build Permission" + +instance ToJSON Permission where + toJSON attr = + String $ + case attr of + PermissionPull -> "pull" + PermissionPush -> "push" + PermissionAdmin -> "admin" + +instance FromJSON Team where + parseJSON (Object o) = + Team <$> o .: "id" + <*> o .: "url" + <*> o .: "name" + <*> o .: "slug" + <*> o .:?"description" .!= Nothing + <*> o .:?"privacy" .!= Nothing + <*> o .: "permission" + <*> o .: "members_url" + <*> o .: "repositories_url" + parseJSON _ = fail "Could not build Team" + +instance FromJSON DetailedTeam where + parseJSON (Object o) = + DetailedTeam <$> o .: "id" + <*> o .: "url" + <*> o .: "name" + <*> o .: "slug" + <*> o .:?"description" .!= Nothing + <*> o .:?"privacy" .!= Nothing + <*> o .: "permission" + <*> o .: "members_url" + <*> o .: "repositories_url" + <*> o .: "members_count" + <*> o .: "repos_count" + <*> o .: "organization" + parseJSON _ = fail "Could not build a DetailedTeam" + +instance ToJSON CreateTeam where + toJSON (CreateTeam name desc repo_names {-privacy-} permissions) = + object [ "name" .= name + , "description" .= desc + , "repo_names" .= repo_names + {-, "privacy" .= privacy-} + , "permissions" .= permissions ] + +instance ToJSON EditTeam where + toJSON (EditTeam name desc {-privacy-} permissions) = + object [ "name" .= name + , "description" .= desc + {-, "privacy" .= privacy-} + , "permissions" .= permissions ] + +instance FromJSON Role where + parseJSON (String attr) = + case attr of + "maintainer" -> return RoleMaintainer + "member" -> return RoleMember + _ -> fail "Unknown Role" + parseJSON _ = fail "Could not build Role" + +instance ToJSON Role where + toJSON RoleMaintainer = String "maintainer" + toJSON RoleMember = String "member" + +instance FromJSON ReqState where + parseJSON (String attr) = + case attr of + "active" -> return StateActive + "pending" -> return StatePending + _ -> fail "Unknown ReqState" + parseJSON _ = fail "Could not build ReqState" + +instance ToJSON ReqState where + toJSON StateActive = String "active" + toJSON StatePending = String "pending" + +instance FromJSON TeamMembership where + parseJSON (Object o) = + TeamMembership <$> o .: "url" + <*> o .: "role" + <*> o .: "state" + parseJSON _ = fail "Could not build TeamMembership" + +instance FromJSON CreateTeamMembership where + parseJSON (Object o) = + CreateTeamMembership <$> o .: "role" + parseJSON _ = fail "Could not build CreateTeamMembership" + +instance ToJSON CreateTeamMembership where + toJSON (CreateTeamMembership { createTeamMembershipRole = role }) = + object [ "role" .= role ] + instance FromJSON RepoWebhook where parseJSON (Object o) = RepoWebhook <$> o .: "url" diff --git a/Github/Data/Definitions.hs b/Github/Data/Definitions.hs index 211544de..959290c7 100644 --- a/Github/Data/Definitions.hs +++ b/Github/Data/Definitions.hs @@ -335,7 +335,7 @@ data EventType = | Referenced -- ^ The issue was referenced from a commit message. The commit_id attribute is the commit SHA1 of where that happened. | Merged -- ^ The issue was merged by the actor. The commit_id attribute is the SHA1 of the HEAD commit that was merged. | Assigned -- ^ The issue was assigned to the actor. - | Closed -- ^ The issue was closed by the actor. When the commit_id is present, it identifies the commit that closed the issue using “closes / fixes #NN” syntax. + | Closed -- ^ The issue was closed by the actor. When the commit_id is present, it identifies the commit that closed the issue using “closes / fixes #NN” syntax. | Reopened -- ^ The issue was reopened by the actor. | ActorUnassigned -- ^ The issue was unassigned to the actor | Labeled -- ^ A label was added to the issue. @@ -770,3 +770,96 @@ data EditPullRequestState = deriving (Show, Generic) instance NFData EditPullRequestState + +data Privacy = + PrivacyClosed + | PrivacySecret + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Privacy + +data Permission = + PermissionPull + | PermissionPush + | PermissionAdmin + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Permission + +data Team = Team { + teamId :: Int + ,teamUrl :: String + ,teamName :: String + ,teamSlug :: String + ,teamDescription :: Maybe String + ,teamPrivacy :: Maybe Privacy + ,teamPermission :: Permission + ,teamMembersUrl :: String + ,teamRepositoriesUrl :: String +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Team + +data DetailedTeam = DetailedTeam { + detailedTeamId :: Int + ,detailedTeamUrl :: String + ,detailedTeamName :: String + ,detailedTeamSlug :: String + ,detailedTeamDescription :: Maybe String + ,detailedTeamPrivacy :: Maybe Privacy + ,detailedTeamPermission :: Permission + ,detailedTeamMembersUrl :: String + ,detailedTeamRepositoriesUrl :: String + ,detailedTeamMembersCount :: Int + ,detailedTeamReposCount :: Int + ,detailedTeamOrganization :: GithubOwner +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData DetailedTeam + +data CreateTeam = CreateTeam { + createTeamName :: String + ,createTeamDescription :: Maybe String + ,createRepoNames :: [String] + {-,createTeamPrivacy :: Privacy-} + ,createTeamPermission :: Permission +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData CreateTeam + +data EditTeam = EditTeam { + editTeamName :: String + ,editTeamDescription :: Maybe String + {-,editTeamPrivacy :: Privacy-} + ,editTeamPermission :: Permission +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData EditTeam + +data Role = + RoleMaintainer + | RoleMember + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Role + +data ReqState = + StatePending + | StateActive + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData ReqState + +data TeamMembership = TeamMembership { + teamMembershipUrl :: String, + teamMembershipRole :: Role, + teamMembershipReqState :: ReqState +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData TeamMembership + +data CreateTeamMembership = CreateTeamMembership { + createTeamMembershipRole :: Role +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData CreateTeamMembership diff --git a/Github/Organizations/Teams.hs b/Github/Organizations/Teams.hs new file mode 100644 index 00000000..e4c7205f --- /dev/null +++ b/Github/Organizations/Teams.hs @@ -0,0 +1,24 @@ +-- | The organization teams API as described on +-- . +module Github.Organizations.Teams ( + teamsOf +,teamsOf' +,module Github.Data +) where + +import Github.Data +import Github.Private + +-- | List the teams of an organization. +-- | When authenticated, lists private teams visible to the authenticated user. +-- | When unauthenticated, lists only public teams for an organization. +-- +-- > teamsOf' (Just $ GithubOAuth "token") "thoughtbot" +teamsOf' :: Maybe GithubAuth -> String -> IO (Either Error [Team]) +teamsOf' auth organization = githubGet' auth ["orgs", organization, "teams"] + +-- | List the public teams of an organization. +-- +-- > teamsOf "thoughtbot" +teamsOf :: String -> IO (Either Error [Team]) +teamsOf = teamsOf' Nothing diff --git a/Github/Private.hs b/Github/Private.hs index fcb6ddca..e25f3c77 100644 --- a/Github/Private.hs +++ b/Github/Private.hs @@ -72,6 +72,17 @@ githubPatch auth paths body = (Just auth) (Just body) +githubPut :: (ToJSON a, Show a, FromJSON b, Show b) => GithubAuth -> [String] -> a -> IO (Either Error b) +githubPut auth paths body = + githubAPI (BS.pack "PUT") + (buildPath paths) + (Just auth) + (Just body) + +githubDelete :: GithubAuth -> [String] -> IO (Either Error ()) +githubDelete auth paths = + githubAPIDelete auth (buildPath paths) + apiEndpoint :: Maybe GithubAuth -> String apiEndpoint (Just (GithubEnterpriseOAuth endpoint _)) = endpoint apiEndpoint _ = "https://api.github.com" @@ -127,7 +138,7 @@ doHttps :: BS.ByteString -> [Char] -> Maybe GithubAuth -> Maybe RequestBody - -> IO (Either E.SomeException (Response LBS.ByteString)) + -> IO (Either E.SomeException (Response LBS.ByteString)) doHttps reqMethod url auth body = do let reqBody = fromMaybe (RequestBodyBS $ BS.pack "") body reqHeaders = maybe [] getOAuth auth @@ -209,3 +220,32 @@ jsonResultToE jsonString result = case result of parseJson :: (FromJSON b, Show b) => LBS.ByteString -> Either Error b parseJson jsonString = either Left (jsonResultToE jsonString . fromJSON) (parseJsonRaw jsonString) + +-- | Generically delete something +-- +-- > githubApiDelete (GithubBasicAuth (user, password)) ["some", "path"] +githubAPIDelete :: GithubAuth + -> String -- ^ paths + -> IO (Either Error ()) +githubAPIDelete auth paths = do + result <- doHttps "DELETE" + (apiEndpoint (Just auth) ++ paths) + (Just auth) + Nothing + case result of + Left e -> return (Left (HTTPConnectionError e)) + Right resp -> + let status = responseStatus resp + headers = responseHeaders resp + in if status == notFound404 + -- doHttps silently absorbs 404 errors, but for this operation + -- we want the user to know if they've tried to delete a + -- non-existent repository + then return (Left (HTTPConnectionError + (E.toException + (StatusCodeException status headers +#if MIN_VERSION_http_conduit(1, 9, 0) + (responseCookieJar resp) +#endif + )))) + else return (Right ()) diff --git a/Github/Teams.hs b/Github/Teams.hs new file mode 100644 index 00000000..57c534b0 --- /dev/null +++ b/Github/Teams.hs @@ -0,0 +1,64 @@ +module Github.Teams ( + teamInfoFor +,teamInfoFor' +,teamsInfo' +,createTeamFor' +,editTeam' +,deleteTeam' +,listTeamsCurrent' +,module Github.Data +) where + +import Github.Data +import Github.Private + +-- | The information for a single team, by team id. +-- | With authentication +-- +-- > teamInfoFor' (Just $ GithubOAuth "token") 1010101 +teamInfoFor' :: Maybe GithubAuth -> Int -> IO (Either Error DetailedTeam) +teamInfoFor' auth team_id = githubGet' auth ["teams", show team_id] + +-- | The information for a single team, by team id. +-- +-- > teamInfoFor' (Just $ GithubOAuth "token") 1010101 +teamInfoFor :: Int -> IO (Either Error DetailedTeam) +teamInfoFor = teamInfoFor' Nothing + +-- | Lists all teams, across all organizations, that the current user belongs to. +-- +-- > teamsInfo' (Just $ GithubOAuth "token") +teamsInfo' :: Maybe GithubAuth -> IO (Either Error [DetailedTeam]) +teamsInfo' auth = githubGet' auth ["user", "teams"] + +-- | Create a team under an organization +-- +-- > createTeamFor' (GithubOAuth "token") "organization" (CreateTeam "newteamname" "some description" [] PermssionPull) +createTeamFor' :: GithubAuth + -> String + -> CreateTeam + -> IO (Either Error DetailedTeam) +createTeamFor' auth organization create_team = + githubPost auth ["orgs", organization, "teams"] create_team + +-- | Edit a team, by id. +-- +-- > editTeamFor' +editTeam' :: GithubAuth + -> Int + -> EditTeam + -> IO (Either Error DetailedTeam) +editTeam' auth team_id edit_team = + githubPatch auth ["teams", show team_id] edit_team + +-- | Delete a team, by id. +-- +-- > deleteTeam' (GithubOAuth "token") 1010101 +deleteTeam' :: GithubAuth -> Int -> IO (Either Error ()) +deleteTeam' auth team_id = githubDelete auth ["teams", show team_id] + +-- | List teams for current authenticated user +-- +-- > listTeamsCurrent' (GithubOAuth "token") +listTeamsCurrent' :: GithubAuth -> IO (Either Error [DetailedTeam]) +listTeamsCurrent' auth = githubGet' (Just auth) ["user", "teams"] diff --git a/Github/Teams/Memberships.hs b/Github/Teams/Memberships.hs new file mode 100644 index 00000000..b3a880a2 --- /dev/null +++ b/Github/Teams/Memberships.hs @@ -0,0 +1,38 @@ +module Github.Teams.Memberships ( + teamMembershipInfoFor +,teamMembershipInfoFor' +,addTeamMembershipFor' +,deleteTeamMembershipFor' +, module Github.Data +) where + +import Github.Data +import Github.Private + +-- | Retrieve team mebership information for a user. +-- | With authentication +-- +-- > teamMembershipInfoFor' (Just $ GithubOAuth "token") 1010101 "mburns" +teamMembershipInfoFor' :: Maybe GithubAuth -> Int -> String -> IO (Either Error TeamMembership) +teamMembershipInfoFor' auth team_id username = + githubGet' auth ["teams", show team_id, "memberships", username] + +-- | Retrieve team mebership information for a user. +-- +-- > teamMembershipInfoFor 1010101 "mburns" +teamMembershipInfoFor :: Int -> String -> IO (Either Error TeamMembership) +teamMembershipInfoFor = teamMembershipInfoFor' Nothing + +-- | Add (or invite) a member to a team. +-- +-- > addTeamMembershipFor' (GithubOAuth "token") 1010101 "mburns" RoleMember +addTeamMembershipFor' :: GithubAuth -> Int -> String -> Role -> IO (Either Error TeamMembership) +addTeamMembershipFor' auth team_id username role = + githubPut auth ["teams", show team_id, "memberships", username] (CreateTeamMembership role) + +-- | Delete a member of a team. +-- +-- > deleteTeamMembershipFor' (GithubOAuth "token") 1010101 "mburns" +deleteTeamMembershipFor' :: GithubAuth -> Int -> String -> IO (Either Error ()) +deleteTeamMembershipFor' auth team_id username = + githubDelete auth ["teams", show team_id, "memberships", username] diff --git a/github.cabal b/github.cabal index 0a31d886..ed0b407f 100644 --- a/github.cabal +++ b/github.cabal @@ -73,6 +73,8 @@ Extra-source-files: README.md ,samples/Organizations/Members/ShowMembers.hs ,samples/Organizations/ShowPublicOrganization.hs ,samples/Organizations/ShowPublicOrganizations.hs + ,samples/Organizations/Teams/CreateTeamFor.hs + ,samples/Organizations/Teams/ListTeamsForOrganization.hs ,samples/Pulls/Diff.hs ,samples/Pulls/ListPulls.hs ,samples/Pulls/ReviewComments/ListComments.hs @@ -107,6 +109,13 @@ Extra-source-files: README.md ,samples/Repos/Webhooks/ListWebhooks.hs ,samples/Repos/Webhooks/PingWebhook.hs ,samples/Repos/Webhooks/TestPushWebhook.hs + ,samples/Teams/DeleteTeam.hs + ,samples/Teams/EditTeam.hs + ,samples/Teams/ListTeamsCurrent.hs + ,samples/Teams/TeamInfoFor.hs + ,samples/Teams/Memberships/AddTeamMembershipFor.hs + ,samples/Teams/Memberships/DeleteTeamMembershipFor.hs + ,samples/Teams/Memberships/TeamMembershipInfoFor.hs ,samples/Users/Followers/ListFollowers.hs ,samples/Users/Followers/ListFollowing.hs ,samples/Users/ShowUser.hs @@ -140,6 +149,7 @@ Library Github.Issues.Milestones, Github.Organizations, Github.Organizations.Members, + Github.Organizations.Teams, Github.PullRequests, Github.PullRequests.ReviewComments, Github.Repos, @@ -151,6 +161,8 @@ Library Github.Repos.Subscribing, Github.Repos.Webhooks Github.Repos.Webhooks.Validate, + Github.Teams + Github.Teams.Memberships, Github.Users, Github.Users.Followers Github.Search diff --git a/samples/Organizations/Teams/CreateTeamFor.hs b/samples/Organizations/Teams/CreateTeamFor.hs new file mode 100644 index 00000000..9cb29aea --- /dev/null +++ b/samples/Organizations/Teams/CreateTeamFor.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE OverloadedStrings #-} + +module CreateTeamFor where + +import qualified Github.Auth as Github +import qualified Github.Teams as Github +import System.Environment (getArgs) + +main = do + args <- getArgs + result <- case args of + [token, org, team, desc, repos] -> + Github.createTeamFor' + (Github.GithubOAuth token) + org + (Github.CreateTeam team (Just desc) (read repos :: [String]) Github.PermissionPull) + _ -> + error "usage: CreateTeamFor <[\"repos\"]>" + case result of + Left err -> putStrLn $ "Error: " ++ show err + Right team -> putStrLn $ show team diff --git a/samples/Organizations/Teams/ListTeamsForOrganization.hs b/samples/Organizations/Teams/ListTeamsForOrganization.hs new file mode 100644 index 00000000..e29f147d --- /dev/null +++ b/samples/Organizations/Teams/ListTeamsForOrganization.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE OverloadedStrings #-} + +module ListTeamsForOrganization where + +import qualified Github.Auth as Github +import qualified Github.Organizations.Teams as Github +import System.Environment (getArgs) + +main = do + args <- getArgs + result <- case args of + [team, token] -> Github.teamsOf' (Just $ Github.GithubOAuth token) team + [team] -> Github.teamsOf team + _ -> error "usage: ListTeamsForOrganization [auth token]" + case result of + Left err -> putStrLn $ "Error: " ++ show err + Right teams -> mapM_ (putStrLn . show) teams diff --git a/samples/Organizations/Teams/skipped-for-now b/samples/Organizations/Teams/skipped-for-now deleted file mode 100644 index 10a9e1d5..00000000 --- a/samples/Organizations/Teams/skipped-for-now +++ /dev/null @@ -1,2 +0,0 @@ -I can't get all the API calls to work properly on this page from curl so I'm -skipping for now: http://developer.github.com/v3/orgs/teams/ diff --git a/samples/Teams/DeleteTeam.hs b/samples/Teams/DeleteTeam.hs new file mode 100644 index 00000000..c619b5c9 --- /dev/null +++ b/samples/Teams/DeleteTeam.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE OverloadedStrings #-} + +module DeleteTeam where + +import qualified Github.Auth as Github +import qualified Github.Teams as Github +import System.Environment (getArgs) + +main = do + args <- getArgs + result <- case args of + [token, team_id] -> Github.deleteTeam' (Github.GithubOAuth token) (read team_id) + _ -> error "usage: DeleteTeam " + case result of + Left err -> putStrLn $ "Error: " ++ show err + Right team -> putStrLn $ show team diff --git a/samples/Teams/EditTeam.hs b/samples/Teams/EditTeam.hs new file mode 100644 index 00000000..d6c82319 --- /dev/null +++ b/samples/Teams/EditTeam.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE OverloadedStrings #-} + +module EditTeam where + +import qualified Github.Auth as Github +import qualified Github.Teams as Github +import System.Environment (getArgs) + +main = do + args <- getArgs + result <- case args of + [token, team_id, team_name, desc] -> + Github.editTeam' + (Github.GithubOAuth token) + (read team_id) + (Github.EditTeam team_name (Just desc) Github.PermissionPull) + _ -> + error "usage: EditTeam " + case result of + Left err -> putStrLn $ "Error: " ++ show err + Right team -> putStrLn $ show team diff --git a/samples/Teams/ListTeamsCurrent.hs b/samples/Teams/ListTeamsCurrent.hs new file mode 100644 index 00000000..75e4aa4a --- /dev/null +++ b/samples/Teams/ListTeamsCurrent.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE OverloadedStrings #-} + +module ListTeamsCurrent where + +import qualified Github.Auth as Github +import qualified Github.Teams as Github +import System.Environment (getArgs) + +main = do + args <- getArgs + result <- case args of + [token] -> Github.listTeamsCurrent' (Github.GithubOAuth token) + _ -> error "usage: ListTeamsCurrent " + case result of + Left err -> putStrLn $ "Error: " ++ show err + Right teams -> mapM_ (putStrLn . show) teams diff --git a/samples/Teams/Memberships/AddTeamMembershipFor.hs b/samples/Teams/Memberships/AddTeamMembershipFor.hs new file mode 100644 index 00000000..d771ffb7 --- /dev/null +++ b/samples/Teams/Memberships/AddTeamMembershipFor.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE OverloadedStrings #-} + +module AddTeamMembershipFor where + +import qualified Github.Auth as Github +import qualified Github.Teams.Memberships as Github +import System.Environment (getArgs) + +main = do + args <- getArgs + result <- case args of + [token, team_id, username] -> + Github.addTeamMembershipFor' (Github.GithubOAuth token) (read team_id) username Github.RoleMember + _ -> + error "usage: AddTeamMembershipFor " + case result of + Left err -> putStrLn $ "Error: " ++ show err + Right team -> putStrLn $ show team diff --git a/samples/Teams/Memberships/DeleteTeamMembershipFor.hs b/samples/Teams/Memberships/DeleteTeamMembershipFor.hs new file mode 100644 index 00000000..c96d8ee6 --- /dev/null +++ b/samples/Teams/Memberships/DeleteTeamMembershipFor.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE OverloadedStrings #-} + +module DeleteTeamMembershipFor where + +import qualified Github.Auth as Github +import qualified Github.Teams.Memberships as Github +import System.Environment (getArgs) + +main = do + args <- getArgs + result <- case args of + [token, team_id, username] -> + Github.deleteTeamMembershipFor' (Github.GithubOAuth token) (read team_id) username + _ -> + error "usage: DeleteTeamMembershipFor " + case result of + Left err -> putStrLn $ "Error: " ++ show err + Right team -> putStrLn $ show team diff --git a/samples/Teams/Memberships/TeamMembershipInfoFor.hs b/samples/Teams/Memberships/TeamMembershipInfoFor.hs new file mode 100644 index 00000000..7c0ca251 --- /dev/null +++ b/samples/Teams/Memberships/TeamMembershipInfoFor.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE OverloadedStrings #-} + +module TeamMembershipInfoFor where + +import qualified Github.Auth as Github +import qualified Github.Teams.Memberships as Github +import System.Environment (getArgs) + +main = do + args <- getArgs + result <- case args of + [team_id, username, token] -> + Github.teamMembershipInfoFor' (Just $ Github.GithubOAuth token) (read team_id) username + [team_id, username] -> + Github.teamMembershipInfoFor (read team_id) username + _ -> + error "usage: TeamMembershipInfoFor [token]" + case result of + Left err -> putStrLn $ "Error: " ++ show err + Right team -> putStrLn $ show team diff --git a/samples/Teams/TeamInfoFor.hs b/samples/Teams/TeamInfoFor.hs new file mode 100644 index 00000000..9f5fa0c4 --- /dev/null +++ b/samples/Teams/TeamInfoFor.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE OverloadedStrings #-} + +module TeamInfoFor where + +import qualified Github.Auth as Github +import qualified Github.Teams as Github +import System.Environment (getArgs) + +main = do + args <- getArgs + result <- case args of + [team_id, token] -> Github.teamInfoFor' (Just $ Github.GithubOAuth token) (read team_id) + [team_id] -> Github.teamInfoFor (read team_id) + _ -> error "usage: TeamInfoFor [auth token]" + case result of + Left err -> putStrLn $ "Error: " ++ show err + Right team -> putStrLn $ show team From 1c770f54ef19e4ebab5195803f2b137b11ae1059 Mon Sep 17 00:00:00 2001 From: Andrew Darqui Date: Tue, 22 Sep 2015 22:40:40 -0400 Subject: [PATCH 084/510] Support authenticated requests for the members of an organization. --- Github/Organizations/Members.hs | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) diff --git a/Github/Organizations/Members.hs b/Github/Organizations/Members.hs index 1506d433..ad19554f 100644 --- a/Github/Organizations/Members.hs +++ b/Github/Organizations/Members.hs @@ -2,14 +2,23 @@ -- . module Github.Organizations.Members ( membersOf +,membersOf' ,module Github.Data ) where import Github.Data import Github.Private --- | All the users who are members of the specified organization. +-- | All the users who are members of the specified organization, +-- | with or without authentication. +-- +-- > membersOf' (Just $ GithubOAuth "token") "thoughtbot" +membersOf' :: Maybe GithubAuth -> String -> IO (Either Error [GithubOwner]) +membersOf' auth organization = githubGet' auth ["orgs", organization, "members"] + +-- | All the users who are members of the specified organization, +-- | without authentication. -- -- > membersOf "thoughtbot" membersOf :: String -> IO (Either Error [GithubOwner]) -membersOf organization = githubGet ["orgs", organization, "members"] +membersOf = membersOf' Nothing From d2ed388cda270f40d915fadd2b1ac3c110bbbab7 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Wed, 30 Sep 2015 15:52:32 +0300 Subject: [PATCH 085/510] Use built library in tests --- github.cabal | 24 +++--------------------- 1 file changed, 3 insertions(+), 21 deletions(-) diff --git a/github.cabal b/github.cabal index ed0b407f..6fb0e88b 100644 --- a/github.cabal +++ b/github.cabal @@ -200,28 +200,10 @@ Library test-suite github-test default-language: Haskell2010 type: exitcode-stdio-1.0 - hs-source-dirs: spec, . + hs-source-dirs: spec main-is: Spec.hs build-depends: base >= 4.0 && < 5.0, - time, - aeson >= 0.6.1.0, - attoparsec >= 0.10.3.0, - bytestring, - case-insensitive >= 0.4.0.4, - containers, - hashable, - text, - old-locale, - http-conduit >= 1.8, - http-types, - data-default, - vector, - deepseq, - unordered-containers >= 0.2 && < 0.3, - cryptohash >= 0.11, - byteable >= 0.1.0, - base16-bytestring >= 0.1.1.6 - - , hspec + github, + hspec ghc-options: -Wall -fno-warn-orphans From abf0557389ba65dbec80c2aa19aa3eea72de42b1 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Wed, 30 Sep 2015 15:52:49 +0300 Subject: [PATCH 086/510] Use aeson-extra for compatibility --- Github/Data.hs | 3 ++- github.cabal | 1 + 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/Github/Data.hs b/Github/Data.hs index 544928aa..7e0cd87b 100644 --- a/Github/Data.hs +++ b/Github/Data.hs @@ -9,7 +9,8 @@ module Github.Data (module Github.Data.Definitions) where import Control.Applicative import Control.Monad import qualified Data.Text as T -import Data.Aeson.Types +import Data.Aeson.Compat +import Data.Aeson.Types hiding ((.:?)) import qualified Data.Vector as V import qualified Data.HashMap.Lazy as Map import Data.Hashable (Hashable) diff --git a/github.cabal b/github.cabal index 6fb0e88b..a5b2ea60 100644 --- a/github.cabal +++ b/github.cabal @@ -174,6 +174,7 @@ Library Build-depends: base >= 4.0 && < 5.0, time >=1.4 && <1.6, aeson >= 0.6.1.0, + aeson-extra >= 0.2.0.0, attoparsec >= 0.10.3.0, bytestring, case-insensitive >= 0.4.0.4, From dbd6148057b58effa3f2df2e9f63713cdfe03c75 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Wed, 30 Sep 2015 16:26:47 +0300 Subject: [PATCH 087/510] Split Definitions --- Github/Data.hs | 14 +- Github/Data/Definitions.hs | 523 ------------------------------------ Github/Data/Gists.hs | 47 ++++ Github/Data/GitData.hs | 148 ++++++++++ Github/Data/Issues.hs | 124 +++++++++ Github/Data/PullRequests.hs | 144 ++++++++++ Github/Data/Teams.hs | 101 +++++++ github.cabal | 5 + 8 files changed, 582 insertions(+), 524 deletions(-) create mode 100644 Github/Data/Gists.hs create mode 100644 Github/Data/GitData.hs create mode 100644 Github/Data/Issues.hs create mode 100644 Github/Data/PullRequests.hs create mode 100644 Github/Data/Teams.hs diff --git a/Github/Data.hs b/Github/Data.hs index 7e0cd87b..bab2dad5 100644 --- a/Github/Data.hs +++ b/Github/Data.hs @@ -4,7 +4,14 @@ -- instances of @FromJSON@ to it. If you wish to use the data without the -- instances, use the @Github.Data.Definitions@ module instead. -module Github.Data (module Github.Data.Definitions) where +module Github.Data ( + module Github.Data.Definitions, + module Github.Data.Gists, + module Github.Data.GitData, + module Github.Data.Issues, + module Github.Data.PullRequests, + module Github.Data.Teams, + ) where import Control.Applicative import Control.Monad @@ -23,6 +30,11 @@ import System.Locale (defaultTimeLocale) #endif import Github.Data.Definitions +import Github.Data.Gists +import Github.Data.GitData +import Github.Data.Issues +import Github.Data.PullRequests +import Github.Data.Teams instance FromJSON GithubDate where parseJSON (String t) = diff --git a/Github/Data/Definitions.hs b/Github/Data/Definitions.hs index 959290c7..3650460e 100644 --- a/Github/Data/Definitions.hs +++ b/Github/Data/Definitions.hs @@ -32,51 +32,6 @@ newtype GithubDate = GithubDate { fromGithubDate :: UTCTime } instance NFData GithubDate -data Commit = Commit { - commitSha :: String - ,commitParents :: [Tree] - ,commitUrl :: String - ,commitGitCommit :: GitCommit - ,commitCommitter :: Maybe GithubOwner - ,commitAuthor :: Maybe GithubOwner - ,commitFiles :: [File] - ,commitStats :: Maybe Stats -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData Commit - -data Tree = Tree { - treeSha :: String - ,treeUrl :: String - ,treeGitTrees :: [GitTree] -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData Tree - -data GitTree = GitTree { - gitTreeType :: String - ,gitTreeSha :: String - -- Can be empty for submodule - ,gitTreeUrl :: Maybe String - ,gitTreeSize :: Maybe Int - ,gitTreePath :: String - ,gitTreeMode :: String -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData GitTree - -data GitCommit = GitCommit { - gitCommitMessage :: String - ,gitCommitUrl :: String - ,gitCommitCommitter :: GitUser - ,gitCommitAuthor :: GitUser - ,gitCommitTree :: Tree - ,gitCommitSha :: Maybe String - ,gitCommitParents :: [Tree] -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData GitCommit - data GithubOwner = GithubUser { githubOwnerAvatarUrl :: String ,githubOwnerLogin :: String @@ -93,28 +48,6 @@ data GithubOwner = GithubUser { instance NFData GithubOwner -data GitUser = GitUser { - gitUserName :: String - ,gitUserEmail :: String - ,gitUserDate :: GithubDate -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData GitUser - -data File = File { - fileBlobUrl :: String - ,fileStatus :: String - ,fileRawUrl :: String - ,fileAdditions :: Int - ,fileSha :: String - ,fileChanges :: Int - ,filePatch :: String - ,fileFilename :: String - ,fileDeletions :: Int -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData File - data Stats = Stats { statsAdditions :: Int ,statsTotal :: Int @@ -151,218 +84,6 @@ data EditComment = EditComment { instance NFData EditComment -data Diff = Diff { - diffStatus :: String - ,diffBehindBy :: Int - ,diffPatchUrl :: String - ,diffUrl :: String - ,diffBaseCommit :: Commit - ,diffCommits :: [Commit] - ,diffTotalCommits :: Int - ,diffHtmlUrl :: String - ,diffFiles :: [File] - ,diffAheadBy :: Int - ,diffDiffUrl :: String - ,diffPermalinkUrl :: String -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData Diff - -data Gist = Gist { - gistUser :: GithubOwner - ,gistGitPushUrl :: String - ,gistUrl :: String - ,gistDescription :: Maybe String - ,gistCreatedAt :: GithubDate - ,gistPublic :: Bool - ,gistComments :: Int - ,gistUpdatedAt :: GithubDate - ,gistHtmlUrl :: String - ,gistId :: String - ,gistFiles :: [GistFile] - ,gistGitPullUrl :: String -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData Gist - -data GistFile = GistFile { - gistFileType :: String - ,gistFileRawUrl :: String - ,gistFileSize :: Int - ,gistFileLanguage :: Maybe String - ,gistFileFilename :: String - ,gistFileContent :: Maybe String -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData GistFile - -data GistComment = GistComment { - gistCommentUser :: GithubOwner - ,gistCommentUrl :: String - ,gistCommentCreatedAt :: GithubDate - ,gistCommentBody :: String - ,gistCommentUpdatedAt :: GithubDate - ,gistCommentId :: Int -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData GistComment - -data Blob = Blob { - blobUrl :: String - ,blobEncoding :: String - ,blobContent :: String - ,blobSha :: String - ,blobSize :: Int -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData Blob - -data NewGitReference = NewGitReference { - newGitReferenceRef :: String - ,newGitReferenceSha :: String -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData NewGitReference - -data GitReference = GitReference { - gitReferenceObject :: GitObject - ,gitReferenceUrl :: String - ,gitReferenceRef :: String -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData GitReference - -data GitObject = GitObject { - gitObjectType :: String - ,gitObjectSha :: String - ,gitObjectUrl :: String -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData GitObject - -data Issue = Issue { - issueClosedAt :: Maybe GithubDate - ,issueUpdatedAt :: GithubDate - ,issueEventsUrl :: String - ,issueHtmlUrl :: Maybe String - ,issueClosedBy :: Maybe GithubOwner - ,issueLabels :: [IssueLabel] - ,issueNumber :: Int - ,issueAssignee :: Maybe GithubOwner - ,issueUser :: GithubOwner - ,issueTitle :: String - ,issuePullRequest :: Maybe PullRequestReference - ,issueUrl :: String - ,issueCreatedAt :: GithubDate - ,issueBody :: Maybe String - ,issueState :: String - ,issueId :: Int - ,issueComments :: Int - ,issueMilestone :: Maybe Milestone -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData Issue - -data NewIssue = NewIssue { - newIssueTitle :: String -, newIssueBody :: Maybe String -, newIssueAssignee :: Maybe String -, newIssueMilestone :: Maybe Int -, newIssueLabels :: Maybe [String] -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData NewIssue - -data EditIssue = EditIssue { - editIssueTitle :: Maybe String -, editIssueBody :: Maybe String -, editIssueAssignee :: Maybe String -, editIssueState :: Maybe String -, editIssueMilestone :: Maybe Int -, editIssueLabels :: Maybe [String] -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData EditIssue - -data Milestone = Milestone { - milestoneCreator :: GithubOwner - ,milestoneDueOn :: Maybe GithubDate - ,milestoneOpenIssues :: Int - ,milestoneNumber :: Int - ,milestoneClosedIssues :: Int - ,milestoneDescription :: Maybe String - ,milestoneTitle :: String - ,milestoneUrl :: String - ,milestoneCreatedAt :: GithubDate - ,milestoneState :: String -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData Milestone - -data IssueLabel = IssueLabel { - labelColor :: String - ,labelUrl :: String - ,labelName :: String -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData IssueLabel - -data PullRequestReference = PullRequestReference { - pullRequestReferenceHtmlUrl :: Maybe String - ,pullRequestReferencePatchUrl :: Maybe String - ,pullRequestReferenceDiffUrl :: Maybe String -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData PullRequestReference - -data IssueComment = IssueComment { - issueCommentUpdatedAt :: GithubDate - ,issueCommentUser :: GithubOwner - ,issueCommentUrl :: String - ,issueCommentHtmlUrl :: String - ,issueCommentCreatedAt :: GithubDate - ,issueCommentBody :: String - ,issueCommentId :: Int -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData IssueComment - --- | Data describing an @Event@. -data EventType = - Mentioned -- ^ The actor was @mentioned in an issue body. - | Subscribed -- ^ The actor subscribed to receive notifications for an issue. - | Unsubscribed -- ^ The issue was unsubscribed from by the actor. - | Referenced -- ^ The issue was referenced from a commit message. The commit_id attribute is the commit SHA1 of where that happened. - | Merged -- ^ The issue was merged by the actor. The commit_id attribute is the SHA1 of the HEAD commit that was merged. - | Assigned -- ^ The issue was assigned to the actor. - | Closed -- ^ The issue was closed by the actor. When the commit_id is present, it identifies the commit that closed the issue using “closes / fixes #NN” syntax. - | Reopened -- ^ The issue was reopened by the actor. - | ActorUnassigned -- ^ The issue was unassigned to the actor - | Labeled -- ^ A label was added to the issue. - | Unlabeled -- ^ A label was removed from the issue. - | Milestoned -- ^ The issue was added to a milestone. - | Demilestoned -- ^ The issue was removed from a milestone. - | Renamed -- ^ The issue title was changed. - | Locked -- ^ The issue was locked by the actor. - | Unlocked -- ^ The issue was unlocked by the actor. - | HeadRefDeleted -- ^ The pull request’s branch was deleted. - | HeadRefRestored -- ^ The pull request’s branch was restored. - deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData EventType - -data Event = Event { - eventActor :: GithubOwner - ,eventType :: EventType - ,eventCommitId :: Maybe String - ,eventUrl :: String - ,eventCreatedAt :: GithubDate - ,eventId :: Int - ,eventIssue :: Maybe Issue -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData Event - data SimpleOrganization = SimpleOrganization { simpleOrganizationUrl :: String ,simpleOrganizationAvatarUrl :: String @@ -393,104 +114,6 @@ data Organization = Organization { instance NFData Organization -data PullRequest = PullRequest { - pullRequestClosedAt :: Maybe GithubDate - ,pullRequestCreatedAt :: GithubDate - ,pullRequestUser :: GithubOwner - ,pullRequestPatchUrl :: String - ,pullRequestState :: String - ,pullRequestNumber :: Int - ,pullRequestHtmlUrl :: String - ,pullRequestUpdatedAt :: GithubDate - ,pullRequestBody :: String - ,pullRequestIssueUrl :: String - ,pullRequestDiffUrl :: String - ,pullRequestUrl :: String - ,pullRequestLinks :: PullRequestLinks - ,pullRequestMergedAt :: Maybe GithubDate - ,pullRequestTitle :: String - ,pullRequestId :: Int -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData PullRequest - -data DetailedPullRequest = DetailedPullRequest { - -- this is a duplication of a PullRequest - detailedPullRequestClosedAt :: Maybe GithubDate - ,detailedPullRequestCreatedAt :: GithubDate - ,detailedPullRequestUser :: GithubOwner - ,detailedPullRequestPatchUrl :: String - ,detailedPullRequestState :: String - ,detailedPullRequestNumber :: Int - ,detailedPullRequestHtmlUrl :: String - ,detailedPullRequestUpdatedAt :: GithubDate - ,detailedPullRequestBody :: String - ,detailedPullRequestIssueUrl :: String - ,detailedPullRequestDiffUrl :: String - ,detailedPullRequestUrl :: String - ,detailedPullRequestLinks :: PullRequestLinks - ,detailedPullRequestMergedAt :: Maybe GithubDate - ,detailedPullRequestTitle :: String - ,detailedPullRequestId :: Int - - ,detailedPullRequestMergedBy :: Maybe GithubOwner - ,detailedPullRequestChangedFiles :: Int - ,detailedPullRequestHead :: PullRequestCommit - ,detailedPullRequestComments :: Int - ,detailedPullRequestDeletions :: Int - ,detailedPullRequestAdditions :: Int - ,detailedPullRequestReviewComments :: Int - ,detailedPullRequestBase :: PullRequestCommit - ,detailedPullRequestCommits :: Int - ,detailedPullRequestMerged :: Bool - ,detailedPullRequestMergeable :: Maybe Bool -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData DetailedPullRequest - -data EditPullRequest = EditPullRequest { - editPullRequestTitle :: Maybe String - ,editPullRequestBody :: Maybe String - ,editPullRequestState :: Maybe EditPullRequestState -} deriving (Show, Generic) - -instance NFData EditPullRequest - -data CreatePullRequest = - CreatePullRequest - { createPullRequestTitle :: String - , createPullRequestBody :: String - , createPullRequestHead :: String - , createPullRequestBase :: String - } - | CreatePullRequestIssue - { createPullRequestIssueNum :: Int - , createPullRequestHead :: String - , createPullRequestBase :: String - } - deriving (Show, Generic) - -instance NFData CreatePullRequest - -data PullRequestLinks = PullRequestLinks { - pullRequestLinksReviewComments :: String - ,pullRequestLinksComments :: String - ,pullRequestLinksHtml :: String - ,pullRequestLinksSelf :: String -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData PullRequestLinks - -data PullRequestCommit = PullRequestCommit { - pullRequestCommitLabel :: String - ,pullRequestCommitRef :: String - ,pullRequestCommitSha :: String - ,pullRequestCommitUser :: GithubOwner - ,pullRequestCommitRepo :: Repo -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData PullRequestCommit - data SearchReposResult = SearchReposResult { searchReposTotalCount :: Int ,searchReposRepos :: [Repo] @@ -620,29 +243,6 @@ data Language = Language String Int instance NFData Language -data Tag = Tag { - tagName :: String - ,tagZipballUrl :: String - ,tagTarballUrl :: String - ,tagCommit :: BranchCommit -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData Tag - -data Branch = Branch { - branchName :: String - ,branchCommit :: BranchCommit -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData Branch - -data BranchCommit = BranchCommit { - branchCommitSha :: String - ,branchCommitUrl :: String -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData BranchCommit - data DetailedOwner = DetailedUser { detailedOwnerCreatedAt :: GithubDate ,detailedOwnerType :: String @@ -733,29 +333,6 @@ data RepoWebhookResponse = RepoWebhookResponse { instance NFData RepoWebhookResponse -data PullRequestEvent = PullRequestEvent { - pullRequestEventAction :: PullRequestEventType - ,pullRequestEventNumber :: Int - ,pullRequestEventPullRequest :: DetailedPullRequest - ,pullRequestRepository :: Repo - ,pullRequestSender :: GithubOwner -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData PullRequestEvent - -data PullRequestEventType = - PullRequestOpened - | PullRequestClosed - | PullRequestSynchronized - | PullRequestReopened - | PullRequestAssigned - | PullRequestUnassigned - | PullRequestLabeled - | PullRequestUnlabeled - deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData PullRequestEventType - data PingEvent = PingEvent { pingEventZen :: String ,pingEventHook :: RepoWebhook @@ -763,103 +340,3 @@ data PingEvent = PingEvent { } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData PingEvent - -data EditPullRequestState = - EditPullRequestStateOpen - | EditPullRequestStateClosed - deriving (Show, Generic) - -instance NFData EditPullRequestState - -data Privacy = - PrivacyClosed - | PrivacySecret - deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData Privacy - -data Permission = - PermissionPull - | PermissionPush - | PermissionAdmin - deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData Permission - -data Team = Team { - teamId :: Int - ,teamUrl :: String - ,teamName :: String - ,teamSlug :: String - ,teamDescription :: Maybe String - ,teamPrivacy :: Maybe Privacy - ,teamPermission :: Permission - ,teamMembersUrl :: String - ,teamRepositoriesUrl :: String -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData Team - -data DetailedTeam = DetailedTeam { - detailedTeamId :: Int - ,detailedTeamUrl :: String - ,detailedTeamName :: String - ,detailedTeamSlug :: String - ,detailedTeamDescription :: Maybe String - ,detailedTeamPrivacy :: Maybe Privacy - ,detailedTeamPermission :: Permission - ,detailedTeamMembersUrl :: String - ,detailedTeamRepositoriesUrl :: String - ,detailedTeamMembersCount :: Int - ,detailedTeamReposCount :: Int - ,detailedTeamOrganization :: GithubOwner -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData DetailedTeam - -data CreateTeam = CreateTeam { - createTeamName :: String - ,createTeamDescription :: Maybe String - ,createRepoNames :: [String] - {-,createTeamPrivacy :: Privacy-} - ,createTeamPermission :: Permission -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData CreateTeam - -data EditTeam = EditTeam { - editTeamName :: String - ,editTeamDescription :: Maybe String - {-,editTeamPrivacy :: Privacy-} - ,editTeamPermission :: Permission -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData EditTeam - -data Role = - RoleMaintainer - | RoleMember - deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData Role - -data ReqState = - StatePending - | StateActive - deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData ReqState - -data TeamMembership = TeamMembership { - teamMembershipUrl :: String, - teamMembershipRole :: Role, - teamMembershipReqState :: ReqState -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData TeamMembership - -data CreateTeamMembership = CreateTeamMembership { - createTeamMembershipRole :: Role -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData CreateTeamMembership diff --git a/Github/Data/Gists.hs b/Github/Data/Gists.hs new file mode 100644 index 00000000..10dfe9e2 --- /dev/null +++ b/Github/Data/Gists.hs @@ -0,0 +1,47 @@ +{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-} +module Github.Data.Gists where + +import Github.Data.Definitions + +import Control.DeepSeq (NFData) +import Data.Data (Typeable, Data) +import GHC.Generics (Generic) + +data Gist = Gist { + gistUser :: GithubOwner + ,gistGitPushUrl :: String + ,gistUrl :: String + ,gistDescription :: Maybe String + ,gistCreatedAt :: GithubDate + ,gistPublic :: Bool + ,gistComments :: Int + ,gistUpdatedAt :: GithubDate + ,gistHtmlUrl :: String + ,gistId :: String + ,gistFiles :: [GistFile] + ,gistGitPullUrl :: String +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Gist + +data GistFile = GistFile { + gistFileType :: String + ,gistFileRawUrl :: String + ,gistFileSize :: Int + ,gistFileLanguage :: Maybe String + ,gistFileFilename :: String + ,gistFileContent :: Maybe String +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData GistFile + +data GistComment = GistComment { + gistCommentUser :: GithubOwner + ,gistCommentUrl :: String + ,gistCommentCreatedAt :: GithubDate + ,gistCommentBody :: String + ,gistCommentUpdatedAt :: GithubDate + ,gistCommentId :: Int +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData GistComment \ No newline at end of file diff --git a/Github/Data/GitData.hs b/Github/Data/GitData.hs new file mode 100644 index 00000000..63cbe4e8 --- /dev/null +++ b/Github/Data/GitData.hs @@ -0,0 +1,148 @@ +{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-} +module Github.Data.GitData where + +import Github.Data.Definitions + +import Control.DeepSeq (NFData) +import Data.Data (Typeable, Data) +import GHC.Generics (Generic) + +data Commit = Commit { + commitSha :: String + ,commitParents :: [Tree] + ,commitUrl :: String + ,commitGitCommit :: GitCommit + ,commitCommitter :: Maybe GithubOwner + ,commitAuthor :: Maybe GithubOwner + ,commitFiles :: [File] + ,commitStats :: Maybe Stats +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Commit + +data Tree = Tree { + treeSha :: String + ,treeUrl :: String + ,treeGitTrees :: [GitTree] +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Tree + +data GitTree = GitTree { + gitTreeType :: String + ,gitTreeSha :: String + -- Can be empty for submodule + ,gitTreeUrl :: Maybe String + ,gitTreeSize :: Maybe Int + ,gitTreePath :: String + ,gitTreeMode :: String +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData GitTree + +data GitCommit = GitCommit { + gitCommitMessage :: String + ,gitCommitUrl :: String + ,gitCommitCommitter :: GitUser + ,gitCommitAuthor :: GitUser + ,gitCommitTree :: Tree + ,gitCommitSha :: Maybe String + ,gitCommitParents :: [Tree] +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData GitCommit + +data Blob = Blob { + blobUrl :: String + ,blobEncoding :: String + ,blobContent :: String + ,blobSha :: String + ,blobSize :: Int +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Blob + +data Tag = Tag { + tagName :: String + ,tagZipballUrl :: String + ,tagTarballUrl :: String + ,tagCommit :: BranchCommit +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Tag + +data Branch = Branch { + branchName :: String + ,branchCommit :: BranchCommit +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Branch + +data BranchCommit = BranchCommit { + branchCommitSha :: String + ,branchCommitUrl :: String +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData BranchCommit + +data Diff = Diff { + diffStatus :: String + ,diffBehindBy :: Int + ,diffPatchUrl :: String + ,diffUrl :: String + ,diffBaseCommit :: Commit + ,diffCommits :: [Commit] + ,diffTotalCommits :: Int + ,diffHtmlUrl :: String + ,diffFiles :: [File] + ,diffAheadBy :: Int + ,diffDiffUrl :: String + ,diffPermalinkUrl :: String +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Diff + +data NewGitReference = NewGitReference { + newGitReferenceRef :: String + ,newGitReferenceSha :: String +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData NewGitReference + +data GitReference = GitReference { + gitReferenceObject :: GitObject + ,gitReferenceUrl :: String + ,gitReferenceRef :: String +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData GitReference + +data GitObject = GitObject { + gitObjectType :: String + ,gitObjectSha :: String + ,gitObjectUrl :: String +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData GitObject + +data GitUser = GitUser { + gitUserName :: String + ,gitUserEmail :: String + ,gitUserDate :: GithubDate +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData GitUser + +data File = File { + fileBlobUrl :: String + ,fileStatus :: String + ,fileRawUrl :: String + ,fileAdditions :: Int + ,fileSha :: String + ,fileChanges :: Int + ,filePatch :: String + ,fileFilename :: String + ,fileDeletions :: Int +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData File diff --git a/Github/Data/Issues.hs b/Github/Data/Issues.hs new file mode 100644 index 00000000..0757ee1a --- /dev/null +++ b/Github/Data/Issues.hs @@ -0,0 +1,124 @@ +{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-} +module Github.Data.Issues where + +import Github.Data.Definitions +import Github.Data.PullRequests + +import Control.DeepSeq (NFData) +import Data.Data (Typeable, Data) +import GHC.Generics (Generic) + +data Issue = Issue { + issueClosedAt :: Maybe GithubDate + ,issueUpdatedAt :: GithubDate + ,issueEventsUrl :: String + ,issueHtmlUrl :: Maybe String + ,issueClosedBy :: Maybe GithubOwner + ,issueLabels :: [IssueLabel] + ,issueNumber :: Int + ,issueAssignee :: Maybe GithubOwner + ,issueUser :: GithubOwner + ,issueTitle :: String + ,issuePullRequest :: Maybe PullRequestReference + ,issueUrl :: String + ,issueCreatedAt :: GithubDate + ,issueBody :: Maybe String + ,issueState :: String + ,issueId :: Int + ,issueComments :: Int + ,issueMilestone :: Maybe Milestone +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Issue + +data NewIssue = NewIssue { + newIssueTitle :: String +, newIssueBody :: Maybe String +, newIssueAssignee :: Maybe String +, newIssueMilestone :: Maybe Int +, newIssueLabels :: Maybe [String] +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData NewIssue + +data EditIssue = EditIssue { + editIssueTitle :: Maybe String +, editIssueBody :: Maybe String +, editIssueAssignee :: Maybe String +, editIssueState :: Maybe String +, editIssueMilestone :: Maybe Int +, editIssueLabels :: Maybe [String] +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData EditIssue + +data Milestone = Milestone { + milestoneCreator :: GithubOwner + ,milestoneDueOn :: Maybe GithubDate + ,milestoneOpenIssues :: Int + ,milestoneNumber :: Int + ,milestoneClosedIssues :: Int + ,milestoneDescription :: Maybe String + ,milestoneTitle :: String + ,milestoneUrl :: String + ,milestoneCreatedAt :: GithubDate + ,milestoneState :: String +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Milestone + +data IssueLabel = IssueLabel { + labelColor :: String + ,labelUrl :: String + ,labelName :: String +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData IssueLabel + +data IssueComment = IssueComment { + issueCommentUpdatedAt :: GithubDate + ,issueCommentUser :: GithubOwner + ,issueCommentUrl :: String + ,issueCommentHtmlUrl :: String + ,issueCommentCreatedAt :: GithubDate + ,issueCommentBody :: String + ,issueCommentId :: Int +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData IssueComment + +data EventType = + Mentioned -- ^ The actor was @mentioned in an issue body. + | Subscribed -- ^ The actor subscribed to receive notifications for an issue. + | Unsubscribed -- ^ The issue was unsubscribed from by the actor. + | Referenced -- ^ The issue was referenced from a commit message. The commit_id attribute is the commit SHA1 of where that happened. + | Merged -- ^ The issue was merged by the actor. The commit_id attribute is the SHA1 of the HEAD commit that was merged. + | Assigned -- ^ The issue was assigned to the actor. + | Closed -- ^ The issue was closed by the actor. When the commit_id is present, it identifies the commit that closed the issue using “closes / fixes #NN” syntax. + | Reopened -- ^ The issue was reopened by the actor. + | ActorUnassigned -- ^ The issue was unassigned to the actor + | Labeled -- ^ A label was added to the issue. + | Unlabeled -- ^ A label was removed from the issue. + | Milestoned -- ^ The issue was added to a milestone. + | Demilestoned -- ^ The issue was removed from a milestone. + | Renamed -- ^ The issue title was changed. + | Locked -- ^ The issue was locked by the actor. + | Unlocked -- ^ The issue was unlocked by the actor. + | HeadRefDeleted -- ^ The pull request’s branch was deleted. + | HeadRefRestored -- ^ The pull request’s branch was restored. + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData EventType + +-- | Issue event +data Event = Event { + eventActor :: GithubOwner + ,eventType :: EventType + ,eventCommitId :: Maybe String + ,eventUrl :: String + ,eventCreatedAt :: GithubDate + ,eventId :: Int + ,eventIssue :: Maybe Issue +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Event \ No newline at end of file diff --git a/Github/Data/PullRequests.hs b/Github/Data/PullRequests.hs new file mode 100644 index 00000000..4639b04b --- /dev/null +++ b/Github/Data/PullRequests.hs @@ -0,0 +1,144 @@ +{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-} +module Github.Data.PullRequests where + +import Github.Data.Definitions + +import Control.DeepSeq (NFData) +import Data.Data (Typeable, Data) +import GHC.Generics (Generic) + +data PullRequest = PullRequest { + pullRequestClosedAt :: Maybe GithubDate + ,pullRequestCreatedAt :: GithubDate + ,pullRequestUser :: GithubOwner + ,pullRequestPatchUrl :: String + ,pullRequestState :: String + ,pullRequestNumber :: Int + ,pullRequestHtmlUrl :: String + ,pullRequestUpdatedAt :: GithubDate + ,pullRequestBody :: String + ,pullRequestIssueUrl :: String + ,pullRequestDiffUrl :: String + ,pullRequestUrl :: String + ,pullRequestLinks :: PullRequestLinks + ,pullRequestMergedAt :: Maybe GithubDate + ,pullRequestTitle :: String + ,pullRequestId :: Int +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData PullRequest + +data DetailedPullRequest = DetailedPullRequest { + -- this is a duplication of a PullRequest + detailedPullRequestClosedAt :: Maybe GithubDate + ,detailedPullRequestCreatedAt :: GithubDate + ,detailedPullRequestUser :: GithubOwner + ,detailedPullRequestPatchUrl :: String + ,detailedPullRequestState :: String + ,detailedPullRequestNumber :: Int + ,detailedPullRequestHtmlUrl :: String + ,detailedPullRequestUpdatedAt :: GithubDate + ,detailedPullRequestBody :: String + ,detailedPullRequestIssueUrl :: String + ,detailedPullRequestDiffUrl :: String + ,detailedPullRequestUrl :: String + ,detailedPullRequestLinks :: PullRequestLinks + ,detailedPullRequestMergedAt :: Maybe GithubDate + ,detailedPullRequestTitle :: String + ,detailedPullRequestId :: Int + + ,detailedPullRequestMergedBy :: Maybe GithubOwner + ,detailedPullRequestChangedFiles :: Int + ,detailedPullRequestHead :: PullRequestCommit + ,detailedPullRequestComments :: Int + ,detailedPullRequestDeletions :: Int + ,detailedPullRequestAdditions :: Int + ,detailedPullRequestReviewComments :: Int + ,detailedPullRequestBase :: PullRequestCommit + ,detailedPullRequestCommits :: Int + ,detailedPullRequestMerged :: Bool + ,detailedPullRequestMergeable :: Maybe Bool +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData DetailedPullRequest + +data EditPullRequest = EditPullRequest { + editPullRequestTitle :: Maybe String + ,editPullRequestBody :: Maybe String + ,editPullRequestState :: Maybe EditPullRequestState +} deriving (Show, Generic) + +instance NFData EditPullRequest + +data CreatePullRequest = + CreatePullRequest + { createPullRequestTitle :: String + , createPullRequestBody :: String + , createPullRequestHead :: String + , createPullRequestBase :: String + } + | CreatePullRequestIssue + { createPullRequestIssueNum :: Int + , createPullRequestHead :: String + , createPullRequestBase :: String + } + deriving (Show, Generic) + +instance NFData CreatePullRequest + +data PullRequestLinks = PullRequestLinks { + pullRequestLinksReviewComments :: String + ,pullRequestLinksComments :: String + ,pullRequestLinksHtml :: String + ,pullRequestLinksSelf :: String +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData PullRequestLinks + +data PullRequestCommit = PullRequestCommit { + pullRequestCommitLabel :: String + ,pullRequestCommitRef :: String + ,pullRequestCommitSha :: String + ,pullRequestCommitUser :: GithubOwner + ,pullRequestCommitRepo :: Repo +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData PullRequestCommit + +data PullRequestEvent = PullRequestEvent { + pullRequestEventAction :: PullRequestEventType + ,pullRequestEventNumber :: Int + ,pullRequestEventPullRequest :: DetailedPullRequest + ,pullRequestRepository :: Repo + ,pullRequestSender :: GithubOwner +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData PullRequestEvent + +data PullRequestEventType = + PullRequestOpened + | PullRequestClosed + | PullRequestSynchronized + | PullRequestReopened + | PullRequestAssigned + | PullRequestUnassigned + | PullRequestLabeled + | PullRequestUnlabeled + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData PullRequestEventType + +data PullRequestReference = PullRequestReference { + pullRequestReferenceHtmlUrl :: Maybe String + ,pullRequestReferencePatchUrl :: Maybe String + ,pullRequestReferenceDiffUrl :: Maybe String +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData PullRequestReference + +data EditPullRequestState = + EditPullRequestStateOpen + | EditPullRequestStateClosed + deriving (Show, Generic) + +instance NFData EditPullRequestState \ No newline at end of file diff --git a/Github/Data/Teams.hs b/Github/Data/Teams.hs new file mode 100644 index 00000000..87a47120 --- /dev/null +++ b/Github/Data/Teams.hs @@ -0,0 +1,101 @@ +{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-} +module Github.Data.Teams where + +import Github.Data.Definitions + +import Control.DeepSeq (NFData) +import Data.Data (Typeable, Data) +import GHC.Generics (Generic) + +data Privacy = + PrivacyClosed + | PrivacySecret + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Privacy + +data Permission = + PermissionPull + | PermissionPush + | PermissionAdmin + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Permission + +data Team = Team { + teamId :: Int + ,teamUrl :: String + ,teamName :: String + ,teamSlug :: String + ,teamDescription :: Maybe String + ,teamPrivacy :: Maybe Privacy + ,teamPermission :: Permission + ,teamMembersUrl :: String + ,teamRepositoriesUrl :: String +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Team + +data DetailedTeam = DetailedTeam { + detailedTeamId :: Int + ,detailedTeamUrl :: String + ,detailedTeamName :: String + ,detailedTeamSlug :: String + ,detailedTeamDescription :: Maybe String + ,detailedTeamPrivacy :: Maybe Privacy + ,detailedTeamPermission :: Permission + ,detailedTeamMembersUrl :: String + ,detailedTeamRepositoriesUrl :: String + ,detailedTeamMembersCount :: Int + ,detailedTeamReposCount :: Int + ,detailedTeamOrganization :: GithubOwner +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData DetailedTeam + +data CreateTeam = CreateTeam { + createTeamName :: String + ,createTeamDescription :: Maybe String + ,createRepoNames :: [String] + {-,createTeamPrivacy :: Privacy-} + ,createTeamPermission :: Permission +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData CreateTeam + +data EditTeam = EditTeam { + editTeamName :: String + ,editTeamDescription :: Maybe String + {-,editTeamPrivacy :: Privacy-} + ,editTeamPermission :: Permission +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData EditTeam + +data Role = + RoleMaintainer + | RoleMember + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Role + +data ReqState = + StatePending + | StateActive + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData ReqState + +data TeamMembership = TeamMembership { + teamMembershipUrl :: String, + teamMembershipRole :: Role, + teamMembershipReqState :: ReqState +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData TeamMembership + +data CreateTeamMembership = CreateTeamMembership { + createTeamMembershipRole :: Role +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData CreateTeamMembership \ No newline at end of file diff --git a/github.cabal b/github.cabal index a5b2ea60..669f80df 100644 --- a/github.cabal +++ b/github.cabal @@ -135,6 +135,11 @@ Library Exposed-modules: Github.Auth, Github.Data, Github.Data.Definitions, + Github.Data.GitData, + Github.Data.Gists, + Github.Data.Issues, + Github.Data.PullRequests, + Github.Data.Teams, Github.Events, Github.Gists, Github.Gists.Comments, From acbf26f019e2e47b8728c0704a0c1ef027bbe52e Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Thu, 22 Oct 2015 10:47:04 +0300 Subject: [PATCH 088/510] Fix haddock generation --- .travis.yml | 4 ++++ Github/Private.hs | 6 +++--- 2 files changed, 7 insertions(+), 3 deletions(-) diff --git a/.travis.yml b/.travis.yml index 0358f72b..4a59d0d6 100644 --- a/.travis.yml +++ b/.travis.yml @@ -39,6 +39,10 @@ script: - cabal build - cabal test + # Various checks + - if [ "$CABALVER" = "1.22" ]; then cabal check; fi + - if [ "$CABALVER" = "1.22" ]; then cabal haddock; fi + # tests that a source-distribution can be generated - cabal sdist diff --git a/Github/Private.hs b/Github/Private.hs index e25f3c77..d61e5321 100644 --- a/Github/Private.hs +++ b/Github/Private.hs @@ -31,9 +31,9 @@ import Data.Maybe (fromMaybe) -- | user/password for HTTP basic access authentication data GithubAuth = GithubBasicAuth BS.ByteString BS.ByteString | GithubOAuth String -- ^ token - | GithubEnterpriseOAuth String -- ^ custom API endpoint without - -- trailing slash - String -- ^ token + | GithubEnterpriseOAuth String -- custom API endpoint without + -- trailing slash + String -- token deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData GithubAuth From 3ec0b622051150ed5201ad5c8cadde1ad88750d1 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Thu, 22 Oct 2015 10:58:38 +0300 Subject: [PATCH 089/510] Use container travis --- .travis.yml | 112 ++++++++++++++++++++++++++++++++------------------- github.cabal | 2 + 2 files changed, 73 insertions(+), 41 deletions(-) diff --git a/.travis.yml b/.travis.yml index 4a59d0d6..ab3b6279 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,59 +1,89 @@ -# NB: don't set `language: haskell` here +# This file has been generated -- see https://github.com/hvr/multi-ghc-travis +language: c +sudo: false -# See also https://github.com/hvr/multi-ghc-travis for more information -env: - - GHCVER=7.8.4 CABALVER=1.18 - - GHCVER=7.8.4 CABALVER=1.18 STACKAGEURL=https://www.stackage.org/lts-2.22/cabal.config - - GHCVER=7.10.2 CABALVER=1.22 - - GHCVER=7.10.2 CABALVER=1.22 STACKAGEURL=https://www.stackage.org/lts-3/cabal.config - - GHCVER=7.10.2 CABALVER=1.22 STACKAGEURL=https://www.stackage.org/nightly/cabal.config - - GHCVER=head CABALVER=head +cache: + directories: + - $HOME/.cabsnap + - $HOME/.cabal/packages + +before_cache: + - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log + - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.tar matrix: - allow_failures: - - env: GHCVER=head CABALVER=head + include: + - env: CABALVER=1.18 GHCVER=7.8.4 + compiler: ": #GHC 7.8.4" + addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4], sources: [hvr-ghc]}} + - env: CABALVER=1.18 GHCVER=7.8.4 STACKAGESNAPSHOT=lts-2.22 + compiler: ": #GHC 7.8.4 lts-2.22" + addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4], sources: [hvr-ghc]}} + - env: CABALVER=1.22 GHCVER=7.10.2 + compiler: ": #GHC 7.10.2" + addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.2], sources: [hvr-ghc]}} + - env: CABALVER=1.22 GHCVER=7.10.2 STACKAGESNAPSHOT=lts-3 + compiler: ": #GHC 7.10.2 lts-3" + addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.2], sources: [hvr-ghc]}} -# Note: the distinction between `before_install` and `install` is not -# important. before_install: - - travis_retry sudo add-apt-repository -y ppa:hvr/ghc - - travis_retry sudo apt-get update - - travis_retry sudo apt-get install cabal-install-$CABALVER ghc-$GHCVER + - unset CC - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH - - cabal --version install: - - if [ -n "$STACKAGEURL" ]; then wget $STACKAGEURL; fi - - travis_retry cabal update - - cabal install --only-dependencies --enable-tests + - if [ -n "$STACKAGESNAPSHOT" ]; then wget https://www.stackage.org/$STACKAGESNAPSHOT/cabal.config; fi + - cabal --version + - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]" + - if [ -f $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz ]; + then + zcat $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz > + $HOME/.cabal/packages/hackage.haskell.org/00-index.tar; + fi + - travis_retry cabal update -v + - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config + - cabal install --only-dependencies --enable-tests --enable-benchmarks --dry -v > installplan.txt + - sed -i -e '1,/^Resolving /d' installplan.txt; cat installplan.txt -# Here starts the actual work to be performed for the package under -# test; any command which exits with a non-zero exit code causes the -# build to fail. -script: - # -v2 provides useful information for debugging - - cabal configure -v2 --enable-tests +# check whether current requested install-plan matches cached package-db snapshot + - if diff -u installplan.txt $HOME/.cabsnap/installplan.txt; + then + echo "cabal build-cache HIT"; + rm -rfv .ghc; + cp -a $HOME/.cabsnap/ghc $HOME/.ghc; + cp -a $HOME/.cabsnap/lib $HOME/.cabsnap/share $HOME/.cabsnap/bin $HOME/.cabal/; + else + echo "cabal build-cache MISS"; + rm -rf $HOME/.cabsnap; + mkdir -p $HOME/.ghc $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin; + cabal install --only-dependencies --enable-tests --enable-benchmarks; + fi + +# snapshot package-db on cache miss + - if [ ! -d $HOME/.cabsnap ]; + then + echo "snapshotting package-db to build-cache"; + mkdir $HOME/.cabsnap; + cp -a $HOME/.ghc $HOME/.cabsnap/ghc; + cp -a $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin installplan.txt $HOME/.cabsnap/; + fi - # this builds all libraries and executables - # (including tests/benchmarks) - - cabal build +# Here starts the actual work to be performed for the package under test; +# any command which exits with a non-zero exit code causes the build to fail. +script: + - if [ -f configure.ac ]; then autoreconf -i; fi + - cabal configure --enable-tests --enable-benchmarks -v2 # -v2 provides useful information for debugging + - cabal build # this builds all libraries and executables (including tests/benchmarks) - cabal test - # Various checks - if [ "$CABALVER" = "1.22" ]; then cabal check; fi - if [ "$CABALVER" = "1.22" ]; then cabal haddock; fi - # tests that a source-distribution can be generated - - cabal sdist + - cabal sdist # tests that a source-distribution can be generated - # check that the generated source-distribution can be built & installed - - export SRC_TGZ=$(cabal info . | awk '{print $2 ".tar.gz";exit}') ; - cd dist/; - if [ -f "$SRC_TGZ" ]; then - cabal install --force-reinstalls "$SRC_TGZ"; - else - echo "expected '$SRC_TGZ' not found"; - exit 1; - fi +# Check that the resulting source distribution can be built & installed. +# If there are no other `.tar.gz` files in `dist`, this can be even simpler: +# `cabal install --force-reinstalls dist/*-*.tar.gz` + - SRC_TGZ=$(cabal info . | awk '{print $2;exit}').tar.gz && + (cd dist && cabal install --force-reinstalls "$SRC_TGZ") # EOF diff --git a/github.cabal b/github.cabal index 669f80df..0712a3e4 100644 --- a/github.cabal +++ b/github.cabal @@ -42,6 +42,8 @@ Category: Network APIs Build-type: Simple +Tested-with: GHC==7.8.4, GHC==7.10.2 + -- Extra files to be distributed with the package, such as examples or -- a README. Extra-source-files: README.md From 4af01e66d1a483f7916e5293dbdabdf363ae1880 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Thu, 22 Oct 2015 11:42:48 +0300 Subject: [PATCH 090/510] Import only Parser from D.A.Types --- Github/Data.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Github/Data.hs b/Github/Data.hs index bab2dad5..d00686d7 100644 --- a/Github/Data.hs +++ b/Github/Data.hs @@ -17,7 +17,7 @@ import Control.Applicative import Control.Monad import qualified Data.Text as T import Data.Aeson.Compat -import Data.Aeson.Types hiding ((.:?)) +import Data.Aeson.Types (Parser) import qualified Data.Vector as V import qualified Data.HashMap.Lazy as Map import Data.Hashable (Hashable) From 19b072481072bc91db5b783ebf3d86b25f91f4c4 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Thu, 22 Oct 2015 11:42:55 +0300 Subject: [PATCH 091/510] More descriptive errors in tests --- spec/Github/UsersSpec.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/spec/Github/UsersSpec.hs b/spec/Github/UsersSpec.hs index fff5e529..bbda6db1 100644 --- a/spec/Github/UsersSpec.hs +++ b/spec/Github/UsersSpec.hs @@ -5,13 +5,13 @@ import Github.Data.Definitions (DetailedOwner(..)) import Test.Hspec (it, describe, shouldBe, Spec) -fromRight :: Either a b -> b -fromRight (Right b) = b -fromRight (Left _) = error "Expected a Right and got a Left" +fromRightS :: Show a => Either a b -> b +fromRightS (Right b) = b +fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a spec :: Spec spec = describe "userInfoFor" $ do it "returns information about the user" $ do userInfo <- userInfoFor "mike-burns" - detailedOwnerLogin (fromRight userInfo) `shouldBe` "mike-burns" + detailedOwnerLogin (fromRightS userInfo) `shouldBe` "mike-burns" From bfc8ceff8c3595342342b1fb2f659a054622ff71 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 15 Dec 2015 09:53:38 +0200 Subject: [PATCH 092/510] Make accessing private repositories possible --- Github/Repos.hs | 36 +++++++++++++++++++----------------- 1 file changed, 19 insertions(+), 17 deletions(-) diff --git a/Github/Repos.hs b/Github/Repos.hs index 32be173f..dab444e6 100644 --- a/Github/Repos.hs +++ b/Github/Repos.hs @@ -68,42 +68,44 @@ data RepoPublicity = instance NFData RepoPublicity +repoPublicityQueryString :: RepoPublicity -> String +repoPublicityQueryString All = "type=all" +repoPublicityQueryString Owner = "type=owner" +repoPublicityQueryString Member = "type=member" +repoPublicityQueryString Public = "type=public" +repoPublicityQueryString Private = "type=private" + -- | The repos for a user, by their login. Can be restricted to just repos they --- own, are a member of, or publicize. Private repos are currently not --- supported. +-- own, are a member of, or publicize. Private repos will return empty list. -- -- > userRepos "mike-burns" All userRepos :: String -> RepoPublicity -> IO (Either Error [Repo]) userRepos = userRepos' Nothing -- | The repos for a user, by their login. --- With authentication, but note that private repos are currently not supported. +-- With authentication. -- -- > userRepos' (Just (GithubBasicAuth (user, password))) "mike-burns" All userRepos' :: Maybe GithubAuth -> String -> RepoPublicity -> IO (Either Error [Repo]) -userRepos' auth userName All = - githubGetWithQueryString' auth ["users", userName, "repos"] "type=all" -userRepos' auth userName Owner = - githubGetWithQueryString' auth ["users", userName, "repos"] "type=owner" -userRepos' auth userName Member = - githubGetWithQueryString' auth ["users", userName, "repos"] "type=member" -userRepos' auth userName Public = - githubGetWithQueryString' auth ["users", userName, "repos"] "type=public" -userRepos' _auth _userName Private = - return $ Left $ UserError "Cannot access private repos using userRepos" +userRepos' auth userName publicity = + githubGetWithQueryString' auth ["users", userName, "repos"] qs + where qs = repoPublicityQueryString publicity -- | The repos for an organization, by the organization name. -- -- > organizationRepos "thoughtbot" organizationRepos :: String -> IO (Either Error [Repo]) -organizationRepos = organizationRepos' Nothing +organizationRepos org = organizationRepos' Nothing org All -- | The repos for an organization, by the organization name. -- With authentication. -- --- > organizationRepos (Just (GithubBasicAuth (user, password))) "thoughtbot" -organizationRepos' :: Maybe GithubAuth -> String -> IO (Either Error [Repo]) -organizationRepos' auth orgName = githubGet' auth ["orgs", orgName, "repos"] +-- > organizationRepos (Just (GithubBasicAuth (user, password))) "thoughtbot" All +organizationRepos' :: Maybe GithubAuth -> String -> RepoPublicity -> IO (Either Error [Repo]) +organizationRepos' auth orgName publicity = + githubGetWithQueryString' auth ["orgs", orgName, "repos"] qs + where qs = repoPublicityQueryString publicity + -- | A specific organization repo, by the organization name. -- From b6c38563fdeaf26ea2cad4a489737b2bfdbe288c Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 15 Dec 2015 10:12:10 +0200 Subject: [PATCH 093/510] Get collaborators of private repositories --- Github/Repos/Collaborators.hs | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/Github/Repos/Collaborators.hs b/Github/Repos/Collaborators.hs index 78ee1042..762a3163 100644 --- a/Github/Repos/Collaborators.hs +++ b/Github/Repos/Collaborators.hs @@ -2,6 +2,7 @@ -- . module Github.Repos.Collaborators ( collaboratorsOn +,collaboratorsOn' ,isCollaboratorOn ,module Github.Data ) where @@ -20,6 +21,12 @@ collaboratorsOn :: String -> String -> IO (Either Error [GithubOwner]) collaboratorsOn userName reqRepoName = githubGet ["repos", userName, reqRepoName, "collaborators"] +-- | All the users who have collaborated on a repo. +-- With authentication. +collaboratorsOn' :: Maybe GithubAuth -> String -> String -> IO (Either Error [GithubOwner]) +collaboratorsOn' auth userName reqRepoName = + githubGet' auth ["repos", userName, reqRepoName, "collaborators"] + -- | Whether the user is collaborating on a repo. Takes the user in question, -- the user who owns the repo, and the repo name. -- From 3188bcf4beeeeb17a950999330ce0a330f501d5a Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Fri, 18 Dec 2015 16:19:19 +0200 Subject: [PATCH 094/510] Compile warning free --- Github/Data.hs | 11 ++++++++++- Github/Private.hs | 12 ++++++++++-- Github/Repos/Webhooks/Validate.hs | 3 +++ github.cabal | 1 + 4 files changed, 24 insertions(+), 3 deletions(-) diff --git a/Github/Data.hs b/Github/Data.hs index d00686d7..0fee4258 100644 --- a/Github/Data.hs +++ b/Github/Data.hs @@ -1,4 +1,5 @@ {-# LANGUAGE CPP, DeriveDataTypeable, OverloadedStrings #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} -- | This module re-exports the @Github.Data.Definitions@ module, adding -- instances of @FromJSON@ to it. If you wish to use the data without the @@ -13,7 +14,9 @@ module Github.Data ( module Github.Data.Teams, ) where +#if !MIN_VERSION_base(4,8,0) import Control.Applicative +#endif import Control.Monad import qualified Data.Text as T import Data.Aeson.Compat @@ -38,9 +41,15 @@ import Github.Data.Teams instance FromJSON GithubDate where parseJSON (String t) = - case parseTime defaultTimeLocale "%FT%T%Z" (T.unpack t) of + case pt defaultTimeLocale "%FT%T%Z" (T.unpack t) of Just d -> pure $ GithubDate d _ -> fail "could not parse Github datetime" + where +#if MIN_VERSION_time(1,5,0) + pt = parseTimeM True +#else + pt = parseTime +#endif parseJSON _ = fail "Given something besides a String" instance FromJSON Commit where diff --git a/Github/Private.hs b/Github/Private.hs index d61e5321..8578fb56 100644 --- a/Github/Private.hs +++ b/Github/Private.hs @@ -10,13 +10,15 @@ -- module Github.Private where +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative +#endif import Github.Data import Control.DeepSeq (NFData) import Data.Aeson import Data.Attoparsec.ByteString.Lazy import Data.Data import Data.Monoid -import Control.Applicative import Data.List import Data.CaseInsensitive (mk) import qualified Data.ByteString.Char8 as BS @@ -169,7 +171,13 @@ doHttps reqMethod url auth body = do getOAuth (GithubOAuth token) = [(mk (BS.pack "Authorization"), BS.pack ("token " ++ token))] getOAuth _ = [] - getResponse request = withManager $ \manager -> httpLbs request manager + getResponse request = do + manager <- newManager tlsManagerSettings + x <- httpLbs request manager +#if !MIN_VERSION_http_client(0, 4, 18) + closeManager manager +#endif + pure x #if MIN_VERSION_http_conduit(1, 9, 0) successOrMissing s@(Status sci _) hs cookiejar #else diff --git a/Github/Repos/Webhooks/Validate.hs b/Github/Repos/Webhooks/Validate.hs index 23d835ac..00fe3f9a 100644 --- a/Github/Repos/Webhooks/Validate.hs +++ b/Github/Repos/Webhooks/Validate.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} -- | Verification of incomming webhook payloads, as described at @@ -7,7 +8,9 @@ module Github.Repos.Webhooks.Validate ( isValidPayload ) where +#if !MIN_VERSION_base(4,8,0) import Control.Applicative +#endif import Crypto.Hash import qualified Data.ByteString.Char8 as BS import Data.Byteable (constEqBytes, toBytes) diff --git a/github.cabal b/github.cabal index 0712a3e4..5ad03c24 100644 --- a/github.cabal +++ b/github.cabal @@ -191,6 +191,7 @@ Library text, old-locale, http-conduit >= 1.8, + http-client, http-types, data-default, vector, From ffa6d6b03a82c53d27ec6771e95eb1e3e89da228 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Fri, 25 Dec 2015 23:34:42 +0200 Subject: [PATCH 095/510] Make test runner more robust --- .travis.yml | 6 +++++- README.md | 9 +++++++++ fixtures/user.json | 32 ++++++++++++++++++++++++++++++++ github.cabal | 6 +++++- spec/Github/UsersSpec.hs | 24 ++++++++++++++++++++---- 5 files changed, 71 insertions(+), 6 deletions(-) create mode 100644 fixtures/user.json diff --git a/.travis.yml b/.travis.yml index ab3b6279..8767e557 100644 --- a/.travis.yml +++ b/.travis.yml @@ -11,6 +11,10 @@ before_cache: - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.tar +env: + global: + secure: "J522iO9HE8yIMwcbBBCXYiAJ0bZSzMjq9nue6oockCIZc3kSoF/IGhfBMns3KRrzMR7nD0IirpHB0jjSXIQLA+51SaWS8HG2+pI+U3qvCoeDIaB85Iyhk932GIymdySCH7ypw71AeuJTErvZ67TR3m+o98BBk8WgMCcLkGykWKA=" + matrix: include: - env: CABALVER=1.18 GHCVER=7.8.4 @@ -73,7 +77,7 @@ script: - if [ -f configure.ac ]; then autoreconf -i; fi - cabal configure --enable-tests --enable-benchmarks -v2 # -v2 provides useful information for debugging - cabal build # this builds all libraries and executables (including tests/benchmarks) - - cabal test + - cabal test --show-details=always - if [ "$CABALVER" = "1.22" ]; then cabal check; fi - if [ "$CABALVER" = "1.22" ]; then cabal haddock; fi diff --git a/README.md b/README.md index 8932fec5..49274db6 100644 --- a/README.md +++ b/README.md @@ -139,6 +139,15 @@ No support? Not sure. See `DetailedOwner` to know what data could be provided. +Test setup +========== + +To run integration part of tests, you'll need [github access token](https://github.com/settings/tokens/new) +Token is needed, because unauthorised access is highly limited. +It's enough to add only basic read access for public information. + +With `travis encrypt --org --repo yournick/github "GITHUB_TOKEN=yourtoken"` command you get a secret, +you can use in your travis setup to run the test-suite there. Contributions ============= diff --git a/fixtures/user.json b/fixtures/user.json new file mode 100644 index 00000000..ab58bf99 --- /dev/null +++ b/fixtures/user.json @@ -0,0 +1,32 @@ +{ + "login": "mike-burns", + "id": 4550, + "avatar_url": "https://avatars.githubusercontent.com/u/4550?v=3", + "gravatar_id": "", + "url": "https://api.github.com/users/mike-burns", + "html_url": "https://github.com/mike-burns", + "followers_url": "https://api.github.com/users/mike-burns/followers", + "following_url": "https://api.github.com/users/mike-burns/following{/other_user}", + "gists_url": "https://api.github.com/users/mike-burns/gists{/gist_id}", + "starred_url": "https://api.github.com/users/mike-burns/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/mike-burns/subscriptions", + "organizations_url": "https://api.github.com/users/mike-burns/orgs", + "repos_url": "https://api.github.com/users/mike-burns/repos", + "events_url": "https://api.github.com/users/mike-burns/events{/privacy}", + "received_events_url": "https://api.github.com/users/mike-burns/received_events", + "type": "User", + "site_admin": false, + "name": "Mike Burns", + "company": "thoughtbot", + "blog": "http://mike-burns.com/", + "location": "Stockholm, Sweden", + "email": "mburns@thoughtbot.com", + "hireable": true, + "bio": null, + "public_repos": 35, + "public_gists": 32, + "followers": 171, + "following": 0, + "created_at": "2008-04-03T17:54:24Z", + "updated_at": "2015-10-02T16:53:25Z" +} diff --git a/github.cabal b/github.cabal index 5ad03c24..d783f56e 100644 --- a/github.cabal +++ b/github.cabal @@ -181,7 +181,7 @@ Library Build-depends: base >= 4.0 && < 5.0, time >=1.4 && <1.6, aeson >= 0.6.1.0, - aeson-extra >= 0.2.0.0, + aeson-extra >= 0.2.0.0 && <0.3, attoparsec >= 0.10.3.0, bytestring, case-insensitive >= 0.4.0.4, @@ -210,9 +210,13 @@ test-suite github-test default-language: Haskell2010 type: exitcode-stdio-1.0 hs-source-dirs: spec + other-modules: + Github.UsersSpec main-is: Spec.hs build-depends: base >= 4.0 && < 5.0, + aeson-extra >= 0.2.0.0 && <0.3, github, + file-embed, hspec ghc-options: -Wall -fno-warn-orphans diff --git a/spec/Github/UsersSpec.hs b/spec/Github/UsersSpec.hs index bbda6db1..b2dc9f1d 100644 --- a/spec/Github/UsersSpec.hs +++ b/spec/Github/UsersSpec.hs @@ -1,17 +1,33 @@ +{-# LANGUAGE TemplateHaskell #-} module Github.UsersSpec where -import Github.Users (userInfoFor) +import Github.Auth (GithubAuth(..)) +import Github.Users (userInfoFor') import Github.Data.Definitions (DetailedOwner(..)) -import Test.Hspec (it, describe, shouldBe, Spec) +import Data.Aeson.Compat (eitherDecodeStrict) +import Test.Hspec (it, describe, shouldBe, pendingWith, Spec) +import System.Environment (lookupEnv) +import Data.FileEmbed (embedFile) fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a +withAuth :: (GithubAuth -> IO ()) -> IO () +withAuth action = do + mtoken <- lookupEnv "GITHUB_TOKEN" + case mtoken of + Nothing -> pendingWith "no GITHUB_TOKEN" + Just token -> action (GithubOAuth token) + spec :: Spec spec = describe "userInfoFor" $ do - it "returns information about the user" $ do - userInfo <- userInfoFor "mike-burns" + it "decodes user json" $ do + let userInfo = eitherDecodeStrict $(embedFile "fixtures/user.json") :: Either String DetailedOwner + detailedOwnerLogin (fromRightS userInfo) `shouldBe` "mike-burns" + + it "returns information about the user" $ withAuth $ \auth -> do + userInfo <- userInfoFor' (Just auth) "mike-burns" detailedOwnerLogin (fromRightS userInfo) `shouldBe` "mike-burns" From 28e9b3bcac4b0b44953e3a9c85e8157c3269e758 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sat, 26 Dec 2015 13:28:15 +0200 Subject: [PATCH 096/510] Decouple requests creation from execution --- Github/Private.hs | 52 ++++++---- Github/Repos.hs | 28 +----- Github/Repos/Collaborators.hs | 2 +- Github/Request.hs | 182 ++++++++++++++++++++++++++++++++++ Github/Users.hs | 25 ++++- github.cabal | 2 + spec/Github/UsersSpec.hs | 25 +++-- 7 files changed, 258 insertions(+), 58 deletions(-) create mode 100644 Github/Request.hs diff --git a/Github/Private.hs b/Github/Private.hs index 8578fb56..074442db 100644 --- a/Github/Private.hs +++ b/Github/Private.hs @@ -94,8 +94,18 @@ buildPath paths = '/' : intercalate "/" paths githubAPI :: (ToJSON a, Show a, FromJSON b, Show b) => BS.ByteString -> String -> Maybe GithubAuth -> Maybe a -> IO (Either Error b) -githubAPI apimethod p auth body = do - result <- doHttps apimethod (apiEndpoint auth ++ p) auth (encodeBody body) +githubAPI apimethod p auth body = + githubAPI' getResponseNewManager apimethod p auth (encode . toJSON <$> body) + +githubAPI' :: (FromJSON b, Show b) + => (Request -> IO (Response LBS.ByteString)) + -> BS.ByteString -- ^ method + -> String -- ^ paths + -> Maybe GithubAuth -- ^ auth + -> Maybe LBS.ByteString -- ^ body + -> IO (Either Error b) +githubAPI' getResponse apimethod p auth body = do + result <- doHttps getResponse apimethod (apiEndpoint auth ++ p) auth (RequestBodyLBS <$> body) case result of Left e -> return (Left (HTTPConnectionError e)) Right resp -> either Left (\x -> jsonResultToE (LBS.pack (show x)) @@ -103,8 +113,6 @@ githubAPI apimethod p auth body = do <$> handleBody resp where - encodeBody = Just . RequestBodyLBS . encode . toJSON - handleBody resp = either (return . Left) (handleJson resp) (parseJsonRaw (responseBody resp)) @@ -126,7 +134,7 @@ githubAPI apimethod p auth body = do nextJson <- handleBody nextResp return $ (\(Array x) -> Array (ary <> x)) <$> nextJson) - =<< doHttps apimethod nu auth Nothing + =<< doHttps getResponse apimethod nu auth Nothing handleJson _ gotjson = return (Right gotjson) getNextUrl l = @@ -136,12 +144,22 @@ githubAPI apimethod p auth body = do in Just (Data.List.takeWhile (/= '>') s') else Nothing -doHttps :: BS.ByteString +getResponseNewManager :: Request -> IO (Response LBS.ByteString) +getResponseNewManager request = do + manager <- newManager tlsManagerSettings + x <- httpLbs request manager +#if !MIN_VERSION_http_client(0, 4, 18) + closeManager manager +#endif + pure x + +doHttps :: (Request -> IO (Response LBS.ByteString)) + -> BS.ByteString -> [Char] -> Maybe GithubAuth -> Maybe RequestBody -> IO (Either E.SomeException (Response LBS.ByteString)) -doHttps reqMethod url auth body = do +doHttps getResponse reqMethod url auth body = do let reqBody = fromMaybe (RequestBodyBS $ BS.pack "") body reqHeaders = maybe [] getOAuth auth Just uri = parseUrl url @@ -171,13 +189,7 @@ doHttps reqMethod url auth body = do getOAuth (GithubOAuth token) = [(mk (BS.pack "Authorization"), BS.pack ("token " ++ token))] getOAuth _ = [] - getResponse request = do - manager <- newManager tlsManagerSettings - x <- httpLbs request manager -#if !MIN_VERSION_http_client(0, 4, 18) - closeManager manager -#endif - pure x + #if MIN_VERSION_http_conduit(1, 9, 0) successOrMissing s@(Status sci _) hs cookiejar #else @@ -192,7 +204,7 @@ doHttps reqMethod url auth body = do doHttpsStatus :: BS.ByteString -> String -> GithubAuth -> Maybe RequestBody -> IO (Either Error Status) doHttpsStatus reqMethod p auth payload = do - result <- doHttps reqMethod (apiEndpoint (Just auth) ++ p) (Just auth) payload + result <- doHttps getResponseNewManager reqMethod (apiEndpoint (Just auth) ++ p) (Just auth) payload case result of Left e -> return (Left (HTTPConnectionError e)) Right resp -> @@ -235,8 +247,14 @@ parseJson jsonString = either Left (jsonResultToE jsonString . fromJSON) githubAPIDelete :: GithubAuth -> String -- ^ paths -> IO (Either Error ()) -githubAPIDelete auth paths = do - result <- doHttps "DELETE" +githubAPIDelete = githubAPIDelete' getResponseNewManager + +githubAPIDelete' :: (Request -> IO (Response LBS.ByteString)) + -> GithubAuth + -> String -- ^ paths + -> IO (Either Error ()) +githubAPIDelete' getResponse auth paths = do + result <- doHttps getResponse "DELETE" (apiEndpoint (Just auth) ++ paths) (Just auth) Nothing diff --git a/Github/Repos.hs b/Github/Repos.hs index dab444e6..1f880739 100644 --- a/Github/Repos.hs +++ b/Github/Repos.hs @@ -1,5 +1,4 @@ {-# LANGUAGE OverloadedStrings, DeriveGeneric, DeriveDataTypeable #-} -{-# LANGUAGE CPP #-} -- | The Github Repos API, as documented at -- module Github.Repos ( @@ -51,11 +50,8 @@ import Data.Aeson.Types import Github.Data import Github.Private import GHC.Generics (Generic) -import Network.HTTP.Conduit import Control.Applicative import Control.DeepSeq (NFData) -import qualified Control.Exception as E -import Network.HTTP.Types -- | Filter the list of the user's repos using any of these constructors. data RepoPublicity = @@ -347,25 +343,5 @@ deleteRepo :: GithubAuth -> String -- ^ owner -> String -- ^ repository name -> IO (Either Error ()) -deleteRepo auth owner repo = do - result <- doHttps "DELETE" - (apiEndpoint (Just auth) ++ buildPath ["repos", owner, repo]) - (Just auth) - Nothing - case result of - Left e -> return (Left (HTTPConnectionError e)) - Right resp -> - let status = responseStatus resp - headers = responseHeaders resp - in if status == notFound404 - -- doHttps silently absorbs 404 errors, but for this operation - -- we want the user to know if they've tried to delete a - -- non-existent repository - then return (Left (HTTPConnectionError - (E.toException - (StatusCodeException status headers -#if MIN_VERSION_http_conduit(1, 9, 0) - (responseCookieJar resp) -#endif - )))) - else return (Right ()) +deleteRepo auth owner repo = + githubAPIDelete auth $ buildPath ["repos", owner, repo] diff --git a/Github/Repos/Collaborators.hs b/Github/Repos/Collaborators.hs index 762a3163..46472790 100644 --- a/Github/Repos/Collaborators.hs +++ b/Github/Repos/Collaborators.hs @@ -34,7 +34,7 @@ collaboratorsOn' auth userName reqRepoName = -- > isCollaboratorOn Nothing "johnson" "thoughtbot" "paperclip" isCollaboratorOn :: Maybe GithubAuth -> String -> String -> String -> IO (Either Error Bool) isCollaboratorOn auth userName repoOwnerName reqRepoName = do - result <- doHttps (pack "GET") + result <- doHttps getResponseNewManager (pack "GET") (apiEndpoint auth ++ buildPath ["repos", repoOwnerName, reqRepoName, "collaborators", userName]) Nothing Nothing diff --git a/Github/Request.hs b/Github/Request.hs new file mode 100644 index 00000000..f01b2ed4 --- /dev/null +++ b/Github/Request.hs @@ -0,0 +1,182 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE StandaloneDeriving #-} +module Github.Request ( + GithubRequest(..), + PostMethod(..), + toMethod, + Paths, + QueryString, + executeRequest, + executeRequestWithMgr, + executeRequest', + executeRequestWithMgr', + executeRequestMaybe, + unsafeDropAuthRequirements, + ) where + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative +#endif + +import Data.Aeson.Compat (FromJSON) +import Data.Typeable (Typeable) +import GHC.Generics (Generic) +import Network.HTTP.Conduit (Manager, httpLbs, newManager, tlsManagerSettings) + +import qualified Data.ByteString.Lazy as LBS +import qualified Network.HTTP.Types.Method as Method + +import Github.Data (Error) +import Github.Private (GithubAuth) + +import qualified Github.Private as Private + +------------------------------------------------------------------------------ +-- Auxillary types +------------------------------------------------------------------------------ + +type Paths = [String] +type QueryString = String + +-- | Http method of requests with body. +data PostMethod = Post | Patch | Put + deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable) + +toMethod :: PostMethod -> Method.Method +toMethod Post = Method.methodPost +toMethod Patch = Method.methodPatch +toMethod Put = Method.methodPut + +------------------------------------------------------------------------------ +-- Github request +------------------------------------------------------------------------------ + +-- | Github request data type. +-- +-- * @k@ describes whether authentication is required. It's required for non-@GET@ requests. +-- * @a@ is the result type +-- +-- /Note:/ 'GithubRequest' is not 'Functor' on purpose. +-- +-- TODO: Add constructor for collection fetches. +data GithubRequest (k :: Bool) a where + GithubGet :: Paths -> QueryString -> GithubRequest k a + GithubPost :: PostMethod -> Paths -> LBS.ByteString -> GithubRequest 'True a + GithubDelete :: Paths -> GithubRequest 'True () + deriving (Typeable) + +deriving instance Eq (GithubRequest k a) +deriving instance Ord (GithubRequest k a) + +instance Show (GithubRequest k a) where + showsPrec d r = + case r of + GithubGet ps qs -> showParen (d > appPrec) $ + showString "GithubGet " + . showsPrec (appPrec + 1) ps + . showString " " + . showsPrec (appPrec + 1) qs + GithubPost m ps body -> showParen (d > appPrec) $ + showString "GithubPost " + . showsPrec (appPrec + 1) m + . showString " " + . showsPrec (appPrec + 1) ps + . showString " " + . showsPrec (appPrec + 1) body + GithubDelete ps -> showParen (d > appPrec) $ + showString "GithubDelete " + . showsPrec (appPrec + 1) ps + where appPrec = 10 :: Int + +------------------------------------------------------------------------------ +-- Basic IO executor +------------------------------------------------------------------------------ + +-- | Execute 'GithubRequest' in 'IO' +executeRequest :: (FromJSON a, Show a) + => GithubAuth -> GithubRequest k a -> IO (Either Error a) +executeRequest auth req = do + manager <- newManager tlsManagerSettings + x <- executeRequestWithMgr manager auth req +#if !MIN_VERSION_http_client(0, 4, 18) + closeManager manager +#endif + pure x + +-- | Like 'executeRequest' but with provided 'Manager'. +executeRequestWithMgr :: (FromJSON a, Show a) + => Manager + -> GithubAuth + -> GithubRequest k a + -> IO (Either Error a) +executeRequestWithMgr mgr auth req = + case req of + GithubGet paths qs -> + Private.githubAPI' getResponse + Method.methodGet + (Private.buildPath paths ++ qs') + (Just auth) + Nothing + where qs' | null qs = "" + | otherwise = '?' : qs + GithubPost m paths body -> + Private.githubAPI' getResponse + (toMethod m) + (Private.buildPath paths) + (Just auth) + (Just body) + GithubDelete paths -> + Private.githubAPIDelete' getResponse + auth + (Private.buildPath paths) + where + getResponse = flip httpLbs mgr + +-- | Like 'executeRequest' but without authentication. +executeRequest' :: (FromJSON a, Show a) + => GithubRequest 'False a -> IO (Either Error a) +executeRequest' req = do + manager <- newManager tlsManagerSettings + x <- executeRequestWithMgr' manager req +#if !MIN_VERSION_http_client(0, 4, 18) + closeManager manager +#endif + pure x + +-- | Like 'executeRequestWithMgr' but without authentication. +executeRequestWithMgr' :: (FromJSON a, Show a) + => Manager + -> GithubRequest 'False a + -> IO (Either Error a) +executeRequestWithMgr' mgr req = + case req of + GithubGet paths qs -> + Private.githubAPI' getResponse + Method.methodGet + (Private.buildPath paths ++ qs') + Nothing + Nothing + where qs' | null qs = "" + | otherwise = '?' : qs + where + getResponse = flip httpLbs mgr + +-- | Helper for picking between 'executeRequest' and 'executeRequest''. +-- +-- The use is discouraged. +executeRequestMaybe :: (FromJSON a, Show a) + => Maybe GithubAuth -> GithubRequest 'False a + -> IO (Either Error a) +executeRequestMaybe = maybe executeRequest' executeRequest + +-- | Partial function to drop authentication need. +unsafeDropAuthRequirements :: GithubRequest 'True a -> GithubRequest k a +unsafeDropAuthRequirements (GithubGet ps qs) = GithubGet ps qs +unsafeDropAuthRequirements r = + error $ "Trying to drop authenatication from" ++ show r diff --git a/Github/Users.hs b/Github/Users.hs index 50cbd254..2e61a136 100644 --- a/Github/Users.hs +++ b/Github/Users.hs @@ -1,30 +1,45 @@ +{-# LANGUAGE DataKinds #-} -- | The Github Users API, as described at -- . module Github.Users ( userInfoFor ,userInfoFor' +,userInfoForR ,userInfoCurrent' +,userInfoCurrentR ,module Github.Data ) where +import Github.Auth import Github.Data -import Github.Private +import Github.Request -- | The information for a single user, by login name. --- | With authentification +-- With authentification -- -- > userInfoFor' (Just ("github-username", "github-password")) "mike-burns" userInfoFor' :: Maybe GithubAuth -> String -> IO (Either Error DetailedOwner) -userInfoFor' auth userName = githubGet' auth ["users", userName] +userInfoFor' auth = executeRequestMaybe auth . userInfoForR -- | The information for a single user, by login name. -- -- > userInfoFor "mike-burns" userInfoFor :: String -> IO (Either Error DetailedOwner) -userInfoFor = userInfoFor' Nothing +userInfoFor = executeRequest' . userInfoForR + +-- | The information for a single user, by login name. The request +userInfoForR :: String -> GithubRequest k DetailedOwner +userInfoForR userName = GithubGet ["users", userName] "" -- | Retrieve information about the user associated with the supplied authentication. -- -- > userInfoCurrent' (GithubOAuth "...") +-- +-- TODO: Change to require 'GithubAuth'? userInfoCurrent' :: Maybe GithubAuth -> IO (Either Error DetailedOwner) -userInfoCurrent' auth = githubGet' auth ["user"] +userInfoCurrent' auth = + executeRequestMaybe auth . unsafeDropAuthRequirements $ userInfoCurrentR + +-- | Retrieve information about the user associated with the supplied authentication. +userInfoCurrentR :: GithubRequest 'True DetailedOwner +userInfoCurrentR = GithubGet ["user"] "" diff --git a/github.cabal b/github.cabal index d783f56e..b785c09d 100644 --- a/github.cabal +++ b/github.cabal @@ -173,6 +173,7 @@ Library Github.Users, Github.Users.Followers Github.Search + Github.Request -- Private Github.Private @@ -214,6 +215,7 @@ test-suite github-test Github.UsersSpec main-is: Spec.hs build-depends: base >= 4.0 && < 5.0, + base-compat, aeson-extra >= 0.2.0.0 && <0.3, github, file-embed, diff --git a/spec/Github/UsersSpec.hs b/spec/Github/UsersSpec.hs index b2dc9f1d..a25b325d 100644 --- a/spec/Github/UsersSpec.hs +++ b/spec/Github/UsersSpec.hs @@ -1,14 +1,16 @@ {-# LANGUAGE TemplateHaskell #-} module Github.UsersSpec where -import Github.Auth (GithubAuth(..)) -import Github.Users (userInfoFor') -import Github.Data.Definitions (DetailedOwner(..)) - -import Data.Aeson.Compat (eitherDecodeStrict) -import Test.Hspec (it, describe, shouldBe, pendingWith, Spec) +import Data.Aeson.Compat (eitherDecodeStrict) +import Data.Either.Compat (isRight) +import Data.FileEmbed (embedFile) import System.Environment (lookupEnv) -import Data.FileEmbed (embedFile) +import Test.Hspec (Spec, describe, it, pendingWith, shouldBe, + shouldSatisfy) + +import Github.Auth (GithubAuth (..)) +import Github.Data.Definitions (DetailedOwner (..)) +import Github.Users (userInfoCurrent', userInfoFor') fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b @@ -22,12 +24,17 @@ withAuth action = do Just token -> action (GithubOAuth token) spec :: Spec -spec = +spec = do describe "userInfoFor" $ do it "decodes user json" $ do - let userInfo = eitherDecodeStrict $(embedFile "fixtures/user.json") :: Either String DetailedOwner + let userInfo = eitherDecodeStrict $(embedFile "fixtures/user.json") detailedOwnerLogin (fromRightS userInfo) `shouldBe` "mike-burns" it "returns information about the user" $ withAuth $ \auth -> do userInfo <- userInfoFor' (Just auth) "mike-burns" detailedOwnerLogin (fromRightS userInfo) `shouldBe` "mike-burns" + + describe "userInfoCurrent'" $ do + it "returns information about the autenticated user" $ withAuth $ \auth -> do + userInfo <- userInfoCurrent' (Just auth) + userInfo `shouldSatisfy` isRight From f3b837195513ac14c50a0919992b3db8801c1da1 Mon Sep 17 00:00:00 2001 From: Volodymyr Shatsky Date: Sun, 27 Dec 2015 01:04:10 +0200 Subject: [PATCH 097/510] 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 098/510] 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 099/510] 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. -- From db69edd6d5bc17f443ec605230cf36f5ab63b21b Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sun, 3 Jan 2016 16:42:31 +0200 Subject: [PATCH 100/510] Change secret to work with phadej/github repository --- .travis.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index 8767e557..9969ee2b 100644 --- a/.travis.yml +++ b/.travis.yml @@ -13,7 +13,7 @@ before_cache: env: global: - secure: "J522iO9HE8yIMwcbBBCXYiAJ0bZSzMjq9nue6oockCIZc3kSoF/IGhfBMns3KRrzMR7nD0IirpHB0jjSXIQLA+51SaWS8HG2+pI+U3qvCoeDIaB85Iyhk932GIymdySCH7ypw71AeuJTErvZ67TR3m+o98BBk8WgMCcLkGykWKA=" + secure: "IRtE1XwgzQKlD/fzNrapx8l3dVIC8/0BeQoA3C2qQM7BW2BVs5Z12tX/I1nco3E7J5SwfMWStGJxgghcI1t4uTKg6Q1CQDhNNy+Sr3jX9kd3Evvd3HacE/FiBBtIoiE1tIqd0/duCpJ+EH5d9Gd/Zk+1BWnDTdEdAYZVbc6sEMM=" matrix: include: From b3c3d4682f4ceb5ba92a83452814478ffb830fc5 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sat, 26 Dec 2015 14:31:05 +0200 Subject: [PATCH 101/510] Add tagged name --- Github/Data.hs | 6 +++++ Github/Data/Definitions.hs | 18 ++++++++------- Github/Data/Name.hs | 38 ++++++++++++++++++++++++++++++++ Github/Organizations.hs | 12 +++++----- fixtures/user-organizations.json | 9 ++++++++ github.cabal | 3 +++ spec/Github/OrganizationsSpec.hs | 36 ++++++++++++++++++++++++++++++ spec/Github/UsersSpec.hs | 1 + 8 files changed, 109 insertions(+), 14 deletions(-) create mode 100644 Github/Data/Name.hs create mode 100644 fixtures/user-organizations.json create mode 100644 spec/Github/OrganizationsSpec.hs diff --git a/Github/Data.hs b/Github/Data.hs index 0fee4258..379daa2d 100644 --- a/Github/Data.hs +++ b/Github/Data.hs @@ -6,12 +6,17 @@ -- instances, use the @Github.Data.Definitions@ module instead. module Github.Data ( + -- * Module re-exports module Github.Data.Definitions, module Github.Data.Gists, module Github.Data.GitData, module Github.Data.Issues, module Github.Data.PullRequests, module Github.Data.Teams, + -- * Name + Name, + mkName, + untagName, ) where #if !MIN_VERSION_base(4,8,0) @@ -36,6 +41,7 @@ import Github.Data.Definitions import Github.Data.Gists import Github.Data.GitData import Github.Data.Issues +import Github.Data.Name import Github.Data.PullRequests import Github.Data.Teams diff --git a/Github/Data/Definitions.hs b/Github/Data/Definitions.hs index 3650460e..3461e275 100644 --- a/Github/Data/Definitions.hs +++ b/Github/Data/Definitions.hs @@ -9,6 +9,8 @@ import GHC.Generics (Generic) import qualified Control.Exception as E import qualified Data.Map as M +import Github.Data.Name + -- | The options for querying commits. data CommitQueryOption = CommitQuerySha String | CommitQueryPath String @@ -34,14 +36,14 @@ instance NFData GithubDate data GithubOwner = GithubUser { githubOwnerAvatarUrl :: String - ,githubOwnerLogin :: String + ,githubOwnerLogin :: Name GithubOwner ,githubOwnerUrl :: String ,githubOwnerId :: Int ,githubOwnerGravatarId :: Maybe String } | GithubOrganization { githubOwnerAvatarUrl :: String - ,githubOwnerLogin :: String + ,githubOwnerLogin :: Name GithubOwner ,githubOwnerUrl :: String ,githubOwnerId :: Int } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -97,7 +99,7 @@ data Organization = Organization { organizationType :: String ,organizationBlog :: Maybe String ,organizationLocation :: Maybe String - ,organizationLogin :: String + ,organizationLogin :: Name Organization ,organizationFollowers :: Int ,organizationCompany :: Maybe String ,organizationAvatarUrl :: String @@ -137,7 +139,7 @@ data Repo = Repo { ,repoUpdatedAt :: Maybe GithubDate ,repoWatchers :: Maybe Int ,repoOwner :: GithubOwner - ,repoName :: String + ,repoName :: Name Repo ,repoLanguage :: Maybe String ,repoMasterBranch :: Maybe String ,repoPushedAt :: Maybe GithubDate -- ^ this is Nothing for new repositories @@ -155,7 +157,7 @@ data Repo = Repo { instance NFData Repo -data RepoRef = RepoRef GithubOwner String -- Repo owner and name +data RepoRef = RepoRef GithubOwner (Name Repo) -- Repo owner and name deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData RepoRef @@ -223,7 +225,7 @@ instance NFData ContentInfo data Contributor -- | An existing Github user, with their number of contributions, avatar -- URL, login, URL, ID, and Gravatar ID. - = KnownContributor Int String String String Int String + = KnownContributor Int String (Name Contributor) String Int String -- | An unknown Github user with their number of contributions and recorded name. | AnonymousContributor Int String deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -262,7 +264,7 @@ data DetailedOwner = DetailedUser { ,detailedOwnerUrl :: String ,detailedOwnerId :: Int ,detailedOwnerHtmlUrl :: String - ,detailedOwnerLogin :: String + ,detailedOwnerLogin :: Name GithubOwner } | DetailedOrganization { detailedOwnerCreatedAt :: GithubDate @@ -280,7 +282,7 @@ data DetailedOwner = DetailedUser { ,detailedOwnerUrl :: String ,detailedOwnerId :: Int ,detailedOwnerHtmlUrl :: String - ,detailedOwnerLogin :: String + ,detailedOwnerLogin :: Name GithubOwner } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData DetailedOwner diff --git a/Github/Data/Name.hs b/Github/Data/Name.hs new file mode 100644 index 00000000..20c6ddc1 --- /dev/null +++ b/Github/Data/Name.hs @@ -0,0 +1,38 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +module Github.Data.Name ( + Name(..), + mkName, + untagName, + ) where + +import Control.DeepSeq (NFData(..)) +import Data.Aeson.Compat (FromJSON(..), ToJSON(..)) +import Data.Data (Data, Typeable) +import Data.Hashable (Hashable) +import Data.String (IsString(..)) +import GHC.Generics (Generic) + +newtype Name entity = N String + deriving (Eq, Ord, Show, Read, Generic, Typeable, Data) + +-- | Smart constructor for 'Name' +mkName :: proxy entity -> String -> Name entity +mkName _ = N + +untagName :: Name entity -> String +untagName (N name) = name + +instance Hashable (Name entity) + +instance NFData (Name entity) where + rnf (N s) = rnf s + +instance FromJSON (Name entity) where + parseJSON = fmap N . parseJSON + +instance ToJSON (Name entity) where + toJSON = toJSON . untagName + +instance IsString (Name entity) where + fromString = N diff --git a/Github/Organizations.hs b/Github/Organizations.hs index db42dec3..a0e3a8f9 100644 --- a/Github/Organizations.hs +++ b/Github/Organizations.hs @@ -13,23 +13,23 @@ import Github.Private -- | The public organizations for a user, given the user's login, with authorization -- -- > publicOrganizationsFor' (Just ("github-username", "github-password")) "mike-burns" -publicOrganizationsFor' :: Maybe GithubAuth -> String -> IO (Either Error [SimpleOrganization]) -publicOrganizationsFor' auth userName = githubGet' auth ["users", userName, "orgs"] +publicOrganizationsFor' :: Maybe GithubAuth -> Name GithubOwner -> IO (Either Error [SimpleOrganization]) +publicOrganizationsFor' auth userName = githubGet' auth ["users", untagName userName, "orgs"] -- | The public organizations for a user, given the user's login. -- -- > publicOrganizationsFor "mike-burns" -publicOrganizationsFor :: String -> IO (Either Error [SimpleOrganization]) +publicOrganizationsFor :: Name GithubOwner -> IO (Either Error [SimpleOrganization]) publicOrganizationsFor = publicOrganizationsFor' Nothing -- | Details on a public organization. Takes the organization's login. -- -- > publicOrganization' (Just ("github-username", "github-password")) "thoughtbot" -publicOrganization' :: Maybe GithubAuth -> String -> IO (Either Error Organization) -publicOrganization' auth reqOrganizationName = githubGet' auth ["orgs", reqOrganizationName] +publicOrganization' :: Maybe GithubAuth -> Name Organization -> IO (Either Error Organization) +publicOrganization' auth reqOrganizationName = githubGet' auth ["orgs", untagName reqOrganizationName] -- | Details on a public organization. Takes the organization's login. -- -- > publicOrganization "thoughtbot" -publicOrganization :: String -> IO (Either Error Organization) +publicOrganization :: Name Organization -> IO (Either Error Organization) publicOrganization = publicOrganization' Nothing diff --git a/fixtures/user-organizations.json b/fixtures/user-organizations.json new file mode 100644 index 00000000..f8830228 --- /dev/null +++ b/fixtures/user-organizations.json @@ -0,0 +1,9 @@ +[ + { + "login": "github", + "id": 1, + "url": "https://api.github.com/orgs/github", + "avatar_url": "https://github.com/images/error/octocat_happy.gif", + "description": "A great organization" + } +] diff --git a/github.cabal b/github.cabal index d783f56e..3cc8cd31 100644 --- a/github.cabal +++ b/github.cabal @@ -142,6 +142,7 @@ Library Github.Data.Issues, Github.Data.PullRequests, Github.Data.Teams, + Github.Data.Name, Github.Events, Github.Gists, Github.Gists.Comments, @@ -212,8 +213,10 @@ test-suite github-test hs-source-dirs: spec other-modules: Github.UsersSpec + Github.OrganizationsSpec main-is: Spec.hs build-depends: base >= 4.0 && < 5.0, + base-compat, aeson-extra >= 0.2.0.0 && <0.3, github, file-embed, diff --git a/spec/Github/OrganizationsSpec.hs b/spec/Github/OrganizationsSpec.hs new file mode 100644 index 00000000..fddb8648 --- /dev/null +++ b/spec/Github/OrganizationsSpec.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE OverloadedStrings #-} +module Github.OrganizationsSpec where + +import Github.Auth (GithubAuth (..)) +import Github.Data.Definitions (SimpleOrganization (..)) +import Github.Organizations (publicOrganizationsFor') + +import Data.Aeson.Compat (eitherDecodeStrict) +import Data.Either.Compat (isRight) +import Data.FileEmbed (embedFile) +import System.Environment (lookupEnv) +import Test.Hspec (Spec, describe, it, pendingWith, shouldBe, + shouldSatisfy) + +fromRightS :: Show a => Either a b -> b +fromRightS (Right b) = b +fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a + +withAuth :: (GithubAuth -> IO ()) -> IO () +withAuth action = do + mtoken <- lookupEnv "GITHUB_TOKEN" + case mtoken of + Nothing -> pendingWith "no GITHUB_TOKEN" + Just token -> action (GithubOAuth token) + +spec :: Spec +spec = + describe "publicOrganizationsFor'" $ do + it "decodes simple organization json" $ do + let orgs = eitherDecodeStrict $(embedFile "fixtures/user-organizations.json") + simpleOrganizationLogin (head $ fromRightS orgs) `shouldBe` "github" + + it "returns information about the user's organizations" $ withAuth $ \auth -> do + orgs <- publicOrganizationsFor' (Just auth) "mike-burns" + orgs `shouldSatisfy` isRight diff --git a/spec/Github/UsersSpec.hs b/spec/Github/UsersSpec.hs index b2dc9f1d..bafbe95e 100644 --- a/spec/Github/UsersSpec.hs +++ b/spec/Github/UsersSpec.hs @@ -1,4 +1,5 @@ {-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE OverloadedStrings #-} module Github.UsersSpec where import Github.Auth (GithubAuth(..)) From 2cb7efad88745bb068f0a205d01adef06e179750 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sun, 3 Jan 2016 18:35:17 +0200 Subject: [PATCH 102/510] Add tagged identifier --- Github/Data.hs | 8 +++++++- Github/Data/Definitions.hs | 23 ++++++++++++----------- Github/Data/Id.hs | 35 +++++++++++++++++++++++++++++++++++ github.cabal | 1 + 4 files changed, 55 insertions(+), 12 deletions(-) create mode 100644 Github/Data/Id.hs diff --git a/Github/Data.hs b/Github/Data.hs index 379daa2d..8470d6bc 100644 --- a/Github/Data.hs +++ b/Github/Data.hs @@ -13,10 +13,15 @@ module Github.Data ( module Github.Data.Issues, module Github.Data.PullRequests, module Github.Data.Teams, - -- * Name + -- * Tagged types + -- ** Name Name, mkName, untagName, + -- ** Id + Id, + mkId, + untagId, ) where #if !MIN_VERSION_base(4,8,0) @@ -40,6 +45,7 @@ import System.Locale (defaultTimeLocale) import Github.Data.Definitions import Github.Data.Gists import Github.Data.GitData +import Github.Data.Id import Github.Data.Issues import Github.Data.Name import Github.Data.PullRequests diff --git a/Github/Data/Definitions.hs b/Github/Data/Definitions.hs index 3461e275..53326806 100644 --- a/Github/Data/Definitions.hs +++ b/Github/Data/Definitions.hs @@ -9,6 +9,7 @@ import GHC.Generics (Generic) import qualified Control.Exception as E import qualified Data.Map as M +import Github.Data.Id import Github.Data.Name -- | The options for querying commits. @@ -38,14 +39,14 @@ data GithubOwner = GithubUser { githubOwnerAvatarUrl :: String ,githubOwnerLogin :: Name GithubOwner ,githubOwnerUrl :: String - ,githubOwnerId :: Int + ,githubOwnerId :: Id GithubOwner ,githubOwnerGravatarId :: Maybe String } | GithubOrganization { githubOwnerAvatarUrl :: String ,githubOwnerLogin :: Name GithubOwner ,githubOwnerUrl :: String - ,githubOwnerId :: Int + ,githubOwnerId :: Id GithubOwner } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData GithubOwner @@ -69,7 +70,7 @@ data Comment = Comment { ,commentCreatedAt :: Maybe UTCTime ,commentPath :: Maybe String ,commentUser :: GithubOwner - ,commentId :: Int + ,commentId :: Id Comment } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Comment @@ -89,7 +90,7 @@ instance NFData EditComment data SimpleOrganization = SimpleOrganization { simpleOrganizationUrl :: String ,simpleOrganizationAvatarUrl :: String - ,simpleOrganizationId :: Int + ,simpleOrganizationId :: Id Organization ,simpleOrganizationLogin :: String } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -111,7 +112,7 @@ data Organization = Organization { ,organizationUrl :: String ,organizationCreatedAt :: GithubDate ,organizationName :: Maybe String - ,organizationId :: Int + ,organizationId :: Id Organization } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Organization @@ -143,7 +144,7 @@ data Repo = Repo { ,repoLanguage :: Maybe String ,repoMasterBranch :: Maybe String ,repoPushedAt :: Maybe GithubDate -- ^ this is Nothing for new repositories - ,repoId :: Int + ,repoId :: Id Repo ,repoUrl :: String ,repoOpenIssues :: Maybe Int ,repoHasWiki :: Maybe Bool @@ -225,7 +226,7 @@ instance NFData ContentInfo data Contributor -- | An existing Github user, with their number of contributions, avatar -- URL, login, URL, ID, and Gravatar ID. - = KnownContributor Int String (Name Contributor) String Int String + = KnownContributor Int String (Name Contributor) String (Id Contributor) String -- | An unknown Github user with their number of contributions and recorded name. | AnonymousContributor Int String deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -262,7 +263,7 @@ data DetailedOwner = DetailedUser { ,detailedOwnerCompany :: Maybe String ,detailedOwnerEmail :: Maybe String ,detailedOwnerUrl :: String - ,detailedOwnerId :: Int + ,detailedOwnerId :: Id GithubOwner ,detailedOwnerHtmlUrl :: String ,detailedOwnerLogin :: Name GithubOwner } @@ -280,7 +281,7 @@ data DetailedOwner = DetailedUser { ,detailedOwnerLocation :: Maybe String ,detailedOwnerCompany :: Maybe String ,detailedOwnerUrl :: String - ,detailedOwnerId :: Int + ,detailedOwnerId :: Id GithubOwner ,detailedOwnerHtmlUrl :: String ,detailedOwnerLogin :: Name GithubOwner } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -290,7 +291,7 @@ instance NFData DetailedOwner data RepoWebhook = RepoWebhook { repoWebhookUrl :: String ,repoWebhookTestUrl :: String - ,repoWebhookId :: Integer + ,repoWebhookId :: Id RepoWebhook ,repoWebhookName :: String ,repoWebhookActive :: Bool ,repoWebhookEvents :: [RepoWebhookEvent] @@ -338,7 +339,7 @@ instance NFData RepoWebhookResponse data PingEvent = PingEvent { pingEventZen :: String ,pingEventHook :: RepoWebhook - ,pingEventHookId :: Int + ,pingEventHookId :: Id RepoWebhook } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData PingEvent diff --git a/Github/Data/Id.hs b/Github/Data/Id.hs new file mode 100644 index 00000000..6f1861ba --- /dev/null +++ b/Github/Data/Id.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +module Github.Data.Id ( + Id(..), + mkId, + untagId, + ) where + +import Control.DeepSeq (NFData(..)) +import Data.Aeson.Compat (FromJSON(..), ToJSON(..)) +import Data.Data (Data, Typeable) +import Data.Hashable (Hashable) +import GHC.Generics (Generic) + +-- | Numeric identifier. +newtype Id entity = Id Int + deriving (Eq, Ord, Show, Read, Generic, Typeable, Data) + +-- | Smart constructor for 'Id' +mkId :: proxy entity -> Int -> Id entity +mkId _ = Id + +untagId :: Id entity -> Int +untagId (Id name) = name + +instance Hashable (Id entity) + +instance NFData (Id entity) where + rnf (Id s) = rnf s + +instance FromJSON (Id entity) where + parseJSON = fmap Id . parseJSON + +instance ToJSON (Id entity) where + toJSON = toJSON . untagId diff --git a/github.cabal b/github.cabal index ff924e2a..4fd92223 100644 --- a/github.cabal +++ b/github.cabal @@ -143,6 +143,7 @@ Library Github.Data.PullRequests, Github.Data.Teams, Github.Data.Name, + Github.Data.Id, Github.Events, Github.Gists, Github.Gists.Comments, From a6e8cbd6f31b52f9a4ea1f9e93e464d0088429ac Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sun, 3 Jan 2016 19:18:45 +0200 Subject: [PATCH 103/510] Add Github.All stub --- Github/All.hs | 33 ++++++++++++++++++++++++++++ Github/Organizations.hs | 37 ++++++++++++++++++++++---------- Github/Organizations/Members.hs | 24 ++++++++++++++------- Github/Organizations/Teams.hs | 32 +++++++++++++++++---------- fixtures/list-teams.json | 13 +++++++++++ fixtures/members-list.json | 21 ++++++++++++++++++ github.cabal | 3 ++- spec/Github/OrganizationsSpec.hs | 26 +++++++++++++++++----- 8 files changed, 153 insertions(+), 36 deletions(-) create mode 100644 Github/All.hs create mode 100644 fixtures/list-teams.json create mode 100644 fixtures/members-list.json diff --git a/Github/All.hs b/Github/All.hs new file mode 100644 index 00000000..42eaa35d --- /dev/null +++ b/Github/All.hs @@ -0,0 +1,33 @@ +-- | +-- +-- This module re-exports all request constructrors and +-- data definitions from this package. +module Github.All ( + -- * Organizations + -- | See + -- + -- Missing endpoints: + -- + -- * List your organizations + -- * List all organizations + -- * Edit an organization + publicOrganizationsForR, + publicOrganizationR, + -- ** Members + -- | See + -- + -- Missing endpoints: All except /Members List/ + membersOfR, + -- ** Teams + -- | See + -- + -- Missing endpoints: All except /List teams/ + teamsOfR, + -- * Data definitions + module Github.Data + ) where + +import Github.Data +import Github.Organizations +import Github.Organizations.Members +import Github.Organizations.Teams diff --git a/Github/Organizations.hs b/Github/Organizations.hs index a0e3a8f9..819b64f2 100644 --- a/Github/Organizations.hs +++ b/Github/Organizations.hs @@ -1,35 +1,50 @@ -- | The orgs API as described on . module Github.Organizations ( - publicOrganizationsFor -,publicOrganizationsFor' -,publicOrganization -,publicOrganization' -,module Github.Data -) where + publicOrganizationsFor, + publicOrganizationsFor', + publicOrganizationsForR, + publicOrganization, + publicOrganization', + publicOrganizationR, + module Github.Data, + ) where +import Github.Auth import Github.Data -import Github.Private +import Github.Request -- | The public organizations for a user, given the user's login, with authorization -- -- > publicOrganizationsFor' (Just ("github-username", "github-password")) "mike-burns" publicOrganizationsFor' :: Maybe GithubAuth -> Name GithubOwner -> IO (Either Error [SimpleOrganization]) -publicOrganizationsFor' auth userName = githubGet' auth ["users", untagName userName, "orgs"] +publicOrganizationsFor' auth = executeRequestMaybe auth . publicOrganizationsForR --- | The public organizations for a user, given the user's login. +-- | List user organizations. The public organizations for a user, given the user's login. -- -- > publicOrganizationsFor "mike-burns" publicOrganizationsFor :: Name GithubOwner -> IO (Either Error [SimpleOrganization]) publicOrganizationsFor = publicOrganizationsFor' Nothing +-- | List user organizations. The public organizations for a user, given the user's login. +-- +-- See +publicOrganizationsForR :: Name GithubOwner -> GithubRequest k [SimpleOrganization] +publicOrganizationsForR userName = GithubGet ["users", untagName userName, "orgs"] "" -- TODO: Use PagedGet + -- | Details on a public organization. Takes the organization's login. -- -- > publicOrganization' (Just ("github-username", "github-password")) "thoughtbot" publicOrganization' :: Maybe GithubAuth -> Name Organization -> IO (Either Error Organization) -publicOrganization' auth reqOrganizationName = githubGet' auth ["orgs", untagName reqOrganizationName] +publicOrganization' auth = executeRequestMaybe auth . publicOrganizationR --- | Details on a public organization. Takes the organization's login. +-- | Get an organization. Details on a public organization. Takes the organization's login. -- -- > publicOrganization "thoughtbot" publicOrganization :: Name Organization -> IO (Either Error Organization) publicOrganization = publicOrganization' Nothing + +-- | Get an organization. Details on a public organization. Takes the organization's login. +-- +-- See +publicOrganizationR :: Name Organization -> GithubRequest k Organization +publicOrganizationR reqOrganizationName = GithubGet ["orgs", untagName reqOrganizationName] "" diff --git a/Github/Organizations/Members.hs b/Github/Organizations/Members.hs index ad19554f..c0b14b44 100644 --- a/Github/Organizations/Members.hs +++ b/Github/Organizations/Members.hs @@ -1,24 +1,32 @@ -- | The organization members API as described on -- . module Github.Organizations.Members ( - membersOf -,membersOf' -,module Github.Data -) where + membersOf, + membersOf', + membersOfR, + module Github.Data, + ) where +import Github.Auth import Github.Data -import Github.Private +import Github.Request -- | All the users who are members of the specified organization, -- | with or without authentication. -- -- > membersOf' (Just $ GithubOAuth "token") "thoughtbot" -membersOf' :: Maybe GithubAuth -> String -> IO (Either Error [GithubOwner]) -membersOf' auth organization = githubGet' auth ["orgs", organization, "members"] +membersOf' :: Maybe GithubAuth -> Name Organization -> IO (Either Error [GithubOwner]) +membersOf' auth = executeRequestMaybe auth . membersOfR -- | All the users who are members of the specified organization, -- | without authentication. -- -- > membersOf "thoughtbot" -membersOf :: String -> IO (Either Error [GithubOwner]) +membersOf :: Name Organization -> IO (Either Error [GithubOwner]) membersOf = membersOf' Nothing + +-- | All the users who are members of the specified organization. +-- +-- See +membersOfR :: Name Organization -> GithubRequest k [GithubOwner] +membersOfR organization = GithubGet ["orgs", untagName organization, "members"] "" diff --git a/Github/Organizations/Teams.hs b/Github/Organizations/Teams.hs index e4c7205f..6b42c384 100644 --- a/Github/Organizations/Teams.hs +++ b/Github/Organizations/Teams.hs @@ -1,24 +1,34 @@ -- | The organization teams API as described on -- . module Github.Organizations.Teams ( - teamsOf -,teamsOf' -,module Github.Data -) where + teamsOf, + teamsOf', + teamsOfR, + module Github.Data, + ) where +import Github.Auth import Github.Data -import Github.Private +import Github.Request --- | List the teams of an organization. --- | When authenticated, lists private teams visible to the authenticated user. --- | When unauthenticated, lists only public teams for an organization. +-- | List teams. List the teams of an organization. +-- When authenticated, lists private teams visible to the authenticated user. +-- When unauthenticated, lists only public teams for an organization. -- -- > teamsOf' (Just $ GithubOAuth "token") "thoughtbot" -teamsOf' :: Maybe GithubAuth -> String -> IO (Either Error [Team]) -teamsOf' auth organization = githubGet' auth ["orgs", organization, "teams"] +teamsOf' :: Maybe GithubAuth -> Name Organization -> IO (Either Error [Team]) +teamsOf' auth = executeRequestMaybe auth . teamsOfR -- | List the public teams of an organization. -- -- > teamsOf "thoughtbot" -teamsOf :: String -> IO (Either Error [Team]) +teamsOf :: Name Organization -> IO (Either Error [Team]) teamsOf = teamsOf' Nothing + +-- | List teams. List the teams of an organization. +-- When authenticated, lists private teams visible to the authenticated user. +-- When unauthenticated, lists only public teams for an organization. +-- +-- See +teamsOfR :: Name Organization -> GithubRequest k [Team] +teamsOfR organization = GithubGet ["orgs", untagName organization, "teams"] "" diff --git a/fixtures/list-teams.json b/fixtures/list-teams.json new file mode 100644 index 00000000..f4ec6b8d --- /dev/null +++ b/fixtures/list-teams.json @@ -0,0 +1,13 @@ +[ + { + "id": 1, + "url": "https://api.github.com/teams/1", + "name": "Justice League", + "slug": "justice-league", + "description": "A great team.", + "privacy": "closed", + "permission": "admin", + "members_url": "https://api.github.com/teams/1/members{/member}", + "repositories_url": "https://api.github.com/teams/1/repos" + } +] diff --git a/fixtures/members-list.json b/fixtures/members-list.json new file mode 100644 index 00000000..d581825b --- /dev/null +++ b/fixtures/members-list.json @@ -0,0 +1,21 @@ +[ + { + "login": "octocat", + "id": 1, + "avatar_url": "https://github.com/images/error/octocat_happy.gif", + "gravatar_id": "", + "url": "https://api.github.com/users/octocat", + "html_url": "https://github.com/octocat", + "followers_url": "https://api.github.com/users/octocat/followers", + "following_url": "https://api.github.com/users/octocat/following{/other_user}", + "gists_url": "https://api.github.com/users/octocat/gists{/gist_id}", + "starred_url": "https://api.github.com/users/octocat/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/octocat/subscriptions", + "organizations_url": "https://api.github.com/users/octocat/orgs", + "repos_url": "https://api.github.com/users/octocat/repos", + "events_url": "https://api.github.com/users/octocat/events{/privacy}", + "received_events_url": "https://api.github.com/users/octocat/received_events", + "type": "User", + "site_admin": false + } +] diff --git a/github.cabal b/github.cabal index 4fd92223..93858637 100644 --- a/github.cabal +++ b/github.cabal @@ -134,7 +134,8 @@ source-repository head Library -- Modules exported by the library. Default-Language: Haskell2010 - Exposed-modules: Github.Auth, + Exposed-modules: Github.All, + Github.Auth, Github.Data, Github.Data.Definitions, Github.Data.GitData, diff --git a/spec/Github/OrganizationsSpec.hs b/spec/Github/OrganizationsSpec.hs index fddb8648..45b16048 100644 --- a/spec/Github/OrganizationsSpec.hs +++ b/spec/Github/OrganizationsSpec.hs @@ -1,10 +1,12 @@ -{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} module Github.OrganizationsSpec where -import Github.Auth (GithubAuth (..)) -import Github.Data.Definitions (SimpleOrganization (..)) -import Github.Organizations (publicOrganizationsFor') +import Github.Auth (GithubAuth (..)) +import Github.Data (GithubOwner (..), SimpleOrganization (..), + Team (..)) +import Github.Organizations (publicOrganizationsFor') +import Github.Organizations.Members (membersOf') import Data.Aeson.Compat (eitherDecodeStrict) import Data.Either.Compat (isRight) @@ -25,7 +27,7 @@ withAuth action = do Just token -> action (GithubOAuth token) spec :: Spec -spec = +spec = do describe "publicOrganizationsFor'" $ do it "decodes simple organization json" $ do let orgs = eitherDecodeStrict $(embedFile "fixtures/user-organizations.json") @@ -34,3 +36,17 @@ spec = it "returns information about the user's organizations" $ withAuth $ \auth -> do orgs <- publicOrganizationsFor' (Just auth) "mike-burns" orgs `shouldSatisfy` isRight + + describe "teamsOf" $ do + it "parse" $ do + let ts = eitherDecodeStrict $(embedFile "fixtures/list-teams.json") + teamName (head $ fromRightS ts) `shouldBe` "Justice League" + + describe "membersOf" $ do + it "parse" $ do + let ms = eitherDecodeStrict $(embedFile "fixtures/members-list.json") + githubOwnerLogin (head $ fromRightS ms) `shouldBe` "octocat" + + it "works" $ withAuth $ \auth -> do + ms <- membersOf' (Just auth) "haskell" + ms `shouldSatisfy` isRight From 1c1432c549e702090ce3c9874e27a930ae8bd41a Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sun, 3 Jan 2016 19:58:35 +0200 Subject: [PATCH 104/510] Tagged name and id in Teams --- Github/Data/Teams.hs | 64 +++++++++++++++++++++++--------------------- 1 file changed, 34 insertions(+), 30 deletions(-) diff --git a/Github/Data/Teams.hs b/Github/Data/Teams.hs index 87a47120..b23f26a7 100644 --- a/Github/Data/Teams.hs +++ b/Github/Data/Teams.hs @@ -1,11 +1,15 @@ -{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} module Github.Data.Teams where import Github.Data.Definitions import Control.DeepSeq (NFData) -import Data.Data (Typeable, Data) -import GHC.Generics (Generic) +import Data.Data (Data, Typeable) +import GHC.Generics (Generic) + +import Github.Data.Id +import Github.Data.Name data Privacy = PrivacyClosed @@ -23,51 +27,51 @@ data Permission = instance NFData Permission data Team = Team { - teamId :: Int - ,teamUrl :: String - ,teamName :: String - ,teamSlug :: String - ,teamDescription :: Maybe String - ,teamPrivacy :: Maybe Privacy - ,teamPermission :: Permission - ,teamMembersUrl :: String + teamId :: Id Team + ,teamUrl :: String + ,teamName :: Name Team + ,teamSlug :: String + ,teamDescription :: Maybe String + ,teamPrivacy :: Maybe Privacy + ,teamPermission :: Permission + ,teamMembersUrl :: String ,teamRepositoriesUrl :: String } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Team data DetailedTeam = DetailedTeam { - detailedTeamId :: Int - ,detailedTeamUrl :: String - ,detailedTeamName :: String - ,detailedTeamSlug :: String - ,detailedTeamDescription :: Maybe String - ,detailedTeamPrivacy :: Maybe Privacy - ,detailedTeamPermission :: Permission - ,detailedTeamMembersUrl :: String + detailedTeamId :: Id Team + ,detailedTeamUrl :: String + ,detailedTeamName :: Name Team + ,detailedTeamSlug :: String + ,detailedTeamDescription :: Maybe String + ,detailedTeamPrivacy :: Maybe Privacy + ,detailedTeamPermission :: Permission + ,detailedTeamMembersUrl :: String ,detailedTeamRepositoriesUrl :: String - ,detailedTeamMembersCount :: Int - ,detailedTeamReposCount :: Int - ,detailedTeamOrganization :: GithubOwner + ,detailedTeamMembersCount :: Int + ,detailedTeamReposCount :: Int + ,detailedTeamOrganization :: GithubOwner } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData DetailedTeam data CreateTeam = CreateTeam { - createTeamName :: String + createTeamName :: Name Team ,createTeamDescription :: Maybe String - ,createRepoNames :: [String] + ,createRepoNames :: [String] {-,createTeamPrivacy :: Privacy-} - ,createTeamPermission :: Permission + ,createTeamPermission :: Permission } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData CreateTeam data EditTeam = EditTeam { - editTeamName :: String + editTeamName :: Name Team ,editTeamDescription :: Maybe String {-,editTeamPrivacy :: Privacy-} - ,editTeamPermission :: Permission + ,editTeamPermission :: Permission } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData EditTeam @@ -87,8 +91,8 @@ data ReqState = instance NFData ReqState data TeamMembership = TeamMembership { - teamMembershipUrl :: String, - teamMembershipRole :: Role, + teamMembershipUrl :: String, + teamMembershipRole :: Role, teamMembershipReqState :: ReqState } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -98,4 +102,4 @@ data CreateTeamMembership = CreateTeamMembership { createTeamMembershipRole :: Role } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData CreateTeamMembership \ No newline at end of file +instance NFData CreateTeamMembership From 1bcdd89c50c2fc5f7fa6fad59aadcef5356a6c57 Mon Sep 17 00:00:00 2001 From: Daniel Strittmatter Date: Sun, 3 Jan 2016 01:25:32 +0100 Subject: [PATCH 105/510] Add search issues functionality --- Github/Data.hs | 6 ++++++ Github/Data/Issues.hs | 7 +++++++ Github/Search.hs | 16 ++++++++++++++++ github.cabal | 1 + samples/Search/SearchIssues.hs | 26 ++++++++++++++++++++++++++ 5 files changed, 56 insertions(+) create mode 100644 samples/Search/SearchIssues.hs diff --git a/Github/Data.hs b/Github/Data.hs index 8470d6bc..ad54e03d 100644 --- a/Github/Data.hs +++ b/Github/Data.hs @@ -550,6 +550,12 @@ instance FromJSON SearchReposResult where <*> o .:< "items" parseJSON _ = fail "Could not build a SearchReposResult" +instance FromJSON SearchIssuesResult where + parseJSON (Object o) = + SearchIssuesResult <$> o .: "total_count" + <*> o .:< "items" + parseJSON _ = fail "Could not build a SearchIssuesResult" + instance FromJSON Repo where parseJSON (Object o) = Repo <$> o .:? "ssh_url" diff --git a/Github/Data/Issues.hs b/Github/Data/Issues.hs index 0757ee1a..7679f32d 100644 --- a/Github/Data/Issues.hs +++ b/Github/Data/Issues.hs @@ -87,6 +87,13 @@ data IssueComment = IssueComment { instance NFData IssueComment +data SearchIssuesResult = SearchIssuesResult { + searchIssuesTotalCount :: Int + ,searchIssuesIssues :: [Issue] +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData SearchIssuesResult + data EventType = Mentioned -- ^ The actor was @mentioned in an issue body. | Subscribed -- ^ The actor subscribed to receive notifications for an issue. diff --git a/Github/Search.hs b/Github/Search.hs index 88036073..c15e1a32 100644 --- a/Github/Search.hs +++ b/Github/Search.hs @@ -5,6 +5,8 @@ module Github.Search( ,searchRepos ,searchCode' ,searchCode +,searchIssues' +,searchIssues ,module Github.Data ) where @@ -39,4 +41,18 @@ searchCode' auth queryString = githubGetWithQueryString' auth ["search", "code"] searchCode :: String -> IO (Either Error SearchCodeResult) searchCode = searchCode' Nothing +-- | Perform an issue search. +-- | With authentication. +-- +-- > searchIssues' (Just $ GithubBasicAuth "github-username" "github-password') "q=a repo%3Aphadej%2Fgithub&per_page=100" +searchIssues' :: Maybe GithubAuth -> String -> IO (Either Error SearchIssuesResult) +searchIssues' auth queryString = githubGetWithQueryString' auth ["search", "issues"] queryString + +-- | Perform an issue search. +-- | Without authentication. +-- +-- > searchIssues "q=a repo%3Aphadej%2Fgithub&per_page=100" +searchIssues :: String -> IO (Either Error SearchIssuesResult) +searchIssues = searchIssues' Nothing + diff --git a/github.cabal b/github.cabal index 4fd92223..51d0f32c 100644 --- a/github.cabal +++ b/github.cabal @@ -84,6 +84,7 @@ Extra-source-files: README.md ,samples/Pulls/ShowCommits.hs ,samples/Pulls/ShowPull.hs ,samples/Search/SearchRepos.hs + ,samples/Search/SearchIssues.hs ,samples/Repos/Collaborators/IsCollaborator.hs ,samples/Repos/Collaborators/ListCollaborators.hs ,samples/Repos/Commits/CommitComment.hs diff --git a/samples/Search/SearchIssues.hs b/samples/Search/SearchIssues.hs new file mode 100644 index 00000000..d317508c --- /dev/null +++ b/samples/Search/SearchIssues.hs @@ -0,0 +1,26 @@ +{-# LANGUAGE OverloadedStrings #-} +module SearchIssues where + +import qualified Github.Search as Github +import Control.Monad (forM_) + +main = do + let query = "q=build%2Arepo%3Aphadej%2Fgithub&per_page=100" + let auth = Nothing + result <- Github.searchIssues' auth query + case result of + Left e -> putStrLn $ "Error: " ++ show e + Right r -> do forM_ (Github.searchIssuesIssues r) (\i -> do + putStrLn $ formatIssue i + putStrLn "" + ) + putStrLn $ "Count: " ++ show n ++ " build issues" + where n = Github.searchIssuesTotalCount r + +formatIssue issue = + (Github.githubOwnerLogin $ Github.issueUser issue) ++ + " opened this issue " ++ + (show $ Github.fromGithubDate $ Github.issueCreatedAt issue) ++ "\n" ++ + (Github.issueState issue) ++ " with " ++ + (show $ Github.issueComments issue) ++ " comments" ++ "\n\n" ++ + (Github.issueTitle issue) From 04816293789c0db26378ea0249f0beabfe26ec41 Mon Sep 17 00:00:00 2001 From: Daniel Strittmatter Date: Sun, 3 Jan 2016 18:53:57 +0100 Subject: [PATCH 106/510] Fix typo in sample --- samples/Search/SearchIssues.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/samples/Search/SearchIssues.hs b/samples/Search/SearchIssues.hs index d317508c..3910f556 100644 --- a/samples/Search/SearchIssues.hs +++ b/samples/Search/SearchIssues.hs @@ -5,7 +5,7 @@ import qualified Github.Search as Github import Control.Monad (forM_) main = do - let query = "q=build%2Arepo%3Aphadej%2Fgithub&per_page=100" + let query = "q=build%20repo%3Aphadej%2Fgithub&per_page=100" let auth = Nothing result <- Github.searchIssues' auth query case result of From 276c256ec120870050773d714e587564f42be900 Mon Sep 17 00:00:00 2001 From: Daniel Strittmatter Date: Sun, 3 Jan 2016 18:54:11 +0100 Subject: [PATCH 107/510] Add issue search tests --- fixtures/issueSearch.json | 96 +++++++++++++++++++++++++++++++++++++++ spec/Github/UsersSpec.hs | 41 ++++++++++++++--- 2 files changed, 131 insertions(+), 6 deletions(-) create mode 100644 fixtures/issueSearch.json diff --git a/fixtures/issueSearch.json b/fixtures/issueSearch.json new file mode 100644 index 00000000..c95cacba --- /dev/null +++ b/fixtures/issueSearch.json @@ -0,0 +1,96 @@ +{ + "total_count": 2, + "incomplete_results": false, + "items": [ + { + "url": "https://api.github.com/repos/phadej/github/issues/130", + "labels_url": "https://api.github.com/repos/phadej/github/issues/130/labels{/name}", + "comments_url": "https://api.github.com/repos/phadej/github/issues/130/comments", + "events_url": "https://api.github.com/repos/phadej/github/issues/130/events", + "html_url": "https://github.com/phadej/github/pull/130", + "id": 123898390, + "number": 130, + "title": "Make test runner more robust", + "user": { + "login": "phadej", + "id": 51087, + "avatar_url": "https://avatars.githubusercontent.com/u/51087?v=3", + "gravatar_id": "", + "url": "https://api.github.com/users/phadej", + "html_url": "https://github.com/phadej", + "followers_url": "https://api.github.com/users/phadej/followers", + "following_url": "https://api.github.com/users/phadej/following{/other_user}", + "gists_url": "https://api.github.com/users/phadej/gists{/gist_id}", + "starred_url": "https://api.github.com/users/phadej/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/phadej/subscriptions", + "organizations_url": "https://api.github.com/users/phadej/orgs", + "repos_url": "https://api.github.com/users/phadej/repos", + "events_url": "https://api.github.com/users/phadej/events{/privacy}", + "received_events_url": "https://api.github.com/users/phadej/received_events", + "type": "User", + "site_admin": false + }, + "labels": [ + + ], + "state": "closed", + "locked": false, + "assignee": null, + "milestone": null, + "comments": 0, + "created_at": "2015-12-25T21:37:39Z", + "updated_at": "2015-12-26T08:57:52Z", + "closed_at": "2015-12-25T23:32:12Z", + "pull_request": { + "url": "https://api.github.com/repos/phadej/github/pulls/130", + "html_url": "https://github.com/phadej/github/pull/130", + "diff_url": "https://github.com/phadej/github/pull/130.diff", + "patch_url": "https://github.com/phadej/github/pull/130.patch" + }, + "body": "As they use access token, it's highly unlikely it will be rate limited. ATM there's only one request per test job. i.e. travis could be re-enabled.\r\n\r\nExample run https://travis-ci.org/phadej/github/builds/98815089\r\nSome tests are pending as secret is made for this `jwiegley/github` repository.", + "score": 0.75566536 + }, + { + "url": "https://api.github.com/repos/phadej/github/issues/127", + "labels_url": "https://api.github.com/repos/phadej/github/issues/127/labels{/name}", + "comments_url": "https://api.github.com/repos/phadej/github/issues/127/comments", + "events_url": "https://api.github.com/repos/phadej/github/issues/127/events", + "html_url": "https://github.com/phadej/github/issues/127", + "id": 119694665, + "number": 127, + "title": "Decouple request creation from execution", + "user": { + "login": "phadej", + "id": 51087, + "avatar_url": "https://avatars.githubusercontent.com/u/51087?v=3", + "gravatar_id": "", + "url": "https://api.github.com/users/phadej", + "html_url": "https://github.com/phadej", + "followers_url": "https://api.github.com/users/phadej/followers", + "following_url": "https://api.github.com/users/phadej/following{/other_user}", + "gists_url": "https://api.github.com/users/phadej/gists{/gist_id}", + "starred_url": "https://api.github.com/users/phadej/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/phadej/subscriptions", + "organizations_url": "https://api.github.com/users/phadej/orgs", + "repos_url": "https://api.github.com/users/phadej/repos", + "events_url": "https://api.github.com/users/phadej/events{/privacy}", + "received_events_url": "https://api.github.com/users/phadej/received_events", + "type": "User", + "site_admin": false + }, + "labels": [ + + ], + "state": "open", + "locked": false, + "assignee": null, + "milestone": null, + "comments": 2, + "created_at": "2015-12-01T11:09:03Z", + "updated_at": "2015-12-25T19:15:33Z", + "closed_at": null, + "body": "After working with this API, and making few others, I found that separating request creation and execution is better (i.e. more flexible) design.\r\n\r\nNow one cannot use different network client or add new endpoints.\r\n\r\nShorly\r\n\r\n```hs\r\n-- New stuff:\r\ndata GithubRequest a = GithubRequestGet Url\r\n | ...\r\n\r\n-- or alternatively\r\ndata GithubRequest a where\r\n GithubRequestGet :: Url -> GithubRequest a\r\n GithubRequestMultiGet :: Url -> GithubRequest [a]\r\n\r\nexecGithubRequest :: FromJSON a => GithubRequest a -> IO (Either Error a)\r\nexecGithubRequest' :: FromJSON a => Maybe GithubAuth -> GithubRequest a -> IO (Either Error a)\r\n\r\npublicOrganizationForRequest :: String -> GithubRequest [SimpleOrganisation]\r\npublicOrganizationForRequest org = GithubRequestGet ...\r\n\r\n-- Old IO methods become:\r\npublicOrganizationsFor :: String -> IO (Either Error [SimpleOrganization])\r\npublicOrganizationsFor = execGithubRequest . publicOrganizationForRequest\r\n\r\npublicOrganizationsFor' :: Maybe GithubAuth -> String -> IO (Either Error [SimpleOrganization])\r\npublicOrganizationsFor' auth = execGithubRequest' auth . publicOrganizationForRequest\r\n```\r\n\r\nHow does this sound? I can make a refactoring, it's quite straight-forward.", + "score": 0.7265285 + } + ] +} diff --git a/spec/Github/UsersSpec.hs b/spec/Github/UsersSpec.hs index 826e096a..ed4208b6 100644 --- a/spec/Github/UsersSpec.hs +++ b/spec/Github/UsersSpec.hs @@ -2,15 +2,18 @@ {-# LANGUAGE OverloadedStrings #-} module Github.UsersSpec where -import Data.Aeson.Compat (eitherDecodeStrict) -import Data.Either.Compat (isRight) -import Data.FileEmbed (embedFile) -import System.Environment (lookupEnv) -import Test.Hspec (Spec, describe, it, pendingWith, shouldBe, - shouldSatisfy) +import Control.Applicative ((<$>)) +import Data.Aeson.Compat (eitherDecodeStrict) +import Data.Either.Compat (isRight) +import Data.FileEmbed (embedFile) +import System.Environment (lookupEnv) +import Test.Hspec (Spec, describe, it, pendingWith, shouldBe, + shouldSatisfy) import Github.Auth (GithubAuth (..)) import Github.Data.Definitions (DetailedOwner (..)) +import Github.Data.Issues (Issue(..), SearchIssuesResult(..)) +import Github.Search (searchIssues) import Github.Users (userInfoCurrent', userInfoFor') fromRightS :: Show a => Either a b -> b @@ -39,3 +42,29 @@ spec = do it "returns information about the autenticated user" $ withAuth $ \auth -> do userInfo <- userInfoCurrent' (Just auth) userInfo `shouldSatisfy` isRight + + describe "searchIssues" $ do + it "decodes issue search response JSON" $ do + let searchIssuesResult = fromRightS $ eitherDecodeStrict $(embedFile "fixtures/issueSearch.json") :: SearchIssuesResult + searchIssuesTotalCount searchIssuesResult `shouldBe` 2 + + let issues = searchIssuesIssues searchIssuesResult + length issues `shouldBe` 2 + + let issue1 = head issues + issueId issue1 `shouldBe` 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 + issueNumber issue2 `shouldBe` 127 + issueTitle issue2 `shouldBe` "Decouple request creation from execution" + issueState issue2 `shouldBe` "open" + + it "performs an issue search via the API" $ 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 From 2797391d67d42dc5e27e45faaf07046d3e88e7d8 Mon Sep 17 00:00:00 2001 From: Daniel Strittmatter Date: Sun, 3 Jan 2016 19:20:34 +0100 Subject: [PATCH 108/510] Put issue search tests in its own module --- github.cabal | 1 + spec/Github/SearchSpec.hs | 43 +++++++++++++++++++++++++++++++++++++++ spec/Github/UsersSpec.hs | 41 ++++++------------------------------- 3 files changed, 50 insertions(+), 35 deletions(-) create mode 100644 spec/Github/SearchSpec.hs diff --git a/github.cabal b/github.cabal index 51d0f32c..bfa760e7 100644 --- a/github.cabal +++ b/github.cabal @@ -215,6 +215,7 @@ test-suite github-test type: exitcode-stdio-1.0 hs-source-dirs: spec other-modules: + Github.SearchSpec Github.UsersSpec Github.OrganizationsSpec main-is: Spec.hs diff --git a/spec/Github/SearchSpec.hs b/spec/Github/SearchSpec.hs new file mode 100644 index 00000000..7c1174ee --- /dev/null +++ b/spec/Github/SearchSpec.hs @@ -0,0 +1,43 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE OverloadedStrings #-} +module Github.SearchSpec where + +import Control.Applicative ((<$>)) +import Data.Aeson.Compat (eitherDecodeStrict) +import Data.FileEmbed (embedFile) +import Test.Hspec (Spec, describe, it, shouldBe) + +import Github.Data.Issues (Issue(..), SearchIssuesResult(..)) +import Github.Search (searchIssues) + +fromRightS :: Show a => Either a b -> b +fromRightS (Right b) = b +fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a + +spec :: Spec +spec = do + describe "searchIssues" $ do + it "decodes issue search response JSON" $ do + let searchIssuesResult = fromRightS $ eitherDecodeStrict $(embedFile "fixtures/issueSearch.json") :: SearchIssuesResult + searchIssuesTotalCount searchIssuesResult `shouldBe` 2 + + let issues = searchIssuesIssues searchIssuesResult + length issues `shouldBe` 2 + + let issue1 = head issues + issueId issue1 `shouldBe` 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 + issueNumber issue2 `shouldBe` 127 + issueTitle issue2 `shouldBe` "Decouple request creation from execution" + issueState issue2 `shouldBe` "open" + + it "performs an issue search via the API" $ 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 diff --git a/spec/Github/UsersSpec.hs b/spec/Github/UsersSpec.hs index ed4208b6..826e096a 100644 --- a/spec/Github/UsersSpec.hs +++ b/spec/Github/UsersSpec.hs @@ -2,18 +2,15 @@ {-# LANGUAGE OverloadedStrings #-} module Github.UsersSpec where -import Control.Applicative ((<$>)) -import Data.Aeson.Compat (eitherDecodeStrict) -import Data.Either.Compat (isRight) -import Data.FileEmbed (embedFile) -import System.Environment (lookupEnv) -import Test.Hspec (Spec, describe, it, pendingWith, shouldBe, - shouldSatisfy) +import Data.Aeson.Compat (eitherDecodeStrict) +import Data.Either.Compat (isRight) +import Data.FileEmbed (embedFile) +import System.Environment (lookupEnv) +import Test.Hspec (Spec, describe, it, pendingWith, shouldBe, + shouldSatisfy) import Github.Auth (GithubAuth (..)) import Github.Data.Definitions (DetailedOwner (..)) -import Github.Data.Issues (Issue(..), SearchIssuesResult(..)) -import Github.Search (searchIssues) import Github.Users (userInfoCurrent', userInfoFor') fromRightS :: Show a => Either a b -> b @@ -42,29 +39,3 @@ spec = do it "returns information about the autenticated user" $ withAuth $ \auth -> do userInfo <- userInfoCurrent' (Just auth) userInfo `shouldSatisfy` isRight - - describe "searchIssues" $ do - it "decodes issue search response JSON" $ do - let searchIssuesResult = fromRightS $ eitherDecodeStrict $(embedFile "fixtures/issueSearch.json") :: SearchIssuesResult - searchIssuesTotalCount searchIssuesResult `shouldBe` 2 - - let issues = searchIssuesIssues searchIssuesResult - length issues `shouldBe` 2 - - let issue1 = head issues - issueId issue1 `shouldBe` 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 - issueNumber issue2 `shouldBe` 127 - issueTitle issue2 `shouldBe` "Decouple request creation from execution" - issueState issue2 `shouldBe` "open" - - it "performs an issue search via the API" $ 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 From 4a463049269f93e40f373faf9346a83b2822a914 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sun, 3 Jan 2016 22:57:56 +0200 Subject: [PATCH 109/510] Rework cabal and travis files --- .gitignore | 1 + .travis.yml | 77 +++++++++++---------------------------- github.cabal | 66 ++++++++++----------------------- spec/Github/SearchSpec.hs | 4 +- stack-lts-2.yaml | 8 ++++ stack-lts-3.yaml | 7 ++++ stack-nightly.yaml | 7 ++++ stack.yaml | 1 + travis-install.sh | 44 ++++++++++++++++++++++ travis-script.sh | 22 +++++++++++ 10 files changed, 134 insertions(+), 103 deletions(-) create mode 100644 stack-lts-2.yaml create mode 100644 stack-lts-3.yaml create mode 100644 stack-nightly.yaml create mode 120000 stack.yaml create mode 100644 travis-install.sh create mode 100644 travis-script.sh diff --git a/.gitignore b/.gitignore index ad17ab3e..83d72d13 100644 --- a/.gitignore +++ b/.gitignore @@ -7,3 +7,4 @@ cabal.sandbox.config *~ *.hi *.o +.stack-work diff --git a/.travis.yml b/.travis.yml index 9969ee2b..cf154a53 100644 --- a/.travis.yml +++ b/.travis.yml @@ -6,6 +6,7 @@ cache: directories: - $HOME/.cabsnap - $HOME/.cabal/packages + - $HOME/.stack before_cache: - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log @@ -17,77 +18,41 @@ env: matrix: include: - - env: CABALVER=1.18 GHCVER=7.8.4 + - env: BUILD=cabal CABALVER=1.18 GHCVER=7.8.4 compiler: ": #GHC 7.8.4" addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4], sources: [hvr-ghc]}} - - env: CABALVER=1.18 GHCVER=7.8.4 STACKAGESNAPSHOT=lts-2.22 + - env: BUILD=cabal CABALVER=1.18 GHCVER=7.8.4 STACKAGESNAPSHOT=lts-2.22 compiler: ": #GHC 7.8.4 lts-2.22" addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4], sources: [hvr-ghc]}} - - env: CABALVER=1.22 GHCVER=7.10.2 + - env: BUILD=cabal CABALVER=1.22 GHCVER=7.10.2 compiler: ": #GHC 7.10.2" addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.2], sources: [hvr-ghc]}} - - env: CABALVER=1.22 GHCVER=7.10.2 STACKAGESNAPSHOT=lts-3 + - env: BUILD=cabal CABALVER=1.22 GHCVER=7.10.2 STACKAGESNAPSHOT=lts-3 compiler: ": #GHC 7.10.2 lts-3" addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.2], sources: [hvr-ghc]}} + - env: BUILD=stack STACK_YAML=stack-lts-2.yaml + compiler: ": #STACK LTS2" + addons: {apt: {packages: [ghc-7.8.4], sources: [hvr-ghc]}} + - env: BUILD=stack STACK_YAML=stack-lts-3.yaml + compiler: ": #STACK LTS3" + addons: {apt: {packages: [ghc-7.10.2], sources: [hvr-ghc]}} + - env: BUILD=stack STACK_YAML=stack-nightly.yaml + compiler: ": #STACK nightly" + addons: {apt: {packages: [ghc-7.10.3], sources: [hvr-ghc]}} + - env: BUILD=stack STACK_YAML=stack-lts-3.yaml + compiler: ": #stack LTS3 OSX" + os: osx before_install: - - unset CC - - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH + - unset CC + - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$HOME/.local/bin:$PATH install: - - if [ -n "$STACKAGESNAPSHOT" ]; then wget https://www.stackage.org/$STACKAGESNAPSHOT/cabal.config; fi - - cabal --version - - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]" - - if [ -f $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz ]; - then - zcat $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz > - $HOME/.cabal/packages/hackage.haskell.org/00-index.tar; - fi - - travis_retry cabal update -v - - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config - - cabal install --only-dependencies --enable-tests --enable-benchmarks --dry -v > installplan.txt - - sed -i -e '1,/^Resolving /d' installplan.txt; cat installplan.txt - -# check whether current requested install-plan matches cached package-db snapshot - - if diff -u installplan.txt $HOME/.cabsnap/installplan.txt; - then - echo "cabal build-cache HIT"; - rm -rfv .ghc; - cp -a $HOME/.cabsnap/ghc $HOME/.ghc; - cp -a $HOME/.cabsnap/lib $HOME/.cabsnap/share $HOME/.cabsnap/bin $HOME/.cabal/; - else - echo "cabal build-cache MISS"; - rm -rf $HOME/.cabsnap; - mkdir -p $HOME/.ghc $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin; - cabal install --only-dependencies --enable-tests --enable-benchmarks; - fi - -# snapshot package-db on cache miss - - if [ ! -d $HOME/.cabsnap ]; - then - echo "snapshotting package-db to build-cache"; - mkdir $HOME/.cabsnap; - cp -a $HOME/.ghc $HOME/.cabsnap/ghc; - cp -a $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin installplan.txt $HOME/.cabsnap/; - fi + - sh travis-install.sh # Here starts the actual work to be performed for the package under test; # any command which exits with a non-zero exit code causes the build to fail. script: - - if [ -f configure.ac ]; then autoreconf -i; fi - - cabal configure --enable-tests --enable-benchmarks -v2 # -v2 provides useful information for debugging - - cabal build # this builds all libraries and executables (including tests/benchmarks) - - cabal test --show-details=always - - - if [ "$CABALVER" = "1.22" ]; then cabal check; fi - - if [ "$CABALVER" = "1.22" ]; then cabal haddock; fi - - - cabal sdist # tests that a source-distribution can be generated - -# Check that the resulting source distribution can be built & installed. -# If there are no other `.tar.gz` files in `dist`, this can be even simpler: -# `cabal install --force-reinstalls dist/*-*.tar.gz` - - SRC_TGZ=$(cabal info . | awk '{print $2;exit}').tar.gz && - (cd dist && cabal install --force-reinstalls "$SRC_TGZ") + - sh travis-script.sh # EOF diff --git a/github.cabal b/github.cabal index 3211bf2e..addf27a7 100644 --- a/github.cabal +++ b/github.cabal @@ -1,51 +1,22 @@ --- github.cabal auto-generated by cabal init. For additional options, --- see --- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr. --- The name of the package. Name: github - --- The package version. See the Haskell package versioning policy --- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for --- standards guiding when and how versions should be incremented. Version: 0.14.0 - --- A short (one-line) description of the package. Synopsis: Access to the Github API, v3. - --- A longer description of the package. Description: The Github API provides programmatic access to the full Github Web site, from Issues to Gists to repos down to the underlying git data like references and trees. This library wraps all of that, exposing a basic but Haskell-friendly set of functions and data structures. . For more of an overview please see the README: - --- The license under which the package is released. License: BSD3 - --- The file containing the license text. License-file: LICENSE - --- The package author(s). -Author: Mike Burns, John Wiegley - --- An email address to which users can send suggestions, bug reports, --- and patches. -Maintainer: johnw@newartisans.com - -Homepage: https://github.com/jwiegley/github - --- A copyright notice. -Copyright: Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley - -Category: Network APIs - +Author: Mike Burns, John Wiegley, Oleg Grenrus +Maintainer: Oleg Grenrus +Homepage: https://github.com/phadej/github +Copyright: Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016 Oleg Grenrus +Category: Network Build-type: Simple - Tested-with: GHC==7.8.4, GHC==7.10.2 - --- Extra files to be distributed with the package, such as examples or --- a README. +Cabal-version: >=1.10 Extra-source-files: README.md ,samples/Gists/Comments/ShowComment.hs ,samples/Gists/Comments/ShowComments.hs @@ -124,9 +95,10 @@ Extra-source-files: README.md ,samples/Users/ShowUser.hs ,LICENSE - --- Constraint on the version of Cabal needed to build this package. -Cabal-version: >=1.10 +flag aeson-compat + description: Whether to use aeson-compat or aeson-extra + default: True + manual: False source-repository head type: git @@ -135,6 +107,7 @@ source-repository head Library -- Modules exported by the library. Default-Language: Haskell2010 + GHC-Options: -Wall Exposed-modules: Github.All, Github.Auth, Github.Data, @@ -186,7 +159,6 @@ Library Build-depends: base >= 4.0 && < 5.0, time >=1.4 && <1.6, aeson >= 0.6.1.0, - aeson-extra >= 0.2.0.0 && <0.3, attoparsec >= 0.10.3.0, bytestring, case-insensitive >= 0.4.0.4, @@ -205,11 +177,10 @@ Library byteable >= 0.1.0, base16-bytestring >= 0.1.1.6 - -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source. - -- Build-tools: - - GHC-Options: -Wall -fno-warn-orphans - + if flag(aeson-compat) + Build-depends: aeson-compat >= 0.3.0.0 && <0.4 + else + Build-depends: aeson-extra >= 0.2.0.0 && <0.3 test-suite github-test default-language: Haskell2010 @@ -220,11 +191,14 @@ test-suite github-test Github.UsersSpec Github.OrganizationsSpec main-is: Spec.hs + ghc-options: -Wall build-depends: base >= 4.0 && < 5.0, base-compat, - aeson-extra >= 0.2.0.0 && <0.3, github, file-embed, hspec + if flag(aeson-compat) + build-depends: aeson-compat >= 0.3.0.0 && <0.4 + else + build-depends: aeson-extra >= 0.2.0.0 && <0.3 - ghc-options: -Wall -fno-warn-orphans diff --git a/spec/Github/SearchSpec.hs b/spec/Github/SearchSpec.hs index 7c1174ee..2af7d67e 100644 --- a/spec/Github/SearchSpec.hs +++ b/spec/Github/SearchSpec.hs @@ -2,7 +2,9 @@ {-# LANGUAGE OverloadedStrings #-} module Github.SearchSpec where -import Control.Applicative ((<$>)) +import Prelude () +import Prelude.Compat + import Data.Aeson.Compat (eitherDecodeStrict) import Data.FileEmbed (embedFile) import Test.Hspec (Spec, describe, it, shouldBe) diff --git a/stack-lts-2.yaml b/stack-lts-2.yaml new file mode 100644 index 00000000..20d0a524 --- /dev/null +++ b/stack-lts-2.yaml @@ -0,0 +1,8 @@ +packages: +- '.' +extra-deps: +- aeson-extra-0.2.3.0 +resolver: lts-2.22 +flags: + github: + aeson-compat: false diff --git a/stack-lts-3.yaml b/stack-lts-3.yaml new file mode 100644 index 00000000..bffb1600 --- /dev/null +++ b/stack-lts-3.yaml @@ -0,0 +1,7 @@ +packages: +- '.' +extra-deps: [] +resolver: lts-3.20 +flags: + github: + aeson-compat: false diff --git a/stack-nightly.yaml b/stack-nightly.yaml new file mode 100644 index 00000000..5c4307ba --- /dev/null +++ b/stack-nightly.yaml @@ -0,0 +1,7 @@ +resolver: nightly-2016-01-03 +packages: +- '.' +extra-deps: [] +flags: + github: + aeson-compat: true diff --git a/stack.yaml b/stack.yaml new file mode 120000 index 00000000..671f4734 --- /dev/null +++ b/stack.yaml @@ -0,0 +1 @@ +stack-lts-3.yaml \ No newline at end of file diff --git a/travis-install.sh b/travis-install.sh new file mode 100644 index 00000000..80ffdc92 --- /dev/null +++ b/travis-install.sh @@ -0,0 +1,44 @@ +case $BUILD in + stack) + mkdir -p ~/.local/bin; + if [ `uname` = "Darwin" ]; then + curl -kL https://www.stackage.org/stack/osx-x86_64 | tar xz --strip-components=1 --include '*/stack' -C ~/.local/bin; + else + curl -L https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack'; + fi + stack --no-terminal setup + ;; + cabal) + if [ -n "$STACKAGESNAPSHOT" ]; then wget https://www.stackage.org/$STACKAGESNAPSHOT/cabal.config; fi + cabal --version + echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]" + if [ -f $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz ]; then + zcat $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz > $HOME/.cabal/packages/hackage.haskell.org/00-index.tar + fi + travis_retry cabal update -v + sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config + cabal install --only-dependencies --enable-tests --enable-benchmarks --dry -v > installplan.txt + sed -i -e '1,/^Resolving /d' installplan.txt; cat installplan.txt + + # check whether current requested install-plan matches cached package-db snapshot + if diff -u installplan.txt $HOME/.cabsnap/installplan.txt; then + echo "cabal build-cache HIT"; + rm -rfv .ghc; + cp -a $HOME/.cabsnap/ghc $HOME/.ghc; + cp -a $HOME/.cabsnap/lib $HOME/.cabsnap/share $HOME/.cabsnap/bin $HOME/.cabal/; + else + echo "cabal build-cache MISS"; + rm -rf $HOME/.cabsnap; + mkdir -p $HOME/.ghc $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin; + cabal install --only-dependencies --enable-tests --enable-benchmarks; + fi + + # snapshot package-db on cache miss + if [ ! -d $HOME/.cabsnap ]; then + echo "snapshotting package-db to build-cache"; + mkdir $HOME/.cabsnap; + cp -a $HOME/.ghc $HOME/.cabsnap/ghc; + cp -a $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin installplan.txt $HOME/.cabsnap/; + fi + ;; +esac \ No newline at end of file diff --git a/travis-script.sh b/travis-script.sh new file mode 100644 index 00000000..cea8cb6a --- /dev/null +++ b/travis-script.sh @@ -0,0 +1,22 @@ +case $BUILD in + stack) + stack --no-terminal test --only-dependencies + ;; + cabal) + if [ -f configure.ac ]; then autoreconf -i; fi + cabal configure --enable-tests --enable-benchmarks -v2 # -v2 provides useful information for debugging + cabal build # this builds all libraries and executables (including tests/benchmarks) + cabal test --show-details=always + + if [ "$CABALVER" = "1.22" ]; then cabal check; fi + if [ "$CABALVER" = "1.22" ]; then cabal haddock; fi + + cabal sdist # tests that a source-distribution can be generated + + # Check that the resulting source distribution can be built & installed. + # If there are no other `.tar.gz` files in `dist`, this can be even simpler: + # `cabal install --force-reinstalls dist/*-*.tar.gz` + SRC_TGZ=$(cabal info . | awk '{print $2;exit}').tar.gz && + (cd dist && cabal install --force-reinstalls "$SRC_TGZ") + ;; +esac \ No newline at end of file From f0d3846dd05de4fec3f40f035bc691883d986b7e Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 4 Jan 2016 14:05:35 +0200 Subject: [PATCH 110/510] Add users endpoints to Github.All --- Github/All.hs | 24 ++++++++++++++++++++++++ Github/Users.hs | 18 +++++++++++------- Github/Users/Followers.hs | 32 +++++++++++++++++++++++--------- spec/Github/UsersSpec.hs | 14 +++++++++++++- 4 files changed, 71 insertions(+), 17 deletions(-) diff --git a/Github/All.hs b/Github/All.hs index 42eaa35d..5debe325 100644 --- a/Github/All.hs +++ b/Github/All.hs @@ -23,6 +23,28 @@ module Github.All ( -- -- Missing endpoints: All except /List teams/ teamsOfR, + + -- * Users + -- | See + -- + -- Missing endpoints: + -- + -- * Update the authenticated user + -- * Get all users + userInfoForR, + userInfoCurrentR, + -- ** Followers + -- | See + -- + -- Missing endpoints: + -- + -- * Check if you are following a user + -- * Check if one user follows another + -- * Follow a user + -- * Unfollow a user + usersFollowingR, + usersFollowedByR, + -- * Data definitions module Github.Data ) where @@ -31,3 +53,5 @@ import Github.Data import Github.Organizations import Github.Organizations.Members import Github.Organizations.Teams +import Github.Users +import Github.Users.Followers diff --git a/Github/Users.hs b/Github/Users.hs index 2e61a136..bcac4eba 100644 --- a/Github/Users.hs +++ b/Github/Users.hs @@ -18,18 +18,20 @@ import Github.Request -- With authentification -- -- > userInfoFor' (Just ("github-username", "github-password")) "mike-burns" -userInfoFor' :: Maybe GithubAuth -> String -> IO (Either Error DetailedOwner) +userInfoFor' :: Maybe GithubAuth -> Name DetailedOwner -> IO (Either Error DetailedOwner) userInfoFor' auth = executeRequestMaybe auth . userInfoForR -- | The information for a single user, by login name. -- -- > userInfoFor "mike-burns" -userInfoFor :: String -> IO (Either Error DetailedOwner) -userInfoFor = executeRequest' . userInfoForR +userInfoFor :: Name DetailedOwner -> IO (Either Error DetailedOwner) +userInfoFor = executeRequest' . userInfoForR --- | The information for a single user, by login name. The request -userInfoForR :: String -> GithubRequest k DetailedOwner -userInfoForR userName = GithubGet ["users", userName] "" +-- | Get a single user. The information for a single user, by login name. The request +-- +-- See +userInfoForR :: Name DetailedOwner -> GithubRequest k DetailedOwner +userInfoForR userName = GithubGet ["users", untagName userName] "" -- | Retrieve information about the user associated with the supplied authentication. -- @@ -40,6 +42,8 @@ userInfoCurrent' :: Maybe GithubAuth -> IO (Either Error DetailedOwner) userInfoCurrent' auth = executeRequestMaybe auth . unsafeDropAuthRequirements $ userInfoCurrentR --- | Retrieve information about the user associated with the supplied authentication. +-- | Get the authenticated user. Retrieve information about the user associated with the supplied authentication. +-- +-- See userInfoCurrentR :: GithubRequest 'True DetailedOwner userInfoCurrentR = GithubGet ["user"] "" diff --git a/Github/Users/Followers.hs b/Github/Users/Followers.hs index 3ef53aa7..467a2d87 100644 --- a/Github/Users/Followers.hs +++ b/Github/Users/Followers.hs @@ -1,22 +1,36 @@ -- | The user followers API as described on -- . module Github.Users.Followers ( - usersFollowing -,usersFollowedBy -,module Github.Data -) where + usersFollowing, + usersFollowedBy, + usersFollowingR, + usersFollowedByR, + module Github.Data, + ) where import Github.Data -import Github.Private +import Github.Request -- | All the users following the given user. -- -- > usersFollowing "mike-burns" -usersFollowing :: String -> IO (Either Error [GithubOwner]) -usersFollowing userName = githubGet ["users", userName, "followers"] +usersFollowing :: Name GithubOwner -> IO (Either Error [GithubOwner]) +usersFollowing = executeRequest' . usersFollowingR + +-- | List followers of a user. All the users following the given user. +-- +-- See +usersFollowingR :: Name GithubOwner -> GithubRequest k [GithubOwner] +usersFollowingR userName = GithubGet ["users", untagName userName, "followers"] "" -- TODO: use paged get -- | All the users that the given user follows. -- -- > usersFollowedBy "mike-burns" -usersFollowedBy :: String -> IO (Either Error [GithubOwner]) -usersFollowedBy userName = githubGet ["users", userName, "following"] +usersFollowedBy :: Name GithubOwner -> IO (Either Error [GithubOwner]) +usersFollowedBy = executeRequest' . usersFollowedByR + +-- | List users followed by another user. All the users that the given user follows. +-- +-- See +usersFollowedByR :: Name GithubOwner -> GithubRequest k [GithubOwner] +usersFollowedByR userName = GithubGet ["users", untagName userName, "following"] "" -- TODO: use paged get diff --git a/spec/Github/UsersSpec.hs b/spec/Github/UsersSpec.hs index 826e096a..b97bae3c 100644 --- a/spec/Github/UsersSpec.hs +++ b/spec/Github/UsersSpec.hs @@ -1,5 +1,5 @@ -{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} module Github.UsersSpec where import Data.Aeson.Compat (eitherDecodeStrict) @@ -11,7 +11,9 @@ import Test.Hspec (Spec, describe, it, pendingWith, shouldBe, import Github.Auth (GithubAuth (..)) import Github.Data.Definitions (DetailedOwner (..)) +import Github.Request (executeRequest) import Github.Users (userInfoCurrent', userInfoFor') +import Github.Users.Followers (usersFollowedByR, usersFollowingR) fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b @@ -39,3 +41,13 @@ spec = do it "returns information about the autenticated user" $ withAuth $ \auth -> do userInfo <- userInfoCurrent' (Just auth) userInfo `shouldSatisfy` isRight + + describe "usersFollowing" $ do + it "works" $ withAuth $ \auth -> do + us <- executeRequest auth $ usersFollowingR "phadej" + us `shouldSatisfy` isRight + + describe "usersFollowedBy" $ do + it "works" $ withAuth $ \auth -> do + us <- executeRequest auth $ usersFollowedByR "phadej" + us `shouldSatisfy` isRight From 87c207edfbdab1287556841e08d99efcc9c26842 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 5 Jan 2016 00:22:58 +0200 Subject: [PATCH 111/510] Add search endpoints to Github.All --- Github/All.hs | 11 +++++++++ Github/Search.hs | 62 ++++++++++++++++++++++++++++++++---------------- 2 files changed, 52 insertions(+), 21 deletions(-) diff --git a/Github/All.hs b/Github/All.hs index 5debe325..94a75564 100644 --- a/Github/All.hs +++ b/Github/All.hs @@ -24,6 +24,16 @@ module Github.All ( -- Missing endpoints: All except /List teams/ teamsOfR, + -- * Search + -- | See + -- + -- Missing endpoints: + -- + -- * Search users + searchReposR, + searchCodeR, + searchIssuesR, + -- * Users -- | See -- @@ -53,5 +63,6 @@ import Github.Data import Github.Organizations import Github.Organizations.Members import Github.Organizations.Teams +import Github.Search import Github.Users import Github.Users.Followers diff --git a/Github/Search.hs b/Github/Search.hs index c15e1a32..d400ce93 100644 --- a/Github/Search.hs +++ b/Github/Search.hs @@ -1,58 +1,78 @@ -- | The Github Search API, as described at -- . module Github.Search( - searchRepos' -,searchRepos -,searchCode' -,searchCode -,searchIssues' -,searchIssues -,module Github.Data -) where + searchRepos', + searchRepos, + searchReposR, + searchCode', + searchCode, + searchCodeR, + searchIssues', + searchIssues, + searchIssuesR, + module Github.Data, + ) where +import Github.Auth import Github.Data -import Github.Private +import Github.Request -- | Perform a repository search. --- | With authentication. +-- With authentication. -- -- > searchRepos' (Just $ GithubBasicAuth "github-username" "github-password') "q=a in%3Aname language%3Ahaskell created%3A>2013-10-01&per_page=100" searchRepos' :: Maybe GithubAuth -> String -> IO (Either Error SearchReposResult) -searchRepos' auth queryString = githubGetWithQueryString' auth ["search", "repositories"] queryString +searchRepos' auth = executeRequestMaybe auth . searchReposR -- | Perform a repository search. --- | Without authentication. +-- Without authentication. -- -- > searchRepos "q=a in%3Aname language%3Ahaskell created%3A>2013-10-01&per_page=100" searchRepos :: String -> IO (Either Error SearchReposResult) -searchRepos = searchRepos' Nothing +searchRepos = searchRepos' Nothing + +-- | Search repositories. +-- +-- See +searchReposR :: String -> GithubRequest k SearchReposResult +searchReposR queryString = GithubGet ["search", "repositories"] queryString -- | Perform a code search. --- | With authentication. +-- With authentication. -- -- > searchCode' (Just $ GithubBasicAuth "github-username" "github-password') "q=a in%3Aname language%3Ahaskell created%3A>2013-10-01&per_page=100" searchCode' :: Maybe GithubAuth -> String -> IO (Either Error SearchCodeResult) -searchCode' auth queryString = githubGetWithQueryString' auth ["search", "code"] queryString +searchCode' auth = executeRequestMaybe auth . searchCodeR -- | Perform a code search. --- | Without authentication. +-- Without authentication. -- -- > searchCode "q=addClass+in:file+language:js+repo:jquery/jquery" searchCode :: String -> IO (Either Error SearchCodeResult) -searchCode = searchCode' Nothing +searchCode = searchCode' Nothing + +-- | Search code. +-- +-- See +searchCodeR :: String -> GithubRequest k SearchCodeResult +searchCodeR queryString = GithubGet ["search", "code"] queryString -- | Perform an issue search. --- | With authentication. +-- With authentication. -- -- > searchIssues' (Just $ GithubBasicAuth "github-username" "github-password') "q=a repo%3Aphadej%2Fgithub&per_page=100" searchIssues' :: Maybe GithubAuth -> String -> IO (Either Error SearchIssuesResult) -searchIssues' auth queryString = githubGetWithQueryString' auth ["search", "issues"] queryString +searchIssues' auth = executeRequestMaybe auth . searchIssuesR -- | Perform an issue search. --- | Without authentication. +-- Without authentication. -- -- > searchIssues "q=a repo%3Aphadej%2Fgithub&per_page=100" searchIssues :: String -> IO (Either Error SearchIssuesResult) searchIssues = searchIssues' Nothing - +-- | Search issues. +-- +-- See +searchIssuesR :: String -> GithubRequest k SearchIssuesResult +searchIssuesR queryString = GithubGet ["search", "issues"] queryString From 4288d9b948d293267bbe53d5156b418b493ed318 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 5 Jan 2016 01:13:06 +0200 Subject: [PATCH 112/510] Fix stack travis setup --- travis-install.sh | 3 ++- travis-script.sh | 4 ++-- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/travis-install.sh b/travis-install.sh index 80ffdc92..7f360094 100644 --- a/travis-install.sh +++ b/travis-install.sh @@ -7,6 +7,7 @@ case $BUILD in curl -L https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack'; fi stack --no-terminal setup + stack --no-terminal test --only-dependencies ;; cabal) if [ -n "$STACKAGESNAPSHOT" ]; then wget https://www.stackage.org/$STACKAGESNAPSHOT/cabal.config; fi @@ -41,4 +42,4 @@ case $BUILD in cp -a $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin installplan.txt $HOME/.cabsnap/; fi ;; -esac \ No newline at end of file +esac diff --git a/travis-script.sh b/travis-script.sh index cea8cb6a..d8b86796 100644 --- a/travis-script.sh +++ b/travis-script.sh @@ -1,6 +1,6 @@ case $BUILD in stack) - stack --no-terminal test --only-dependencies + stack --no-terminal test ;; cabal) if [ -f configure.ac ]; then autoreconf -i; fi @@ -19,4 +19,4 @@ case $BUILD in SRC_TGZ=$(cabal info . | awk '{print $2;exit}').tar.gz && (cd dist && cabal install --force-reinstalls "$SRC_TGZ") ;; -esac \ No newline at end of file +esac From 17849a858aa6762837ed1c475b7f76420df830e5 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 5 Jan 2016 16:27:36 +0200 Subject: [PATCH 113/510] Add issues endpoints to Github.All --- Github/All.hs | 62 ++++++++ Github/Data/Issues.hs | 3 +- Github/Issues.hs | 106 +++++++++----- Github/Issues/Comments.hs | 83 +++++++---- Github/Issues/Events.hs | 73 ++++++---- Github/Issues/Labels.hs | 283 +++++++++++++++++++++++++----------- Github/Issues/Milestones.hs | 43 ++++-- github.cabal | 1 + spec/Github/SearchSpec.hs | 7 +- 9 files changed, 466 insertions(+), 195 deletions(-) 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 From fad371c6431a6e866283e195841abf806295ba05 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 5 Jan 2016 18:33:52 +0200 Subject: [PATCH 114/510] Add teams endpoints to Github.All --- Github/All.hs | 19 ++++- Github/Organizations/Teams.hs | 147 +++++++++++++++++++++++++++++++++- Github/Teams.hs | 64 --------------- Github/Teams/Memberships.hs | 38 --------- github.cabal | 2 - 5 files changed, 161 insertions(+), 109 deletions(-) delete mode 100644 Github/Teams.hs delete mode 100644 Github/Teams/Memberships.hs diff --git a/Github/All.hs b/Github/All.hs index 94a75564..27c05cdf 100644 --- a/Github/All.hs +++ b/Github/All.hs @@ -21,8 +21,25 @@ module Github.All ( -- ** Teams -- | See -- - -- Missing endpoints: All except /List teams/ + -- Missing endpoints: + -- + -- * List team members + -- * Get team member (deprecated) + -- * Add team member (deprecated) + -- * Remove team member (deprecated) + -- * List team repos + -- * Check if a team manages a repository + -- * Add team repository + -- * Remove team repository teamsOfR, + teamInfoForR, + createTeamForR, + editTeamR, + deleteTeamR, + teamMembershipInfoForR, + addTeamMembershipForR, + deleteTeamMembershipForR, + listTeamsCurrentR, -- * Search -- | See diff --git a/Github/Organizations/Teams.hs b/Github/Organizations/Teams.hs index 6b42c384..1a12e9fd 100644 --- a/Github/Organizations/Teams.hs +++ b/Github/Organizations/Teams.hs @@ -1,12 +1,32 @@ +{-# LANGUAGE DataKinds #-} -- | The organization teams API as described on -- . module Github.Organizations.Teams ( teamsOf, teamsOf', teamsOfR, + teamInfoFor, + teamInfoFor', + teamInfoForR, + createTeamFor', + createTeamForR, + editTeam', + editTeamR, + deleteTeam', + deleteTeamR, + teamMembershipInfoFor, + teamMembershipInfoFor', + teamMembershipInfoForR, + addTeamMembershipFor', + addTeamMembershipForR, + deleteTeamMembershipFor', + deleteTeamMembershipForR, + listTeamsCurrent', + listTeamsCurrentR, module Github.Data, ) where +import Data.Aeson.Compat (encode) import Github.Auth import Github.Data import Github.Request @@ -25,10 +45,129 @@ teamsOf' auth = executeRequestMaybe auth . teamsOfR teamsOf :: Name Organization -> IO (Either Error [Team]) teamsOf = teamsOf' Nothing --- | List teams. List the teams of an organization. --- When authenticated, lists private teams visible to the authenticated user. --- When unauthenticated, lists only public teams for an organization. --- +-- | List teams. -- See teamsOfR :: Name Organization -> GithubRequest k [Team] teamsOfR organization = GithubGet ["orgs", untagName organization, "teams"] "" + +-- | The information for a single team, by team id. +-- | With authentication +-- +-- > teamInfoFor' (Just $ GithubOAuth "token") 1010101 +teamInfoFor' :: Maybe GithubAuth -> Id Team -> IO (Either Error DetailedTeam) +teamInfoFor' auth tid = + executeRequestMaybe auth $ teamInfoForR tid + +-- | The information for a single team, by team id. +-- +-- > teamInfoFor' (Just $ GithubOAuth "token") 1010101 +teamInfoFor :: Id Team -> IO (Either Error DetailedTeam) +teamInfoFor = teamInfoFor' Nothing + +-- | Get team. +-- See +teamInfoForR :: Id Team -> GithubRequest k DetailedTeam +teamInfoForR tid = + GithubGet ["teams", show $ untagId tid] "" + +-- | Create a team under an organization +-- +-- > createTeamFor' (GithubOAuth "token") "organization" (CreateTeam "newteamname" "some description" [] PermssionPull) +createTeamFor' :: GithubAuth + -> Name Organization + -> CreateTeam + -> IO (Either Error DetailedTeam) +createTeamFor' auth org cteam = + executeRequest auth $ createTeamForR org cteam + +-- | Create team. +-- See +createTeamForR :: Name Organization -> CreateTeam -> GithubRequest 'True DetailedTeam +createTeamForR org cteam = + GithubPost Post ["orgs", untagName org, "teams"] (encode cteam) + +-- | Edit a team, by id. +-- +-- > editTeamFor' +editTeam' :: GithubAuth + -> Id DetailedTeam + -> EditTeam + -> IO (Either Error DetailedTeam) +editTeam' auth tid eteam = + executeRequest auth $ editTeamR tid eteam + +-- | Edit team. +-- See +editTeamR :: Id DetailedTeam -> EditTeam -> GithubRequest 'True DetailedTeam +editTeamR tid eteam = + GithubPost Patch ["teams", show $ untagId tid] (encode eteam) + +-- | Delete a team, by id. +-- +-- > deleteTeam' (GithubOAuth "token") 1010101 +deleteTeam' :: GithubAuth -> Id DetailedTeam -> IO (Either Error ()) +deleteTeam' auth tid = + executeRequest auth $ deleteTeamR tid + +-- | Delete team. +-- See +deleteTeamR :: Id DetailedTeam -> GithubRequest 'True () +deleteTeamR tid = + GithubDelete ["teams", show $ untagId tid] + +-- | Retrieve team mebership information for a user. +-- | With authentication +-- +-- > teamMembershipInfoFor' (Just $ GithubOAuth "token") 1010101 "mburns" +teamMembershipInfoFor' :: Maybe GithubAuth -> Id Team -> Name GithubOwner -> IO (Either Error TeamMembership) +teamMembershipInfoFor' auth tid user = + executeRequestMaybe auth $ teamMembershipInfoForR tid user + +-- | Get team membership. +-- See Name GithubOwner -> GithubRequest k TeamMembership +teamMembershipInfoForR tid user = + GithubGet ["teams", show $ untagId tid, "memberships", untagName user] "" + +-- | Retrieve team mebership information for a user. +-- +-- > teamMembershipInfoFor 1010101 "mburns" +teamMembershipInfoFor :: Id Team -> Name GithubOwner -> IO (Either Error TeamMembership) +teamMembershipInfoFor = teamMembershipInfoFor' Nothing + +-- | Add (or invite) a member to a team. +-- +-- > addTeamMembershipFor' (GithubOAuth "token") 1010101 "mburns" RoleMember +addTeamMembershipFor' :: GithubAuth -> Id Team -> Name GithubOwner -> Role-> IO (Either Error TeamMembership) +addTeamMembershipFor' auth tid user role = + executeRequest auth $ addTeamMembershipForR tid user role + +-- | Add team membership. +-- See +addTeamMembershipForR :: Id Team -> Name GithubOwner -> Role -> GithubRequest 'True TeamMembership +addTeamMembershipForR tid user role = + GithubPost Put ["teams", show $ untagId tid, "memberships", untagName user] (encode $ CreateTeamMembership role) + +-- | Delete a member of a team. +-- +-- > deleteTeamMembershipFor' (GithubOAuth "token") 1010101 "mburns" +deleteTeamMembershipFor' :: GithubAuth -> Id Team -> Name GithubOwner -> IO (Either Error ()) +deleteTeamMembershipFor' auth tid user = + executeRequest auth $ deleteTeamMembershipForR tid user + +-- | Remove team membership +-- See +deleteTeamMembershipForR :: Id Team -> Name GithubOwner -> GithubRequest 'True () +deleteTeamMembershipForR tid user = + GithubDelete ["teams", show $ untagId tid, "memberships", untagName user] + +-- | List teams for current authenticated user +-- +-- > listTeamsCurrent' (GithubOAuth "token") +listTeamsCurrent' :: GithubAuth -> IO (Either Error [DetailedTeam]) +listTeamsCurrent' auth = executeRequest auth $ listTeamsCurrentR + +-- | List user teams. +-- See +listTeamsCurrentR :: GithubRequest 'True [DetailedTeam] +listTeamsCurrentR = GithubGet ["user", "teams"] "" diff --git a/Github/Teams.hs b/Github/Teams.hs deleted file mode 100644 index 57c534b0..00000000 --- a/Github/Teams.hs +++ /dev/null @@ -1,64 +0,0 @@ -module Github.Teams ( - teamInfoFor -,teamInfoFor' -,teamsInfo' -,createTeamFor' -,editTeam' -,deleteTeam' -,listTeamsCurrent' -,module Github.Data -) where - -import Github.Data -import Github.Private - --- | The information for a single team, by team id. --- | With authentication --- --- > teamInfoFor' (Just $ GithubOAuth "token") 1010101 -teamInfoFor' :: Maybe GithubAuth -> Int -> IO (Either Error DetailedTeam) -teamInfoFor' auth team_id = githubGet' auth ["teams", show team_id] - --- | The information for a single team, by team id. --- --- > teamInfoFor' (Just $ GithubOAuth "token") 1010101 -teamInfoFor :: Int -> IO (Either Error DetailedTeam) -teamInfoFor = teamInfoFor' Nothing - --- | Lists all teams, across all organizations, that the current user belongs to. --- --- > teamsInfo' (Just $ GithubOAuth "token") -teamsInfo' :: Maybe GithubAuth -> IO (Either Error [DetailedTeam]) -teamsInfo' auth = githubGet' auth ["user", "teams"] - --- | Create a team under an organization --- --- > createTeamFor' (GithubOAuth "token") "organization" (CreateTeam "newteamname" "some description" [] PermssionPull) -createTeamFor' :: GithubAuth - -> String - -> CreateTeam - -> IO (Either Error DetailedTeam) -createTeamFor' auth organization create_team = - githubPost auth ["orgs", organization, "teams"] create_team - --- | Edit a team, by id. --- --- > editTeamFor' -editTeam' :: GithubAuth - -> Int - -> EditTeam - -> IO (Either Error DetailedTeam) -editTeam' auth team_id edit_team = - githubPatch auth ["teams", show team_id] edit_team - --- | Delete a team, by id. --- --- > deleteTeam' (GithubOAuth "token") 1010101 -deleteTeam' :: GithubAuth -> Int -> IO (Either Error ()) -deleteTeam' auth team_id = githubDelete auth ["teams", show team_id] - --- | List teams for current authenticated user --- --- > listTeamsCurrent' (GithubOAuth "token") -listTeamsCurrent' :: GithubAuth -> IO (Either Error [DetailedTeam]) -listTeamsCurrent' auth = githubGet' (Just auth) ["user", "teams"] diff --git a/Github/Teams/Memberships.hs b/Github/Teams/Memberships.hs deleted file mode 100644 index b3a880a2..00000000 --- a/Github/Teams/Memberships.hs +++ /dev/null @@ -1,38 +0,0 @@ -module Github.Teams.Memberships ( - teamMembershipInfoFor -,teamMembershipInfoFor' -,addTeamMembershipFor' -,deleteTeamMembershipFor' -, module Github.Data -) where - -import Github.Data -import Github.Private - --- | Retrieve team mebership information for a user. --- | With authentication --- --- > teamMembershipInfoFor' (Just $ GithubOAuth "token") 1010101 "mburns" -teamMembershipInfoFor' :: Maybe GithubAuth -> Int -> String -> IO (Either Error TeamMembership) -teamMembershipInfoFor' auth team_id username = - githubGet' auth ["teams", show team_id, "memberships", username] - --- | Retrieve team mebership information for a user. --- --- > teamMembershipInfoFor 1010101 "mburns" -teamMembershipInfoFor :: Int -> String -> IO (Either Error TeamMembership) -teamMembershipInfoFor = teamMembershipInfoFor' Nothing - --- | Add (or invite) a member to a team. --- --- > addTeamMembershipFor' (GithubOAuth "token") 1010101 "mburns" RoleMember -addTeamMembershipFor' :: GithubAuth -> Int -> String -> Role -> IO (Either Error TeamMembership) -addTeamMembershipFor' auth team_id username role = - githubPut auth ["teams", show team_id, "memberships", username] (CreateTeamMembership role) - --- | Delete a member of a team. --- --- > deleteTeamMembershipFor' (GithubOAuth "token") 1010101 "mburns" -deleteTeamMembershipFor' :: GithubAuth -> Int -> String -> IO (Either Error ()) -deleteTeamMembershipFor' auth team_id username = - githubDelete auth ["teams", show team_id, "memberships", username] diff --git a/github.cabal b/github.cabal index addf27a7..b24862c9 100644 --- a/github.cabal +++ b/github.cabal @@ -145,8 +145,6 @@ Library Github.Repos.Subscribing, Github.Repos.Webhooks Github.Repos.Webhooks.Validate, - Github.Teams - Github.Teams.Memberships, Github.Users, Github.Users.Followers Github.Search From 5f511390635bae8776bdafc5af546f087734b611 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 5 Jan 2016 18:50:46 +0200 Subject: [PATCH 115/510] Add gists to Github.All --- Github/All.hs | 30 ++++++++++++++++++++++++ Github/Data/Gists.hs | 49 +++++++++++++++++++++------------------- Github/Gists.hs | 46 +++++++++++++++++++++++++------------ Github/Gists/Comments.hs | 36 +++++++++++++++++++++-------- 4 files changed, 113 insertions(+), 48 deletions(-) diff --git a/Github/All.hs b/Github/All.hs index 10ce06a8..54e66f66 100644 --- a/Github/All.hs +++ b/Github/All.hs @@ -3,6 +3,34 @@ -- This module re-exports all request constructrors and -- data definitions from this package. module Github.All ( + -- * Gists + -- | See + -- + -- Missing endpoints: + -- + -- * Get a specific revision of a gist + -- * Create a gist + -- * Edit a gist + -- * List gist commits + -- * Star a gist + -- * Unstar a gist + -- * Check if a gist is starred + -- * Fork a gist + -- * List gist forks + -- * Delete a gist + gistsR, + gistR, + + -- ** Comments + -- | See + -- + -- Missing endpoints: + -- * Create a comment + -- * Edit a comment + -- * Delete a comment + commentsOnR, + gistCommentR, + -- * Issues -- | See -- @@ -139,6 +167,8 @@ import Github.Issues.Comments import Github.Issues.Events import Github.Issues.Labels import Github.Issues.Milestones +import Github.Gists +import Github.Gists.Comments import Github.Organizations import Github.Organizations.Members import Github.Organizations.Teams diff --git a/Github/Data/Gists.hs b/Github/Data/Gists.hs index 10dfe9e2..34e4f61c 100644 --- a/Github/Data/Gists.hs +++ b/Github/Data/Gists.hs @@ -1,47 +1,50 @@ -{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} module Github.Data.Gists where import Github.Data.Definitions +import Github.Data.Id +import Github.Data.Name import Control.DeepSeq (NFData) -import Data.Data (Typeable, Data) -import GHC.Generics (Generic) +import Data.Data (Data, Typeable) +import GHC.Generics (Generic) data Gist = Gist { - gistUser :: GithubOwner - ,gistGitPushUrl :: String - ,gistUrl :: String + gistUser :: GithubOwner + ,gistGitPushUrl :: String + ,gistUrl :: String ,gistDescription :: Maybe String - ,gistCreatedAt :: GithubDate - ,gistPublic :: Bool - ,gistComments :: Int - ,gistUpdatedAt :: GithubDate - ,gistHtmlUrl :: String - ,gistId :: String - ,gistFiles :: [GistFile] - ,gistGitPullUrl :: String + ,gistCreatedAt :: GithubDate + ,gistPublic :: Bool + ,gistComments :: Int + ,gistUpdatedAt :: GithubDate + ,gistHtmlUrl :: String + ,gistId :: Name Gist + ,gistFiles :: [GistFile] + ,gistGitPullUrl :: String } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Gist data GistFile = GistFile { - gistFileType :: String - ,gistFileRawUrl :: String - ,gistFileSize :: Int + gistFileType :: String + ,gistFileRawUrl :: String + ,gistFileSize :: Int ,gistFileLanguage :: Maybe String ,gistFileFilename :: String - ,gistFileContent :: Maybe String + ,gistFileContent :: Maybe String } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData GistFile data GistComment = GistComment { - gistCommentUser :: GithubOwner - ,gistCommentUrl :: String + gistCommentUser :: GithubOwner + ,gistCommentUrl :: String ,gistCommentCreatedAt :: GithubDate - ,gistCommentBody :: String + ,gistCommentBody :: String ,gistCommentUpdatedAt :: GithubDate - ,gistCommentId :: Int + ,gistCommentId :: Id GistComment } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData GistComment \ No newline at end of file +instance NFData GistComment diff --git a/Github/Gists.hs b/Github/Gists.hs index 6f2f2c94..feb16ec8 100644 --- a/Github/Gists.hs +++ b/Github/Gists.hs @@ -1,35 +1,51 @@ -- | The gists API as described at . module Github.Gists ( - gists -,gists' -,gist -,gist' -,module Github.Data -) where + gists, + gists', + gistsR, + gist, + gist', + gistR, + module Github.Data, + ) where +import Github.Auth import Github.Data -import Github.Private +import Github.Request --- | The list of all gists created by the user --- +-- | The list of all gists created by the user +-- -- > gists' (Just ("github-username", "github-password")) "mike-burns" -gists' :: Maybe GithubAuth -> String -> IO (Either Error [Gist]) -gists' auth userName = githubGet' auth ["users", userName, "gists"] +gists' :: Maybe GithubAuth -> Name GithubOwner -> IO (Either Error [Gist]) +gists' auth user = + executeRequestMaybe auth $ gistsR user -- | The list of all public gists created by the user. -- -- > gists "mike-burns" -gists :: String -> IO (Either Error [Gist]) +gists :: Name GithubOwner -> IO (Either Error [Gist]) gists = gists' Nothing +-- | List gists. +-- See +gistsR :: Name GithubOwner -> GithubRequest k [Gist] +gistsR user = GithubGet ["users", untagName user, "gists"] "" + -- | A specific gist, given its id, with authentication credentials -- -- > gist' (Just ("github-username", "github-password")) "225074" -gist' :: Maybe GithubAuth -> String -> IO (Either Error Gist) -gist' auth reqGistId = githubGet' auth ["gists", reqGistId] +gist' :: Maybe GithubAuth -> Name Gist -> IO (Either Error Gist) +gist' auth gid = + executeRequestMaybe auth $ gistR gid -- | A specific gist, given its id. -- -- > gist "225074" -gist :: String -> IO (Either Error Gist) +gist :: Name Gist -> IO (Either Error Gist) gist = gist' Nothing + +-- | Get a single gist. +-- See +gistR :: Name Gist ->GithubRequest k Gist +gistR gid = + GithubGet ["gists", untagName gid] "" diff --git a/Github/Gists/Comments.hs b/Github/Gists/Comments.hs index b670bbc3..2664285e 100644 --- a/Github/Gists/Comments.hs +++ b/Github/Gists/Comments.hs @@ -1,22 +1,38 @@ -- | The loving comments people have left on Gists, described on -- . module Github.Gists.Comments ( - commentsOn -,comment -,module Github.Data -) where + commentsOn, + commentsOnR, + comment, + gistCommentR, + module Github.Data, + ) where import Github.Data -import Github.Private +import Github.Request -- | All the comments on a Gist, given the Gist ID. -- -- > commentsOn "1174060" -commentsOn :: String -> IO (Either Error [GistComment]) -commentsOn reqGistId = githubGet ["gists", reqGistId, "comments"] +commentsOn :: Name Gist -> IO (Either Error [GistComment]) +commentsOn gid = + executeRequest' $ commentsOnR gid + +-- | List comments on a gist. +-- See +commentsOnR :: Name Gist -> GithubRequest k [GistComment] +commentsOnR gid = + GithubGet ["gists", untagName gid, "comments"] "" -- | A specific comment, by the comment ID. -- --- > comment "62449" -comment :: String -> IO (Either Error GistComment) -comment reqCommentId = githubGet ["gists", "comments", reqCommentId] +-- > comment (Id 62449) +comment :: Id GistComment -> IO (Either Error GistComment) +comment cid = + executeRequest' $ gistCommentR cid + +-- | Get a single comment. +-- See +gistCommentR :: Id GistComment -> GithubRequest k GistComment +gistCommentR cid = + GithubGet ["gists", "comments", show $ untagId cid] "" From 139bcdba1756a8d20d221f0c1bc21b9355fc314d Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 5 Jan 2016 21:36:50 +0200 Subject: [PATCH 116/510] Add pull request endpoints to Github.All --- Github/All.hs | 25 ++++ Github/PullRequests.hs | 190 +++++++++++++++++--------- Github/PullRequests/ReviewComments.hs | 40 ++++-- Github/Request.hs | 30 ++-- 4 files changed, 200 insertions(+), 85 deletions(-) diff --git a/Github/All.hs b/Github/All.hs index 54e66f66..8143bb7f 100644 --- a/Github/All.hs +++ b/Github/All.hs @@ -125,6 +125,29 @@ module Github.All ( deleteTeamMembershipForR, listTeamsCurrentR, + -- * Pull Requests + -- | See + pullRequestsForR, + pullRequestR, + createPullRequestR, + updatePullRequestR, + pullRequestCommitsR, + pullRequestFilesR, + isPullRequestMergedR, + mergePullRequestR, + + -- ** Review comments + -- | See + -- + -- Missing endpoints: + -- + -- * List comments in a repository + -- * Create a comment + -- * Edit a comment + -- * Delete a comment + pullRequestReviewCommentsR, + pullRequestReviewCommentR, + -- * Search -- | See -- @@ -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 diff --git a/Github/PullRequests.hs b/Github/PullRequests.hs index b15a364b..5140a918 100644 --- a/Github/PullRequests.hs +++ b/Github/PullRequests.hs @@ -1,126 +1,194 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings, DataKinds #-} -- | The pull requests API as documented at -- . 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 +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 +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 +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 +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 +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 +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 +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 diff --git a/Github/PullRequests/ReviewComments.hs b/Github/PullRequests/ReviewComments.hs index cd7de72f..d33b7c24 100644 --- a/Github/PullRequests/ReviewComments.hs +++ b/Github/PullRequests/ReviewComments.hs @@ -1,24 +1,38 @@ -- | The pull request review comments API as described at -- . 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 +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 +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] "" diff --git a/Github/Request.hs b/Github/Request.hs index f01b2ed4..0723625c 100644 --- a/Github/Request.hs +++ b/Github/Request.hs @@ -28,6 +28,7 @@ import Data.Aeson.Compat (FromJSON) import Data.Typeable (Typeable) import GHC.Generics (Generic) import Network.HTTP.Conduit (Manager, httpLbs, newManager, tlsManagerSettings) +import Network.HTTP.Types (Status) import qualified Data.ByteString.Lazy as LBS import qualified Network.HTTP.Types.Method as Method @@ -66,13 +67,13 @@ toMethod Put = Method.methodPut -- -- TODO: Add constructor for collection fetches. data GithubRequest (k :: Bool) a where - GithubGet :: Paths -> QueryString -> GithubRequest k a - GithubPost :: PostMethod -> Paths -> LBS.ByteString -> GithubRequest 'True a + GithubGet :: FromJSON a => Paths -> QueryString -> GithubRequest k a + GithubPost :: FromJSON a => PostMethod -> Paths -> LBS.ByteString -> GithubRequest 'True a GithubDelete :: Paths -> GithubRequest 'True () + GithubStatus :: GithubRequest k () -> GithubRequest k Status deriving (Typeable) deriving instance Eq (GithubRequest k a) -deriving instance Ord (GithubRequest k a) instance Show (GithubRequest k a) where showsPrec d r = @@ -92,6 +93,9 @@ instance Show (GithubRequest k a) where GithubDelete ps -> showParen (d > appPrec) $ showString "GithubDelete " . showsPrec (appPrec + 1) ps + GithubStatus req -> showParen (d > appPrec) $ + showString "GithubStatus " + . showsPrec (appPrec + 1) req where appPrec = 10 :: Int ------------------------------------------------------------------------------ @@ -99,7 +103,7 @@ instance Show (GithubRequest k a) where ------------------------------------------------------------------------------ -- | Execute 'GithubRequest' in 'IO' -executeRequest :: (FromJSON a, Show a) +executeRequest :: Show a => GithubAuth -> GithubRequest k a -> IO (Either Error a) executeRequest auth req = do manager <- newManager tlsManagerSettings @@ -110,7 +114,7 @@ executeRequest auth req = do pure x -- | Like 'executeRequest' but with provided 'Manager'. -executeRequestWithMgr :: (FromJSON a, Show a) +executeRequestWithMgr :: Show a => Manager -> GithubAuth -> GithubRequest k a @@ -135,11 +139,13 @@ executeRequestWithMgr mgr auth req = Private.githubAPIDelete' getResponse auth (Private.buildPath paths) + GithubStatus _req' -> + error "executeRequestWithMgr GithubStatus not implemented" where getResponse = flip httpLbs mgr -- | Like 'executeRequest' but without authentication. -executeRequest' :: (FromJSON a, Show a) +executeRequest' :: Show a => GithubRequest 'False a -> IO (Either Error a) executeRequest' req = do manager <- newManager tlsManagerSettings @@ -150,10 +156,10 @@ executeRequest' req = do pure x -- | Like 'executeRequestWithMgr' but without authentication. -executeRequestWithMgr' :: (FromJSON a, Show a) - => Manager - -> GithubRequest 'False a - -> IO (Either Error a) +executeRequestWithMgr' :: Show a + => Manager + -> GithubRequest 'False a + -> IO (Either Error a) executeRequestWithMgr' mgr req = case req of GithubGet paths qs -> @@ -164,13 +170,15 @@ executeRequestWithMgr' mgr req = Nothing where qs' | null qs = "" | otherwise = '?' : qs + GithubStatus (GithubGet _paths _qs) -> + error "executeRequestWithMgr' GithubStatus not implemented" where getResponse = flip httpLbs mgr -- | Helper for picking between 'executeRequest' and 'executeRequest''. -- -- The use is discouraged. -executeRequestMaybe :: (FromJSON a, Show a) +executeRequestMaybe :: Show a => Maybe GithubAuth -> GithubRequest 'False a -> IO (Either Error a) executeRequestMaybe = maybe executeRequest' executeRequest From 7c5f68124262a86093d07a844240b0bd41b90795 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Wed, 6 Jan 2016 00:07:12 +0200 Subject: [PATCH 117/510] Add git data to Github.All --- Github/All.hs | 37 ++++++++++++++--- Github/GitData/Blobs.hs | 27 ++++++++----- Github/GitData/Commits.hs | 20 ++++++--- Github/GitData/References.hs | 78 +++++++++++++++++++++++++----------- Github/GitData/Trees.hs | 46 +++++++++++++-------- 5 files changed, 147 insertions(+), 61 deletions(-) diff --git a/Github/All.hs b/Github/All.hs index 8143bb7f..62a2e2b1 100644 --- a/Github/All.hs +++ b/Github/All.hs @@ -30,11 +30,33 @@ module Github.All ( -- * Delete a comment commentsOnR, gistCommentR, - + + -- * Git Data + -- | See + + -- ** Blobs + -- | See + blobR, + + -- ** Commits + -- | See + commitR, + + -- ** References + -- | See + referenceR, + referencesR, + createReferenceR, + + -- ** Trees + -- | See + treeR, + nestedTreeR, + -- * Issues -- | See -- - -- Missing endpoints: + -- Missing endpoints: -- -- * List issues issueR, @@ -77,7 +99,7 @@ module Github.All ( -- ** Milestone -- | See - -- + -- -- Missing endpoints: -- -- * Create a milestone @@ -185,13 +207,17 @@ module Github.All ( ) where import Github.Data +import Github.Gists +import Github.Gists.Comments +import Github.GitData.Blobs +import Github.GitData.Commits +import Github.GitData.References +import Github.GitData.Trees import Github.Issues import Github.Issues.Comments import Github.Issues.Events import Github.Issues.Labels import Github.Issues.Milestones -import Github.Gists -import Github.Gists.Comments import Github.Organizations import Github.Organizations.Members import Github.Organizations.Teams @@ -200,3 +226,4 @@ import Github.PullRequests.ReviewComments import Github.Search import Github.Users import Github.Users.Followers + diff --git a/Github/GitData/Blobs.hs b/Github/GitData/Blobs.hs index f1868668..bf6d24e1 100644 --- a/Github/GitData/Blobs.hs +++ b/Github/GitData/Blobs.hs @@ -1,24 +1,31 @@ -- | The API for dealing with git blobs from Github repos, as described in -- . module Github.GitData.Blobs ( - blob -,blob' -,module Github.Data -) where + blob, + blob', + blobR, + module Github.Data, + ) where +import Github.Auth import Github.Data -import Github.Private +import Github.Request -- | Get a blob by SHA1. -- -- > blob' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" "bc5c51d1ece1ee45f94b056a0f5a1674d7e8cba9" -blob' :: Maybe GithubAuth -> String -> String -> String -> IO (Either Error Blob) -blob' auth user reqRepoName sha = - githubGet' auth ["repos", user, reqRepoName, "git", "blobs", sha] - +blob' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> Name Blob -> IO (Either Error Blob) +blob' auth user repo sha = + executeRequestMaybe auth $ blobR user repo sha -- | Get a blob by SHA1. -- -- > blob "thoughtbot" "paperclip" "bc5c51d1ece1ee45f94b056a0f5a1674d7e8cba9" -blob :: String -> String -> String -> IO (Either Error Blob) +blob :: Name GithubOwner -> Name Repo -> Name Blob -> IO (Either Error Blob) blob = blob' Nothing + +-- | Get a blob. +-- See +blobR :: Name GithubOwner -> Name Repo -> Name Blob -> GithubRequest k Blob +blobR user repo sha = + GithubGet ["repos", untagName user, untagName repo, "git", "blobs", untagName sha] "" diff --git a/Github/GitData/Commits.hs b/Github/GitData/Commits.hs index 07cd7bbb..51d65e3f 100644 --- a/Github/GitData/Commits.hs +++ b/Github/GitData/Commits.hs @@ -1,16 +1,24 @@ -- | The API for underlying git commits of a Github repo, as described on -- . module Github.GitData.Commits ( - commit -,module Github.Data + commit, + commitR, + module Github.Data, ) where import Github.Data -import Github.Private +import Github.Request -- | A single commit, by SHA1. -- -- > commit "thoughtbot" "paperclip" "bc5c51d1ece1ee45f94b056a0f5a1674d7e8cba9" -commit :: String -> String -> String -> IO (Either Error GitCommit) -commit user reqRepoName sha = - githubGet ["repos", user, reqRepoName, "git", "commits", sha] +commit :: Name GithubOwner -> Name Repo -> Name GitCommit -> IO (Either Error GitCommit) +commit user repo sha = + executeRequest' $ commitR user repo sha + + +-- | Get a commit. +-- See +commitR :: Name GithubOwner -> Name Repo -> Name GitCommit -> GithubRequest k GitCommit +commitR user repo sha = + GithubGet ["repos", untagName user, untagName repo, "git", "commits", untagName sha] "" diff --git a/Github/GitData/References.hs b/Github/GitData/References.hs index a29f3be5..3b22d70a 100644 --- a/Github/GitData/References.hs +++ b/Github/GitData/References.hs @@ -1,53 +1,83 @@ +{-# LANGUAGE DataKinds #-} -- | The underlying git references on a Github repo, exposed for the world to -- see. The git internals documentation will also prove handy for understanding -- these. API documentation at . module Github.GitData.References ( - reference -,reference' -,references -,references' -,createReference -,namespacedReferences -,module Github.Data -) where + reference, + reference', + referenceR, + references, + references', + referencesR, + createReference, + createReferenceR, + namespacedReferences, + module Github.Data, + ) where +import Data.Aeson.Compat (encode) +import Github.Auth import Github.Data -import Github.Private +import Github.Request -- | A single reference by the ref name. -- -- > reference' (Just ("github-username", "github-password")) "mike-burns" "github" "heads/master" -reference' :: Maybe GithubAuth -> String -> String -> String -> IO (Either Error GitReference) -reference' auth user reqRepoName ref = - githubGet' auth ["repos", user, reqRepoName, "git", "refs", ref] +reference' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> Name GitReference -> IO (Either Error GitReference) +reference' auth user repo ref = + executeRequestMaybe auth $ referenceR user repo ref -- | A single reference by the ref name. -- -- > reference "mike-burns" "github" "heads/master" -reference :: String -> String -> String -> IO (Either Error GitReference) +reference :: Name GithubOwner -> Name Repo -> Name GitReference -> IO (Either Error GitReference) reference = reference' Nothing +-- | Get a reference. +-- See +referenceR :: Name GithubOwner -> Name Repo -> Name GitReference -> GithubRequest k GitReference +referenceR user repo ref = + GithubGet ["repos", untagName user, untagName repo, "git", "refs", untagName ref] "" + -- | The history of references for a repo. -- -- > references "mike-burns" "github" -references' :: Maybe GithubAuth -> String -> String -> IO (Either Error [GitReference]) -references' auth user reqRepoName = - githubGet' auth ["repos", user, reqRepoName, "git", "refs"] +references' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error [GitReference]) +references' auth user repo = + executeRequestMaybe auth $ referencesR user repo -- | The history of references for a repo. -- -- > references "mike-burns" "github" -references :: String -> String -> IO (Either Error [GitReference]) +references :: Name GithubOwner -> Name Repo -> IO (Either Error [GitReference]) references = references' Nothing - -createReference :: GithubAuth -> String -> String -> NewGitReference -> IO (Either Error GitReference) -createReference auth owner reqRepoName newRef = - githubPost auth ["repos", owner, reqRepoName, "git", "refs"] newRef +-- | Get all References. +-- See +referencesR :: Name GithubOwner -> Name Repo -> GithubRequest k [GitReference] +referencesR user repo = + GithubGet ["repos", untagName user, untagName repo, "git", "refs"] "" + +-- | Create a reference. +createReference :: GithubAuth -> Name GithubOwner -> Name Repo -> NewGitReference -> IO (Either Error GitReference) +createReference auth user repo newRef = + executeRequest auth $ createReferenceR user repo newRef + +-- | Create a reference. +-- See +createReferenceR :: Name GithubOwner -> Name Repo -> NewGitReference -> GithubRequest 'True GitReference +createReferenceR user repo newRef = + GithubPost Post ["repos", untagName user, untagName repo , "git", "refs"] (encode newRef) -- | Limited references by a namespace. -- -- > namespacedReferences "thoughtbot" "paperclip" "tags" -namespacedReferences :: String -> String -> String -> IO (Either Error [GitReference]) -namespacedReferences user reqRepoName namespace = - githubGet ["repos", user, reqRepoName, "git", "refs", namespace] +namespacedReferences :: Name GithubOwner -> Name Repo -> String -> IO (Either Error [GitReference]) +namespacedReferences user repo namespace = + executeRequest' $ namespacedReferencesR user repo namespace + +-- | Get namespaced references. +-- See +namespacedReferencesR :: Name GithubOwner -> Name Repo -> String -> GithubRequest k [GitReference] +namespacedReferencesR user repo namespace = + GithubGet ["repos", untagName user, untagName repo, "git", "refs", namespace] "" diff --git a/Github/GitData/Trees.hs b/Github/GitData/Trees.hs index 56ea062a..95d10d67 100644 --- a/Github/GitData/Trees.hs +++ b/Github/GitData/Trees.hs @@ -1,39 +1,53 @@ -- | The underlying tree of SHA1s and files that make up a git repo. The API is -- described on . module Github.GitData.Trees ( - tree -,tree' -,nestedTree -,nestedTree' -,module Github.Data -) where + tree, + tree', + treeR, + nestedTree, + nestedTree', + nestedTreeR, + module Github.Data, + ) where +import Github.Auth import Github.Data -import Github.Private +import Github.Request -- | A tree for a SHA1. -- -- > tree (Just ("github-username", "github-password")) "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844" -tree' :: Maybe GithubAuth -> String -> String -> String -> IO (Either Error Tree) -tree' auth user reqRepoName sha = - githubGet' auth ["repos", user, reqRepoName, "git", "trees", sha] +tree' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> Name Tree -> IO (Either Error Tree) +tree' auth user repo sha = + executeRequestMaybe auth $ treeR user repo sha -- | A tree for a SHA1. -- -- > tree "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844" -tree :: String -> String -> String -> IO (Either Error Tree) +tree :: Name GithubOwner -> Name Repo -> Name Tree -> IO (Either Error Tree) tree = tree' Nothing +-- | Get a Tree. +-- See +treeR :: Name GithubOwner -> Name Repo -> Name Tree -> GithubRequest k Tree +treeR user repo sha = + GithubGet ["repos", untagName user, untagName repo, "git", "trees", untagName sha] "" + -- | A recursively-nested tree for a SHA1. -- -- > nestedTree' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844" -nestedTree' :: Maybe GithubAuth -> String -> String -> String -> IO (Either Error Tree) -nestedTree' auth user reqRepoName sha = - githubGetWithQueryString' auth ["repos", user, reqRepoName, "git", "trees", sha] - "recursive=1" +nestedTree' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> Name Tree -> IO (Either Error Tree) +nestedTree' auth user repo sha = + executeRequestMaybe auth $ nestedTreeR user repo sha -- | A recursively-nested tree for a SHA1. -- -- > nestedTree "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844" -nestedTree :: String -> String -> String -> IO (Either Error Tree) +nestedTree :: Name GithubOwner -> Name Repo -> Name Tree -> IO (Either Error Tree) nestedTree = nestedTree' Nothing + +-- | Get a Tree Recursively. +-- See +nestedTreeR :: Name GithubOwner -> Name Repo -> Name Tree -> GithubRequest k Tree +nestedTreeR user repo sha = + GithubGet ["repos", untagName user, untagName repo, "git", "trees", untagName sha] "recursive=1" From daef745c540273366382251bbef2eea31c2c6a44 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Wed, 6 Jan 2016 11:20:46 +0200 Subject: [PATCH 118/510] Add activity endpoints to Github.All --- Github/Activity/Starring.hs | 51 ++++++++++++++++++++++++++++++++++ Github/Activity/Watching.hs | 55 +++++++++++++++++++++++++++++++++++++ Github/All.hs | 40 +++++++++++++++++++++++++-- Github/Repos/Starring.hs | 28 ------------------- Github/Repos/Subscribing.hs | 39 -------------------------- Github/Repos/Watching.hs | 39 -------------------------- github.cabal | 5 ++-- 7 files changed, 146 insertions(+), 111 deletions(-) create mode 100644 Github/Activity/Starring.hs create mode 100644 Github/Activity/Watching.hs delete mode 100644 Github/Repos/Starring.hs delete mode 100644 Github/Repos/Subscribing.hs delete mode 100644 Github/Repos/Watching.hs diff --git a/Github/Activity/Starring.hs b/Github/Activity/Starring.hs new file mode 100644 index 00000000..915c6b97 --- /dev/null +++ b/Github/Activity/Starring.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE DataKinds #-} +-- | The repo starring API as described on +-- . +module Github.Activity.Starring ( + stargazersFor, + stargazersForR, + reposStarredBy, + reposStarredByR, + myStarred, + myStarredR, + module Github.Data, + ) where + +import Github.Auth +import Github.Data +import Github.Request + +-- | The list of users that have starred the specified Github repo. +-- +-- > userInfoFor' Nothing "mike-burns" +stargazersFor :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error [GithubOwner]) +stargazersFor auth user repo = + executeRequestMaybe auth $ stargazersForR user repo + +-- | List Stargazers. +-- See +stargazersForR :: Name GithubOwner -> Name Repo -> GithubRequest k [GithubOwner] +stargazersForR user repo = + GithubGet ["repos", untagName user, untagName repo, "stargazers"] "" + +-- | All the public repos starred by the specified user. +-- +-- > reposStarredBy Nothing "croaky" +reposStarredBy :: Maybe GithubAuth -> Name GithubOwner -> IO (Either Error [Repo]) +reposStarredBy auth user = + executeRequestMaybe auth $ reposStarredByR user + +-- | List repositories being starred. +-- See +reposStarredByR :: Name GithubOwner -> GithubRequest k [Repo] +reposStarredByR user = + GithubGet ["users", untagName user, "starred"] "" + +-- | All the repos starred by the authenticated user. +myStarred :: GithubAuth -> IO (Either Error [Repo]) +myStarred auth = + executeRequest auth $ myStarredR + +-- | All the repos starred by the authenticated user. +myStarredR :: GithubRequest 'True [Repo] +myStarredR = GithubGet ["user", "starred"] "" diff --git a/Github/Activity/Watching.hs b/Github/Activity/Watching.hs new file mode 100644 index 00000000..0ca19d49 --- /dev/null +++ b/Github/Activity/Watching.hs @@ -0,0 +1,55 @@ +-- | The repo watching API as described on +-- . +module Github.Activity.Watching ( + watchersFor, + watchersFor', + watchersForR, + reposWatchedBy, + reposWatchedBy', + reposWatchedByR, + module Github.Data, +) where + +import Github.Auth +import Github.Data +import Github.Request + +-- | The list of users that are watching the specified Github repo. +-- +-- > watchersFor "thoughtbot" "paperclip" +watchersFor :: Name GithubOwner -> Name Repo -> IO (Either Error [GithubOwner]) +watchersFor = watchersFor' Nothing + +-- | The list of users that are watching the specified Github repo. +-- With authentication +-- +-- > watchersFor' (Just (GithubUser (user, password))) "thoughtbot" "paperclip" +watchersFor' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error [GithubOwner]) +watchersFor' auth user repo = + executeRequestMaybe auth $ watchersForR user repo + +-- | List watchers. +-- See +watchersForR :: Name GithubOwner -> Name Repo -> GithubRequest k [GithubOwner] +watchersForR user repo = + GithubGet ["repos", untagName user, untagName repo, "watchers"] "" + +-- | All the public repos watched by the specified user. +-- +-- > reposWatchedBy "croaky" +reposWatchedBy :: Name GithubOwner -> IO (Either Error [Repo]) +reposWatchedBy = reposWatchedBy' Nothing + +-- | All the public repos watched by the specified user. +-- With authentication +-- +-- > reposWatchedBy' (Just (GithubUser (user, password))) "croaky" +reposWatchedBy' :: Maybe GithubAuth -> Name GithubOwner -> IO (Either Error [Repo]) +reposWatchedBy' auth user = + executeRequestMaybe auth $ reposWatchedByR user + +-- | List repositories being watched. +-- See +reposWatchedByR :: Name GithubOwner -> GithubRequest k [Repo] +reposWatchedByR user = + GithubGet ["users", untagName user, "subscriptions"] "" diff --git a/Github/All.hs b/Github/All.hs index 62a2e2b1..62742db4 100644 --- a/Github/All.hs +++ b/Github/All.hs @@ -3,7 +3,33 @@ -- This module re-exports all request constructrors and -- data definitions from this package. module Github.All ( - -- * Gists + -- * Activity + -- | See + + -- ** Starring + -- | See + -- + -- Missing endpoints: + -- + -- * Check if you are starring a repository + -- * Star a repository + -- * Unstar a repository + stargazersForR, + reposStarredByR, + myStarredR, + + -- ** Watching + -- | See + -- + -- Missing endpoints: + -- + -- * Get a Repository Subscription + -- * Set a Repository Subscription + -- * Delete a Repository Subscription + watchersForR, + reposWatchedByR, + + -- * Gists -- | See -- -- Missing endpoints: @@ -170,6 +196,15 @@ module Github.All ( pullRequestReviewCommentsR, pullRequestReviewCommentR, + -- * Repositories + -- | See + + -- ** Collaborators + + -- ** Commits + + -- ** Forks + -- * Search -- | See -- @@ -206,6 +241,8 @@ module Github.All ( module Github.Data ) where +import Github.Activity.Starring +import Github.Activity.Watching import Github.Data import Github.Gists import Github.Gists.Comments @@ -226,4 +263,3 @@ import Github.PullRequests.ReviewComments import Github.Search import Github.Users import Github.Users.Followers - diff --git a/Github/Repos/Starring.hs b/Github/Repos/Starring.hs deleted file mode 100644 index 79d6f95f..00000000 --- a/Github/Repos/Starring.hs +++ /dev/null @@ -1,28 +0,0 @@ --- | The repo starring API as described on --- . -module Github.Repos.Starring ( - stargazersFor -,reposStarredBy -,myStarred -,module Github.Data -) where - -import Github.Data -import Github.Private - --- | The list of users that have starred the specified Github repo. --- --- > userInfoFor' Nothing "mike-burns" -stargazersFor :: Maybe GithubAuth -> String -> String -> IO (Either Error [GithubOwner]) -stargazersFor auth userName reqRepoName = - githubGet' auth ["repos", userName, reqRepoName, "stargazers"] - --- | All the public repos starred by the specified user. --- --- > reposStarredBy Nothing "croaky" -reposStarredBy :: Maybe GithubAuth -> String -> IO (Either Error [Repo]) -reposStarredBy auth userName = githubGet' auth ["users", userName, "starred"] - --- | All the repos starred by the authenticated user. -myStarred :: GithubAuth -> IO (Either Error [Repo]) -myStarred auth = githubGet' (Just auth) ["user", "starred"] diff --git a/Github/Repos/Subscribing.hs b/Github/Repos/Subscribing.hs deleted file mode 100644 index 8f848b7d..00000000 --- a/Github/Repos/Subscribing.hs +++ /dev/null @@ -1,39 +0,0 @@ --- | The repo subscribing API as described on --- . -module Github.Repos.Subscribing ( - subscribersFor -,subscribersFor' -,reposSubscribedToBy -,reposSubscribedToBy' -,module Github.Data -) where - -import Github.Data -import Github.Private - --- | The list of users that are subscribed to the specified Github repo. --- --- > subscribersFor "thoughtbot" "paperclip" -subscribersFor :: String -> String -> IO (Either Error [GithubOwner]) -subscribersFor = subscribersFor' Nothing - --- | The list of users that are subscribed to the specified Github repo. --- | With authentication --- --- > subscribersFor' (Just (GithubUser (user, password))) "thoughtbot" "paperclip" -subscribersFor' :: Maybe GithubAuth -> String -> String -> IO (Either Error [GithubOwner]) -subscribersFor' auth userName reqRepoName = - githubGet' auth ["repos", userName, reqRepoName, "subscribers"] - --- | All the public repos subscribed to by the specified user. --- --- > reposSubscribedToBy "croaky" -reposSubscribedToBy :: String -> IO (Either Error [Repo]) -reposSubscribedToBy = reposSubscribedToBy' Nothing - --- | All the public repos subscribed to by the specified user. --- | With authentication --- --- > reposSubscribedToBy' (Just (GithubUser (user, password))) "croaky" -reposSubscribedToBy' :: Maybe GithubAuth -> String -> IO (Either Error [Repo]) -reposSubscribedToBy' auth userName = githubGet' auth ["users", userName, "subscriptions"] diff --git a/Github/Repos/Watching.hs b/Github/Repos/Watching.hs deleted file mode 100644 index 63238446..00000000 --- a/Github/Repos/Watching.hs +++ /dev/null @@ -1,39 +0,0 @@ --- | The repo watching API as described on --- . -module Github.Repos.Watching ( - watchersFor -,watchersFor' -,reposWatchedBy -,reposWatchedBy' -,module Github.Data -) where - -import Github.Data -import Github.Private - --- | The list of users that are watching the specified Github repo. --- --- > watchersFor "thoughtbot" "paperclip" -watchersFor :: String -> String -> IO (Either Error [GithubOwner]) -watchersFor = watchersFor' Nothing - --- | The list of users that are watching the specified Github repo. --- | With authentication --- --- > watchersFor' (Just (GithubUser (user, password))) "thoughtbot" "paperclip" -watchersFor' :: Maybe GithubAuth -> String -> String -> IO (Either Error [GithubOwner]) -watchersFor' auth userName reqRepoName = - githubGet' auth ["repos", userName, reqRepoName, "watchers"] - --- | All the public repos watched by the specified user. --- --- > reposWatchedBy "croaky" -reposWatchedBy :: String -> IO (Either Error [Repo]) -reposWatchedBy = reposWatchedBy' Nothing - --- | All the public repos watched by the specified user. --- | With authentication --- --- > reposWatchedBy' (Just (GithubUser (user, password))) "croaky" -reposWatchedBy' :: Maybe GithubAuth -> String -> IO (Either Error [Repo]) -reposWatchedBy' auth userName = githubGet' auth ["users", userName, "watched"] diff --git a/github.cabal b/github.cabal index 99a5b926..aada1b88 100644 --- a/github.cabal +++ b/github.cabal @@ -109,6 +109,8 @@ Library Default-Language: Haskell2010 GHC-Options: -Wall Exposed-modules: Github.All, + Github.Activity.Starring, + Github.Activity.Watching, Github.Auth, Github.Data, Github.Data.Definitions, @@ -140,9 +142,6 @@ Library Github.Repos.Collaborators, Github.Repos.Commits, Github.Repos.Forks, - Github.Repos.Watching, - Github.Repos.Starring, - Github.Repos.Subscribing, Github.Repos.Webhooks Github.Repos.Webhooks.Validate, Github.Users, From b0a90e877a14c59f3375403eda0afa40cf71b954 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Wed, 6 Jan 2016 12:14:17 +0200 Subject: [PATCH 119/510] Add repos endpoints to Github.All --- Github/All.hs | 56 ++++- Github/Data.hs | 118 +++++++-- Github/Data/Definitions.hs | 286 +++++++++------------- Github/Data/Repos.hs | 46 ++++ Github/Data/Webhooks.hs | 88 +++++++ Github/GitData/Commits.hs | 8 +- Github/Repos.hs | 445 +++++++++++++++++----------------- Github/Repos/Collaborators.hs | 64 +++-- Github/Repos/Comments.hs | 79 ++++++ Github/Repos/Commits.hs | 132 +++++----- Github/Repos/Forks.hs | 26 +- Github/Repos/Webhooks.hs | 222 ++++++++--------- github.cabal | 9 +- 13 files changed, 926 insertions(+), 653 deletions(-) create mode 100644 Github/Data/Repos.hs create mode 100644 Github/Data/Webhooks.hs create mode 100644 Github/Repos/Comments.hs diff --git a/Github/All.hs b/Github/All.hs index 62742db4..b0b2955f 100644 --- a/Github/All.hs +++ b/Github/All.hs @@ -2,6 +2,8 @@ -- -- This module re-exports all request constructrors and -- data definitions from this package. +-- +-- The missing endpoints lists are exhausive, they indicate endpoints we know are missing. module Github.All ( -- * Activity -- | See @@ -66,7 +68,7 @@ module Github.All ( -- ** Commits -- | See - commitR, + gitCommitR, -- ** References -- | See @@ -198,16 +200,60 @@ module Github.All ( -- * Repositories -- | See + -- + -- Missing endpoints: + -- * List your repositories + -- * List all public repositories + -- * List Teams + -- * Get Branch + -- * Enabling and disabling branch protection + userReposR, -- ** Collaborators + -- | See + collaboratorsOnR, + isCollaboratorOnR, + + -- ** Comments + -- | See + -- + -- Missing endpoints: + -- + -- * Create a commit comment + -- * Update a commit comment + -- * Delete a commit comment + commentsForR, + commitCommentsForR, + commitCommentForR, -- ** Commits + -- | See + commitsForR, + commitsWithOptionsForR, + commitR, + diffR, -- ** Forks + -- | See + -- + -- Missing endpoints: + -- + -- * Create a fork + forksForR, + + -- ** Webhooks + -- | See + webhooksForR, + webhookForR, + createRepoWebhookR, + editRepoWebhookR, + testPushRepoWebhookR, + pingRepoWebhookR, + deleteRepoWebhookR, -- * Search -- | See - -- + -- -- Missing endpoints: -- -- * Search users @@ -260,6 +306,12 @@ import Github.Organizations.Members import Github.Organizations.Teams import Github.PullRequests import Github.PullRequests.ReviewComments +import Github.Repos +import Github.Repos.Collaborators +import Github.Repos.Comments +import Github.Repos.Commits +import Github.Repos.Forks +import Github.Repos.Webhooks import Github.Search import Github.Users import Github.Users.Followers diff --git a/Github/Data.hs b/Github/Data.hs index ad54e03d..382c1e0c 100644 --- a/Github/Data.hs +++ b/Github/Data.hs @@ -1,4 +1,6 @@ -{-# LANGUAGE CPP, DeriveDataTypeable, OverloadedStrings #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- | This module re-exports the @Github.Data.Definitions@ module, adding @@ -6,34 +8,37 @@ -- instances, use the @Github.Data.Definitions@ module instead. module Github.Data ( - -- * Module re-exports - module Github.Data.Definitions, - module Github.Data.Gists, - module Github.Data.GitData, - module Github.Data.Issues, - module Github.Data.PullRequests, - module Github.Data.Teams, - -- * Tagged types - -- ** Name - Name, - mkName, - untagName, - -- ** Id - Id, - mkId, - untagId, - ) where + -- * Module re-exports + module Github.Data.Definitions, + module Github.Data.Gists, + module Github.Data.GitData, + module Github.Data.Issues, + module Github.Data.PullRequests, + module Github.Data.Repos, + module Github.Data.Teams, + module Github.Data.Webhooks, + + -- * Tagged types + -- ** Name + Name, + mkName, + untagName, + -- ** Id + Id, + mkId, + untagId, + ) where #if !MIN_VERSION_base(4,8,0) import Control.Applicative #endif -import Control.Monad -import qualified Data.Text as T -import Data.Aeson.Compat -import Data.Aeson.Types (Parser) -import qualified Data.Vector as V +import Control.Monad +import Data.Aeson.Compat +import Data.Aeson.Types (Parser) +import Data.Hashable (Hashable) import qualified Data.HashMap.Lazy as Map -import Data.Hashable (Hashable) +import qualified Data.Text as T +import qualified Data.Vector as V #if MIN_VERSION_time(1,5,0) import Data.Time @@ -49,7 +54,9 @@ import Github.Data.Id import Github.Data.Issues import Github.Data.Name import Github.Data.PullRequests +import Github.Data.Repos import Github.Data.Teams +import Github.Data.Webhooks instance FromJSON GithubDate where parseJSON (String t) = @@ -589,6 +596,42 @@ instance FromJSON Repo where <*> o .: "stargazers_count" parseJSON _ = fail "Could not build a Repo" +instance ToJSON NewRepo where + toJSON (NewRepo { newRepoName = name + , newRepoDescription = description + , newRepoHomepage = homepage + , newRepoPrivate = private + , newRepoHasIssues = hasIssues + , newRepoHasWiki = hasWiki + , newRepoAutoInit = autoInit + }) = object + [ "name" .= name + , "description" .= description + , "homepage" .= homepage + , "private" .= private + , "has_issues" .= hasIssues + , "has_wiki" .= hasWiki + , "auto_init" .= autoInit + ] + +instance ToJSON EditRepo where + toJSON (EditRepo { editName = name + , editDescription = description + , editHomepage = homepage + , editPublic = public + , editHasIssues = hasIssues + , editHasWiki = hasWiki + , editHasDownloads = hasDownloads + }) = object + [ "name" .= name + , "description" .= description + , "homepage" .= homepage + , "public" .= public + , "has_issues" .= hasIssues + , "has_wiki" .= hasWiki + , "has_downloads" .= hasDownloads + ] + instance FromJSON SearchCodeResult where parseJSON (Object o) = SearchCodeResult <$> o .: "total_count" @@ -827,6 +870,33 @@ instance FromJSON RepoWebhookResponse where <*> o .: "message" parseJSON _ = fail "Could not build a RepoWebhookResponse" +instance ToJSON NewRepoWebhook where + toJSON (NewRepoWebhook { newRepoWebhookName = name + , newRepoWebhookConfig = config + , newRepoWebhookEvents = events + , newRepoWebhookActive = active + + }) = object + [ "name" .= name + , "config" .= config + , "events" .= events + , "active" .= active + ] + +instance ToJSON EditRepoWebhook where + toJSON (EditRepoWebhook { editRepoWebhookConfig = config + , editRepoWebhookEvents = events + , editRepoWebhookAddEvents = addEvents + , editRepoWebhookRemoveEvents = removeEvents + , editRepoWebhookActive = active + }) = object + [ "config" .= config + , "events" .= events + , "add_events" .= addEvents + , "remove_events" .= removeEvents + , "active" .= active + ] + instance FromJSON Content where parseJSON o@(Object _) = ContentFile <$> parseJSON o parseJSON (Array os) = ContentDirectory <$> (mapM parseJSON $ V.toList os) diff --git a/Github/Data/Definitions.hs b/Github/Data/Definitions.hs index 53326806..a35f32a2 100644 --- a/Github/Data/Definitions.hs +++ b/Github/Data/Definitions.hs @@ -1,13 +1,13 @@ -{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} module Github.Data.Definitions where -import Control.DeepSeq (NFData) -import Data.Time -import Data.Data -import GHC.Generics (Generic) +import Control.DeepSeq (NFData) import qualified Control.Exception as E -import qualified Data.Map as M +import Data.Data +import Data.Time +import GHC.Generics (Generic) import Github.Data.Id import Github.Data.Name @@ -36,41 +36,41 @@ newtype GithubDate = GithubDate { fromGithubDate :: UTCTime } instance NFData GithubDate data GithubOwner = GithubUser { - githubOwnerAvatarUrl :: String - ,githubOwnerLogin :: Name GithubOwner - ,githubOwnerUrl :: String - ,githubOwnerId :: Id GithubOwner + githubOwnerAvatarUrl :: String + ,githubOwnerLogin :: Name GithubOwner + ,githubOwnerUrl :: String + ,githubOwnerId :: Id GithubOwner ,githubOwnerGravatarId :: Maybe String } | GithubOrganization { githubOwnerAvatarUrl :: String - ,githubOwnerLogin :: Name GithubOwner - ,githubOwnerUrl :: String - ,githubOwnerId :: Id GithubOwner + ,githubOwnerLogin :: Name GithubOwner + ,githubOwnerUrl :: String + ,githubOwnerId :: Id GithubOwner } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData GithubOwner data Stats = Stats { statsAdditions :: Int - ,statsTotal :: Int + ,statsTotal :: Int ,statsDeletions :: Int } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Stats data Comment = Comment { - commentPosition :: Maybe Int - ,commentLine :: Maybe Int - ,commentBody :: String - ,commentCommitId :: Maybe String + commentPosition :: Maybe Int + ,commentLine :: Maybe Int + ,commentBody :: String + ,commentCommitId :: Maybe String ,commentUpdatedAt :: UTCTime - ,commentHtmlUrl :: Maybe String - ,commentUrl :: String + ,commentHtmlUrl :: Maybe String + ,commentUrl :: String ,commentCreatedAt :: Maybe UTCTime - ,commentPath :: Maybe String - ,commentUser :: GithubOwner - ,commentId :: Id Comment + ,commentPath :: Maybe String + ,commentUser :: GithubOwner + ,commentId :: Id Comment } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Comment @@ -88,71 +88,71 @@ data EditComment = EditComment { instance NFData EditComment data SimpleOrganization = SimpleOrganization { - simpleOrganizationUrl :: String + simpleOrganizationUrl :: String ,simpleOrganizationAvatarUrl :: String - ,simpleOrganizationId :: Id Organization - ,simpleOrganizationLogin :: String + ,simpleOrganizationId :: Id Organization + ,simpleOrganizationLogin :: String } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData SimpleOrganization data Organization = Organization { - organizationType :: String - ,organizationBlog :: Maybe String - ,organizationLocation :: Maybe String - ,organizationLogin :: Name Organization - ,organizationFollowers :: Int - ,organizationCompany :: Maybe String - ,organizationAvatarUrl :: String + organizationType :: String + ,organizationBlog :: Maybe String + ,organizationLocation :: Maybe String + ,organizationLogin :: Name Organization + ,organizationFollowers :: Int + ,organizationCompany :: Maybe String + ,organizationAvatarUrl :: String ,organizationPublicGists :: Int - ,organizationHtmlUrl :: String - ,organizationEmail :: Maybe String - ,organizationFollowing :: Int + ,organizationHtmlUrl :: String + ,organizationEmail :: Maybe String + ,organizationFollowing :: Int ,organizationPublicRepos :: Int - ,organizationUrl :: String - ,organizationCreatedAt :: GithubDate - ,organizationName :: Maybe String - ,organizationId :: Id Organization + ,organizationUrl :: String + ,organizationCreatedAt :: GithubDate + ,organizationName :: Maybe String + ,organizationId :: Id Organization } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Organization data SearchReposResult = SearchReposResult { searchReposTotalCount :: Int - ,searchReposRepos :: [Repo] + ,searchReposRepos :: [Repo] } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData SearchReposResult data Repo = Repo { - repoSshUrl :: Maybe String - ,repoDescription :: Maybe String - ,repoCreatedAt :: Maybe GithubDate - ,repoHtmlUrl :: String - ,repoSvnUrl :: Maybe String - ,repoForks :: Maybe Int - ,repoHomepage :: Maybe String - ,repoFork :: Maybe Bool - ,repoGitUrl :: Maybe String - ,repoPrivate :: Bool - ,repoCloneUrl :: Maybe String - ,repoSize :: Maybe Int - ,repoUpdatedAt :: Maybe GithubDate - ,repoWatchers :: Maybe Int - ,repoOwner :: GithubOwner - ,repoName :: Name Repo - ,repoLanguage :: Maybe String - ,repoMasterBranch :: Maybe String - ,repoPushedAt :: Maybe GithubDate -- ^ this is Nothing for new repositories - ,repoId :: Id Repo - ,repoUrl :: String - ,repoOpenIssues :: Maybe Int - ,repoHasWiki :: Maybe Bool - ,repoHasIssues :: Maybe Bool - ,repoHasDownloads :: Maybe Bool - ,repoParent :: Maybe RepoRef - ,repoSource :: Maybe RepoRef - ,repoHooksUrl :: String + repoSshUrl :: Maybe String + ,repoDescription :: Maybe String + ,repoCreatedAt :: Maybe GithubDate + ,repoHtmlUrl :: String + ,repoSvnUrl :: Maybe String + ,repoForks :: Maybe Int + ,repoHomepage :: Maybe String + ,repoFork :: Maybe Bool + ,repoGitUrl :: Maybe String + ,repoPrivate :: Bool + ,repoCloneUrl :: Maybe String + ,repoSize :: Maybe Int + ,repoUpdatedAt :: Maybe GithubDate + ,repoWatchers :: Maybe Int + ,repoOwner :: GithubOwner + ,repoName :: Name Repo + ,repoLanguage :: Maybe String + ,repoMasterBranch :: Maybe String + ,repoPushedAt :: Maybe GithubDate -- ^ this is Nothing for new repositories + ,repoId :: Id Repo + ,repoUrl :: String + ,repoOpenIssues :: Maybe Int + ,repoHasWiki :: Maybe Bool + ,repoHasIssues :: Maybe Bool + ,repoHasDownloads :: Maybe Bool + ,repoParent :: Maybe RepoRef + ,repoSource :: Maybe RepoRef + ,repoHooksUrl :: String ,repoStargazersCount :: Int } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -165,19 +165,19 @@ instance NFData RepoRef data SearchCodeResult = SearchCodeResult { searchCodeTotalCount :: Int - ,searchCodeCodes :: [Code] + ,searchCodeCodes :: [Code] } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData SearchCodeResult data Code = Code { - codeName :: String - ,codePath :: String - ,codeSha :: String - ,codeUrl :: String - ,codeGitUrl :: String + codeName :: String + ,codePath :: String + ,codeSha :: String + ,codeUrl :: String + ,codeGitUrl :: String ,codeHtmlUrl :: String - ,codeRepo :: Repo + ,codeRepo :: Repo } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Code @@ -190,10 +190,10 @@ data Content instance NFData Content data ContentFileData = ContentFileData { - contentFileInfo :: ContentInfo + contentFileInfo :: ContentInfo ,contentFileEncoding :: String - ,contentFileSize :: Int - ,contentFileContent :: String + ,contentFileSize :: Int + ,contentFileContent :: String } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData ContentFileData @@ -213,11 +213,11 @@ instance NFData ContentItemType -- | Information common to both kinds of Content: files and directories. data ContentInfo = ContentInfo { - contentName :: String - ,contentPath :: String - ,contentSha :: String - ,contentUrl :: String - ,contentGitUrl :: String + contentName :: String + ,contentPath :: String + ,contentSha :: String + ,contentUrl :: String + ,contentGitUrl :: String ,contentHtmlUrl :: String } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -247,99 +247,43 @@ data Language = Language String Int instance NFData Language data DetailedOwner = DetailedUser { - detailedOwnerCreatedAt :: GithubDate - ,detailedOwnerType :: String + detailedOwnerCreatedAt :: GithubDate + ,detailedOwnerType :: String ,detailedOwnerPublicGists :: Int - ,detailedOwnerAvatarUrl :: String - ,detailedOwnerFollowers :: Int - ,detailedOwnerFollowing :: Int - ,detailedOwnerHireable :: Maybe Bool - ,detailedOwnerGravatarId :: Maybe String - ,detailedOwnerBlog :: Maybe String - ,detailedOwnerBio :: Maybe String + ,detailedOwnerAvatarUrl :: String + ,detailedOwnerFollowers :: Int + ,detailedOwnerFollowing :: Int + ,detailedOwnerHireable :: Maybe Bool + ,detailedOwnerGravatarId :: Maybe String + ,detailedOwnerBlog :: Maybe String + ,detailedOwnerBio :: Maybe String ,detailedOwnerPublicRepos :: Int - ,detailedOwnerName :: Maybe String - ,detailedOwnerLocation :: Maybe String - ,detailedOwnerCompany :: Maybe String - ,detailedOwnerEmail :: Maybe String - ,detailedOwnerUrl :: String - ,detailedOwnerId :: Id GithubOwner - ,detailedOwnerHtmlUrl :: String - ,detailedOwnerLogin :: Name GithubOwner + ,detailedOwnerName :: Maybe String + ,detailedOwnerLocation :: Maybe String + ,detailedOwnerCompany :: Maybe String + ,detailedOwnerEmail :: Maybe String + ,detailedOwnerUrl :: String + ,detailedOwnerId :: Id GithubOwner + ,detailedOwnerHtmlUrl :: String + ,detailedOwnerLogin :: Name GithubOwner } | DetailedOrganization { - detailedOwnerCreatedAt :: GithubDate - ,detailedOwnerType :: String + detailedOwnerCreatedAt :: GithubDate + ,detailedOwnerType :: String ,detailedOwnerPublicGists :: Int - ,detailedOwnerAvatarUrl :: String - ,detailedOwnerFollowers :: Int - ,detailedOwnerFollowing :: Int - ,detailedOwnerBlog :: Maybe String - ,detailedOwnerBio :: Maybe String + ,detailedOwnerAvatarUrl :: String + ,detailedOwnerFollowers :: Int + ,detailedOwnerFollowing :: Int + ,detailedOwnerBlog :: Maybe String + ,detailedOwnerBio :: Maybe String ,detailedOwnerPublicRepos :: Int - ,detailedOwnerName :: Maybe String - ,detailedOwnerLocation :: Maybe String - ,detailedOwnerCompany :: Maybe String - ,detailedOwnerUrl :: String - ,detailedOwnerId :: Id GithubOwner - ,detailedOwnerHtmlUrl :: String - ,detailedOwnerLogin :: Name GithubOwner + ,detailedOwnerName :: Maybe String + ,detailedOwnerLocation :: Maybe String + ,detailedOwnerCompany :: Maybe String + ,detailedOwnerUrl :: String + ,detailedOwnerId :: Id GithubOwner + ,detailedOwnerHtmlUrl :: String + ,detailedOwnerLogin :: Name GithubOwner } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData DetailedOwner - -data RepoWebhook = RepoWebhook { - repoWebhookUrl :: String - ,repoWebhookTestUrl :: String - ,repoWebhookId :: Id RepoWebhook - ,repoWebhookName :: String - ,repoWebhookActive :: Bool - ,repoWebhookEvents :: [RepoWebhookEvent] - ,repoWebhookConfig :: M.Map String String - ,repoWebhookLastResponse :: RepoWebhookResponse - ,repoWebhookUpdatedAt :: GithubDate - ,repoWebhookCreatedAt :: GithubDate -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData RepoWebhook - -data RepoWebhookEvent = - WebhookWildcardEvent - | WebhookCommitCommentEvent - | WebhookCreateEvent - | WebhookDeleteEvent - | WebhookDeploymentEvent - | WebhookDeploymentStatusEvent - | WebhookForkEvent - | WebhookGollumEvent - | WebhookIssueCommentEvent - | WebhookIssuesEvent - | WebhookMemberEvent - | WebhookPageBuildEvent - | WebhookPublicEvent - | WebhookPullRequestReviewCommentEvent - | WebhookPullRequestEvent - | WebhookPushEvent - | WebhookReleaseEvent - | WebhookStatusEvent - | WebhookTeamAddEvent - | WebhookWatchEvent - deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData RepoWebhookEvent - -data RepoWebhookResponse = RepoWebhookResponse { - repoWebhookResponseCode :: Maybe Int - ,repoWebhookResponseStatus :: String - ,repoWebhookResponseMessage :: Maybe String -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData RepoWebhookResponse - -data PingEvent = PingEvent { - pingEventZen :: String - ,pingEventHook :: RepoWebhook - ,pingEventHookId :: Id RepoWebhook -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData PingEvent diff --git a/Github/Data/Repos.hs b/Github/Data/Repos.hs new file mode 100644 index 00000000..884c2557 --- /dev/null +++ b/Github/Data/Repos.hs @@ -0,0 +1,46 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +module Github.Data.Repos where + +import Github.Data.Definitions +import Github.Data.Name + +import Control.DeepSeq (NFData) +import Data.Data (Data, Typeable) +import GHC.Generics (Generic) + +data NewRepo = NewRepo { + newRepoName :: Name Repo +, newRepoDescription :: (Maybe String) +, newRepoHomepage :: (Maybe String) +, newRepoPrivate :: (Maybe Bool) +, newRepoHasIssues :: (Maybe Bool) +, newRepoHasWiki :: (Maybe Bool) +, newRepoAutoInit :: (Maybe Bool) +} deriving (Eq, Ord, Show, Data, Typeable, Generic) + +instance NFData NewRepo + +newRepo :: Name Repo -> NewRepo +newRepo name = NewRepo name Nothing Nothing Nothing Nothing Nothing Nothing + +data EditRepo = EditRepo { + editName :: Maybe (Name Repo) +, editDescription :: Maybe String +, editHomepage :: Maybe String +, editPublic :: Maybe Bool +, editHasIssues :: Maybe Bool +, editHasWiki :: Maybe Bool +, editHasDownloads :: Maybe Bool +} deriving (Eq, Ord, Show, Data, Typeable, Generic) + +instance NFData EditRepo + +-- | Filter the list of the user's repos using any of these constructors. +data RepoPublicity = + All -- ^ All repos accessible to the user. + | Owner -- ^ Only repos owned by the user. + | Public -- ^ Only public repos. + | Private -- ^ Only private repos. + | Member -- ^ Only repos to which the user is a member but not an owner. + deriving (Show, Eq, Ord, Typeable, Data, Generic) diff --git a/Github/Data/Webhooks.hs b/Github/Data/Webhooks.hs new file mode 100644 index 00000000..8f77aba4 --- /dev/null +++ b/Github/Data/Webhooks.hs @@ -0,0 +1,88 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} +module Github.Data.Webhooks where + +import Github.Data.Definitions +import Github.Data.Id + +import Control.DeepSeq (NFData) +import Data.Data (Data, Typeable) +import GHC.Generics (Generic) + +import qualified Data.Map as M + +data RepoWebhook = RepoWebhook { + repoWebhookUrl :: String + ,repoWebhookTestUrl :: String + ,repoWebhookId :: Id RepoWebhook + ,repoWebhookName :: String + ,repoWebhookActive :: Bool + ,repoWebhookEvents :: [RepoWebhookEvent] + ,repoWebhookConfig :: M.Map String String + ,repoWebhookLastResponse :: RepoWebhookResponse + ,repoWebhookUpdatedAt :: GithubDate + ,repoWebhookCreatedAt :: GithubDate +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData RepoWebhook + +data RepoWebhookEvent = + WebhookWildcardEvent + | WebhookCommitCommentEvent + | WebhookCreateEvent + | WebhookDeleteEvent + | WebhookDeploymentEvent + | WebhookDeploymentStatusEvent + | WebhookForkEvent + | WebhookGollumEvent + | WebhookIssueCommentEvent + | WebhookIssuesEvent + | WebhookMemberEvent + | WebhookPageBuildEvent + | WebhookPublicEvent + | WebhookPullRequestReviewCommentEvent + | WebhookPullRequestEvent + | WebhookPushEvent + | WebhookReleaseEvent + | WebhookStatusEvent + | WebhookTeamAddEvent + | WebhookWatchEvent + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData RepoWebhookEvent + +data RepoWebhookResponse = RepoWebhookResponse { + repoWebhookResponseCode :: Maybe Int + ,repoWebhookResponseStatus :: String + ,repoWebhookResponseMessage :: Maybe String +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData RepoWebhookResponse + +data PingEvent = PingEvent { + pingEventZen :: String + ,pingEventHook :: RepoWebhook + ,pingEventHookId :: Id RepoWebhook +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData PingEvent + +data NewRepoWebhook = NewRepoWebhook { + newRepoWebhookName :: String + ,newRepoWebhookConfig :: M.Map String String + ,newRepoWebhookEvents :: Maybe [RepoWebhookEvent] + ,newRepoWebhookActive :: Maybe Bool +} deriving (Eq, Ord, Show, Typeable, Data, Generic) + +instance NFData NewRepoWebhook + +data EditRepoWebhook = EditRepoWebhook { + editRepoWebhookConfig :: Maybe (M.Map String String) + ,editRepoWebhookEvents :: Maybe [RepoWebhookEvent] + ,editRepoWebhookAddEvents :: Maybe [RepoWebhookEvent] + ,editRepoWebhookRemoveEvents :: Maybe [RepoWebhookEvent] + ,editRepoWebhookActive :: Maybe Bool +} deriving (Eq, Ord, Show, Typeable, Data, Generic) + +instance NFData EditRepoWebhook diff --git a/Github/GitData/Commits.hs b/Github/GitData/Commits.hs index 51d65e3f..3d2a42ef 100644 --- a/Github/GitData/Commits.hs +++ b/Github/GitData/Commits.hs @@ -2,7 +2,7 @@ -- . module Github.GitData.Commits ( commit, - commitR, + gitCommitR, module Github.Data, ) where @@ -14,11 +14,11 @@ import Github.Request -- > commit "thoughtbot" "paperclip" "bc5c51d1ece1ee45f94b056a0f5a1674d7e8cba9" commit :: Name GithubOwner -> Name Repo -> Name GitCommit -> IO (Either Error GitCommit) commit user repo sha = - executeRequest' $ commitR user repo sha + executeRequest' $ gitCommitR user repo sha -- | Get a commit. -- See -commitR :: Name GithubOwner -> Name Repo -> Name GitCommit -> GithubRequest k GitCommit -commitR user repo sha = +gitCommitR :: Name GithubOwner -> Name Repo -> Name GitCommit -> GithubRequest k GitCommit +gitCommitR user repo sha = GithubGet ["repos", untagName user, untagName repo, "git", "commits", untagName sha] "" diff --git a/Github/Repos.hs b/Github/Repos.hs index 1f880739..d9e3070f 100644 --- a/Github/Repos.hs +++ b/Github/Repos.hs @@ -1,68 +1,63 @@ -{-# LANGUAGE OverloadedStrings, DeriveGeneric, DeriveDataTypeable #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} -- | The Github Repos API, as documented at -- module Github.Repos ( - --- * Querying repositories - userRepos -,userRepos' -,userRepo -,userRepo' -,organizationRepos -,organizationRepos' -,organizationRepo -,organizationRepo' -,contributors -,contributors' -,contributorsWithAnonymous -,contributorsWithAnonymous' -,languagesFor -,languagesFor' -,tagsFor -,tagsFor' -,branchesFor -,branchesFor' -,contentsFor -,contentsFor' -,readmeFor -,readmeFor' -,module Github.Data -,RepoPublicity(..) - --- ** Create -,createRepo -,createOrganizationRepo -,newRepo -,NewRepo(..) - --- ** Edit -,editRepo -,def -,Edit(..) - --- ** Delete -,deleteRepo -) where - -import Data.Data -import Data.Default -import Data.Aeson.Types + -- * Querying repositories + userRepos, + userRepos', + userReposR, + organizationRepos, + organizationRepos', + organizationReposR, + repository, + repository', + repositoryR, + contributors, + contributors', + contributorsR, + contributorsWithAnonymous, + contributorsWithAnonymous', + languagesFor, + languagesFor', + languagesForR, + tagsFor, + tagsFor', + tagsForR, + branchesFor, + branchesFor', + branchesForR, + contentsFor, + contentsFor', + readmeFor, + readmeFor', + + -- ** Create + createRepo', + createRepoR, + createOrganizationRepo', + createOrganizationRepoR, + + -- ** Edit + editRepo, + editRepoR, + + -- ** Delete + deleteRepo, + deleteRepoR, + + -- * Data + module Github.Data, + ) where + +import Control.Applicative ((<|>)) +import Data.Aeson.Compat (encode) + +import Github.Auth import Github.Data -import Github.Private -import GHC.Generics (Generic) -import Control.Applicative -import Control.DeepSeq (NFData) - --- | Filter the list of the user's repos using any of these constructors. -data RepoPublicity = - All -- ^ All repos accessible to the user. - | Owner -- ^ Only repos owned by the user. - | Public -- ^ Only public repos. - | Private -- ^ Only private repos. - | Member -- ^ Only repos to which the user is a member but not an owner. - deriving (Show, Eq, Ord, Typeable, Data, Generic) - -instance NFData RepoPublicity +import Github.Request repoPublicityQueryString :: RepoPublicity -> String repoPublicityQueryString All = "type=all" @@ -75,80 +70,146 @@ repoPublicityQueryString Private = "type=private" -- own, are a member of, or publicize. Private repos will return empty list. -- -- > userRepos "mike-burns" All -userRepos :: String -> RepoPublicity -> IO (Either Error [Repo]) +userRepos :: Name GithubOwner -> RepoPublicity -> IO (Either Error [Repo]) userRepos = userRepos' Nothing -- | The repos for a user, by their login. -- With authentication. -- -- > userRepos' (Just (GithubBasicAuth (user, password))) "mike-burns" All -userRepos' :: Maybe GithubAuth -> String -> RepoPublicity -> IO (Either Error [Repo]) -userRepos' auth userName publicity = - githubGetWithQueryString' auth ["users", userName, "repos"] qs - where qs = repoPublicityQueryString publicity +userRepos' :: Maybe GithubAuth -> Name GithubOwner -> RepoPublicity -> IO (Either Error [Repo]) +userRepos' auth user publicity = + executeRequestMaybe auth $ userReposR user publicity + +-- | List user repositories. +-- See +userReposR :: Name GithubOwner -> RepoPublicity -> GithubRequest k [Repo] +userReposR user publicity = + GithubGet ["users", untagName user, "repos"] qs + where + qs = repoPublicityQueryString publicity -- | The repos for an organization, by the organization name. -- -- > organizationRepos "thoughtbot" -organizationRepos :: String -> IO (Either Error [Repo]) +organizationRepos :: Name Organization -> IO (Either Error [Repo]) organizationRepos org = organizationRepos' Nothing org All -- | The repos for an organization, by the organization name. -- With authentication. -- -- > organizationRepos (Just (GithubBasicAuth (user, password))) "thoughtbot" All -organizationRepos' :: Maybe GithubAuth -> String -> RepoPublicity -> IO (Either Error [Repo]) -organizationRepos' auth orgName publicity = - githubGetWithQueryString' auth ["orgs", orgName, "repos"] qs - where qs = repoPublicityQueryString publicity - - --- | A specific organization repo, by the organization name. --- --- > organizationRepo "thoughtbot" "github" -organizationRepo :: String -> String -> IO (Either Error Repo) -organizationRepo = organizationRepo' Nothing - --- | A specific organization repo, by the organization name. --- With authentication. --- --- > organizationRepo (Just (GithubBasicAuth (user, password))) "thoughtbot" "github" -organizationRepo' :: Maybe GithubAuth -> String -> String -> IO (Either Error Repo) -organizationRepo' auth orgName reqRepoName = githubGet' auth ["orgs", orgName, reqRepoName] +organizationRepos' :: Maybe GithubAuth -> Name Organization -> RepoPublicity -> IO (Either Error [Repo]) +organizationRepos' auth org publicity = + executeRequestMaybe auth $ organizationReposR org publicity + +-- | List organization repositories. +-- See +organizationReposR :: Name Organization -> RepoPublicity -> GithubRequest k [Repo] +organizationReposR org publicity = + GithubGet ["orgs", untagName org, "repos"] qs + where + qs = repoPublicityQueryString publicity -- | Details on a specific repo, given the owner and repo name. -- -- > userRepo "mike-burns" "github" -userRepo :: String -> String -> IO (Either Error Repo) -userRepo = userRepo' Nothing +repository :: Name GithubOwner -> Name Repo -> IO (Either Error Repo) +repository = repository' Nothing -- | Details on a specific repo, given the owner and repo name. -- With authentication. -- -- > userRepo' (Just (GithubBasicAuth (user, password))) "mike-burns" "github" -userRepo' :: Maybe GithubAuth -> String -> String -> IO (Either Error Repo) -userRepo' auth userName reqRepoName = githubGet' auth ["repos", userName, reqRepoName] +repository' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error Repo) +repository' auth user repo = + executeRequestMaybe auth $ repositoryR user repo + +-- | Get single repository. +-- See +repositoryR :: Name GithubOwner -> Name Repo -> GithubRequest k Repo +repositoryR user repo = + GithubGet ["repos", untagName user, untagName repo] "" + +-- | Create a new repository. +-- +-- > createRepo' (GithubBasicAuth (user, password)) (newRepo "some_repo") {newRepoHasIssues = Just False} +createRepo' :: GithubAuth -> NewRepo -> IO (Either Error Repo) +createRepo' auth nrepo = + executeRequest auth $ createRepoR nrepo + +-- | Create a new repository. +-- See +createRepoR :: NewRepo -> GithubRequest 'True Repo +createRepoR nrepo = + GithubPost Post ["user", "repos"] (encode nrepo) + +-- | Create a new repository for an organization. +-- +-- > createOrganizationRepo (GithubBasicAuth (user, password)) "thoughtbot" (newRepo "some_repo") {newRepoHasIssues = Just False} +createOrganizationRepo' :: GithubAuth -> Name Organization -> NewRepo -> IO (Either Error Repo) +createOrganizationRepo' auth org nrepo = + executeRequest auth $ createOrganizationRepoR org nrepo + +-- | Create a new repository for an organization. +-- See +createOrganizationRepoR :: Name Organization -> NewRepo -> GithubRequest 'True Repo +createOrganizationRepoR org nrepo = + GithubPost Post ["orgs", untagName org, "repos"] (encode nrepo) + +-- | Edit an existing repository. +-- +-- > editRepo (GithubBasicAuth (user, password)) "some_user" "some_repo" def {editDescription = Just "some description"} +editRepo :: GithubAuth + -> Name GithubOwner -- ^ owner + -> Name Repo -- ^ repository name + -> EditRepo + -> IO (Either Error Repo) +editRepo auth user repo body = + executeRequest auth $ editRepoR user repo body + + +-- | Edit an existing repository. +-- See +editRepoR :: Name GithubOwner -> Name Repo -> EditRepo -> GithubRequest 'True Repo +editRepoR user repo body = + GithubPost Patch ["repos", untagName user, untagName repo] (encode b) + where + -- if no name is given, use curent name + b = body {editName = editName body <|> Just repo} -- | The contributors to a repo, given the owner and repo name. -- -- > contributors "thoughtbot" "paperclip" -contributors :: String -> String -> IO (Either Error [Contributor]) +contributors :: Name GithubOwner -> Name Repo -> IO (Either Error [Contributor]) contributors = contributors' Nothing -- | The contributors to a repo, given the owner and repo name. -- With authentication. -- -- > contributors' (Just (GithubBasicAuth (user, password))) "thoughtbot" "paperclip" -contributors' :: Maybe GithubAuth -> String -> String -> IO (Either Error [Contributor]) -contributors' auth userName reqRepoName = - githubGet' auth ["repos", userName, reqRepoName, "contributors"] +contributors' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error [Contributor]) +contributors' auth user repo = + executeRequestMaybe auth $ contributorsR user repo False + +-- | List contributors. +-- See +contributorsR :: Name GithubOwner + -> Name Repo + -> Bool -- ^ Include anonymous + -> GithubRequest k [Contributor] +contributorsR user repo anon = + GithubGet ["repos", untagName user, untagName repo, "contributors"] qs + where + qs | anon = "anon=true" + | otherwise = "" -- | The contributors to a repo, including anonymous contributors (such as -- deleted users or git commits with unknown email addresses), given the owner -- and repo name. -- -- > contributorsWithAnonymous "thoughtbot" "paperclip" -contributorsWithAnonymous :: String -> String -> IO (Either Error [Contributor]) +contributorsWithAnonymous :: Name GithubOwner -> Name Repo -> IO (Either Error [Contributor]) contributorsWithAnonymous = contributorsWithAnonymous' Nothing -- | The contributors to a repo, including anonymous contributors (such as @@ -157,18 +218,15 @@ contributorsWithAnonymous = contributorsWithAnonymous' Nothing -- With authentication. -- -- > contributorsWithAnonymous' (Just (GithubBasicAuth (user, password))) "thoughtbot" "paperclip" -contributorsWithAnonymous' :: Maybe GithubAuth -> String -> String -> IO (Either Error [Contributor]) -contributorsWithAnonymous' auth userName reqRepoName = - githubGetWithQueryString' auth - ["repos", userName, reqRepoName, "contributors"] - "anon=true" - +contributorsWithAnonymous' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error [Contributor]) +contributorsWithAnonymous' auth user repo = + executeRequestMaybe auth $ contributorsR user repo True -- | The programming languages used in a repo along with the number of -- characters written in that language. Takes the repo owner and name. -- -- > languagesFor "mike-burns" "ohlaunch" -languagesFor :: String -> String -> IO (Either Error [Language]) +languagesFor :: Name GithubOwner -> Name Repo -> IO (Either Error Languages) languagesFor = languagesFor' Nothing -- | The programming languages used in a repo along with the number of @@ -176,172 +234,105 @@ languagesFor = languagesFor' Nothing -- With authentication. -- -- > languagesFor' (Just (GithubBasicAuth (user, password))) "mike-burns" "ohlaunch" -languagesFor' :: Maybe GithubAuth -> String -> String -> IO (Either Error [Language]) -languagesFor' auth userName reqRepoName = do - result <- githubGet' auth ["repos", userName, reqRepoName, "languages"] - return $ either Left (Right . getLanguages) result +languagesFor' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error Languages) +languagesFor' auth user repo = + executeRequestMaybe auth $ languagesForR user repo + +-- | List languages. +-- See +languagesForR :: Name GithubOwner -> Name Repo -> GithubRequest k Languages +languagesForR user repo = + GithubGet ["repos", untagName user, untagName repo, "languages"] "" -- | The git tags on a repo, given the repo owner and name. -- -- > tagsFor "thoughtbot" "paperclip" -tagsFor :: String -> String -> IO (Either Error [Tag]) +tagsFor :: Name GithubOwner -> Name Repo -> IO (Either Error [Tag]) tagsFor = tagsFor' Nothing -- | The git tags on a repo, given the repo owner and name. -- With authentication. -- -- > tagsFor' (Just (GithubBasicAuth (user, password))) "thoughtbot" "paperclip" -tagsFor' :: Maybe GithubAuth -> String -> String -> IO (Either Error [Tag]) -tagsFor' auth userName reqRepoName = - githubGet' auth ["repos", userName, reqRepoName, "tags"] +tagsFor' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error [Tag]) +tagsFor' auth user repo = + executeRequestMaybe auth $ tagsForR user repo + +-- | List tags. +-- See +tagsForR :: Name GithubOwner -> Name Repo -> GithubRequest k [Tag] +tagsForR user repo = + GithubGet ["repos", untagName user, untagName repo, "tags"] "" -- | The git branches on a repo, given the repo owner and name. -- -- > branchesFor "thoughtbot" "paperclip" -branchesFor :: String -> String -> IO (Either Error [Branch]) +branchesFor :: Name GithubOwner -> Name Repo -> IO (Either Error [Branch]) branchesFor = branchesFor' Nothing -- | The git branches on a repo, given the repo owner and name. -- With authentication. -- -- > branchesFor' (Just (GithubBasicAuth (user, password))) "thoughtbot" "paperclip" -branchesFor' :: Maybe GithubAuth -> String -> String -> IO (Either Error [Branch]) -branchesFor' auth userName reqRepoName = - githubGet' auth ["repos", userName, reqRepoName, "branches"] +branchesFor' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error [Branch]) +branchesFor' auth user repo = + executeRequestMaybe auth $ branchesForR user repo + +-- | List branches. +-- See +branchesForR :: Name GithubOwner -> Name Repo -> GithubRequest k [Branch] +branchesForR user repo = + GithubGet ["repos", untagName user, untagName 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 :: String -> String -> String -> Maybe String -> IO (Either Error Content) +contentsFor :: Name GithubOwner -> Name Repo -> String -> Maybe String -> 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 (GithubBasicAuth (user, password))) "thoughtbot" "paperclip" "README.md" -contentsFor' :: Maybe GithubAuth -> String -> String -> String -> Maybe String -> IO (Either Error Content) -contentsFor' auth userName reqRepoName reqContentPath ref = - githubGetWithQueryString' auth - ["repos", userName, reqRepoName, "contents", reqContentPath] $ - maybe "" ("ref="++) ref +-- > contentsFor' (Just (GithubBasicAuth (user, password))) "thoughtbot" "paperclip" "README.md" Nothing +contentsFor' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> String -> Maybe String -> IO (Either Error Content) +contentsFor' auth user repo path ref = + executeRequestMaybe auth $ contentsForR user repo path ref + +contentsForR :: Name GithubOwner + -> Name Repo + -> String -- ^ file or directory + -> Maybe String -- ^ Git commit + -> GithubRequest k Content +contentsForR user repo path ref = + GithubGet ["repos", untagName user, untagName repo, "contents", path] qs + where + qs = maybe "" ("ref=" ++) ref -- | The contents of a README file in a repo, given the repo owner and name -- -- > readmeFor "thoughtbot" "paperclip" -readmeFor :: String -> String -> IO (Either Error Content) +readmeFor :: Name GithubOwner -> 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 (GithubBasicAuth (user, password))) "thoughtbot" "paperclip" -readmeFor' :: Maybe GithubAuth -> String -> String -> IO (Either Error Content) -readmeFor' auth userName reqRepoName = - githubGetWithQueryString' auth - ["repos", userName, reqRepoName, "readme"] $ - "" - -data NewRepo = NewRepo { - newRepoName :: String -, newRepoDescription :: (Maybe String) -, newRepoHomepage :: (Maybe String) -, newRepoPrivate :: (Maybe Bool) -, newRepoHasIssues :: (Maybe Bool) -, newRepoHasWiki :: (Maybe Bool) -, newRepoAutoInit :: (Maybe Bool) -} deriving (Eq, Ord, Show, Data, Typeable, Generic) - -instance NFData NewRepo - -instance ToJSON NewRepo where - toJSON (NewRepo { newRepoName = name - , newRepoDescription = description - , newRepoHomepage = homepage - , newRepoPrivate = private - , newRepoHasIssues = hasIssues - , newRepoHasWiki = hasWiki - , newRepoAutoInit = autoInit - }) = object - [ "name" .= name - , "description" .= description - , "homepage" .= homepage - , "private" .= private - , "has_issues" .= hasIssues - , "has_wiki" .= hasWiki - , "auto_init" .= autoInit - ] - -newRepo :: String -> NewRepo -newRepo name = NewRepo name Nothing Nothing Nothing Nothing Nothing Nothing - --- | --- Create a new repository. --- --- > createRepo (GithubBasicAuth (user, password)) (newRepo "some_repo") {newRepoHasIssues = Just False} -createRepo :: GithubAuth -> NewRepo -> IO (Either Error Repo) -createRepo auth = githubPost auth ["user", "repos"] +readmeFor' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error Content) +readmeFor' auth user repo = + executeRequestMaybe auth $ readmeForR user repo --- | --- Create a new repository for an organization. --- --- > createOrganizationRepo (GithubBasicAuth (user, password)) "thoughtbot" (newRepo "some_repo") {newRepoHasIssues = Just False} -createOrganizationRepo :: GithubAuth -> String -> NewRepo -> IO (Either Error Repo) -createOrganizationRepo auth org = githubPost auth ["orgs", org, "repos"] - -data Edit = Edit { - editName :: Maybe String -, editDescription :: Maybe String -, editHomepage :: Maybe String -, editPublic :: Maybe Bool -, editHasIssues :: Maybe Bool -, editHasWiki :: Maybe Bool -, editHasDownloads :: Maybe Bool -} deriving (Eq, Ord, Show, Data, Typeable, Generic) - -instance NFData Edit - -instance Default Edit where - def = Edit def def def def def def def - -instance ToJSON Edit where - toJSON (Edit { editName = name - , editDescription = description - , editHomepage = homepage - , editPublic = public - , editHasIssues = hasIssues - , editHasWiki = hasWiki - , editHasDownloads = hasDownloads - }) = object - [ "name" .= name - , "description" .= description - , "homepage" .= homepage - , "public" .= public - , "has_issues" .= hasIssues - , "has_wiki" .= hasWiki - , "has_downloads" .= hasDownloads - ] - --- | --- Edit an existing repository. --- --- > editRepo (GithubBasicAuth (user, password)) "some_user" "some_repo" def {editDescription = Just "some description"} -editRepo :: GithubAuth - -> String -- ^ owner - -> String -- ^ repository name - -> Edit - -> IO (Either Error Repo) -editRepo auth user repo body = githubPatch auth ["repos", user, repo] b - where - -- if no name is given, use curent name - b = body {editName = editName body <|> Just repo} +readmeForR :: Name GithubOwner -> Name Repo -> GithubRequest k Content +readmeForR user repo = + GithubGet ["repos", untagName user, untagName repo, "readme"] "" --- | --- Delete an existing repository. +-- | Delete an existing repository. -- -- > deleteRepo (GithubBasicAuth (user, password)) "thoughtbot" "some_repo" -deleteRepo :: GithubAuth - -> String -- ^ owner - -> String -- ^ repository name - -> IO (Either Error ()) -deleteRepo auth owner repo = - githubAPIDelete auth $ buildPath ["repos", owner, repo] +deleteRepo :: GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error ()) +deleteRepo auth user repo = + executeRequest auth $ deleteRepoR user repo + +deleteRepoR :: Name GithubOwner -> Name Repo -> GithubRequest 'True () +deleteRepoR user repo = + GithubDelete ["repos", untagName user, untagName repo] diff --git a/Github/Repos/Collaborators.hs b/Github/Repos/Collaborators.hs index 46472790..e53c80aa 100644 --- a/Github/Repos/Collaborators.hs +++ b/Github/Repos/Collaborators.hs @@ -1,43 +1,57 @@ -- | The repo collaborators API as described on -- . module Github.Repos.Collaborators ( - collaboratorsOn -,collaboratorsOn' -,isCollaboratorOn -,module Github.Data -) where + collaboratorsOn, + collaboratorsOn', + collaboratorsOnR, + isCollaboratorOn, + isCollaboratorOnR, + module Github.Data, + ) where +import Github.Auth import Github.Data -import Github.Private - -import Data.ByteString.Char8 (pack) -import qualified Network.HTTP.Conduit as C (responseStatus) -import qualified Network.HTTP.Types as T (statusCode) +import Github.Request +import Network.HTTP.Types (Status) -- | All the users who have collaborated on a repo. -- -- > collaboratorsOn "thoughtbot" "paperclip" -collaboratorsOn :: String -> String -> IO (Either Error [GithubOwner]) -collaboratorsOn userName reqRepoName = - githubGet ["repos", userName, reqRepoName, "collaborators"] +collaboratorsOn :: Name GithubOwner -> Name Repo -> IO (Either Error [GithubOwner]) +collaboratorsOn = collaboratorsOn' Nothing -- | All the users who have collaborated on a repo. -- With authentication. -collaboratorsOn' :: Maybe GithubAuth -> String -> String -> IO (Either Error [GithubOwner]) -collaboratorsOn' auth userName reqRepoName = - githubGet' auth ["repos", userName, reqRepoName, "collaborators"] +collaboratorsOn' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error [GithubOwner]) +collaboratorsOn' auth user repo = + executeRequestMaybe auth $ collaboratorsOnR user repo + +-- | List collaborators. +-- See +collaboratorsOnR :: Name GithubOwner -> Name Repo -> GithubRequest k [GithubOwner] +collaboratorsOnR user repo = + GithubGet ["repos", untagName user, untagName repo, "collaborators"] "" -- | Whether the user is collaborating on a repo. Takes the user in question, -- the user who owns the repo, and the repo name. -- -- > isCollaboratorOn Nothing "mike-burns" "thoughtbot" "paperclip" -- > isCollaboratorOn Nothing "johnson" "thoughtbot" "paperclip" -isCollaboratorOn :: Maybe GithubAuth -> String -> String -> String -> IO (Either Error Bool) -isCollaboratorOn auth userName repoOwnerName reqRepoName = do - result <- doHttps getResponseNewManager (pack "GET") - (apiEndpoint auth ++ buildPath ["repos", repoOwnerName, reqRepoName, "collaborators", userName]) - Nothing - Nothing - return $ either (Left . HTTPConnectionError) - (Right . (204 ==) . T.statusCode . C.responseStatus) - result +-- +-- TODO: GithubStatus +isCollaboratorOn :: Maybe GithubAuth + -> Name GithubOwner -- ^ Repository owner + -> Name Repo -- ^ Repository name + -> Name GithubOwner -- ^ Collaborator? + -> IO (Either Error Status) +isCollaboratorOn auth user repo coll = + executeRequestMaybe auth $ isCollaboratorOnR user repo coll + +-- | Check if a user is a collaborator. +-- See +isCollaboratorOnR :: Name GithubOwner -- ^ Repository owner + -> Name Repo -- ^ Repository name + -> Name GithubOwner -- ^ Collaborator? + -> GithubRequest k Status +isCollaboratorOnR user repo coll = GithubStatus $ + GithubGet ["repos", untagName user, untagName repo, "collaborators", untagName coll] "" diff --git a/Github/Repos/Comments.hs b/Github/Repos/Comments.hs new file mode 100644 index 00000000..d75d27a9 --- /dev/null +++ b/Github/Repos/Comments.hs @@ -0,0 +1,79 @@ +{-# LANGUAGE CPP #-} + +-- | The repo commits API as described on +-- . +module Github.Repos.Comments ( + commentsFor, + commentsFor', + commentsForR, + commitCommentsFor, + commitCommentsFor', + commitCommentsForR, + commitCommentFor, + commitCommentFor', + commitCommentForR, + module Github.Data, + ) where + +import Github.Data +import Github.Auth +import Github.Request + +-- | All the comments on a Github repo. +-- +-- > commentsFor "thoughtbot" "paperclip" +commentsFor :: Name GithubOwner -> Name Repo -> IO (Either Error [Comment]) +commentsFor = commentsFor' Nothing + +-- | All the comments on a Github repo. +-- With authentication. +-- +-- > commentsFor "thoughtbot" "paperclip" +commentsFor' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error [Comment]) +commentsFor' auth user repo = + executeRequestMaybe auth $ commentsForR user repo + +-- | List commit comments for a repository. +-- See +commentsForR :: Name GithubOwner -> Name Repo -> GithubRequest k [Comment] +commentsForR user repo = + GithubGet ["repos", untagName user, untagName repo, "comments"] "" + +-- | Just the comments on a specific SHA for a given Github repo. +-- +-- > commitCommentsFor "thoughtbot" "paperclip" "41f685f6e01396936bb8cd98e7cca517e2c7d96b" +commitCommentsFor :: Name GithubOwner -> Name Repo -> Name Commit -> IO (Either Error [Comment]) +commitCommentsFor = commitCommentsFor' Nothing + +-- | Just the comments on a specific SHA for a given Github repo. +-- With authentication. +-- +-- > commitCommentsFor "thoughtbot" "paperclip" "41f685f6e01396936bb8cd98e7cca517e2c7d96b" +commitCommentsFor' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> Name Commit -> IO (Either Error [Comment]) +commitCommentsFor' auth user repo sha = + executeRequestMaybe auth $ commitCommentsForR user repo sha + +-- | List comments for a single commit +-- See +commitCommentsForR :: Name GithubOwner -> Name Repo -> Name Commit -> GithubRequest k [Comment] +commitCommentsForR user repo sha = + GithubGet ["repos", untagName user, untagName repo, "commits", untagName sha, "comments"] "" + +-- | A comment, by its ID, relative to the Github repo. +-- +-- > commitCommentFor "thoughtbot" "paperclip" "669575" +commitCommentFor :: Name GithubOwner -> Name Repo -> Id Comment -> IO (Either Error Comment) +commitCommentFor = commitCommentFor' Nothing + +-- | A comment, by its ID, relative to the Github repo. +-- +-- > commitCommentFor "thoughtbot" "paperclip" "669575" +commitCommentFor' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> Id Comment -> IO (Either Error Comment) +commitCommentFor' auth user repo cid = + executeRequestMaybe auth $ commitCommentForR user repo cid + +-- | Get a single commit comment. +-- See +commitCommentForR :: Name GithubOwner -> Name Repo -> Id Comment -> GithubRequest k Comment +commitCommentForR user repo cid = + GithubGet ["repos", untagName user, untagName repo, "comments", show $ untagId cid] "" diff --git a/Github/Repos/Commits.hs b/Github/Repos/Commits.hs index ed4093a8..717865fa 100644 --- a/Github/Repos/Commits.hs +++ b/Github/Repos/Commits.hs @@ -3,31 +3,30 @@ -- | The repo commits API as described on -- . module Github.Repos.Commits ( - CommitQueryOption(..) -,commitsFor -,commitsFor' -,commitsWithOptionsFor -,commitsWithOptionsFor' -,commit -,commit' -,commentsFor -,commentsFor' -,commitCommentsFor -,commitCommentsFor' -,commitCommentFor -,commitCommentFor' -,diff -,diff' -,module Github.Data -) where - + CommitQueryOption(..), + commitsFor, + commitsFor', + commitsForR, + commitsWithOptionsFor, + commitsWithOptionsFor', + commitsWithOptionsForR, + commit, + commit', + commitR, + diff, + diff', + diffR, + module Github.Data, + ) where + +import Github.Auth import Github.Data -import Github.Private +import Github.Request import Data.Time.Format (formatTime) #if MIN_VERSION_time (1,5,0) +import Data.Time (defaultTimeLocale) import Data.Time.Format (iso8601DateFormat) -import Data.Time (defaultTimeLocale) #else import System.Locale (defaultTimeLocale) #endif @@ -52,17 +51,23 @@ renderCommitQueryOption (CommitQueryUntil date) = "until=" ++ ds ++ "Z" -- | The commit history for a repo. -- -- > commitsFor "mike-burns" "github" -commitsFor :: String -> String -> IO (Either Error [Commit]) +commitsFor :: Name GithubOwner -> Name Repo -> IO (Either Error [Commit]) commitsFor = commitsFor' Nothing -- | The commit history for a repo. -- With authentication. -- -- > commitsFor' (Just (GithubBasicAuth (user, password))) "mike-burns" "github" -commitsFor' :: Maybe GithubAuth -> String -> String -> IO (Either Error [Commit]) -commitsFor' auth user repo = githubGet' auth ["repos", user, repo, "commits"] +commitsFor' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error [Commit]) +commitsFor' auth user repo = + commitsWithOptionsFor' auth user repo [] + +-- | List commits on a repository. +-- See +commitsForR :: Name GithubOwner -> Name Repo -> GithubRequest k [Commit] +commitsForR user repo = commitsWithOptionsForR user repo [] -commitsWithOptionsFor :: String -> String -> [CommitQueryOption] -> IO (Either Error [Commit]) +commitsWithOptionsFor :: Name GithubOwner -> Name Repo -> [CommitQueryOption] -> IO (Either Error [Commit]) commitsWithOptionsFor = commitsWithOptionsFor' Nothing -- | The commit history for a repo, with commits filtered to satisfy a list of @@ -70,73 +75,54 @@ commitsWithOptionsFor = commitsWithOptionsFor' Nothing -- With authentication. -- -- > commitsWithOptionsFor' (Just (GithubBasicAuth (user, password))) "mike-burns" "github" [CommitQueryAuthor "djeik"] -commitsWithOptionsFor' :: Maybe GithubAuth -> String -> String -> [CommitQueryOption] -> IO (Either Error [Commit]) -commitsWithOptionsFor' auth user repo opts = githubGetWithQueryString' auth ["repos", user, repo, "commits"] qs - where qs = intercalate "&" $ map renderCommitQueryOption opts +commitsWithOptionsFor' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> [CommitQueryOption] -> IO (Either Error [Commit]) +commitsWithOptionsFor' auth user repo opts = + executeRequestMaybe auth $ commitsWithOptionsForR user repo opts + +-- | List commits on a repository. +-- See +commitsWithOptionsForR :: Name GithubOwner -> Name Repo -> [CommitQueryOption] -> GithubRequest k [Commit] +commitsWithOptionsForR user repo opts = + GithubGet ["repos", untagName user, untagName repo, "commits"] qs + where + qs = intercalate "&" $ map renderCommitQueryOption opts + -- | Details on a specific SHA1 for a repo. -- -- > commit "mike-burns" "github" "9d1a9a361266c3c890b1108ad2fdf52f824b1b81" -commit :: String -> String -> String -> IO (Either Error Commit) +commit :: Name GithubOwner -> Name Repo -> Name Commit -> IO (Either Error Commit) commit = commit' Nothing -- | Details on a specific SHA1 for a repo. -- With authentication. -- -- > commit (Just $ GithubBasicAuth (username, password)) "mike-burns" "github" "9d1a9a361266c3c890b1108ad2fdf52f824b1b81" -commit' :: Maybe GithubAuth -> String -> String -> String -> IO (Either Error Commit) -commit' auth user repo sha1 = githubGet' auth ["repos", user, repo, "commits", sha1] - +commit' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> Name Commit -> IO (Either Error Commit) +commit' auth user repo sha = + executeRequestMaybe auth $ commitR user repo sha --- | All the comments on a Github repo. --- --- > commentsFor "thoughtbot" "paperclip" -commentsFor :: String -> String -> IO (Either Error [Comment]) -commentsFor = commentsFor' Nothing - --- | All the comments on a Github repo. --- With authentication. --- --- > commentsFor "thoughtbot" "paperclip" -commentsFor' :: Maybe GithubAuth -> String -> String -> IO (Either Error [Comment]) -commentsFor' auth user repo = githubGet' auth ["repos", user, repo, "comments"] - --- | Just the comments on a specific SHA for a given Github repo. --- --- > commitCommentsFor "thoughtbot" "paperclip" "41f685f6e01396936bb8cd98e7cca517e2c7d96b" -commitCommentsFor :: String -> String -> String -> IO (Either Error [Comment]) -commitCommentsFor = commitCommentsFor' Nothing - --- | Just the comments on a specific SHA for a given Github repo. --- With authentication. --- --- > commitCommentsFor "thoughtbot" "paperclip" "41f685f6e01396936bb8cd98e7cca517e2c7d96b" -commitCommentsFor' :: Maybe GithubAuth -> String -> String -> String -> IO (Either Error [Comment]) -commitCommentsFor' auth user repo sha1 = - githubGet' auth ["repos", user, repo, "commits", sha1, "comments"] - --- | A comment, by its ID, relative to the Github repo. --- --- > commitCommentFor "thoughtbot" "paperclip" "669575" -commitCommentFor :: String -> String -> String -> IO (Either Error Comment) -commitCommentFor = commitCommentFor' Nothing - --- | A comment, by its ID, relative to the Github repo. --- --- > commitCommentFor "thoughtbot" "paperclip" "669575" -commitCommentFor' :: Maybe GithubAuth -> String -> String -> String -> IO (Either Error Comment) -commitCommentFor' auth user repo reqCommentId = - githubGet' auth ["repos", user, repo, "comments", reqCommentId] +-- | Get a single commit +-- See +commitR :: Name GithubOwner -> Name Repo -> Name Commit -> GithubRequest k Commit +commitR user repo sha = + GithubGet ["repos", untagName user, untagName repo, "commits", untagName sha] "" -- | The diff between two treeishes on a repo. -- -- > diff "thoughtbot" "paperclip" "41f685f6e01396936bb8cd98e7cca517e2c7d96b" "HEAD" -diff :: String -> String -> String -> String -> IO (Either Error Diff) +diff :: Name GithubOwner -> Name Repo -> Name Commit -> Name Commit -> IO (Either Error Diff) diff = diff' Nothing -- | The diff between two treeishes on a repo. -- -- > diff "thoughtbot" "paperclip" "41f685f6e01396936bb8cd98e7cca517e2c7d96b" "HEAD" -diff' :: Maybe GithubAuth -> String -> String -> String -> String -> IO (Either Error Diff) +diff' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> Name Commit -> Name Commit -> IO (Either Error Diff) diff' auth user repo base headref = - githubGet' auth ["repos", user, repo, "compare", base ++ "..." ++ headref] + executeRequestMaybe auth $ diffR user repo base headref + +-- | Compare two commits +-- See +diffR :: Name GithubOwner -> Name Repo -> Name Commit -> Name Commit -> GithubRequest k Diff +diffR user repo base headref = + GithubGet ["repos", untagName user, untagName repo, "compare", untagName base ++ "..." ++ untagName headref] "" diff --git a/Github/Repos/Forks.hs b/Github/Repos/Forks.hs index d24f54b5..1e210c69 100644 --- a/Github/Repos/Forks.hs +++ b/Github/Repos/Forks.hs @@ -1,24 +1,32 @@ -- | Hot forking action, as described at -- . module Github.Repos.Forks ( - forksFor -,forksFor' -,module Github.Data -) where + forksFor, + forksFor', + forksForR, + module Github.Data, + ) where +import Github.Auth import Github.Data -import Github.Private +import Github.Request -- | All the repos that are forked off the given repo. -- -- > forksFor "thoughtbot" "paperclip" -forksFor :: String -> String -> IO (Either Error [Repo]) +forksFor :: Name GithubOwner -> Name Repo -> IO (Either Error [Repo]) forksFor = forksFor' Nothing -- | All the repos that are forked off the given repo. -- | With authentication -- -- > forksFor' (Just (GithubUser (user, password))) "thoughtbot" "paperclip" -forksFor' :: Maybe GithubAuth -> String -> String -> IO (Either Error [Repo]) -forksFor' auth userName reqRepoName = - githubGet' auth ["repos", userName, reqRepoName, "forks"] +forksFor' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error [Repo]) +forksFor' auth user repo = + executeRequestMaybe auth $ forksForR user repo + +-- | List forks. +-- See +forksForR :: Name GithubOwner -> Name Repo -> GithubRequest k [Repo] +forksForR user repo = + GithubGet ["repos", untagName user, untagName repo, "forks"] "" diff --git a/Github/Repos/Webhooks.hs b/Github/Repos/Webhooks.hs index cdaea48a..ae276445 100644 --- a/Github/Repos/Webhooks.hs +++ b/Github/Repos/Webhooks.hs @@ -1,123 +1,115 @@ -{-# LANGUAGE OverloadedStrings, DeriveGeneric, DeriveDataTypeable #-} -{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} -- | The webhooks API, as described at -- -- module Github.Repos.Webhooks ( - --- * Querying repositories - webhooksFor' - ,webhookFor' - --- ** Create - ,createRepoWebhook' - --- ** Edit - ,editRepoWebhook' - --- ** Test - ,testPushRepoWebhook' - ,pingRepoWebhook' - --- ** Delete - ,deleteRepoWebhook' - ,NewRepoWebhook(..) - ,EditRepoWebhook(..) - ,RepoOwner - ,RepoName - ,RepoWebhookId + -- * Querying repositories + webhooksFor', + webhooksForR, + webhookFor', + webhookForR, + + -- ** Create + createRepoWebhook', + createRepoWebhookR, + + -- ** Edit + editRepoWebhook', + editRepoWebhookR, + + -- ** Test + testPushRepoWebhook', + testPushRepoWebhookR, + pingRepoWebhook', + pingRepoWebhookR, + + -- ** Delete + deleteRepoWebhook', + deleteRepoWebhookR, ) where +import Github.Auth import Github.Data -import Github.Private -import Control.DeepSeq (NFData) -import Data.Data -import qualified Data.Map as M -import Network.HTTP.Conduit -import Network.HTTP.Types -import Data.Aeson -import GHC.Generics (Generic) - -type RepoOwner = String -type RepoName = String -type RepoWebhookId = Int - -data NewRepoWebhook = NewRepoWebhook { - newRepoWebhookName :: String - ,newRepoWebhookConfig :: M.Map String String - ,newRepoWebhookEvents :: Maybe [RepoWebhookEvent] - ,newRepoWebhookActive :: Maybe Bool -} deriving (Eq, Ord, Show, Typeable, Data, Generic) - -instance NFData NewRepoWebhook - -data EditRepoWebhook = EditRepoWebhook { - editRepoWebhookConfig :: Maybe (M.Map String String) - ,editRepoWebhookEvents :: Maybe [RepoWebhookEvent] - ,editRepoWebhookAddEvents :: Maybe [RepoWebhookEvent] - ,editRepoWebhookRemoveEvents :: Maybe [RepoWebhookEvent] - ,editRepoWebhookActive :: Maybe Bool -} deriving (Eq, Ord, Show, Typeable, Data, Generic) - -instance NFData EditRepoWebhook - -instance ToJSON NewRepoWebhook where - toJSON (NewRepoWebhook { newRepoWebhookName = name - , newRepoWebhookConfig = config - , newRepoWebhookEvents = events - , newRepoWebhookActive = active - - }) = object - [ "name" .= name - , "config" .= config - , "events" .= events - , "active" .= active - ] - -instance ToJSON EditRepoWebhook where - toJSON (EditRepoWebhook { editRepoWebhookConfig = config - , editRepoWebhookEvents = events - , editRepoWebhookAddEvents = addEvents - , editRepoWebhookRemoveEvents = removeEvents - , editRepoWebhookActive = active - }) = object - [ "config" .= config - , "events" .= events - , "add_events" .= addEvents - , "remove_events" .= removeEvents - , "active" .= active - ] - -webhooksFor' :: GithubAuth -> RepoOwner -> RepoName -> IO (Either Error [RepoWebhook]) -webhooksFor' auth owner reqRepoName = - githubGet' (Just auth) ["repos", owner, reqRepoName, "hooks"] - -webhookFor' :: GithubAuth -> RepoOwner -> RepoName -> RepoWebhookId -> IO (Either Error RepoWebhook) -webhookFor' auth owner reqRepoName webhookId = - githubGet' (Just auth) ["repos", owner, reqRepoName, "hooks", (show webhookId)] - -createRepoWebhook' :: GithubAuth -> RepoOwner -> RepoName -> NewRepoWebhook -> IO (Either Error RepoWebhook) -createRepoWebhook' auth owner reqRepoName = githubPost auth ["repos", owner, reqRepoName, "hooks"] - -editRepoWebhook' :: GithubAuth -> RepoOwner -> RepoName -> RepoWebhookId -> EditRepoWebhook -> IO (Either Error RepoWebhook) -editRepoWebhook' auth owner reqRepoName webhookId edit = githubPatch auth ["repos", owner, reqRepoName, "hooks", (show webhookId)] edit - -testPushRepoWebhook' :: GithubAuth -> RepoOwner -> RepoName -> RepoWebhookId -> IO (Either Error Status) -testPushRepoWebhook' auth owner reqRepoName webhookId = - doHttpsStatus "POST" (createWebhookOpPath owner reqRepoName webhookId (Just "tests")) auth (Just . RequestBodyLBS . encode $ (decode "{}" :: Maybe (M.Map String Int))) - -pingRepoWebhook' :: GithubAuth -> RepoOwner -> RepoName -> RepoWebhookId -> IO (Either Error Status) -pingRepoWebhook' auth owner reqRepoName webhookId = - doHttpsStatus "POST" (createWebhookOpPath owner reqRepoName webhookId (Just "pings")) auth Nothing - -deleteRepoWebhook' :: GithubAuth -> RepoOwner -> RepoName -> RepoWebhookId -> IO (Either Error Status) -deleteRepoWebhook' auth owner reqRepoName webhookId = - doHttpsStatus "DELETE" (createWebhookOpPath owner reqRepoName webhookId Nothing) auth Nothing - -createBaseWebhookPath :: RepoOwner -> RepoName -> RepoWebhookId -> String -createBaseWebhookPath owner reqRepoName webhookId = buildPath ["repos", owner, reqRepoName, "hooks", show webhookId] - -createWebhookOpPath :: RepoOwner -> RepoName -> RepoWebhookId -> Maybe String -> String -createWebhookOpPath owner reqRepoName webhookId Nothing = createBaseWebhookPath owner reqRepoName webhookId -createWebhookOpPath owner reqRepoName webhookId (Just operation) = createBaseWebhookPath owner reqRepoName webhookId ++ "/" ++ operation +import Github.Request + +import Data.Aeson.Compat (encode) +import Network.HTTP.Types (Status) + +webhooksFor' :: GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error [RepoWebhook]) +webhooksFor' auth user repo = + executeRequest auth $ webhooksForR user repo + +-- | List hooks. +-- See +webhooksForR :: Name GithubOwner -> Name Repo -> GithubRequest k [RepoWebhook] +webhooksForR user repo = + GithubGet ["repos", untagName user, untagName repo, "hooks"] "" + +webhookFor' :: GithubAuth -> Name GithubOwner -> Name Repo -> Id RepoWebhook -> IO (Either Error RepoWebhook) +webhookFor' auth user repo hookId = + executeRequest auth $ webhookForR user repo hookId + +-- | Get single hook. +-- See +webhookForR :: Name GithubOwner -> Name Repo -> Id RepoWebhook -> GithubRequest k RepoWebhook +webhookForR user repo hookId = + GithubGet ["repos", untagName user, untagName repo, "hooks", show $ untagId hookId] "" + +createRepoWebhook' :: GithubAuth -> Name GithubOwner -> Name Repo -> NewRepoWebhook -> IO (Either Error RepoWebhook) +createRepoWebhook' auth user repo hook = + executeRequest auth $ createRepoWebhookR user repo hook + +-- | Create a hook. +-- See +createRepoWebhookR :: Name GithubOwner -> Name Repo -> NewRepoWebhook -> GithubRequest 'True RepoWebhook +createRepoWebhookR user repo hook = + GithubPost Post ["repos", untagName user, untagName repo, "hooks"] (encode hook) + +editRepoWebhook' :: GithubAuth -> Name GithubOwner -> Name Repo -> Id RepoWebhook -> EditRepoWebhook -> IO (Either Error RepoWebhook) +editRepoWebhook' auth user repo hookId hookEdit = + executeRequest auth $ editRepoWebhookR user repo hookId hookEdit + +-- | Edit a hook. +-- See +editRepoWebhookR :: Name GithubOwner -> Name Repo -> Id RepoWebhook -> EditRepoWebhook -> GithubRequest 'True RepoWebhook +editRepoWebhookR user repo hookId hookEdit = + GithubPost Patch ["repos", untagName user, untagName repo, "hooks", show $ untagId hookId] (encode hookEdit) + +testPushRepoWebhook' :: GithubAuth -> Name GithubOwner -> Name Repo -> Id RepoWebhook -> IO (Either Error Status) +testPushRepoWebhook' auth user repo hookId = + executeRequest auth $ testPushRepoWebhookR user repo hookId + +-- | Test a push hook. +-- See +testPushRepoWebhookR :: Name GithubOwner -> Name Repo -> Id RepoWebhook -> GithubRequest 'True Status +testPushRepoWebhookR user repo hookId = GithubStatus $ + GithubPost Post (createWebhookOpPath user repo hookId $ Just "tests") (encode ()) + +pingRepoWebhook' :: GithubAuth -> Name GithubOwner -> Name Repo -> Id RepoWebhook -> IO (Either Error Status) +pingRepoWebhook' auth user repo hookId = + executeRequest auth $ pingRepoWebhookR user repo hookId + +-- | Ping a hook. +-- See +pingRepoWebhookR :: Name GithubOwner -> Name Repo -> Id RepoWebhook -> GithubRequest 'True Status +pingRepoWebhookR user repo hookId = GithubStatus $ + GithubPost Post (createWebhookOpPath user repo hookId $ Just "pings") (encode ()) + +deleteRepoWebhook' :: GithubAuth -> Name GithubOwner -> Name Repo -> Id RepoWebhook -> IO (Either Error ()) +deleteRepoWebhook' auth user repo hookId = + executeRequest auth $ deleteRepoWebhookR user repo hookId + +-- | Delete a hook. +-- See +deleteRepoWebhookR :: Name GithubOwner -> Name Repo -> Id RepoWebhook -> GithubRequest 'True () +deleteRepoWebhookR user repo hookId = + GithubDelete $ createWebhookOpPath user repo hookId Nothing + +createBaseWebhookPath :: Name GithubOwner -> Name Repo -> Id RepoWebhook -> [String] +createBaseWebhookPath user repo hookId = + ["repos", untagName user, untagName repo, "hooks", show $ untagId hookId] + +createWebhookOpPath :: Name GithubOwner -> Name Repo -> Id RepoWebhook -> Maybe String -> [String] +createWebhookOpPath owner reqName webhookId Nothing = createBaseWebhookPath owner reqName webhookId +createWebhookOpPath owner reqName webhookId (Just operation) = createBaseWebhookPath owner reqName webhookId ++ [operation] diff --git a/github.cabal b/github.cabal index aada1b88..630a7a1c 100644 --- a/github.cabal +++ b/github.cabal @@ -114,13 +114,15 @@ Library Github.Auth, Github.Data, Github.Data.Definitions, - Github.Data.GitData, Github.Data.Gists, + Github.Data.GitData, + Github.Data.Id, Github.Data.Issues, + Github.Data.Name, Github.Data.PullRequests, + Github.Data.Repos, Github.Data.Teams, - Github.Data.Name, - Github.Data.Id, + Github.Data.Webhooks, Github.Events, Github.Gists, Github.Gists.Comments, @@ -140,6 +142,7 @@ Library Github.PullRequests.ReviewComments, Github.Repos, Github.Repos.Collaborators, + Github.Repos.Comments, Github.Repos.Commits, Github.Repos.Forks, Github.Repos.Webhooks From 2ae1c419fcb28fd262ee35389384722b8cf7957b Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Wed, 6 Jan 2016 21:18:27 +0200 Subject: [PATCH 120/510] Move Auth data definition to Github.Auth --- Github/Auth.hs | 19 +++++++++++++++++-- Github/Private.hs | 31 ++++++++++--------------------- Github/Request.hs | 4 ++-- 3 files changed, 29 insertions(+), 25 deletions(-) diff --git a/Github/Auth.hs b/Github/Auth.hs index fa630c7d..e7303de0 100644 --- a/Github/Auth.hs +++ b/Github/Auth.hs @@ -1,4 +1,19 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +module Github.Auth where + +import Control.DeepSeq (NFData) +import Data.Data (Data, Typeable) +import GHC.Generics (Generic) + +import qualified Data.ByteString as BS + -- | The Github auth data type -module Github.Auth (P.GithubAuth(..)) where +data GithubAuth = GithubBasicAuth BS.ByteString BS.ByteString + | GithubOAuth String -- ^ token + | GithubEnterpriseOAuth String -- custom API endpoint without + -- trailing slash + String -- token + deriving (Show, Data, Typeable, Eq, Ord, Generic) -import qualified Github.Private as P +instance NFData GithubAuth diff --git a/Github/Private.hs b/Github/Private.hs index 074442db..0619f988 100644 --- a/Github/Private.hs +++ b/Github/Private.hs @@ -1,5 +1,5 @@ -{-# LANGUAGE OverloadedStrings, StandaloneDeriving, DeriveDataTypeable #-} -{-# LANGUAGE CPP, FlexibleContexts, DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE CPP, FlexibleContexts #-} -- | This module is /private/. It is exposed to facilitate customization -- and extension of the /public/ API of this package without explicitely @@ -10,35 +10,24 @@ -- module Github.Private where -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative -#endif -import Github.Data -import Control.DeepSeq (NFData) +import Prelude () +import Prelude.Compat + import Data.Aeson import Data.Attoparsec.ByteString.Lazy -import Data.Data import Data.Monoid import Data.List import Data.CaseInsensitive (mk) -import qualified Data.ByteString.Char8 as BS -import qualified Data.ByteString.Lazy.Char8 as LBS -import GHC.Generics (Generic) import Network.HTTP.Types (Status(..), notFound404) import Network.HTTP.Conduit --- import Data.Conduit (ResourceT) -import qualified Control.Exception as E import Data.Maybe (fromMaybe) --- | user/password for HTTP basic access authentication -data GithubAuth = GithubBasicAuth BS.ByteString BS.ByteString - | GithubOAuth String -- ^ token - | GithubEnterpriseOAuth String -- custom API endpoint without - -- trailing slash - String -- token - deriving (Show, Data, Typeable, Eq, Ord, Generic) +import qualified Control.Exception as E +import qualified Data.ByteString.Char8 as BS +import qualified Data.ByteString.Lazy.Char8 as LBS -instance NFData GithubAuth +import Github.Data +import Github.Auth githubGet :: (FromJSON b, Show b) => [String] -> IO (Either Error b) githubGet = githubGet' Nothing diff --git a/Github/Request.hs b/Github/Request.hs index 0723625c..1a05e4f9 100644 --- a/Github/Request.hs +++ b/Github/Request.hs @@ -33,8 +33,8 @@ import Network.HTTP.Types (Status) import qualified Data.ByteString.Lazy as LBS import qualified Network.HTTP.Types.Method as Method -import Github.Data (Error) -import Github.Private (GithubAuth) +import Github.Auth (GithubAuth) +import Github.Data (Error) import qualified Github.Private as Private From a700013aa293d87bc37fdc9dc7ebe48f142f7a36 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Thu, 7 Jan 2016 00:03:40 +0200 Subject: [PATCH 121/510] Apply stylish-haskell --- .stylish-haskell.yaml | 13 ++++ Github/Data/GitData.hs | 85 ++++++++++----------- Github/Data/Id.hs | 4 +- Github/Data/Issues.hs | 109 +++++++++++++-------------- Github/Data/Name.hs | 6 +- Github/Data/PullRequests.hs | 119 +++++++++++++++--------------- Github/Data/Webhooks.hs | 26 +++---- Github/Events.hs | 4 +- Github/Issues.hs | 16 ++-- Github/Issues/Comments.hs | 6 +- Github/PullRequests.hs | 7 +- Github/Repos/Comments.hs | 4 +- Github/Repos/Webhooks/Validate.hs | 10 +-- Github/Request.hs | 2 +- spec/Github/SearchSpec.hs | 14 ++-- 15 files changed, 223 insertions(+), 202 deletions(-) create mode 100644 .stylish-haskell.yaml diff --git a/.stylish-haskell.yaml b/.stylish-haskell.yaml new file mode 100644 index 00000000..0d13efa4 --- /dev/null +++ b/.stylish-haskell.yaml @@ -0,0 +1,13 @@ +steps: + - imports: + align: group + - language_pragmas: + style: vertical + remove_redundant: true + - records: {} + - trailing_whitespace: {} +columns: 80 +language_extensions: + - MultiParamTypeClasses + - FlexibleContexts + - DataKinds diff --git a/Github/Data/GitData.hs b/Github/Data/GitData.hs index 63cbe4e8..ffd55993 100644 --- a/Github/Data/GitData.hs +++ b/Github/Data/GitData.hs @@ -1,11 +1,12 @@ -{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} module Github.Data.GitData where import Github.Data.Definitions import Control.DeepSeq (NFData) -import Data.Data (Typeable, Data) -import GHC.Generics (Generic) +import Data.Data (Data, Typeable) +import GHC.Generics (Generic) data Commit = Commit { commitSha :: String @@ -21,18 +22,18 @@ data Commit = Commit { instance NFData Commit data Tree = Tree { - treeSha :: String - ,treeUrl :: String + treeSha :: String + ,treeUrl :: String ,treeGitTrees :: [GitTree] } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Tree data GitTree = GitTree { - gitTreeType :: String - ,gitTreeSha :: String + gitTreeType :: String + ,gitTreeSha :: String -- Can be empty for submodule - ,gitTreeUrl :: Maybe String + ,gitTreeUrl :: Maybe String ,gitTreeSize :: Maybe Int ,gitTreePath :: String ,gitTreeMode :: String @@ -41,38 +42,38 @@ data GitTree = GitTree { instance NFData GitTree data GitCommit = GitCommit { - gitCommitMessage :: String - ,gitCommitUrl :: String + gitCommitMessage :: String + ,gitCommitUrl :: String ,gitCommitCommitter :: GitUser - ,gitCommitAuthor :: GitUser - ,gitCommitTree :: Tree - ,gitCommitSha :: Maybe String - ,gitCommitParents :: [Tree] + ,gitCommitAuthor :: GitUser + ,gitCommitTree :: Tree + ,gitCommitSha :: Maybe String + ,gitCommitParents :: [Tree] } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData GitCommit data Blob = Blob { - blobUrl :: String + blobUrl :: String ,blobEncoding :: String - ,blobContent :: String - ,blobSha :: String - ,blobSize :: Int + ,blobContent :: String + ,blobSha :: String + ,blobSize :: Int } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Blob data Tag = Tag { - tagName :: String + tagName :: String ,tagZipballUrl :: String ,tagTarballUrl :: String - ,tagCommit :: BranchCommit + ,tagCommit :: BranchCommit } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Tag data Branch = Branch { - branchName :: String + branchName :: String ,branchCommit :: BranchCommit } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -86,17 +87,17 @@ data BranchCommit = BranchCommit { instance NFData BranchCommit data Diff = Diff { - diffStatus :: String - ,diffBehindBy :: Int - ,diffPatchUrl :: String - ,diffUrl :: String - ,diffBaseCommit :: Commit - ,diffCommits :: [Commit] + diffStatus :: String + ,diffBehindBy :: Int + ,diffPatchUrl :: String + ,diffUrl :: String + ,diffBaseCommit :: Commit + ,diffCommits :: [Commit] ,diffTotalCommits :: Int - ,diffHtmlUrl :: String - ,diffFiles :: [File] - ,diffAheadBy :: Int - ,diffDiffUrl :: String + ,diffHtmlUrl :: String + ,diffFiles :: [File] + ,diffAheadBy :: Int + ,diffDiffUrl :: String ,diffPermalinkUrl :: String } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -111,16 +112,16 @@ instance NFData NewGitReference data GitReference = GitReference { gitReferenceObject :: GitObject - ,gitReferenceUrl :: String - ,gitReferenceRef :: String + ,gitReferenceUrl :: String + ,gitReferenceRef :: String } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData GitReference data GitObject = GitObject { gitObjectType :: String - ,gitObjectSha :: String - ,gitObjectUrl :: String + ,gitObjectSha :: String + ,gitObjectUrl :: String } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData GitObject @@ -134,14 +135,14 @@ data GitUser = GitUser { instance NFData GitUser data File = File { - fileBlobUrl :: String - ,fileStatus :: String - ,fileRawUrl :: String + fileBlobUrl :: String + ,fileStatus :: String + ,fileRawUrl :: String ,fileAdditions :: Int - ,fileSha :: String - ,fileChanges :: Int - ,filePatch :: String - ,fileFilename :: String + ,fileSha :: String + ,fileChanges :: Int + ,filePatch :: String + ,fileFilename :: String ,fileDeletions :: Int } deriving (Show, Data, Typeable, Eq, Ord, Generic) diff --git a/Github/Data/Id.hs b/Github/Data/Id.hs index 6f1861ba..0883b856 100644 --- a/Github/Data/Id.hs +++ b/Github/Data/Id.hs @@ -6,8 +6,8 @@ module Github.Data.Id ( untagId, ) where -import Control.DeepSeq (NFData(..)) -import Data.Aeson.Compat (FromJSON(..), ToJSON(..)) +import Control.DeepSeq (NFData (..)) +import Data.Aeson.Compat (FromJSON (..), ToJSON (..)) import Data.Data (Data, Typeable) import Data.Hashable (Hashable) import GHC.Generics (Generic) diff --git a/Github/Data/Issues.hs b/Github/Data/Issues.hs index 0bd4af77..bdc97271 100644 --- a/Github/Data/Issues.hs +++ b/Github/Data/Issues.hs @@ -1,96 +1,97 @@ -{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} module Github.Data.Issues where -import Github.Data.Id import Github.Data.Definitions +import Github.Data.Id import Github.Data.PullRequests import Control.DeepSeq (NFData) -import Data.Data (Typeable, Data) -import GHC.Generics (Generic) +import Data.Data (Data, Typeable) +import GHC.Generics (Generic) data Issue = Issue { - issueClosedAt :: Maybe GithubDate - ,issueUpdatedAt :: GithubDate - ,issueEventsUrl :: String - ,issueHtmlUrl :: Maybe String - ,issueClosedBy :: Maybe GithubOwner - ,issueLabels :: [IssueLabel] - ,issueNumber :: Int - ,issueAssignee :: Maybe GithubOwner - ,issueUser :: GithubOwner - ,issueTitle :: String + issueClosedAt :: Maybe GithubDate + ,issueUpdatedAt :: GithubDate + ,issueEventsUrl :: String + ,issueHtmlUrl :: Maybe String + ,issueClosedBy :: Maybe GithubOwner + ,issueLabels :: [IssueLabel] + ,issueNumber :: Int + ,issueAssignee :: Maybe GithubOwner + ,issueUser :: GithubOwner + ,issueTitle :: String ,issuePullRequest :: Maybe PullRequestReference - ,issueUrl :: String - ,issueCreatedAt :: GithubDate - ,issueBody :: Maybe String - ,issueState :: String - ,issueId :: Id Issue - ,issueComments :: Int - ,issueMilestone :: Maybe Milestone + ,issueUrl :: String + ,issueCreatedAt :: GithubDate + ,issueBody :: Maybe String + ,issueState :: String + ,issueId :: Id Issue + ,issueComments :: Int + ,issueMilestone :: Maybe Milestone } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Issue data NewIssue = NewIssue { - newIssueTitle :: String -, newIssueBody :: Maybe String -, newIssueAssignee :: Maybe String + newIssueTitle :: String +, newIssueBody :: Maybe String +, newIssueAssignee :: Maybe String , newIssueMilestone :: Maybe Int -, newIssueLabels :: Maybe [String] +, newIssueLabels :: Maybe [String] } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData NewIssue data EditIssue = EditIssue { - editIssueTitle :: Maybe String -, editIssueBody :: Maybe String -, editIssueAssignee :: Maybe String -, editIssueState :: Maybe String + editIssueTitle :: Maybe String +, editIssueBody :: Maybe String +, editIssueAssignee :: Maybe String +, editIssueState :: Maybe String , editIssueMilestone :: Maybe Int -, editIssueLabels :: Maybe [String] +, editIssueLabels :: Maybe [String] } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData EditIssue data Milestone = Milestone { - milestoneCreator :: GithubOwner - ,milestoneDueOn :: Maybe GithubDate - ,milestoneOpenIssues :: Int - ,milestoneNumber :: Int + milestoneCreator :: GithubOwner + ,milestoneDueOn :: Maybe GithubDate + ,milestoneOpenIssues :: Int + ,milestoneNumber :: Int ,milestoneClosedIssues :: Int - ,milestoneDescription :: Maybe String - ,milestoneTitle :: String - ,milestoneUrl :: String - ,milestoneCreatedAt :: GithubDate - ,milestoneState :: String + ,milestoneDescription :: Maybe String + ,milestoneTitle :: String + ,milestoneUrl :: String + ,milestoneCreatedAt :: GithubDate + ,milestoneState :: String } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Milestone data IssueLabel = IssueLabel { labelColor :: String - ,labelUrl :: String - ,labelName :: String + ,labelUrl :: String + ,labelName :: String } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData IssueLabel data IssueComment = IssueComment { issueCommentUpdatedAt :: GithubDate - ,issueCommentUser :: GithubOwner - ,issueCommentUrl :: String - ,issueCommentHtmlUrl :: String + ,issueCommentUser :: GithubOwner + ,issueCommentUrl :: String + ,issueCommentHtmlUrl :: String ,issueCommentCreatedAt :: GithubDate - ,issueCommentBody :: String - ,issueCommentId :: Int + ,issueCommentBody :: String + ,issueCommentId :: Int } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData IssueComment data SearchIssuesResult = SearchIssuesResult { searchIssuesTotalCount :: Int - ,searchIssuesIssues :: [Issue] + ,searchIssuesIssues :: [Issue] } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData SearchIssuesResult @@ -120,13 +121,13 @@ instance NFData EventType -- | Issue event data Event = Event { - eventActor :: GithubOwner - ,eventType :: EventType - ,eventCommitId :: Maybe String - ,eventUrl :: String + eventActor :: GithubOwner + ,eventType :: EventType + ,eventCommitId :: Maybe String + ,eventUrl :: String ,eventCreatedAt :: GithubDate - ,eventId :: Int - ,eventIssue :: Maybe Issue + ,eventId :: Int + ,eventIssue :: Maybe Issue } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Event \ No newline at end of file +instance NFData Event diff --git a/Github/Data/Name.hs b/Github/Data/Name.hs index 20c6ddc1..a43d83ac 100644 --- a/Github/Data/Name.hs +++ b/Github/Data/Name.hs @@ -6,11 +6,11 @@ module Github.Data.Name ( untagName, ) where -import Control.DeepSeq (NFData(..)) -import Data.Aeson.Compat (FromJSON(..), ToJSON(..)) +import Control.DeepSeq (NFData (..)) +import Data.Aeson.Compat (FromJSON (..), ToJSON (..)) import Data.Data (Data, Typeable) import Data.Hashable (Hashable) -import Data.String (IsString(..)) +import Data.String (IsString (..)) import GHC.Generics (Generic) newtype Name entity = N String diff --git a/Github/Data/PullRequests.hs b/Github/Data/PullRequests.hs index 4639b04b..0e3da624 100644 --- a/Github/Data/PullRequests.hs +++ b/Github/Data/PullRequests.hs @@ -1,70 +1,71 @@ -{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} module Github.Data.PullRequests where import Github.Data.Definitions import Control.DeepSeq (NFData) -import Data.Data (Typeable, Data) -import GHC.Generics (Generic) +import Data.Data (Data, Typeable) +import GHC.Generics (Generic) data PullRequest = PullRequest { - pullRequestClosedAt :: Maybe GithubDate + pullRequestClosedAt :: Maybe GithubDate ,pullRequestCreatedAt :: GithubDate - ,pullRequestUser :: GithubOwner - ,pullRequestPatchUrl :: String - ,pullRequestState :: String - ,pullRequestNumber :: Int - ,pullRequestHtmlUrl :: String + ,pullRequestUser :: GithubOwner + ,pullRequestPatchUrl :: String + ,pullRequestState :: String + ,pullRequestNumber :: Int + ,pullRequestHtmlUrl :: String ,pullRequestUpdatedAt :: GithubDate - ,pullRequestBody :: String - ,pullRequestIssueUrl :: String - ,pullRequestDiffUrl :: String - ,pullRequestUrl :: String - ,pullRequestLinks :: PullRequestLinks - ,pullRequestMergedAt :: Maybe GithubDate - ,pullRequestTitle :: String - ,pullRequestId :: Int + ,pullRequestBody :: String + ,pullRequestIssueUrl :: String + ,pullRequestDiffUrl :: String + ,pullRequestUrl :: String + ,pullRequestLinks :: PullRequestLinks + ,pullRequestMergedAt :: Maybe GithubDate + ,pullRequestTitle :: String + ,pullRequestId :: Int } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData PullRequest data DetailedPullRequest = DetailedPullRequest { -- this is a duplication of a PullRequest - detailedPullRequestClosedAt :: Maybe GithubDate - ,detailedPullRequestCreatedAt :: GithubDate - ,detailedPullRequestUser :: GithubOwner - ,detailedPullRequestPatchUrl :: String - ,detailedPullRequestState :: String - ,detailedPullRequestNumber :: Int - ,detailedPullRequestHtmlUrl :: String - ,detailedPullRequestUpdatedAt :: GithubDate - ,detailedPullRequestBody :: String - ,detailedPullRequestIssueUrl :: String - ,detailedPullRequestDiffUrl :: String - ,detailedPullRequestUrl :: String - ,detailedPullRequestLinks :: PullRequestLinks - ,detailedPullRequestMergedAt :: Maybe GithubDate - ,detailedPullRequestTitle :: String - ,detailedPullRequestId :: Int - - ,detailedPullRequestMergedBy :: Maybe GithubOwner - ,detailedPullRequestChangedFiles :: Int - ,detailedPullRequestHead :: PullRequestCommit - ,detailedPullRequestComments :: Int - ,detailedPullRequestDeletions :: Int - ,detailedPullRequestAdditions :: Int + detailedPullRequestClosedAt :: Maybe GithubDate + ,detailedPullRequestCreatedAt :: GithubDate + ,detailedPullRequestUser :: GithubOwner + ,detailedPullRequestPatchUrl :: String + ,detailedPullRequestState :: String + ,detailedPullRequestNumber :: Int + ,detailedPullRequestHtmlUrl :: String + ,detailedPullRequestUpdatedAt :: GithubDate + ,detailedPullRequestBody :: String + ,detailedPullRequestIssueUrl :: String + ,detailedPullRequestDiffUrl :: String + ,detailedPullRequestUrl :: String + ,detailedPullRequestLinks :: PullRequestLinks + ,detailedPullRequestMergedAt :: Maybe GithubDate + ,detailedPullRequestTitle :: String + ,detailedPullRequestId :: Int + + ,detailedPullRequestMergedBy :: Maybe GithubOwner + ,detailedPullRequestChangedFiles :: Int + ,detailedPullRequestHead :: PullRequestCommit + ,detailedPullRequestComments :: Int + ,detailedPullRequestDeletions :: Int + ,detailedPullRequestAdditions :: Int ,detailedPullRequestReviewComments :: Int - ,detailedPullRequestBase :: PullRequestCommit - ,detailedPullRequestCommits :: Int - ,detailedPullRequestMerged :: Bool - ,detailedPullRequestMergeable :: Maybe Bool + ,detailedPullRequestBase :: PullRequestCommit + ,detailedPullRequestCommits :: Int + ,detailedPullRequestMerged :: Bool + ,detailedPullRequestMergeable :: Maybe Bool } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData DetailedPullRequest data EditPullRequest = EditPullRequest { editPullRequestTitle :: Maybe String - ,editPullRequestBody :: Maybe String + ,editPullRequestBody :: Maybe String ,editPullRequestState :: Maybe EditPullRequestState } deriving (Show, Generic) @@ -88,29 +89,29 @@ instance NFData CreatePullRequest data PullRequestLinks = PullRequestLinks { pullRequestLinksReviewComments :: String - ,pullRequestLinksComments :: String - ,pullRequestLinksHtml :: String - ,pullRequestLinksSelf :: String + ,pullRequestLinksComments :: String + ,pullRequestLinksHtml :: String + ,pullRequestLinksSelf :: String } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData PullRequestLinks data PullRequestCommit = PullRequestCommit { pullRequestCommitLabel :: String - ,pullRequestCommitRef :: String - ,pullRequestCommitSha :: String - ,pullRequestCommitUser :: GithubOwner - ,pullRequestCommitRepo :: Repo + ,pullRequestCommitRef :: String + ,pullRequestCommitSha :: String + ,pullRequestCommitUser :: GithubOwner + ,pullRequestCommitRepo :: Repo } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData PullRequestCommit data PullRequestEvent = PullRequestEvent { - pullRequestEventAction :: PullRequestEventType - ,pullRequestEventNumber :: Int + pullRequestEventAction :: PullRequestEventType + ,pullRequestEventNumber :: Int ,pullRequestEventPullRequest :: DetailedPullRequest - ,pullRequestRepository :: Repo - ,pullRequestSender :: GithubOwner + ,pullRequestRepository :: Repo + ,pullRequestSender :: GithubOwner } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData PullRequestEvent @@ -129,9 +130,9 @@ data PullRequestEventType = instance NFData PullRequestEventType data PullRequestReference = PullRequestReference { - pullRequestReferenceHtmlUrl :: Maybe String + pullRequestReferenceHtmlUrl :: Maybe String ,pullRequestReferencePatchUrl :: Maybe String - ,pullRequestReferenceDiffUrl :: Maybe String + ,pullRequestReferenceDiffUrl :: Maybe String } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData PullRequestReference @@ -141,4 +142,4 @@ data EditPullRequestState = | EditPullRequestStateClosed deriving (Show, Generic) -instance NFData EditPullRequestState \ No newline at end of file +instance NFData EditPullRequestState diff --git a/Github/Data/Webhooks.hs b/Github/Data/Webhooks.hs index 8f77aba4..7c0cbb4a 100644 --- a/Github/Data/Webhooks.hs +++ b/Github/Data/Webhooks.hs @@ -13,16 +13,16 @@ import GHC.Generics (Generic) import qualified Data.Map as M data RepoWebhook = RepoWebhook { - repoWebhookUrl :: String - ,repoWebhookTestUrl :: String - ,repoWebhookId :: Id RepoWebhook - ,repoWebhookName :: String - ,repoWebhookActive :: Bool - ,repoWebhookEvents :: [RepoWebhookEvent] - ,repoWebhookConfig :: M.Map String String + repoWebhookUrl :: String + ,repoWebhookTestUrl :: String + ,repoWebhookId :: Id RepoWebhook + ,repoWebhookName :: String + ,repoWebhookActive :: Bool + ,repoWebhookEvents :: [RepoWebhookEvent] + ,repoWebhookConfig :: M.Map String String ,repoWebhookLastResponse :: RepoWebhookResponse - ,repoWebhookUpdatedAt :: GithubDate - ,repoWebhookCreatedAt :: GithubDate + ,repoWebhookUpdatedAt :: GithubDate + ,repoWebhookCreatedAt :: GithubDate } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData RepoWebhook @@ -53,16 +53,16 @@ data RepoWebhookEvent = instance NFData RepoWebhookEvent data RepoWebhookResponse = RepoWebhookResponse { - repoWebhookResponseCode :: Maybe Int - ,repoWebhookResponseStatus :: String + repoWebhookResponseCode :: Maybe Int + ,repoWebhookResponseStatus :: String ,repoWebhookResponseMessage :: Maybe String } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData RepoWebhookResponse data PingEvent = PingEvent { - pingEventZen :: String - ,pingEventHook :: RepoWebhook + pingEventZen :: String + ,pingEventHook :: RepoWebhook ,pingEventHookId :: Id RepoWebhook } deriving (Show, Data, Typeable, Eq, Ord, Generic) diff --git a/Github/Events.hs b/Github/Events.hs index 62e492d6..8f877308 100644 --- a/Github/Events.hs +++ b/Github/Events.hs @@ -6,8 +6,8 @@ import qualified Data.ByteString.Lazy.Char8 as LBS import Data.Aeson (FromJSON) -import Github.Data.Definitions (Error(..)) -import Github.Private (parseJson) +import Github.Data.Definitions (Error (..)) +import Github.Private (parseJson) parseEvent :: (FromJSON b, Show b) => LBS.ByteString -> Either Error b parseEvent = parseJson diff --git a/Github/Issues.hs b/Github/Issues.hs index a924f7d7..87881f05 100644 --- a/Github/Issues.hs +++ b/Github/Issues.hs @@ -1,4 +1,8 @@ -{-# LANGUAGE CPP, OverloadedStrings, DeriveGeneric, DeriveDataTypeable, DataKinds #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} -- | The issues API as described on . module Github.Issues ( issue, @@ -21,10 +25,10 @@ import Github.Auth import Github.Data import Github.Request +import Control.DeepSeq (NFData) import Data.Aeson.Compat (encode) -import Control.DeepSeq (NFData) -import Data.List (intercalate) import Data.Data +import Data.List (intercalate) #if MIN_VERSION_time(1,5,0) import Data.Time (defaultTimeLocale) #else @@ -32,8 +36,8 @@ import System.Locale (defaultTimeLocale) #endif import GHC.Generics (Generic) +import Data.Time.Clock (UTCTime (..)) import Data.Time.Format (formatTime) -import Data.Time.Clock (UTCTime(..)) -- | A data structure for describing how to filter issues. This is used by @@ -63,7 +67,7 @@ instance NFData IssueLimitation -- > issue' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" "462" issue' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> Id Issue -> IO (Either Error Issue) issue' auth user reqRepoName reqIssueNumber = - executeRequestMaybe auth $ issueR user reqRepoName reqIssueNumber + executeRequestMaybe auth $ issueR user reqRepoName reqIssueNumber -- | Details on a specific issue, given the repo owner and name, and the issue -- number. @@ -84,7 +88,7 @@ issueR user reqRepoName reqIssueNumber = -- > issuesForRepo' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" [NoMilestone, OnlyClosed, Mentions "jyurek", Ascending] issuesForRepo' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> [IssueLimitation] -> IO (Either Error [Issue]) issuesForRepo' auth user reqRepoName issueLimitations = - executeRequestMaybe auth $ issuesForRepoR user reqRepoName 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. diff --git a/Github/Issues/Comments.hs b/Github/Issues/Comments.hs index 4e263c11..09ef59a5 100644 --- a/Github/Issues/Comments.hs +++ b/Github/Issues/Comments.hs @@ -24,7 +24,7 @@ import Github.Request -- > comment "thoughtbot" "paperclip" 1468184 comment :: Name GithubOwner -> Name Repo -> Id Comment -> IO (Either Error IssueComment) comment user repo cid = - executeRequest' $ commentR user repo cid + executeRequest' $ commentR user repo cid -- | Get a single comment. -- See @@ -43,7 +43,7 @@ comments = comments' Nothing -- > comments' (GithubUser (user, password)) "thoughtbot" "paperclip" 635 comments' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> Id Issue -> IO (Either Error [IssueComment]) comments' auth user repo iid = - executeRequestMaybe auth $ commentsR user repo iid + executeRequestMaybe auth $ commentsR user repo iid -- | List comments on an issue. -- See @@ -77,7 +77,7 @@ editComment :: GithubAuth -> Name GithubOwner -> Name Repo -> Id Comment -> Stri editComment auth user repo commid body = executeRequest auth $ editCommentR user repo commid body --- | Edit a comment. +-- | Edit a comment. -- See editCommentR :: Name GithubOwner -> Name Repo -> Id Comment -> String -> GithubRequest 'True Comment editCommentR user repo commid body = diff --git a/Github/PullRequests.hs b/Github/PullRequests.hs index 5140a918..557e5441 100644 --- a/Github/PullRequests.hs +++ b/Github/PullRequests.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE OverloadedStrings, DataKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} -- | The pull requests API as documented at -- . module Github.PullRequests ( @@ -30,8 +31,8 @@ import Github.Auth import Github.Data import Github.Request +import Data.Aeson.Compat (Value, encode, object, (.=)) import Network.HTTP.Types -import Data.Aeson.Compat (Value, encode, object, (.=)) -- | All pull requests for the repo, by owner, repo name, and pull request state. -- | With authentification @@ -128,7 +129,7 @@ updatePullRequestR user repo prid epr = 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. -- diff --git a/Github/Repos/Comments.hs b/Github/Repos/Comments.hs index d75d27a9..442ef94e 100644 --- a/Github/Repos/Comments.hs +++ b/Github/Repos/Comments.hs @@ -15,8 +15,8 @@ module Github.Repos.Comments ( module Github.Data, ) where -import Github.Data import Github.Auth +import Github.Data import Github.Request -- | All the comments on a Github repo. @@ -70,7 +70,7 @@ commitCommentFor = commitCommentFor' Nothing -- > commitCommentFor "thoughtbot" "paperclip" "669575" commitCommentFor' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> Id Comment -> IO (Either Error Comment) commitCommentFor' auth user repo cid = - executeRequestMaybe auth $ commitCommentForR user repo cid + executeRequestMaybe auth $ commitCommentForR user repo cid -- | Get a single commit comment. -- See diff --git a/Github/Repos/Webhooks/Validate.hs b/Github/Repos/Webhooks/Validate.hs index 00fe3f9a..12447f33 100644 --- a/Github/Repos/Webhooks/Validate.hs +++ b/Github/Repos/Webhooks/Validate.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} -- | Verification of incomming webhook payloads, as described at @@ -11,11 +11,11 @@ module Github.Repos.Webhooks.Validate ( #if !MIN_VERSION_base(4,8,0) import Control.Applicative #endif -import Crypto.Hash -import qualified Data.ByteString.Char8 as BS -import Data.Byteable (constEqBytes, toBytes) +import Crypto.Hash +import Data.Byteable (constEqBytes, toBytes) import qualified Data.ByteString.Base16 as Hex -import Data.Monoid +import qualified Data.ByteString.Char8 as BS +import Data.Monoid -- | Validates a given payload against a given HMAC hexdigest using a given diff --git a/Github/Request.hs b/Github/Request.hs index 1a05e4f9..a6c68dd4 100644 --- a/Github/Request.hs +++ b/Github/Request.hs @@ -139,7 +139,7 @@ executeRequestWithMgr mgr auth req = Private.githubAPIDelete' getResponse auth (Private.buildPath paths) - GithubStatus _req' -> + GithubStatus _req' -> error "executeRequestWithMgr GithubStatus not implemented" where getResponse = flip httpLbs mgr diff --git a/spec/Github/SearchSpec.hs b/spec/Github/SearchSpec.hs index 722920a4..e451c5c1 100644 --- a/spec/Github/SearchSpec.hs +++ b/spec/Github/SearchSpec.hs @@ -1,17 +1,17 @@ -{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} module Github.SearchSpec where import Prelude () import Prelude.Compat -import Data.Aeson.Compat (eitherDecodeStrict) -import Data.FileEmbed (embedFile) -import Test.Hspec (Spec, describe, it, shouldBe) +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) +import Github.Data.Id (Id (..)) +import Github.Data.Issues (Issue (..), SearchIssuesResult (..)) +import Github.Search (searchIssues) fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b From da1ed810f17c2066ffa7c30ff2b8b65176f6586d Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Thu, 7 Jan 2016 00:54:06 +0200 Subject: [PATCH 122/510] Build only master branch --- .travis.yml | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/.travis.yml b/.travis.yml index cf154a53..cf9f04ac 100644 --- a/.travis.yml +++ b/.travis.yml @@ -55,4 +55,8 @@ install: script: - sh travis-script.sh +branches: + only: + - master + # EOF From 9e9bf360bf41b1c39a990e53026fe588bd6eb406 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Thu, 7 Jan 2016 15:32:24 +0200 Subject: [PATCH 123/510] Remove Github.Events --- Github/Events.hs | 13 ------------- github.cabal | 1 - 2 files changed, 14 deletions(-) delete mode 100644 Github/Events.hs diff --git a/Github/Events.hs b/Github/Events.hs deleted file mode 100644 index 8f877308..00000000 --- a/Github/Events.hs +++ /dev/null @@ -1,13 +0,0 @@ -module Github.Events ( - parseEvent -) where - -import qualified Data.ByteString.Lazy.Char8 as LBS - -import Data.Aeson (FromJSON) - -import Github.Data.Definitions (Error (..)) -import Github.Private (parseJson) - -parseEvent :: (FromJSON b, Show b) => LBS.ByteString -> Either Error b -parseEvent = parseJson diff --git a/github.cabal b/github.cabal index 630a7a1c..ccffa5c8 100644 --- a/github.cabal +++ b/github.cabal @@ -123,7 +123,6 @@ Library Github.Data.Repos, Github.Data.Teams, Github.Data.Webhooks, - Github.Events, Github.Gists, Github.Gists.Comments, Github.GitData.Commits, From f8ecc64fb0f52253a4c7545f7af19710a7e6d250 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Thu, 7 Jan 2016 18:05:57 +0200 Subject: [PATCH 124/510] Make fields strict, use Text instead of String --- Github/Data.hs | 2 +- Github/Data/Definitions.hs | 287 ++++++++++++++++++------------------ Github/Data/Gists.hs | 49 +++--- Github/Data/GitData.hs | 139 ++++++++--------- Github/Data/Issues.hs | 65 ++++---- Github/Data/Name.hs | 11 +- Github/Data/PullRequests.hs | 143 +++++++++--------- Github/Data/Repos.hs | 29 ++-- Github/Data/Teams.hs | 63 ++++---- Github/Data/Webhooks.hs | 51 +++---- Github/Issues.hs | 3 +- Github/Issues/Comments.hs | 9 +- Github/Private.hs | 8 +- Github/Repos/Commits.hs | 8 +- 14 files changed, 442 insertions(+), 425 deletions(-) diff --git a/Github/Data.hs b/Github/Data.hs index 382c1e0c..a4e22f2e 100644 --- a/Github/Data.hs +++ b/Github/Data.hs @@ -672,7 +672,7 @@ instance FromJSON Contributor where instance FromJSON Languages where parseJSON (Object o) = Languages <$> - mapM (\name -> Language (T.unpack name) <$> o .: name) + mapM (\name -> Language name <$> o .: name) (Map.keys o) parseJSON _ = fail "Could not build Languages" diff --git a/Github/Data/Definitions.hs b/Github/Data/Definitions.hs index a35f32a2..145b61fc 100644 --- a/Github/Data/Definitions.hs +++ b/Github/Data/Definitions.hs @@ -6,6 +6,7 @@ module Github.Data.Definitions where import Control.DeepSeq (NFData) import qualified Control.Exception as E import Data.Data +import Data.Text (Text) import Data.Time import GHC.Generics (Generic) @@ -13,20 +14,20 @@ import Github.Data.Id import Github.Data.Name -- | The options for querying commits. -data CommitQueryOption = CommitQuerySha String - | CommitQueryPath String - | CommitQueryAuthor String - | CommitQuerySince GithubDate - | CommitQueryUntil GithubDate +data CommitQueryOption = CommitQuerySha !Text + | CommitQueryPath !Text + | CommitQueryAuthor !Text + | CommitQuerySince !GithubDate + | CommitQueryUntil !GithubDate deriving (Show, Eq, Ord) -- | Errors have been tagged according to their source, so you can more easily -- dispatch and handle them. data Error = HTTPConnectionError E.SomeException -- ^ A HTTP error occurred. The actual caught error is included. - | ParseError String -- ^ An error in the parser itself. - | JsonError String -- ^ The JSON is malformed or unexpected. - | UserError String -- ^ Incorrect input. + | ParseError Text -- ^ An error in the parser itself. + | JsonError Text -- ^ The JSON is malformed or unexpected. + | UserError Text -- ^ Incorrect input. deriving Show -- | A date in the Github format, which is a special case of ISO-8601. @@ -36,124 +37,124 @@ newtype GithubDate = GithubDate { fromGithubDate :: UTCTime } instance NFData GithubDate data GithubOwner = GithubUser { - githubOwnerAvatarUrl :: String - ,githubOwnerLogin :: Name GithubOwner - ,githubOwnerUrl :: String - ,githubOwnerId :: Id GithubOwner - ,githubOwnerGravatarId :: Maybe String + githubOwnerAvatarUrl :: !Text + ,githubOwnerLogin :: !(Name GithubOwner) + ,githubOwnerUrl :: !Text + ,githubOwnerId :: !(Id GithubOwner) + ,githubOwnerGravatarId :: !(Maybe Text) } | GithubOrganization { - githubOwnerAvatarUrl :: String - ,githubOwnerLogin :: Name GithubOwner - ,githubOwnerUrl :: String - ,githubOwnerId :: Id GithubOwner + githubOwnerAvatarUrl :: !Text + ,githubOwnerLogin :: !(Name GithubOwner) + ,githubOwnerUrl :: !Text + ,githubOwnerId :: !(Id GithubOwner) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData GithubOwner data Stats = Stats { - statsAdditions :: Int - ,statsTotal :: Int - ,statsDeletions :: Int + statsAdditions :: !Int + ,statsTotal :: !Int + ,statsDeletions :: !Int } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Stats data Comment = Comment { - commentPosition :: Maybe Int - ,commentLine :: Maybe Int - ,commentBody :: String - ,commentCommitId :: Maybe String - ,commentUpdatedAt :: UTCTime - ,commentHtmlUrl :: Maybe String - ,commentUrl :: String - ,commentCreatedAt :: Maybe UTCTime - ,commentPath :: Maybe String - ,commentUser :: GithubOwner - ,commentId :: Id Comment + commentPosition :: !(Maybe Int) + ,commentLine :: !(Maybe Int) + ,commentBody :: !Text + ,commentCommitId :: !(Maybe Text) + ,commentUpdatedAt :: !UTCTime + ,commentHtmlUrl :: !(Maybe Text) + ,commentUrl :: !Text + ,commentCreatedAt :: !(Maybe UTCTime) + ,commentPath :: !(Maybe Text) + ,commentUser :: !GithubOwner + ,commentId :: !(Id Comment) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Comment data NewComment = NewComment { - newCommentBody :: String + newCommentBody :: !Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData NewComment data EditComment = EditComment { - editCommentBody :: String + editCommentBody :: !Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData EditComment data SimpleOrganization = SimpleOrganization { - simpleOrganizationUrl :: String - ,simpleOrganizationAvatarUrl :: String - ,simpleOrganizationId :: Id Organization - ,simpleOrganizationLogin :: String + simpleOrganizationUrl :: !Text + ,simpleOrganizationAvatarUrl :: !Text + ,simpleOrganizationId :: !(Id Organization) + ,simpleOrganizationLogin :: !Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData SimpleOrganization data Organization = Organization { - organizationType :: String - ,organizationBlog :: Maybe String - ,organizationLocation :: Maybe String - ,organizationLogin :: Name Organization - ,organizationFollowers :: Int - ,organizationCompany :: Maybe String - ,organizationAvatarUrl :: String - ,organizationPublicGists :: Int - ,organizationHtmlUrl :: String - ,organizationEmail :: Maybe String - ,organizationFollowing :: Int - ,organizationPublicRepos :: Int - ,organizationUrl :: String - ,organizationCreatedAt :: GithubDate - ,organizationName :: Maybe String - ,organizationId :: Id Organization + organizationType :: !Text + ,organizationBlog :: !(Maybe Text) + ,organizationLocation :: !(Maybe Text) + ,organizationLogin :: !(Name Organization) + ,organizationFollowers :: !Int + ,organizationCompany :: !(Maybe Text) + ,organizationAvatarUrl :: !Text + ,organizationPublicGists :: !Int + ,organizationHtmlUrl :: !Text + ,organizationEmail :: !(Maybe Text) + ,organizationFollowing :: !Int + ,organizationPublicRepos :: !Int + ,organizationUrl :: !Text + ,organizationCreatedAt :: !GithubDate + ,organizationName :: !(Maybe Text) + ,organizationId :: !(Id Organization) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Organization data SearchReposResult = SearchReposResult { - searchReposTotalCount :: Int - ,searchReposRepos :: [Repo] + searchReposTotalCount :: !Int + ,searchReposRepos :: ![Repo] } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData SearchReposResult data Repo = Repo { - repoSshUrl :: Maybe String - ,repoDescription :: Maybe String - ,repoCreatedAt :: Maybe GithubDate - ,repoHtmlUrl :: String - ,repoSvnUrl :: Maybe String - ,repoForks :: Maybe Int - ,repoHomepage :: Maybe String - ,repoFork :: Maybe Bool - ,repoGitUrl :: Maybe String - ,repoPrivate :: Bool - ,repoCloneUrl :: Maybe String - ,repoSize :: Maybe Int - ,repoUpdatedAt :: Maybe GithubDate - ,repoWatchers :: Maybe Int - ,repoOwner :: GithubOwner - ,repoName :: Name Repo - ,repoLanguage :: Maybe String - ,repoMasterBranch :: Maybe String - ,repoPushedAt :: Maybe GithubDate -- ^ this is Nothing for new repositories - ,repoId :: Id Repo - ,repoUrl :: String - ,repoOpenIssues :: Maybe Int - ,repoHasWiki :: Maybe Bool - ,repoHasIssues :: Maybe Bool - ,repoHasDownloads :: Maybe Bool - ,repoParent :: Maybe RepoRef - ,repoSource :: Maybe RepoRef - ,repoHooksUrl :: String - ,repoStargazersCount :: Int + repoSshUrl :: !(Maybe Text) + ,repoDescription :: !(Maybe Text) + ,repoCreatedAt :: !(Maybe GithubDate) + ,repoHtmlUrl :: !Text + ,repoSvnUrl :: !(Maybe Text) + ,repoForks :: !(Maybe Int) + ,repoHomepage :: !(Maybe Text) + ,repoFork :: !(Maybe Bool) + ,repoGitUrl :: !(Maybe Text) + ,repoPrivate :: !Bool + ,repoCloneUrl :: !(Maybe Text) + ,repoSize :: !(Maybe Int) + ,repoUpdatedAt :: !(Maybe GithubDate) + ,repoWatchers :: !(Maybe Int) + ,repoOwner :: !GithubOwner + ,repoName :: !(Name Repo) + ,repoLanguage :: !(Maybe Text) + ,repoMasterBranch :: !(Maybe Text) + ,repoPushedAt :: !(Maybe GithubDate) -- ^ this is Nothing for new repositories + ,repoId :: !(Id Repo) + ,repoUrl :: !Text + ,repoOpenIssues :: !(Maybe Int) + ,repoHasWiki :: !(Maybe Bool) + ,repoHasIssues :: !(Maybe Bool) + ,repoHasDownloads :: !(Maybe Bool) + ,repoParent :: !(Maybe RepoRef) + ,repoSource :: !(Maybe RepoRef) + ,repoHooksUrl :: !Text + ,repoStargazersCount :: !Int } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Repo @@ -164,20 +165,20 @@ data RepoRef = RepoRef GithubOwner (Name Repo) -- Repo owner and name instance NFData RepoRef data SearchCodeResult = SearchCodeResult { - searchCodeTotalCount :: Int - ,searchCodeCodes :: [Code] + searchCodeTotalCount :: !Int + ,searchCodeCodes :: ![Code] } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData SearchCodeResult data Code = Code { - codeName :: String - ,codePath :: String - ,codeSha :: String - ,codeUrl :: String - ,codeGitUrl :: String - ,codeHtmlUrl :: String - ,codeRepo :: Repo + codeName :: !Text + ,codePath :: !Text + ,codeSha :: !Text + ,codeUrl :: !Text + ,codeGitUrl :: !Text + ,codeHtmlUrl :: !Text + ,codeRepo :: !Repo } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Code @@ -190,18 +191,18 @@ data Content instance NFData Content data ContentFileData = ContentFileData { - contentFileInfo :: ContentInfo - ,contentFileEncoding :: String - ,contentFileSize :: Int - ,contentFileContent :: String + contentFileInfo :: !ContentInfo + ,contentFileEncoding :: !Text + ,contentFileSize :: !Int + ,contentFileContent :: !Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData ContentFileData -- | An item in a directory listing. data ContentItem = ContentItem { - contentItemType :: ContentItemType - ,contentItemInfo :: ContentInfo + contentItemType :: !ContentItemType + ,contentItemInfo :: !ContentInfo } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData ContentItem @@ -213,12 +214,12 @@ instance NFData ContentItemType -- | Information common to both kinds of Content: files and directories. data ContentInfo = ContentInfo { - contentName :: String - ,contentPath :: String - ,contentSha :: String - ,contentUrl :: String - ,contentGitUrl :: String - ,contentHtmlUrl :: String + contentName :: !Text + ,contentPath :: !Text + ,contentSha :: !Text + ,contentUrl :: !Text + ,contentGitUrl :: !Text + ,contentHtmlUrl :: !Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData ContentInfo @@ -226,9 +227,9 @@ instance NFData ContentInfo data Contributor -- | An existing Github user, with their number of contributions, avatar -- URL, login, URL, ID, and Gravatar ID. - = KnownContributor Int String (Name Contributor) String (Id Contributor) String + = KnownContributor Int Text (Name Contributor) Text (Id Contributor) Text -- | An unknown Github user with their number of contributions and recorded name. - | AnonymousContributor Int String + | AnonymousContributor Int Text deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Contributor @@ -241,49 +242,49 @@ instance NFData Languages -- | A programming language with the name and number of characters written in -- it. -data Language = Language String Int +data Language = Language Text Int deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Language data DetailedOwner = DetailedUser { - detailedOwnerCreatedAt :: GithubDate - ,detailedOwnerType :: String - ,detailedOwnerPublicGists :: Int - ,detailedOwnerAvatarUrl :: String - ,detailedOwnerFollowers :: Int - ,detailedOwnerFollowing :: Int - ,detailedOwnerHireable :: Maybe Bool - ,detailedOwnerGravatarId :: Maybe String - ,detailedOwnerBlog :: Maybe String - ,detailedOwnerBio :: Maybe String - ,detailedOwnerPublicRepos :: Int - ,detailedOwnerName :: Maybe String - ,detailedOwnerLocation :: Maybe String - ,detailedOwnerCompany :: Maybe String - ,detailedOwnerEmail :: Maybe String - ,detailedOwnerUrl :: String - ,detailedOwnerId :: Id GithubOwner - ,detailedOwnerHtmlUrl :: String - ,detailedOwnerLogin :: Name GithubOwner + detailedOwnerCreatedAt :: !GithubDate + ,detailedOwnerType :: !Text + ,detailedOwnerPublicGists :: !Int + ,detailedOwnerAvatarUrl :: !Text + ,detailedOwnerFollowers :: !Int + ,detailedOwnerFollowing :: !Int + ,detailedOwnerHireable :: !(Maybe Bool) + ,detailedOwnerGravatarId :: !(Maybe Text) + ,detailedOwnerBlog :: !(Maybe Text) + ,detailedOwnerBio :: !(Maybe Text) + ,detailedOwnerPublicRepos :: !Int + ,detailedOwnerName :: !(Maybe Text) + ,detailedOwnerLocation :: !(Maybe Text) + ,detailedOwnerCompany :: !(Maybe Text) + ,detailedOwnerEmail :: !(Maybe Text) + ,detailedOwnerUrl :: !Text + ,detailedOwnerId :: !(Id GithubOwner) + ,detailedOwnerHtmlUrl :: !Text + ,detailedOwnerLogin :: !(Name GithubOwner) } | DetailedOrganization { - detailedOwnerCreatedAt :: GithubDate - ,detailedOwnerType :: String - ,detailedOwnerPublicGists :: Int - ,detailedOwnerAvatarUrl :: String - ,detailedOwnerFollowers :: Int - ,detailedOwnerFollowing :: Int - ,detailedOwnerBlog :: Maybe String - ,detailedOwnerBio :: Maybe String - ,detailedOwnerPublicRepos :: Int - ,detailedOwnerName :: Maybe String - ,detailedOwnerLocation :: Maybe String - ,detailedOwnerCompany :: Maybe String - ,detailedOwnerUrl :: String - ,detailedOwnerId :: Id GithubOwner - ,detailedOwnerHtmlUrl :: String - ,detailedOwnerLogin :: Name GithubOwner + detailedOwnerCreatedAt :: !GithubDate + ,detailedOwnerType :: !Text + ,detailedOwnerPublicGists :: !Int + ,detailedOwnerAvatarUrl :: !Text + ,detailedOwnerFollowers :: !Int + ,detailedOwnerFollowing :: !Int + ,detailedOwnerBlog :: !(Maybe Text) + ,detailedOwnerBio :: !(Maybe Text) + ,detailedOwnerPublicRepos :: !Int + ,detailedOwnerName :: !(Maybe Text) + ,detailedOwnerLocation :: !(Maybe Text) + ,detailedOwnerCompany :: !(Maybe Text) + ,detailedOwnerUrl :: !Text + ,detailedOwnerId :: !(Id GithubOwner) + ,detailedOwnerHtmlUrl :: !Text + ,detailedOwnerLogin :: !(Name GithubOwner) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData DetailedOwner diff --git a/Github/Data/Gists.hs b/Github/Data/Gists.hs index 34e4f61c..a315fa6c 100644 --- a/Github/Data/Gists.hs +++ b/Github/Data/Gists.hs @@ -8,43 +8,44 @@ import Github.Data.Name import Control.DeepSeq (NFData) import Data.Data (Data, Typeable) +import Data.Text (Text) import GHC.Generics (Generic) data Gist = Gist { - gistUser :: GithubOwner - ,gistGitPushUrl :: String - ,gistUrl :: String - ,gistDescription :: Maybe String - ,gistCreatedAt :: GithubDate - ,gistPublic :: Bool - ,gistComments :: Int - ,gistUpdatedAt :: GithubDate - ,gistHtmlUrl :: String - ,gistId :: Name Gist - ,gistFiles :: [GistFile] - ,gistGitPullUrl :: String + gistUser :: !GithubOwner + ,gistGitPushUrl :: !Text + ,gistUrl :: !Text + ,gistDescription :: !(Maybe Text) + ,gistCreatedAt :: !GithubDate + ,gistPublic :: !Bool + ,gistComments :: !Int + ,gistUpdatedAt :: !GithubDate + ,gistHtmlUrl :: !Text + ,gistId :: !(Name Gist) + ,gistFiles :: ![GistFile] + ,gistGitPullUrl :: !Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Gist data GistFile = GistFile { - gistFileType :: String - ,gistFileRawUrl :: String - ,gistFileSize :: Int - ,gistFileLanguage :: Maybe String - ,gistFileFilename :: String - ,gistFileContent :: Maybe String + gistFileType :: !Text + ,gistFileRawUrl :: !Text + ,gistFileSize :: !Int + ,gistFileLanguage :: !(Maybe Text) + ,gistFileFilename :: !Text + ,gistFileContent :: !(Maybe Text) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData GistFile data GistComment = GistComment { - gistCommentUser :: GithubOwner - ,gistCommentUrl :: String - ,gistCommentCreatedAt :: GithubDate - ,gistCommentBody :: String - ,gistCommentUpdatedAt :: GithubDate - ,gistCommentId :: Id GistComment + gistCommentUser :: !GithubOwner + ,gistCommentUrl :: !Text + ,gistCommentCreatedAt :: !GithubDate + ,gistCommentBody :: !Text + ,gistCommentUpdatedAt :: !GithubDate + ,gistCommentId :: !(Id GistComment) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData GistComment diff --git a/Github/Data/GitData.hs b/Github/Data/GitData.hs index ffd55993..b519b393 100644 --- a/Github/Data/GitData.hs +++ b/Github/Data/GitData.hs @@ -6,144 +6,145 @@ import Github.Data.Definitions import Control.DeepSeq (NFData) import Data.Data (Data, Typeable) +import Data.Text (Text) import GHC.Generics (Generic) data Commit = Commit { - commitSha :: String - ,commitParents :: [Tree] - ,commitUrl :: String - ,commitGitCommit :: GitCommit - ,commitCommitter :: Maybe GithubOwner - ,commitAuthor :: Maybe GithubOwner - ,commitFiles :: [File] - ,commitStats :: Maybe Stats + commitSha :: !Text + ,commitParents :: ![Tree] + ,commitUrl :: !Text + ,commitGitCommit :: !GitCommit + ,commitCommitter :: !(Maybe GithubOwner) + ,commitAuthor :: !(Maybe GithubOwner) + ,commitFiles :: ![File] + ,commitStats :: !(Maybe Stats) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Commit data Tree = Tree { - treeSha :: String - ,treeUrl :: String - ,treeGitTrees :: [GitTree] + treeSha :: !Text + ,treeUrl :: !Text + ,treeGitTrees :: ![GitTree] } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Tree data GitTree = GitTree { - gitTreeType :: String - ,gitTreeSha :: String + gitTreeType :: !Text + ,gitTreeSha :: !Text -- Can be empty for submodule - ,gitTreeUrl :: Maybe String - ,gitTreeSize :: Maybe Int - ,gitTreePath :: String - ,gitTreeMode :: String + ,gitTreeUrl :: !(Maybe Text) + ,gitTreeSize :: !(Maybe Int) + ,gitTreePath :: !Text + ,gitTreeMode :: !Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData GitTree data GitCommit = GitCommit { - gitCommitMessage :: String - ,gitCommitUrl :: String - ,gitCommitCommitter :: GitUser - ,gitCommitAuthor :: GitUser - ,gitCommitTree :: Tree - ,gitCommitSha :: Maybe String - ,gitCommitParents :: [Tree] + gitCommitMessage :: !Text + ,gitCommitUrl :: !Text + ,gitCommitCommitter :: !GitUser + ,gitCommitAuthor :: !GitUser + ,gitCommitTree :: !Tree + ,gitCommitSha :: !(Maybe Text) + ,gitCommitParents :: ![Tree] } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData GitCommit data Blob = Blob { - blobUrl :: String - ,blobEncoding :: String - ,blobContent :: String - ,blobSha :: String - ,blobSize :: Int + blobUrl :: !Text + ,blobEncoding :: !Text + ,blobContent :: !Text + ,blobSha :: !Text + ,blobSize :: !Int } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Blob data Tag = Tag { - tagName :: String - ,tagZipballUrl :: String - ,tagTarballUrl :: String - ,tagCommit :: BranchCommit + tagName :: !Text + ,tagZipballUrl :: !Text + ,tagTarballUrl :: !Text + ,tagCommit :: !BranchCommit } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Tag data Branch = Branch { - branchName :: String - ,branchCommit :: BranchCommit + branchName :: !Text + ,branchCommit :: !BranchCommit } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Branch data BranchCommit = BranchCommit { - branchCommitSha :: String - ,branchCommitUrl :: String + branchCommitSha :: !Text + ,branchCommitUrl :: !Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData BranchCommit data Diff = Diff { - diffStatus :: String - ,diffBehindBy :: Int - ,diffPatchUrl :: String - ,diffUrl :: String - ,diffBaseCommit :: Commit - ,diffCommits :: [Commit] - ,diffTotalCommits :: Int - ,diffHtmlUrl :: String - ,diffFiles :: [File] - ,diffAheadBy :: Int - ,diffDiffUrl :: String - ,diffPermalinkUrl :: String + diffStatus :: !Text + ,diffBehindBy :: !Int + ,diffPatchUrl :: !Text + ,diffUrl :: !Text + ,diffBaseCommit :: !Commit + ,diffCommits :: ![Commit] + ,diffTotalCommits :: !Int + ,diffHtmlUrl :: !Text + ,diffFiles :: ![File] + ,diffAheadBy :: !Int + ,diffDiffUrl :: !Text + ,diffPermalinkUrl :: !Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Diff data NewGitReference = NewGitReference { - newGitReferenceRef :: String - ,newGitReferenceSha :: String + newGitReferenceRef :: !Text + ,newGitReferenceSha :: !Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData NewGitReference data GitReference = GitReference { - gitReferenceObject :: GitObject - ,gitReferenceUrl :: String - ,gitReferenceRef :: String + gitReferenceObject :: !GitObject + ,gitReferenceUrl :: !Text + ,gitReferenceRef :: !Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData GitReference data GitObject = GitObject { - gitObjectType :: String - ,gitObjectSha :: String - ,gitObjectUrl :: String + gitObjectType :: !Text + ,gitObjectSha :: !Text + ,gitObjectUrl :: !Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData GitObject data GitUser = GitUser { - gitUserName :: String - ,gitUserEmail :: String - ,gitUserDate :: GithubDate + gitUserName :: !Text + ,gitUserEmail :: !Text + ,gitUserDate :: !GithubDate } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData GitUser data File = File { - fileBlobUrl :: String - ,fileStatus :: String - ,fileRawUrl :: String - ,fileAdditions :: Int - ,fileSha :: String - ,fileChanges :: Int - ,filePatch :: String - ,fileFilename :: String - ,fileDeletions :: Int + fileBlobUrl :: !Text + ,fileStatus :: !Text + ,fileRawUrl :: !Text + ,fileAdditions :: !Int + ,fileSha :: !Text + ,fileChanges :: !Int + ,filePatch :: !Text + ,fileFilename :: !Text + ,fileDeletions :: !Int } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData File diff --git a/Github/Data/Issues.hs b/Github/Data/Issues.hs index bdc97271..1b76215f 100644 --- a/Github/Data/Issues.hs +++ b/Github/Data/Issues.hs @@ -8,24 +8,25 @@ import Github.Data.PullRequests import Control.DeepSeq (NFData) import Data.Data (Data, Typeable) +import Data.Text (Text) import GHC.Generics (Generic) data Issue = Issue { issueClosedAt :: Maybe GithubDate ,issueUpdatedAt :: GithubDate - ,issueEventsUrl :: String - ,issueHtmlUrl :: Maybe String + ,issueEventsUrl :: Text + ,issueHtmlUrl :: Maybe Text ,issueClosedBy :: Maybe GithubOwner ,issueLabels :: [IssueLabel] ,issueNumber :: Int ,issueAssignee :: Maybe GithubOwner ,issueUser :: GithubOwner - ,issueTitle :: String + ,issueTitle :: Text ,issuePullRequest :: Maybe PullRequestReference - ,issueUrl :: String + ,issueUrl :: Text ,issueCreatedAt :: GithubDate - ,issueBody :: Maybe String - ,issueState :: String + ,issueBody :: Maybe Text + ,issueState :: Text ,issueId :: Id Issue ,issueComments :: Int ,issueMilestone :: Maybe Milestone @@ -34,22 +35,22 @@ data Issue = Issue { instance NFData Issue data NewIssue = NewIssue { - newIssueTitle :: String -, newIssueBody :: Maybe String -, newIssueAssignee :: Maybe String + newIssueTitle :: Text +, newIssueBody :: Maybe Text +, newIssueAssignee :: Maybe Text , newIssueMilestone :: Maybe Int -, newIssueLabels :: Maybe [String] +, newIssueLabels :: Maybe [Text] } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData NewIssue data EditIssue = EditIssue { - editIssueTitle :: Maybe String -, editIssueBody :: Maybe String -, editIssueAssignee :: Maybe String -, editIssueState :: Maybe String + editIssueTitle :: Maybe Text +, editIssueBody :: Maybe Text +, editIssueAssignee :: Maybe Text +, editIssueState :: Maybe Text , editIssueMilestone :: Maybe Int -, editIssueLabels :: Maybe [String] +, editIssueLabels :: Maybe [Text] } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData EditIssue @@ -60,19 +61,19 @@ data Milestone = Milestone { ,milestoneOpenIssues :: Int ,milestoneNumber :: Int ,milestoneClosedIssues :: Int - ,milestoneDescription :: Maybe String - ,milestoneTitle :: String - ,milestoneUrl :: String + ,milestoneDescription :: Maybe Text + ,milestoneTitle :: Text + ,milestoneUrl :: Text ,milestoneCreatedAt :: GithubDate - ,milestoneState :: String + ,milestoneState :: Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Milestone data IssueLabel = IssueLabel { - labelColor :: String - ,labelUrl :: String - ,labelName :: String + labelColor :: Text + ,labelUrl :: Text + ,labelName :: Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData IssueLabel @@ -80,10 +81,10 @@ instance NFData IssueLabel data IssueComment = IssueComment { issueCommentUpdatedAt :: GithubDate ,issueCommentUser :: GithubOwner - ,issueCommentUrl :: String - ,issueCommentHtmlUrl :: String + ,issueCommentUrl :: Text + ,issueCommentHtmlUrl :: Text ,issueCommentCreatedAt :: GithubDate - ,issueCommentBody :: String + ,issueCommentBody :: Text ,issueCommentId :: Int } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -121,13 +122,13 @@ instance NFData EventType -- | Issue event data Event = Event { - eventActor :: GithubOwner - ,eventType :: EventType - ,eventCommitId :: Maybe String - ,eventUrl :: String - ,eventCreatedAt :: GithubDate - ,eventId :: Int - ,eventIssue :: Maybe Issue + eventActor :: !GithubOwner + ,eventType :: !EventType + ,eventCommitId :: !(Maybe Text) + ,eventUrl :: !Text + ,eventCreatedAt :: !GithubDate + ,eventId :: !Int + ,eventIssue :: !(Maybe Issue) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Event diff --git a/Github/Data/Name.hs b/Github/Data/Name.hs index a43d83ac..0c8f69c3 100644 --- a/Github/Data/Name.hs +++ b/Github/Data/Name.hs @@ -11,17 +11,20 @@ import Data.Aeson.Compat (FromJSON (..), ToJSON (..)) import Data.Data (Data, Typeable) import Data.Hashable (Hashable) import Data.String (IsString (..)) +import Data.Text (Text) import GHC.Generics (Generic) -newtype Name entity = N String +import qualified Data.Text as T + +newtype Name entity = N Text deriving (Eq, Ord, Show, Read, Generic, Typeable, Data) -- | Smart constructor for 'Name' -mkName :: proxy entity -> String -> Name entity +mkName :: proxy entity -> Text -> Name entity mkName _ = N untagName :: Name entity -> String -untagName (N name) = name +untagName (N name) = T.unpack name instance Hashable (Name entity) @@ -35,4 +38,4 @@ instance ToJSON (Name entity) where toJSON = toJSON . untagName instance IsString (Name entity) where - fromString = N + fromString = N . fromString diff --git a/Github/Data/PullRequests.hs b/Github/Data/PullRequests.hs index 0e3da624..4263d9d2 100644 --- a/Github/Data/PullRequests.hs +++ b/Github/Data/PullRequests.hs @@ -6,112 +6,113 @@ import Github.Data.Definitions import Control.DeepSeq (NFData) import Data.Data (Data, Typeable) +import Data.Text (Text) import GHC.Generics (Generic) data PullRequest = PullRequest { - pullRequestClosedAt :: Maybe GithubDate - ,pullRequestCreatedAt :: GithubDate - ,pullRequestUser :: GithubOwner - ,pullRequestPatchUrl :: String - ,pullRequestState :: String - ,pullRequestNumber :: Int - ,pullRequestHtmlUrl :: String - ,pullRequestUpdatedAt :: GithubDate - ,pullRequestBody :: String - ,pullRequestIssueUrl :: String - ,pullRequestDiffUrl :: String - ,pullRequestUrl :: String - ,pullRequestLinks :: PullRequestLinks - ,pullRequestMergedAt :: Maybe GithubDate - ,pullRequestTitle :: String - ,pullRequestId :: Int + pullRequestClosedAt :: !(Maybe GithubDate) + ,pullRequestCreatedAt :: !GithubDate + ,pullRequestUser :: !GithubOwner + ,pullRequestPatchUrl :: !Text + ,pullRequestState :: !Text + ,pullRequestNumber :: !Int + ,pullRequestHtmlUrl :: !Text + ,pullRequestUpdatedAt :: !GithubDate + ,pullRequestBody :: !Text + ,pullRequestIssueUrl :: !Text + ,pullRequestDiffUrl :: !Text + ,pullRequestUrl :: !Text + ,pullRequestLinks :: !PullRequestLinks + ,pullRequestMergedAt :: !(Maybe GithubDate) + ,pullRequestTitle :: !Text + ,pullRequestId :: !Int } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData PullRequest data DetailedPullRequest = DetailedPullRequest { -- this is a duplication of a PullRequest - detailedPullRequestClosedAt :: Maybe GithubDate - ,detailedPullRequestCreatedAt :: GithubDate - ,detailedPullRequestUser :: GithubOwner - ,detailedPullRequestPatchUrl :: String - ,detailedPullRequestState :: String - ,detailedPullRequestNumber :: Int - ,detailedPullRequestHtmlUrl :: String - ,detailedPullRequestUpdatedAt :: GithubDate - ,detailedPullRequestBody :: String - ,detailedPullRequestIssueUrl :: String - ,detailedPullRequestDiffUrl :: String - ,detailedPullRequestUrl :: String - ,detailedPullRequestLinks :: PullRequestLinks - ,detailedPullRequestMergedAt :: Maybe GithubDate - ,detailedPullRequestTitle :: String - ,detailedPullRequestId :: Int - - ,detailedPullRequestMergedBy :: Maybe GithubOwner - ,detailedPullRequestChangedFiles :: Int - ,detailedPullRequestHead :: PullRequestCommit - ,detailedPullRequestComments :: Int - ,detailedPullRequestDeletions :: Int - ,detailedPullRequestAdditions :: Int - ,detailedPullRequestReviewComments :: Int - ,detailedPullRequestBase :: PullRequestCommit - ,detailedPullRequestCommits :: Int - ,detailedPullRequestMerged :: Bool - ,detailedPullRequestMergeable :: Maybe Bool + detailedPullRequestClosedAt :: !(Maybe GithubDate) + ,detailedPullRequestCreatedAt :: !GithubDate + ,detailedPullRequestUser :: !GithubOwner + ,detailedPullRequestPatchUrl :: !Text + ,detailedPullRequestState :: !Text + ,detailedPullRequestNumber :: !Int + ,detailedPullRequestHtmlUrl :: !Text + ,detailedPullRequestUpdatedAt :: !GithubDate + ,detailedPullRequestBody :: !Text + ,detailedPullRequestIssueUrl :: !Text + ,detailedPullRequestDiffUrl :: !Text + ,detailedPullRequestUrl :: !Text + ,detailedPullRequestLinks :: !PullRequestLinks + ,detailedPullRequestMergedAt :: !(Maybe GithubDate) + ,detailedPullRequestTitle :: !Text + ,detailedPullRequestId :: !Int + + ,detailedPullRequestMergedBy :: !(Maybe GithubOwner) + ,detailedPullRequestChangedFiles :: !Int + ,detailedPullRequestHead :: !PullRequestCommit + ,detailedPullRequestComments :: !Int + ,detailedPullRequestDeletions :: !Int + ,detailedPullRequestAdditions :: !Int + ,detailedPullRequestReviewComments :: !Int + ,detailedPullRequestBase :: !PullRequestCommit + ,detailedPullRequestCommits :: !Int + ,detailedPullRequestMerged :: !Bool + ,detailedPullRequestMergeable :: !(Maybe Bool) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData DetailedPullRequest data EditPullRequest = EditPullRequest { - editPullRequestTitle :: Maybe String - ,editPullRequestBody :: Maybe String - ,editPullRequestState :: Maybe EditPullRequestState + editPullRequestTitle :: !(Maybe Text) + ,editPullRequestBody :: !(Maybe Text) + ,editPullRequestState :: !(Maybe EditPullRequestState) } deriving (Show, Generic) instance NFData EditPullRequest data CreatePullRequest = CreatePullRequest - { createPullRequestTitle :: String - , createPullRequestBody :: String - , createPullRequestHead :: String - , createPullRequestBase :: String + { createPullRequestTitle :: !Text + , createPullRequestBody :: !Text + , createPullRequestHead :: !Text + , createPullRequestBase :: !Text } | CreatePullRequestIssue - { createPullRequestIssueNum :: Int - , createPullRequestHead :: String - , createPullRequestBase :: String + { createPullRequestIssueNum :: !Int + , createPullRequestHead :: !Text + , createPullRequestBase :: !Text } deriving (Show, Generic) instance NFData CreatePullRequest data PullRequestLinks = PullRequestLinks { - pullRequestLinksReviewComments :: String - ,pullRequestLinksComments :: String - ,pullRequestLinksHtml :: String - ,pullRequestLinksSelf :: String + pullRequestLinksReviewComments :: !Text + ,pullRequestLinksComments :: !Text + ,pullRequestLinksHtml :: !Text + ,pullRequestLinksSelf :: !Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData PullRequestLinks data PullRequestCommit = PullRequestCommit { - pullRequestCommitLabel :: String - ,pullRequestCommitRef :: String - ,pullRequestCommitSha :: String - ,pullRequestCommitUser :: GithubOwner - ,pullRequestCommitRepo :: Repo + pullRequestCommitLabel :: !Text + ,pullRequestCommitRef :: !Text + ,pullRequestCommitSha :: !Text + ,pullRequestCommitUser :: !GithubOwner + ,pullRequestCommitRepo :: !Repo } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData PullRequestCommit data PullRequestEvent = PullRequestEvent { - pullRequestEventAction :: PullRequestEventType - ,pullRequestEventNumber :: Int - ,pullRequestEventPullRequest :: DetailedPullRequest - ,pullRequestRepository :: Repo - ,pullRequestSender :: GithubOwner + pullRequestEventAction :: !PullRequestEventType + ,pullRequestEventNumber :: !Int + ,pullRequestEventPullRequest :: !DetailedPullRequest + ,pullRequestRepository :: !Repo + ,pullRequestSender :: !GithubOwner } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData PullRequestEvent @@ -130,9 +131,9 @@ data PullRequestEventType = instance NFData PullRequestEventType data PullRequestReference = PullRequestReference { - pullRequestReferenceHtmlUrl :: Maybe String - ,pullRequestReferencePatchUrl :: Maybe String - ,pullRequestReferenceDiffUrl :: Maybe String + pullRequestReferenceHtmlUrl :: !(Maybe Text) + ,pullRequestReferencePatchUrl :: !(Maybe Text) + ,pullRequestReferenceDiffUrl :: !(Maybe Text) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData PullRequestReference diff --git a/Github/Data/Repos.hs b/Github/Data/Repos.hs index 884c2557..34f2b049 100644 --- a/Github/Data/Repos.hs +++ b/Github/Data/Repos.hs @@ -7,16 +7,17 @@ import Github.Data.Name import Control.DeepSeq (NFData) import Data.Data (Data, Typeable) +import Data.Text (Text) import GHC.Generics (Generic) data NewRepo = NewRepo { - newRepoName :: Name Repo -, newRepoDescription :: (Maybe String) -, newRepoHomepage :: (Maybe String) -, newRepoPrivate :: (Maybe Bool) -, newRepoHasIssues :: (Maybe Bool) -, newRepoHasWiki :: (Maybe Bool) -, newRepoAutoInit :: (Maybe Bool) + newRepoName :: !(Name Repo) +, newRepoDescription :: !(Maybe Text) +, newRepoHomepage :: !(Maybe Text) +, newRepoPrivate :: !(Maybe Bool) +, newRepoHasIssues :: !(Maybe Bool) +, newRepoHasWiki :: !(Maybe Bool) +, newRepoAutoInit :: !(Maybe Bool) } deriving (Eq, Ord, Show, Data, Typeable, Generic) instance NFData NewRepo @@ -25,13 +26,13 @@ newRepo :: Name Repo -> NewRepo newRepo name = NewRepo name Nothing Nothing Nothing Nothing Nothing Nothing data EditRepo = EditRepo { - editName :: Maybe (Name Repo) -, editDescription :: Maybe String -, editHomepage :: Maybe String -, editPublic :: Maybe Bool -, editHasIssues :: Maybe Bool -, editHasWiki :: Maybe Bool -, editHasDownloads :: Maybe Bool + editName :: !(Maybe (Name Repo)) +, editDescription :: !(Maybe Text) +, editHomepage :: !(Maybe Text) +, editPublic :: !(Maybe Bool) +, editHasIssues :: !(Maybe Bool) +, editHasWiki :: !(Maybe Bool) +, editHasDownloads :: !(Maybe Bool) } deriving (Eq, Ord, Show, Data, Typeable, Generic) instance NFData EditRepo diff --git a/Github/Data/Teams.hs b/Github/Data/Teams.hs index b23f26a7..c3dca847 100644 --- a/Github/Data/Teams.hs +++ b/Github/Data/Teams.hs @@ -6,6 +6,7 @@ import Github.Data.Definitions import Control.DeepSeq (NFData) import Data.Data (Data, Typeable) +import Data.Text (Text) import GHC.Generics (Generic) import Github.Data.Id @@ -27,40 +28,40 @@ data Permission = instance NFData Permission data Team = Team { - teamId :: Id Team - ,teamUrl :: String - ,teamName :: Name Team - ,teamSlug :: String - ,teamDescription :: Maybe String - ,teamPrivacy :: Maybe Privacy - ,teamPermission :: Permission - ,teamMembersUrl :: String - ,teamRepositoriesUrl :: String + teamId :: !(Id Team) + ,teamUrl :: !Text + ,teamName :: !Text + ,teamSlug :: !(Name Team) + ,teamDescription :: !(Maybe Text) + ,teamPrivacy :: !(Maybe Privacy) + ,teamPermission :: !Permission + ,teamMembersUrl :: !Text + ,teamRepositoriesUrl :: !Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Team data DetailedTeam = DetailedTeam { - detailedTeamId :: Id Team - ,detailedTeamUrl :: String - ,detailedTeamName :: Name Team - ,detailedTeamSlug :: String - ,detailedTeamDescription :: Maybe String - ,detailedTeamPrivacy :: Maybe Privacy - ,detailedTeamPermission :: Permission - ,detailedTeamMembersUrl :: String - ,detailedTeamRepositoriesUrl :: String - ,detailedTeamMembersCount :: Int - ,detailedTeamReposCount :: Int - ,detailedTeamOrganization :: GithubOwner + detailedTeamId :: !(Id Team) + ,detailedTeamUrl :: !Text + ,detailedTeamName :: !(Name Team) + ,detailedTeamSlug :: !Text + ,detailedTeamDescription :: !(Maybe Text) + ,detailedTeamPrivacy :: !(Maybe Privacy) + ,detailedTeamPermission :: !Permission + ,detailedTeamMembersUrl :: !Text + ,detailedTeamRepositoriesUrl :: !Text + ,detailedTeamMembersCount :: !Int + ,detailedTeamReposCount :: !Int + ,detailedTeamOrganization :: !GithubOwner } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData DetailedTeam data CreateTeam = CreateTeam { - createTeamName :: Name Team - ,createTeamDescription :: Maybe String - ,createRepoNames :: [String] + createTeamName :: !(Name Team) + ,createTeamDescription :: !(Maybe Text) + ,createRepoNames :: ![Text] {-,createTeamPrivacy :: Privacy-} ,createTeamPermission :: Permission } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -68,10 +69,10 @@ data CreateTeam = CreateTeam { instance NFData CreateTeam data EditTeam = EditTeam { - editTeamName :: Name Team - ,editTeamDescription :: Maybe String + editTeamName :: !(Name Team) + ,editTeamDescription :: !(Maybe Text) {-,editTeamPrivacy :: Privacy-} - ,editTeamPermission :: Permission + ,editTeamPermission :: !Permission } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData EditTeam @@ -91,15 +92,15 @@ data ReqState = instance NFData ReqState data TeamMembership = TeamMembership { - teamMembershipUrl :: String, - teamMembershipRole :: Role, - teamMembershipReqState :: ReqState + teamMembershipUrl :: !Text, + teamMembershipRole :: !Role, + teamMembershipReqState :: !ReqState } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData TeamMembership data CreateTeamMembership = CreateTeamMembership { - createTeamMembershipRole :: Role + createTeamMembershipRole :: !Role } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData CreateTeamMembership diff --git a/Github/Data/Webhooks.hs b/Github/Data/Webhooks.hs index 7c0cbb4a..27bc8141 100644 --- a/Github/Data/Webhooks.hs +++ b/Github/Data/Webhooks.hs @@ -8,21 +8,22 @@ import Github.Data.Id import Control.DeepSeq (NFData) import Data.Data (Data, Typeable) +import Data.Text (Text) import GHC.Generics (Generic) import qualified Data.Map as M data RepoWebhook = RepoWebhook { - repoWebhookUrl :: String - ,repoWebhookTestUrl :: String - ,repoWebhookId :: Id RepoWebhook - ,repoWebhookName :: String - ,repoWebhookActive :: Bool - ,repoWebhookEvents :: [RepoWebhookEvent] - ,repoWebhookConfig :: M.Map String String - ,repoWebhookLastResponse :: RepoWebhookResponse - ,repoWebhookUpdatedAt :: GithubDate - ,repoWebhookCreatedAt :: GithubDate + repoWebhookUrl :: !Text + ,repoWebhookTestUrl :: !Text + ,repoWebhookId :: !(Id RepoWebhook) + ,repoWebhookName :: !Text + ,repoWebhookActive :: !Bool + ,repoWebhookEvents :: ![RepoWebhookEvent] + ,repoWebhookConfig :: !(M.Map Text Text) + ,repoWebhookLastResponse :: !RepoWebhookResponse + ,repoWebhookUpdatedAt :: !GithubDate + ,repoWebhookCreatedAt :: !GithubDate } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData RepoWebhook @@ -53,36 +54,36 @@ data RepoWebhookEvent = instance NFData RepoWebhookEvent data RepoWebhookResponse = RepoWebhookResponse { - repoWebhookResponseCode :: Maybe Int - ,repoWebhookResponseStatus :: String - ,repoWebhookResponseMessage :: Maybe String + repoWebhookResponseCode :: !(Maybe Int) + ,repoWebhookResponseStatus :: !Text + ,repoWebhookResponseMessage :: !(Maybe Text) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData RepoWebhookResponse data PingEvent = PingEvent { - pingEventZen :: String - ,pingEventHook :: RepoWebhook - ,pingEventHookId :: Id RepoWebhook + pingEventZen :: !Text + ,pingEventHook :: !RepoWebhook + ,pingEventHookId :: !(Id RepoWebhook) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData PingEvent data NewRepoWebhook = NewRepoWebhook { - newRepoWebhookName :: String - ,newRepoWebhookConfig :: M.Map String String - ,newRepoWebhookEvents :: Maybe [RepoWebhookEvent] - ,newRepoWebhookActive :: Maybe Bool + newRepoWebhookName :: !Text + ,newRepoWebhookConfig :: !(M.Map Text Text) + ,newRepoWebhookEvents :: !(Maybe [RepoWebhookEvent]) + ,newRepoWebhookActive :: !(Maybe Bool) } deriving (Eq, Ord, Show, Typeable, Data, Generic) instance NFData NewRepoWebhook data EditRepoWebhook = EditRepoWebhook { - editRepoWebhookConfig :: Maybe (M.Map String String) - ,editRepoWebhookEvents :: Maybe [RepoWebhookEvent] - ,editRepoWebhookAddEvents :: Maybe [RepoWebhookEvent] - ,editRepoWebhookRemoveEvents :: Maybe [RepoWebhookEvent] - ,editRepoWebhookActive :: Maybe Bool + editRepoWebhookConfig :: !(Maybe (M.Map Text Text)) + ,editRepoWebhookEvents :: !(Maybe [RepoWebhookEvent]) + ,editRepoWebhookAddEvents :: !(Maybe [RepoWebhookEvent]) + ,editRepoWebhookRemoveEvents :: !(Maybe [RepoWebhookEvent]) + ,editRepoWebhookActive :: !(Maybe Bool) } deriving (Eq, Ord, Show, Typeable, Data, Generic) instance NFData EditRepoWebhook diff --git a/Github/Issues.hs b/Github/Issues.hs index 87881f05..b27c63c3 100644 --- a/Github/Issues.hs +++ b/Github/Issues.hs @@ -29,6 +29,7 @@ import Control.DeepSeq (NFData) import Data.Aeson.Compat (encode) import Data.Data import Data.List (intercalate) +import Data.Text (Text) #if MIN_VERSION_time(1,5,0) import Data.Time (defaultTimeLocale) #else @@ -124,7 +125,7 @@ issuesForRepoR user reqRepoName issueLimitations = -- Creating new issues. -newIssue :: String -> NewIssue +newIssue :: Text -> NewIssue newIssue title = NewIssue title Nothing Nothing Nothing Nothing diff --git a/Github/Issues/Comments.hs b/Github/Issues/Comments.hs index 09ef59a5..7d295544 100644 --- a/Github/Issues/Comments.hs +++ b/Github/Issues/Comments.hs @@ -15,6 +15,7 @@ module Github.Issues.Comments ( ) where import Data.Aeson.Compat (encode) +import Data.Text (Text) import Github.Auth import Github.Data import Github.Request @@ -55,14 +56,14 @@ commentsR user repo iid = -- -- > createComment (GithubUser (user, password)) user repo issue -- > "some words" -createComment :: GithubAuth -> Name GithubOwner -> Name Repo -> Id Issue -> String +createComment :: GithubAuth -> Name GithubOwner -> Name Repo -> Id Issue -> Text -> IO (Either Error Comment) createComment auth user repo iss body = executeRequest auth $ createCommentR user repo iss body -- | Create a comment. -- See -createCommentR :: Name GithubOwner -> Name Repo -> Id Issue -> String -> GithubRequest 'True Comment +createCommentR :: Name GithubOwner -> Name Repo -> Id Issue -> Text -> GithubRequest 'True Comment createCommentR user repo iss body = GithubPost Post parts (encode $ NewComment body) where @@ -72,14 +73,14 @@ createCommentR user repo iss body = -- -- > editComment (GithubUser (user, password)) user repo commentid -- > "new words" -editComment :: GithubAuth -> Name GithubOwner -> Name Repo -> Id Comment -> String +editComment :: GithubAuth -> Name GithubOwner -> Name Repo -> Id Comment -> Text -> IO (Either Error Comment) editComment auth user repo commid body = executeRequest auth $ editCommentR user repo commid body -- | Edit a comment. -- See -editCommentR :: Name GithubOwner -> Name Repo -> Id Comment -> String -> GithubRequest 'True Comment +editCommentR :: Name GithubOwner -> Name Repo -> Id Comment -> Text -> GithubRequest 'True Comment editCommentR user repo commid body = GithubPost Patch parts (encode $ EditComment body) where diff --git a/Github/Private.hs b/Github/Private.hs index 0619f988..a625a33b 100644 --- a/Github/Private.hs +++ b/Github/Private.hs @@ -22,6 +22,8 @@ import Network.HTTP.Types (Status(..), notFound404) import Network.HTTP.Conduit import Data.Maybe (fromMaybe) +import qualified Data.Text as T + import qualified Control.Exception as E import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as LBS @@ -217,14 +219,14 @@ parseJsonRaw jsonString = let parsed = parse json jsonString in case parsed of Data.Attoparsec.ByteString.Lazy.Done _ jsonResult -> Right jsonResult - (Fail _ _ e) -> Left $ ParseError e + (Fail _ _ e) -> Left $ ParseError (T.pack e) jsonResultToE :: Show b => LBS.ByteString -> Data.Aeson.Result b -> Either Error b jsonResultToE jsonString result = case result of Success s -> Right s - Error e -> Left $ JsonError $ - e ++ " on the JSON: " ++ LBS.unpack jsonString + Error e -> Left $ JsonError $ T.pack $ + e ++ " on the JSON: " ++ LBS.unpack jsonString parseJson :: (FromJSON b, Show b) => LBS.ByteString -> Either Error b parseJson jsonString = either Left (jsonResultToE jsonString . fromJSON) diff --git a/Github/Repos/Commits.hs b/Github/Repos/Commits.hs index 717865fa..d8ebd08b 100644 --- a/Github/Repos/Commits.hs +++ b/Github/Repos/Commits.hs @@ -23,6 +23,8 @@ import Github.Auth import Github.Data import Github.Request +import qualified Data.Text as T + import Data.Time.Format (formatTime) #if MIN_VERSION_time (1,5,0) import Data.Time (defaultTimeLocale) @@ -40,9 +42,9 @@ githubFormat = formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S" . fromGithubDate #endif renderCommitQueryOption :: CommitQueryOption -> String -renderCommitQueryOption (CommitQuerySha sha) = "sha=" ++ sha -renderCommitQueryOption (CommitQueryPath path) = "path=" ++ path -renderCommitQueryOption (CommitQueryAuthor author) = "author=" ++ author +renderCommitQueryOption (CommitQuerySha sha) = "sha=" ++ T.unpack sha +renderCommitQueryOption (CommitQueryPath path) = "path=" ++ T.unpack path +renderCommitQueryOption (CommitQueryAuthor author) = "author=" ++ T.unpack author renderCommitQueryOption (CommitQuerySince date) = "since=" ++ ds ++ "Z" where ds = show $ githubFormat date renderCommitQueryOption (CommitQueryUntil date) = "until=" ++ ds ++ "Z" From b4c4f01a2bd643efb258655a1556e2ab0ddc5d2e Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Thu, 7 Jan 2016 19:34:14 +0200 Subject: [PATCH 125/510] Move data definitions --- Github/Data.hs | 2 + Github/Data/Definitions.hs | 78 ------------------------------------- Github/Data/Gists.hs | 4 +- Github/Data/Issues.hs | 31 +++++++++++---- Github/Data/PullRequests.hs | 1 + Github/Data/Repos.hs | 55 +++++++++++++++++++++++++- Github/Data/Search.hs | 44 +++++++++++++++++++++ Github/Data/Teams.hs | 4 +- Github/Data/Webhooks.hs | 2 +- Github/Issues.hs | 35 ++--------------- github.cabal | 1 + spec/Github/SearchSpec.hs | 4 +- 12 files changed, 135 insertions(+), 126 deletions(-) create mode 100644 Github/Data/Search.hs diff --git a/Github/Data.hs b/Github/Data.hs index a4e22f2e..45c81095 100644 --- a/Github/Data.hs +++ b/Github/Data.hs @@ -15,6 +15,7 @@ module Github.Data ( module Github.Data.Issues, module Github.Data.PullRequests, module Github.Data.Repos, + module Github.Data.Search, module Github.Data.Teams, module Github.Data.Webhooks, @@ -55,6 +56,7 @@ import Github.Data.Issues import Github.Data.Name import Github.Data.PullRequests import Github.Data.Repos +import Github.Data.Search import Github.Data.Teams import Github.Data.Webhooks diff --git a/Github/Data/Definitions.hs b/Github/Data/Definitions.hs index 145b61fc..1980992d 100644 --- a/Github/Data/Definitions.hs +++ b/Github/Data/Definitions.hs @@ -118,71 +118,6 @@ data Organization = Organization { instance NFData Organization -data SearchReposResult = SearchReposResult { - searchReposTotalCount :: !Int - ,searchReposRepos :: ![Repo] -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData SearchReposResult - -data Repo = Repo { - repoSshUrl :: !(Maybe Text) - ,repoDescription :: !(Maybe Text) - ,repoCreatedAt :: !(Maybe GithubDate) - ,repoHtmlUrl :: !Text - ,repoSvnUrl :: !(Maybe Text) - ,repoForks :: !(Maybe Int) - ,repoHomepage :: !(Maybe Text) - ,repoFork :: !(Maybe Bool) - ,repoGitUrl :: !(Maybe Text) - ,repoPrivate :: !Bool - ,repoCloneUrl :: !(Maybe Text) - ,repoSize :: !(Maybe Int) - ,repoUpdatedAt :: !(Maybe GithubDate) - ,repoWatchers :: !(Maybe Int) - ,repoOwner :: !GithubOwner - ,repoName :: !(Name Repo) - ,repoLanguage :: !(Maybe Text) - ,repoMasterBranch :: !(Maybe Text) - ,repoPushedAt :: !(Maybe GithubDate) -- ^ this is Nothing for new repositories - ,repoId :: !(Id Repo) - ,repoUrl :: !Text - ,repoOpenIssues :: !(Maybe Int) - ,repoHasWiki :: !(Maybe Bool) - ,repoHasIssues :: !(Maybe Bool) - ,repoHasDownloads :: !(Maybe Bool) - ,repoParent :: !(Maybe RepoRef) - ,repoSource :: !(Maybe RepoRef) - ,repoHooksUrl :: !Text - ,repoStargazersCount :: !Int -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData Repo - -data RepoRef = RepoRef GithubOwner (Name Repo) -- Repo owner and name - deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData RepoRef - -data SearchCodeResult = SearchCodeResult { - searchCodeTotalCount :: !Int - ,searchCodeCodes :: ![Code] -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData SearchCodeResult - -data Code = Code { - codeName :: !Text - ,codePath :: !Text - ,codeSha :: !Text - ,codeUrl :: !Text - ,codeGitUrl :: !Text - ,codeHtmlUrl :: !Text - ,codeRepo :: !Repo -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData Code - data Content = ContentFile ContentFileData | ContentDirectory [ContentItem] @@ -234,19 +169,6 @@ data Contributor instance NFData Contributor --- | This is only used for the FromJSON instance. -data Languages = Languages { getLanguages :: [Language] } - deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData Languages - --- | A programming language with the name and number of characters written in --- it. -data Language = Language Text Int - deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData Language - data DetailedOwner = DetailedUser { detailedOwnerCreatedAt :: !GithubDate ,detailedOwnerType :: !Text diff --git a/Github/Data/Gists.hs b/Github/Data/Gists.hs index a315fa6c..b87f154e 100644 --- a/Github/Data/Gists.hs +++ b/Github/Data/Gists.hs @@ -3,8 +3,8 @@ module Github.Data.Gists where import Github.Data.Definitions -import Github.Data.Id -import Github.Data.Name +import Github.Data.Id (Id) +import Github.Data.Name (Name) import Control.DeepSeq (NFData) import Data.Data (Data, Typeable) diff --git a/Github/Data/Issues.hs b/Github/Data/Issues.hs index 1b76215f..9cb69baa 100644 --- a/Github/Data/Issues.hs +++ b/Github/Data/Issues.hs @@ -3,12 +3,13 @@ module Github.Data.Issues where import Github.Data.Definitions -import Github.Data.Id +import Github.Data.Id (Id) import Github.Data.PullRequests import Control.DeepSeq (NFData) import Data.Data (Data, Typeable) import Data.Text (Text) +import Data.Time (UTCTime) import GHC.Generics (Generic) data Issue = Issue { @@ -90,13 +91,6 @@ data IssueComment = IssueComment { instance NFData IssueComment -data SearchIssuesResult = SearchIssuesResult { - searchIssuesTotalCount :: Int - ,searchIssuesIssues :: [Issue] -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData SearchIssuesResult - data EventType = Mentioned -- ^ The actor was @mentioned in an issue body. | Subscribed -- ^ The actor subscribed to receive notifications for an issue. @@ -132,3 +126,24 @@ data Event = Event { } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Event + +-- | A data structure for describing how to filter issues. This is used by +-- @issuesForRepo@. +data IssueLimitation = + AnyMilestone -- ^ Issues appearing in any milestone. [default] + | NoMilestone -- ^ Issues without a milestone. + | MilestoneId Int -- ^ Only issues that are in the milestone with the given id. + | Open -- ^ Only open issues. [default] + | OnlyClosed -- ^ Only closed issues. + | Unassigned -- ^ Issues to which no one has been assigned ownership. + | AnyAssignment -- ^ All issues regardless of assignment. [default] + | AssignedTo String -- ^ Only issues assigned to the user with the given login. + | Mentions String -- ^ Issues which mention the given string, taken to be a user's login. + | Labels [String] -- ^ A list of labels to filter by. + | Ascending -- ^ Sort ascending. + | Descending -- ^ Sort descending. [default] + | Since UTCTime -- ^ Only issues created since the specified date and time. + | PerPage Int -- ^ Download this many issues per query + deriving (Eq, Ord, Show, Typeable, Data, Generic) + +instance NFData IssueLimitation diff --git a/Github/Data/PullRequests.hs b/Github/Data/PullRequests.hs index 4263d9d2..6b946a29 100644 --- a/Github/Data/PullRequests.hs +++ b/Github/Data/PullRequests.hs @@ -3,6 +3,7 @@ module Github.Data.PullRequests where import Github.Data.Definitions +import Github.Data.Repos (Repo) import Control.DeepSeq (NFData) import Data.Data (Data, Typeable) diff --git a/Github/Data/Repos.hs b/Github/Data/Repos.hs index 34f2b049..b3dea17a 100644 --- a/Github/Data/Repos.hs +++ b/Github/Data/Repos.hs @@ -3,13 +3,53 @@ module Github.Data.Repos where import Github.Data.Definitions -import Github.Data.Name +import Github.Data.Id (Id) +import Github.Data.Name (Name) import Control.DeepSeq (NFData) import Data.Data (Data, Typeable) import Data.Text (Text) import GHC.Generics (Generic) +data Repo = Repo { + repoSshUrl :: !(Maybe Text) + ,repoDescription :: !(Maybe Text) + ,repoCreatedAt :: !(Maybe GithubDate) + ,repoHtmlUrl :: !Text + ,repoSvnUrl :: !(Maybe Text) + ,repoForks :: !(Maybe Int) + ,repoHomepage :: !(Maybe Text) + ,repoFork :: !(Maybe Bool) + ,repoGitUrl :: !(Maybe Text) + ,repoPrivate :: !Bool + ,repoCloneUrl :: !(Maybe Text) + ,repoSize :: !(Maybe Int) + ,repoUpdatedAt :: !(Maybe GithubDate) + ,repoWatchers :: !(Maybe Int) + ,repoOwner :: !GithubOwner + ,repoName :: !(Name Repo) + ,repoLanguage :: !(Maybe Text) + ,repoMasterBranch :: !(Maybe Text) + ,repoPushedAt :: !(Maybe GithubDate) -- ^ this is Nothing for new repositories + ,repoId :: !(Id Repo) + ,repoUrl :: !Text + ,repoOpenIssues :: !(Maybe Int) + ,repoHasWiki :: !(Maybe Bool) + ,repoHasIssues :: !(Maybe Bool) + ,repoHasDownloads :: !(Maybe Bool) + ,repoParent :: !(Maybe RepoRef) + ,repoSource :: !(Maybe RepoRef) + ,repoHooksUrl :: !Text + ,repoStargazersCount :: !Int +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Repo + +data RepoRef = RepoRef GithubOwner (Name Repo) -- Repo owner and name + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData RepoRef + data NewRepo = NewRepo { newRepoName :: !(Name Repo) , newRepoDescription :: !(Maybe Text) @@ -45,3 +85,16 @@ data RepoPublicity = | Private -- ^ Only private repos. | Member -- ^ Only repos to which the user is a member but not an owner. deriving (Show, Eq, Ord, Typeable, Data, Generic) + +-- | This is only used for the FromJSON instance. +data Languages = Languages { getLanguages :: [Language] } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Languages + +-- | A programming language with the name and number of characters written in +-- it. +data Language = Language Text Int + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Language diff --git a/Github/Data/Search.hs b/Github/Data/Search.hs new file mode 100644 index 00000000..fdc35856 --- /dev/null +++ b/Github/Data/Search.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +module Github.Data.Search where + +import Github.Data.Repos (Repo) +import Github.Data.Issues (Issue) + +import Control.DeepSeq (NFData) +import Data.Data (Data, Typeable) +import Data.Text (Text) +import GHC.Generics (Generic) + +data SearchReposResult = SearchReposResult { + searchReposTotalCount :: !Int + ,searchReposRepos :: ![Repo] +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData SearchReposResult + +data Code = Code { + codeName :: !Text + ,codePath :: !Text + ,codeSha :: !Text + ,codeUrl :: !Text + ,codeGitUrl :: !Text + ,codeHtmlUrl :: !Text + ,codeRepo :: !Repo +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Code + +data SearchCodeResult = SearchCodeResult { + searchCodeTotalCount :: !Int + ,searchCodeCodes :: ![Code] +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData SearchCodeResult + +data SearchIssuesResult = SearchIssuesResult { + searchIssuesTotalCount :: Int + ,searchIssuesIssues :: [Issue] +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData SearchIssuesResult diff --git a/Github/Data/Teams.hs b/Github/Data/Teams.hs index c3dca847..ed4659dc 100644 --- a/Github/Data/Teams.hs +++ b/Github/Data/Teams.hs @@ -9,8 +9,8 @@ import Data.Data (Data, Typeable) import Data.Text (Text) import GHC.Generics (Generic) -import Github.Data.Id -import Github.Data.Name +import Github.Data.Id (Id) +import Github.Data.Name (Name) data Privacy = PrivacyClosed diff --git a/Github/Data/Webhooks.hs b/Github/Data/Webhooks.hs index 27bc8141..f7a68285 100644 --- a/Github/Data/Webhooks.hs +++ b/Github/Data/Webhooks.hs @@ -4,7 +4,7 @@ module Github.Data.Webhooks where import Github.Data.Definitions -import Github.Data.Id +import Github.Data.Id (Id) import Control.DeepSeq (NFData) import Data.Data (Data, Typeable) diff --git a/Github/Issues.hs b/Github/Issues.hs index b27c63c3..fb1de312 100644 --- a/Github/Issues.hs +++ b/Github/Issues.hs @@ -1,8 +1,6 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} -- | The issues API as described on . module Github.Issues ( issue, @@ -25,9 +23,7 @@ import Github.Auth import Github.Data import Github.Request -import Control.DeepSeq (NFData) import Data.Aeson.Compat (encode) -import Data.Data import Data.List (intercalate) import Data.Text (Text) #if MIN_VERSION_time(1,5,0) @@ -35,33 +31,9 @@ import Data.Time (defaultTimeLocale) #else import System.Locale (defaultTimeLocale) #endif -import GHC.Generics (Generic) -import Data.Time.Clock (UTCTime (..)) import Data.Time.Format (formatTime) - --- | A data structure for describing how to filter issues. This is used by --- @issuesForRepo@. -data IssueLimitation = - AnyMilestone -- ^ Issues appearing in any milestone. [default] - | NoMilestone -- ^ Issues without a milestone. - | MilestoneId Int -- ^ Only issues that are in the milestone with the given id. - | Open -- ^ Only open issues. [default] - | OnlyClosed -- ^ Only closed issues. - | Unassigned -- ^ Issues to which no one has been assigned ownership. - | AnyAssignment -- ^ All issues regardless of assignment. [default] - | AssignedTo String -- ^ Only issues assigned to the user with the given login. - | Mentions String -- ^ Issues which mention the given string, taken to be a user's login. - | Labels [String] -- ^ A list of labels to filter by. - | Ascending -- ^ Sort ascending. - | Descending -- ^ Sort descending. [default] - | Since UTCTime -- ^ Only issues created since the specified date and time. - | PerPage Int -- ^ Download this many issues per query - deriving (Eq, Ord, Show, Typeable, Data, Generic) - -instance NFData IssueLimitation - -- | Details on a specific issue, given the repo owner and name, and the issue -- number.' -- @@ -149,7 +121,6 @@ createIssueR user repo = editOfIssue :: EditIssue editOfIssue = EditIssue Nothing Nothing Nothing Nothing Nothing Nothing - -- | Edit an issue. -- -- > editIssue (GithubUser (user, password)) user repo issue diff --git a/github.cabal b/github.cabal index ccffa5c8..7a845b9c 100644 --- a/github.cabal +++ b/github.cabal @@ -121,6 +121,7 @@ Library Github.Data.Name, Github.Data.PullRequests, Github.Data.Repos, + Github.Data.Search, Github.Data.Teams, Github.Data.Webhooks, Github.Gists, diff --git a/spec/Github/SearchSpec.hs b/spec/Github/SearchSpec.hs index e451c5c1..0ea812cb 100644 --- a/spec/Github/SearchSpec.hs +++ b/spec/Github/SearchSpec.hs @@ -10,8 +10,8 @@ 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) +import Github.Data.Issues (Issue (..)) +import Github.Search (SearchIssuesResult (..), searchIssues) fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b From 8520f05810eeff098bb4086ee73d15d88fab01b7 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Thu, 7 Jan 2016 20:36:27 +0200 Subject: [PATCH 126/510] Re-implement request creation --- Github/Data.hs | 2 + Github/Data/Request.hs | 87 +++++++++++++++ Github/Request.hs | 234 ++++++++++++++++++++++------------------- github.cabal | 6 +- 4 files changed, 215 insertions(+), 114 deletions(-) create mode 100644 Github/Data/Request.hs diff --git a/Github/Data.hs b/Github/Data.hs index 45c81095..1df82e65 100644 --- a/Github/Data.hs +++ b/Github/Data.hs @@ -15,6 +15,7 @@ module Github.Data ( module Github.Data.Issues, module Github.Data.PullRequests, module Github.Data.Repos, + module Github.Data.Request, module Github.Data.Search, module Github.Data.Teams, module Github.Data.Webhooks, @@ -56,6 +57,7 @@ import Github.Data.Issues import Github.Data.Name import Github.Data.PullRequests import Github.Data.Repos +import Github.Data.Request import Github.Data.Search import Github.Data.Teams import Github.Data.Webhooks diff --git a/Github/Data/Request.hs b/Github/Data/Request.hs new file mode 100644 index 00000000..fbb59ce5 --- /dev/null +++ b/Github/Data/Request.hs @@ -0,0 +1,87 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE StandaloneDeriving #-} +module Github.Data.Request ( + GithubRequest(..), + PostMethod(..), + toMethod, + Paths, + QueryString, + ) where + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative +#endif + +import Data.Aeson.Compat (FromJSON) +import Data.Typeable (Typeable) +import GHC.Generics (Generic) +import Network.HTTP.Types (Status,) + +import qualified Data.ByteString.Lazy as LBS +import qualified Network.HTTP.Types.Method as Method + +------------------------------------------------------------------------------ +-- Auxillary types +------------------------------------------------------------------------------ + +type Paths = [String] +type QueryString = String + +-- | Http method of requests with body. +data PostMethod = Post | Patch | Put + deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable) + +toMethod :: PostMethod -> Method.Method +toMethod Post = Method.methodPost +toMethod Patch = Method.methodPatch +toMethod Put = Method.methodPut + +------------------------------------------------------------------------------ +-- Github request +------------------------------------------------------------------------------ + +-- | Github request data type. +-- +-- * @k@ describes whether authentication is required. It's required for non-@GET@ requests. +-- * @a@ is the result type +-- +-- /Note:/ 'GithubRequest' is not 'Functor' on purpose. +-- +-- TODO: Add constructor for collection fetches. +data GithubRequest (k :: Bool) a where + GithubGet :: FromJSON a => Paths -> QueryString -> GithubRequest k a + GithubPost :: FromJSON a => PostMethod -> Paths -> LBS.ByteString -> GithubRequest 'True a + GithubDelete :: Paths -> GithubRequest 'True () + GithubStatus :: GithubRequest k () -> GithubRequest k Status + deriving (Typeable) + +deriving instance Eq (GithubRequest k a) + +instance Show (GithubRequest k a) where + showsPrec d r = + case r of + GithubGet ps qs -> showParen (d > appPrec) $ + showString "GithubGet " + . showsPrec (appPrec + 1) ps + . showString " " + . showsPrec (appPrec + 1) qs + GithubPost m ps body -> showParen (d > appPrec) $ + showString "GithubPost " + . showsPrec (appPrec + 1) m + . showString " " + . showsPrec (appPrec + 1) ps + . showString " " + . showsPrec (appPrec + 1) body + GithubDelete ps -> showParen (d > appPrec) $ + showString "GithubDelete " + . showsPrec (appPrec + 1) ps + GithubStatus req -> showParen (d > appPrec) $ + showString "GithubStatus " + . showsPrec (appPrec + 1) req + where appPrec = 10 :: Int diff --git a/Github/Request.hs b/Github/Request.hs index a6c68dd4..9a89240c 100644 --- a/Github/Request.hs +++ b/Github/Request.hs @@ -7,100 +7,46 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE StandaloneDeriving #-} module Github.Request ( + -- * Types GithubRequest(..), PostMethod(..), toMethod, Paths, QueryString, + -- * Request execution in IO executeRequest, executeRequestWithMgr, executeRequest', executeRequestWithMgr', executeRequestMaybe, unsafeDropAuthRequirements, + -- * Tools + makeHttpRequest, ) where #if !MIN_VERSION_base(4,8,0) import Control.Applicative #endif -import Data.Aeson.Compat (FromJSON) -import Data.Typeable (Typeable) -import GHC.Generics (Generic) -import Network.HTTP.Conduit (Manager, httpLbs, newManager, tlsManagerSettings) -import Network.HTTP.Types (Status) - -import qualified Data.ByteString.Lazy as LBS -import qualified Network.HTTP.Types.Method as Method - -import Github.Auth (GithubAuth) -import Github.Data (Error) - -import qualified Github.Private as Private - ------------------------------------------------------------------------------- --- Auxillary types ------------------------------------------------------------------------------- - -type Paths = [String] -type QueryString = String - --- | Http method of requests with body. -data PostMethod = Post | Patch | Put - deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable) - -toMethod :: PostMethod -> Method.Method -toMethod Post = Method.methodPost -toMethod Patch = Method.methodPatch -toMethod Put = Method.methodPut - ------------------------------------------------------------------------------- --- Github request ------------------------------------------------------------------------------- - --- | Github request data type. --- --- * @k@ describes whether authentication is required. It's required for non-@GET@ requests. --- * @a@ is the result type --- --- /Note:/ 'GithubRequest' is not 'Functor' on purpose. --- --- TODO: Add constructor for collection fetches. -data GithubRequest (k :: Bool) a where - GithubGet :: FromJSON a => Paths -> QueryString -> GithubRequest k a - GithubPost :: FromJSON a => PostMethod -> Paths -> LBS.ByteString -> GithubRequest 'True a - GithubDelete :: Paths -> GithubRequest 'True () - GithubStatus :: GithubRequest k () -> GithubRequest k Status - deriving (Typeable) - -deriving instance Eq (GithubRequest k a) - -instance Show (GithubRequest k a) where - showsPrec d r = - case r of - GithubGet ps qs -> showParen (d > appPrec) $ - showString "GithubGet " - . showsPrec (appPrec + 1) ps - . showString " " - . showsPrec (appPrec + 1) qs - GithubPost m ps body -> showParen (d > appPrec) $ - showString "GithubPost " - . showsPrec (appPrec + 1) m - . showString " " - . showsPrec (appPrec + 1) ps - . showString " " - . showsPrec (appPrec + 1) body - GithubDelete ps -> showParen (d > appPrec) $ - showString "GithubDelete " - . showsPrec (appPrec + 1) ps - GithubStatus req -> showParen (d > appPrec) $ - showString "GithubStatus " - . showsPrec (appPrec + 1) req - where appPrec = 10 :: Int - ------------------------------------------------------------------------------- --- Basic IO executor ------------------------------------------------------------------------------- +import Control.Monad.Catch (MonadThrow) +import Data.Aeson.Compat (eitherDecode) +import Data.List (intercalate) +import Data.Monoid ((<>)) +import Network.HTTP.Client (HttpException (..), Manager, Request (..), + RequestBody (..), Response (..), applyBasicAuth, + httpLbs, newManager, parseUrl, setQueryString) +import Network.HTTP.Client.TLS (tlsManagerSettings) +import Network.HTTP.Types (Method, RequestHeaders, Status (..), + methodDelete) + +import qualified Control.Exception as E +import qualified Data.ByteString.Char8 as BS8 +import qualified Data.ByteString.Lazy as LBS +import qualified Data.Text as T + +import Github.Auth (GithubAuth (..)) +import Github.Data (Error (..)) +import Github.Data.Request -- | Execute 'GithubRequest' in 'IO' executeRequest :: Show a @@ -121,28 +67,26 @@ executeRequestWithMgr :: Show a -> IO (Either Error a) executeRequestWithMgr mgr auth req = case req of - GithubGet paths qs -> - Private.githubAPI' getResponse - Method.methodGet - (Private.buildPath paths ++ qs') - (Just auth) - Nothing - where qs' | null qs = "" - | otherwise = '?' : qs - GithubPost m paths body -> - Private.githubAPI' getResponse - (toMethod m) - (Private.buildPath paths) - (Just auth) - (Just body) - GithubDelete paths -> - Private.githubAPIDelete' getResponse - auth - (Private.buildPath paths) - GithubStatus _req' -> - error "executeRequestWithMgr GithubStatus not implemented" - where - getResponse = flip httpLbs mgr + GithubGet {} -> do + httpReq <- makeHttpRequest (Just auth) req + res <- httpLbs httpReq mgr + case eitherDecode (responseBody res) of + Right x -> pure . Right $ x + Left err -> pure . Left . ParseError . T.pack $ err + GithubPost {} -> do + httpReq <- makeHttpRequest (Just auth) req + res <- httpLbs httpReq mgr + case eitherDecode (responseBody res) of + Right x -> pure . Right $ x + Left err -> pure . Left . ParseError . T.pack $ err + GithubDelete {} -> do + httpReq <- makeHttpRequest (Just auth) req + _ <- httpLbs httpReq mgr + pure . Right $ () + GithubStatus {} -> do + httpReq <- makeHttpRequest (Just auth) req + res <- httpLbs httpReq mgr + pure . Right . responseStatus $ res -- | Like 'executeRequest' but without authentication. executeRequest' :: Show a @@ -162,18 +106,16 @@ executeRequestWithMgr' :: Show a -> IO (Either Error a) executeRequestWithMgr' mgr req = case req of - GithubGet paths qs -> - Private.githubAPI' getResponse - Method.methodGet - (Private.buildPath paths ++ qs') - Nothing - Nothing - where qs' | null qs = "" - | otherwise = '?' : qs - GithubStatus (GithubGet _paths _qs) -> - error "executeRequestWithMgr' GithubStatus not implemented" - where - getResponse = flip httpLbs mgr + GithubGet {} -> do + httpReq <- makeHttpRequest Nothing req + res <- httpLbs httpReq mgr + case eitherDecode (responseBody res) of + Right x -> pure . Right $ x + Left err -> pure . Left . ParseError . T.pack $ err + GithubStatus {} -> do + httpReq <- makeHttpRequest Nothing req + res <- httpLbs httpReq mgr + pure . Right . responseStatus $ res -- | Helper for picking between 'executeRequest' and 'executeRequest''. -- @@ -188,3 +130,73 @@ unsafeDropAuthRequirements :: GithubRequest 'True a -> GithubRequest k a unsafeDropAuthRequirements (GithubGet ps qs) = GithubGet ps qs unsafeDropAuthRequirements r = error $ "Trying to drop authenatication from" ++ show r + +------------------------------------------------------------------------------ +-- Tools +------------------------------------------------------------------------------ + +makeHttpRequest :: MonadThrow m + => Maybe GithubAuth + -> GithubRequest k a + -> m Request +makeHttpRequest auth r = case r of + GithubStatus req -> makeHttpRequest auth req + GithubGet paths _qs -> do + req <- parseUrl $ url paths + pure $ setReqHeaders + . setCheckStatus + . setAuthRequest auth + . setQueryString [] + $ req + GithubPost m paths body -> do + req <- parseUrl $ url paths + pure $ setReqHeaders + . setCheckStatus + . setAuthRequest auth + . setBody body + . setMethod (toMethod m) + $ req + GithubDelete paths -> do + req <- parseUrl $ url paths + pure $ setReqHeaders + . setCheckStatus + . setAuthRequest auth + . setMethod methodDelete + $ req + where + url :: Paths -> String + url paths = baseUrl ++ '/' : intercalate "/" paths + + baseUrl :: String + baseUrl = case auth of + Just (GithubEnterpriseOAuth endpoint _) -> endpoint + _ -> "https://api.github.com" + + setReqHeaders :: Request -> Request + setReqHeaders req = req { requestHeaders = reqHeaders <> requestHeaders req } + + setCheckStatus :: Request -> Request + setCheckStatus req = req { checkStatus = successOrMissing } + + setMethod :: Method -> Request -> Request + setMethod m req = req { method = m } + + reqHeaders :: RequestHeaders + reqHeaders = maybe [] getOAuthHeader auth + <> [("User-Agent", "github.hs/0.7.4")] + <> [("Accept", "application/vnd.github.preview")] + + setBody :: LBS.ByteString -> Request -> Request + setBody body req = req { requestBody = RequestBodyLBS body } + + setAuthRequest :: Maybe GithubAuth -> Request -> Request + setAuthRequest (Just (GithubBasicAuth user pass)) = applyBasicAuth user pass + setAuthRequest _ = id + + getOAuthHeader :: GithubAuth -> RequestHeaders + getOAuthHeader (GithubOAuth token) = [("Authorization", BS8.pack ("token " ++ token))] + getOAuthHeader _ = [] + + successOrMissing s@(Status sci _) hs cookiejar + | (200 <= sci && sci < 300) || sci == 404 = Nothing + | otherwise = Just $ E.toException $ StatusCodeException s hs cookiejar diff --git a/github.cabal b/github.cabal index 7a845b9c..0b987919 100644 --- a/github.cabal +++ b/github.cabal @@ -121,6 +121,7 @@ Library Github.Data.Name, Github.Data.PullRequests, Github.Data.Repos, + Github.Data.Request, Github.Data.Search, Github.Data.Teams, Github.Data.Webhooks, @@ -152,9 +153,6 @@ Library Github.Search Github.Request - -- Private - Github.Private - -- Packages needed in order to build this package. Build-depends: base >= 4.0 && < 5.0, base-compat, @@ -166,10 +164,12 @@ Library containers, deepseq, hashable, + exceptions, text, old-locale, http-conduit >= 1.8, http-client, + http-client-tls, http-types, data-default, vector, From 1a9cab3d03ba396db4fd8cf20335860bda3e2839 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Thu, 7 Jan 2016 21:07:34 +0200 Subject: [PATCH 127/510] Use fancier QueryString --- Github/Activity/Starring.hs | 6 ++--- Github/Activity/Watching.hs | 4 +-- Github/Data/Request.hs | 3 ++- Github/Gists.hs | 4 +-- Github/Gists/Comments.hs | 4 +-- Github/GitData/Blobs.hs | 2 +- Github/GitData/Commits.hs | 2 +- Github/GitData/References.hs | 6 ++--- Github/GitData/Trees.hs | 5 ++-- Github/Issues.hs | 37 ++++++++++++++------------- Github/Issues/Comments.hs | 4 +-- Github/Issues/Events.hs | 6 ++--- Github/Issues/Labels.hs | 8 +++--- Github/Issues/Milestones.hs | 4 +-- Github/Organizations.hs | 4 +-- Github/Organizations/Members.hs | 2 +- Github/Organizations/Teams.hs | 8 +++--- Github/PullRequests.hs | 12 +++++---- Github/PullRequests/ReviewComments.hs | 4 +-- Github/Repos.hs | 30 ++++++++++++---------- Github/Repos/Collaborators.hs | 4 +-- Github/Repos/Comments.hs | 6 ++--- Github/Repos/Commits.hs | 26 ++++++++++--------- Github/Repos/Forks.hs | 2 +- Github/Repos/Webhooks.hs | 4 +-- Github/Request.hs | 4 +-- Github/Search.hs | 18 ++++++------- Github/Users.hs | 4 +-- Github/Users/Followers.hs | 4 +-- spec/Github/SearchSpec.hs | 2 +- 30 files changed, 119 insertions(+), 110 deletions(-) diff --git a/Github/Activity/Starring.hs b/Github/Activity/Starring.hs index 915c6b97..3d11e231 100644 --- a/Github/Activity/Starring.hs +++ b/Github/Activity/Starring.hs @@ -26,7 +26,7 @@ stargazersFor auth user repo = -- See stargazersForR :: Name GithubOwner -> Name Repo -> GithubRequest k [GithubOwner] stargazersForR user repo = - GithubGet ["repos", untagName user, untagName repo, "stargazers"] "" + GithubGet ["repos", untagName user, untagName repo, "stargazers"] [] -- | All the public repos starred by the specified user. -- @@ -39,7 +39,7 @@ reposStarredBy auth user = -- See reposStarredByR :: Name GithubOwner -> GithubRequest k [Repo] reposStarredByR user = - GithubGet ["users", untagName user, "starred"] "" + GithubGet ["users", untagName user, "starred"] [] -- | All the repos starred by the authenticated user. myStarred :: GithubAuth -> IO (Either Error [Repo]) @@ -48,4 +48,4 @@ myStarred auth = -- | All the repos starred by the authenticated user. myStarredR :: GithubRequest 'True [Repo] -myStarredR = GithubGet ["user", "starred"] "" +myStarredR = GithubGet ["user", "starred"] [] diff --git a/Github/Activity/Watching.hs b/Github/Activity/Watching.hs index 0ca19d49..76b2d98e 100644 --- a/Github/Activity/Watching.hs +++ b/Github/Activity/Watching.hs @@ -32,7 +32,7 @@ watchersFor' auth user repo = -- See watchersForR :: Name GithubOwner -> Name Repo -> GithubRequest k [GithubOwner] watchersForR user repo = - GithubGet ["repos", untagName user, untagName repo, "watchers"] "" + GithubGet ["repos", untagName user, untagName repo, "watchers"] [] -- | All the public repos watched by the specified user. -- @@ -52,4 +52,4 @@ reposWatchedBy' auth user = -- See reposWatchedByR :: Name GithubOwner -> GithubRequest k [Repo] reposWatchedByR user = - GithubGet ["users", untagName user, "subscriptions"] "" + GithubGet ["users", untagName user, "subscriptions"] [] diff --git a/Github/Data/Request.hs b/Github/Data/Request.hs index fbb59ce5..6011fc03 100644 --- a/Github/Data/Request.hs +++ b/Github/Data/Request.hs @@ -23,6 +23,7 @@ import Data.Typeable (Typeable) import GHC.Generics (Generic) import Network.HTTP.Types (Status,) +import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS import qualified Network.HTTP.Types.Method as Method @@ -31,7 +32,7 @@ import qualified Network.HTTP.Types.Method as Method ------------------------------------------------------------------------------ type Paths = [String] -type QueryString = String +type QueryString = [(BS.ByteString, Maybe BS.ByteString)] -- | Http method of requests with body. data PostMethod = Post | Patch | Put diff --git a/Github/Gists.hs b/Github/Gists.hs index feb16ec8..45809066 100644 --- a/Github/Gists.hs +++ b/Github/Gists.hs @@ -29,7 +29,7 @@ gists = gists' Nothing -- | List gists. -- See gistsR :: Name GithubOwner -> GithubRequest k [Gist] -gistsR user = GithubGet ["users", untagName user, "gists"] "" +gistsR user = GithubGet ["users", untagName user, "gists"] [] -- | A specific gist, given its id, with authentication credentials -- @@ -48,4 +48,4 @@ gist = gist' Nothing -- See gistR :: Name Gist ->GithubRequest k Gist gistR gid = - GithubGet ["gists", untagName gid] "" + GithubGet ["gists", untagName gid] [] diff --git a/Github/Gists/Comments.hs b/Github/Gists/Comments.hs index 2664285e..cfd25c6f 100644 --- a/Github/Gists/Comments.hs +++ b/Github/Gists/Comments.hs @@ -22,7 +22,7 @@ commentsOn gid = -- See commentsOnR :: Name Gist -> GithubRequest k [GistComment] commentsOnR gid = - GithubGet ["gists", untagName gid, "comments"] "" + GithubGet ["gists", untagName gid, "comments"] [] -- | A specific comment, by the comment ID. -- @@ -35,4 +35,4 @@ comment cid = -- See gistCommentR :: Id GistComment -> GithubRequest k GistComment gistCommentR cid = - GithubGet ["gists", "comments", show $ untagId cid] "" + GithubGet ["gists", "comments", show $ untagId cid] [] diff --git a/Github/GitData/Blobs.hs b/Github/GitData/Blobs.hs index bf6d24e1..26dd94b0 100644 --- a/Github/GitData/Blobs.hs +++ b/Github/GitData/Blobs.hs @@ -28,4 +28,4 @@ blob = blob' Nothing -- See blobR :: Name GithubOwner -> Name Repo -> Name Blob -> GithubRequest k Blob blobR user repo sha = - GithubGet ["repos", untagName user, untagName repo, "git", "blobs", untagName sha] "" + GithubGet ["repos", untagName user, untagName repo, "git", "blobs", untagName sha] [] diff --git a/Github/GitData/Commits.hs b/Github/GitData/Commits.hs index 3d2a42ef..1609264c 100644 --- a/Github/GitData/Commits.hs +++ b/Github/GitData/Commits.hs @@ -21,4 +21,4 @@ commit user repo sha = -- See gitCommitR :: Name GithubOwner -> Name Repo -> Name GitCommit -> GithubRequest k GitCommit gitCommitR user repo sha = - GithubGet ["repos", untagName user, untagName repo, "git", "commits", untagName sha] "" + GithubGet ["repos", untagName user, untagName repo, "git", "commits", untagName sha] [] diff --git a/Github/GitData/References.hs b/Github/GitData/References.hs index 3b22d70a..82a8c941 100644 --- a/Github/GitData/References.hs +++ b/Github/GitData/References.hs @@ -37,7 +37,7 @@ reference = reference' Nothing -- See referenceR :: Name GithubOwner -> Name Repo -> Name GitReference -> GithubRequest k GitReference referenceR user repo ref = - GithubGet ["repos", untagName user, untagName repo, "git", "refs", untagName ref] "" + GithubGet ["repos", untagName user, untagName repo, "git", "refs", untagName ref] [] -- | The history of references for a repo. -- @@ -56,7 +56,7 @@ references = references' Nothing -- See referencesR :: Name GithubOwner -> Name Repo -> GithubRequest k [GitReference] referencesR user repo = - GithubGet ["repos", untagName user, untagName repo, "git", "refs"] "" + GithubGet ["repos", untagName user, untagName repo, "git", "refs"] [] -- | Create a reference. createReference :: GithubAuth -> Name GithubOwner -> Name Repo -> NewGitReference -> IO (Either Error GitReference) @@ -80,4 +80,4 @@ namespacedReferences user repo namespace = -- See namespacedReferencesR :: Name GithubOwner -> Name Repo -> String -> GithubRequest k [GitReference] namespacedReferencesR user repo namespace = - GithubGet ["repos", untagName user, untagName repo, "git", "refs", namespace] "" + GithubGet ["repos", untagName user, untagName repo, "git", "refs", namespace] [] diff --git a/Github/GitData/Trees.hs b/Github/GitData/Trees.hs index 95d10d67..5fcb47ea 100644 --- a/Github/GitData/Trees.hs +++ b/Github/GitData/Trees.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedStrings #-} -- | The underlying tree of SHA1s and files that make up a git repo. The API is -- described on . module Github.GitData.Trees ( @@ -31,7 +32,7 @@ tree = tree' Nothing -- See treeR :: Name GithubOwner -> Name Repo -> Name Tree -> GithubRequest k Tree treeR user repo sha = - GithubGet ["repos", untagName user, untagName repo, "git", "trees", untagName sha] "" + GithubGet ["repos", untagName user, untagName repo, "git", "trees", untagName sha] [] -- | A recursively-nested tree for a SHA1. -- @@ -50,4 +51,4 @@ nestedTree = nestedTree' Nothing -- See nestedTreeR :: Name GithubOwner -> Name Repo -> Name Tree -> GithubRequest k Tree nestedTreeR user repo sha = - GithubGet ["repos", untagName user, untagName repo, "git", "trees", untagName sha] "recursive=1" + GithubGet ["repos", untagName user, untagName repo, "git", "trees", untagName sha] [("recursive", Just "1")] diff --git a/Github/Issues.hs b/Github/Issues.hs index fb1de312..6c4f4eaa 100644 --- a/Github/Issues.hs +++ b/Github/Issues.hs @@ -34,6 +34,8 @@ import System.Locale (defaultTimeLocale) import Data.Time.Format (formatTime) +import qualified Data.ByteString.Char8 as BS8 + -- | Details on a specific issue, given the repo owner and name, and the issue -- number.' -- @@ -53,7 +55,7 @@ issue = issue' Nothing -- 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] "" + 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. @@ -76,24 +78,23 @@ issuesForRepoR :: Name GithubOwner -> Name Repo -> [IssueLimitation] -> GithubRe issuesForRepoR user reqRepoName issueLimitations = GithubGet ["repos", untagName user, untagName reqRepoName, "issues"] qs where - qs = queryStringFromLimitations issueLimitations - queryStringFromLimitations = intercalate "&" . map convert - - convert AnyMilestone = "milestone=*" - convert NoMilestone = "milestone=none" - convert (MilestoneId n) = "milestone=" ++ show n - convert Open = "state=open" - convert OnlyClosed = "state=closed" - convert Unassigned = "assignee=none" - convert AnyAssignment = "assignee=*" - convert (AssignedTo u) = "assignee=" ++ u - convert (Mentions u) = "mentioned=" ++ u - convert (Labels l) = "labels=" ++ intercalate "," l - convert Ascending = "direction=asc" - convert Descending = "direction=desc" - convert (PerPage n) = "per_page=" ++ show n + qs = map convert issueLimitations + + convert AnyMilestone = ("milestone", Just "*") + convert NoMilestone = ("milestone", Just "none") + convert (MilestoneId n) = ("milestone", Just . BS8.pack $ show n) + convert Open = ("state", Just "open") + convert OnlyClosed = ("state", Just "closed") + convert Unassigned = ("assignee", Just "none") + convert AnyAssignment = ("assignee", Just "") + convert (AssignedTo u) = ("assignee", Just $ BS8.pack u) + convert (Mentions u) = ("mentioned", Just $ BS8.pack u) + convert (Labels l) = ("labels", Just . BS8.pack $ intercalate "," l) + convert Ascending = ("direction", Just "asc") + convert Descending = ("direction", Just "desc") + convert (PerPage n) = ("per_page", Just . BS8.pack $ show n) convert (Since t) = - "since=" ++ formatTime defaultTimeLocale "%FT%TZ" t + ("since", Just . BS8.pack $ formatTime defaultTimeLocale "%FT%TZ" t) -- Creating new issues. diff --git a/Github/Issues/Comments.hs b/Github/Issues/Comments.hs index 7d295544..92e08cef 100644 --- a/Github/Issues/Comments.hs +++ b/Github/Issues/Comments.hs @@ -31,7 +31,7 @@ comment user repo cid = -- 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] "" + GithubGet ["repos", untagName user, untagName repo, "issues", "comments", show $ untagId cid] [] -- | All comments on an issue, by the issue's number. -- @@ -50,7 +50,7 @@ comments' auth user repo iid = -- 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"] "" + GithubGet ["repos", untagName user, untagName repo, "issues", show $ untagId iid, "comments"] [] -- | Create a new comment. -- diff --git a/Github/Issues/Events.hs b/Github/Issues/Events.hs index 9c8c6691..40ce7c47 100644 --- a/Github/Issues/Events.hs +++ b/Github/Issues/Events.hs @@ -34,7 +34,7 @@ eventsForIssue' auth user repo iid = -- 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"] "" + GithubGet ["repos", untagName user, untagName repo, "issues", show $ untagId iid, "events"] [] -- | All the events for all issues in a repo. -- @@ -53,7 +53,7 @@ eventsForRepo' auth user repo = -- See eventsForRepoR :: Name GithubOwner -> Name Repo -> GithubRequest k [Event] eventsForRepoR user repo = - GithubGet ["repos", untagName user, untagName repo, "issues", "events"] "" + GithubGet ["repos", untagName user, untagName repo, "issues", "events"] [] -- | Details on a specific event, by the event's ID. -- @@ -72,4 +72,4 @@ event' auth user repo eid = -- 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] "" + GithubGet ["repos", untagName user, untagName repo, "issues", "events", show eid] [] diff --git a/Github/Issues/Labels.hs b/Github/Issues/Labels.hs index ca64b6ce..32d55fc7 100644 --- a/Github/Issues/Labels.hs +++ b/Github/Issues/Labels.hs @@ -58,7 +58,7 @@ labelsOnRepo' auth user repo = -- See labelsOnRepoR :: Name GithubOwner -> Name Repo -> GithubRequest k [IssueLabel] labelsOnRepoR user repo = - GithubGet ["repos", untagName user, untagName repo, "labels"] "" + GithubGet ["repos", untagName user, untagName repo, "labels"] [] -- | A label by name. -- @@ -77,7 +77,7 @@ label' auth user repo lbl = -- See labelR :: Name GithubOwner -> Name Repo -> Name IssueLabel -> GithubRequest k IssueLabel labelR user repo lbl = - GithubGet ["repos", untagName user, untagName repo, "labels", untagName lbl] "" + GithubGet ["repos", untagName user, untagName repo, "labels", untagName lbl] [] -- | Create a label -- @@ -152,7 +152,7 @@ labelsOnIssue' auth user repo iid = -- 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"] "" + GithubGet ["repos", untagName user, untagName repo, "issues", show $ untagId iid, "labels"] [] -- | Add labels to an issue. -- @@ -251,4 +251,4 @@ labelsOnMilestone' auth user repo mid = -- 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"] "" + GithubGet ["repos", untagName user, untagName repo, "milestones", show $ untagId mid, "labels"] [] diff --git a/Github/Issues/Milestones.hs b/Github/Issues/Milestones.hs index 7200d833..560578db 100644 --- a/Github/Issues/Milestones.hs +++ b/Github/Issues/Milestones.hs @@ -29,7 +29,7 @@ milestones' auth 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"] "" +milestonesR user repo = GithubGet ["repos", untagName user, untagName repo, "milestones"] [] -- | Details on a specific milestone, given it's milestone number. -- @@ -42,4 +42,4 @@ milestone user repo mid = -- 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] "" + GithubGet ["repos", untagName user, untagName repo, "milestones", show $ untagId mid] [] diff --git a/Github/Organizations.hs b/Github/Organizations.hs index 819b64f2..991b2db7 100644 --- a/Github/Organizations.hs +++ b/Github/Organizations.hs @@ -29,7 +29,7 @@ publicOrganizationsFor = publicOrganizationsFor' Nothing -- -- See publicOrganizationsForR :: Name GithubOwner -> GithubRequest k [SimpleOrganization] -publicOrganizationsForR userName = GithubGet ["users", untagName userName, "orgs"] "" -- TODO: Use PagedGet +publicOrganizationsForR userName = GithubGet ["users", untagName userName, "orgs"] [] -- TODO: Use PagedGet -- | Details on a public organization. Takes the organization's login. -- @@ -47,4 +47,4 @@ publicOrganization = publicOrganization' Nothing -- -- See publicOrganizationR :: Name Organization -> GithubRequest k Organization -publicOrganizationR reqOrganizationName = GithubGet ["orgs", untagName reqOrganizationName] "" +publicOrganizationR reqOrganizationName = GithubGet ["orgs", untagName reqOrganizationName] [] diff --git a/Github/Organizations/Members.hs b/Github/Organizations/Members.hs index c0b14b44..2845b930 100644 --- a/Github/Organizations/Members.hs +++ b/Github/Organizations/Members.hs @@ -29,4 +29,4 @@ membersOf = membersOf' Nothing -- -- See membersOfR :: Name Organization -> GithubRequest k [GithubOwner] -membersOfR organization = GithubGet ["orgs", untagName organization, "members"] "" +membersOfR organization = GithubGet ["orgs", untagName organization, "members"] [] diff --git a/Github/Organizations/Teams.hs b/Github/Organizations/Teams.hs index 1a12e9fd..ab31b060 100644 --- a/Github/Organizations/Teams.hs +++ b/Github/Organizations/Teams.hs @@ -48,7 +48,7 @@ teamsOf = teamsOf' Nothing -- | List teams. -- See teamsOfR :: Name Organization -> GithubRequest k [Team] -teamsOfR organization = GithubGet ["orgs", untagName organization, "teams"] "" +teamsOfR organization = GithubGet ["orgs", untagName organization, "teams"] [] -- | The information for a single team, by team id. -- | With authentication @@ -68,7 +68,7 @@ teamInfoFor = teamInfoFor' Nothing -- See teamInfoForR :: Id Team -> GithubRequest k DetailedTeam teamInfoForR tid = - GithubGet ["teams", show $ untagId tid] "" + GithubGet ["teams", show $ untagId tid] [] -- | Create a team under an organization -- @@ -127,7 +127,7 @@ teamMembershipInfoFor' auth tid user = -- See Name GithubOwner -> GithubRequest k TeamMembership teamMembershipInfoForR tid user = - GithubGet ["teams", show $ untagId tid, "memberships", untagName user] "" + GithubGet ["teams", show $ untagId tid, "memberships", untagName user] [] -- | Retrieve team mebership information for a user. -- @@ -170,4 +170,4 @@ listTeamsCurrent' auth = executeRequest auth $ listTeamsCurrentR -- | List user teams. -- See listTeamsCurrentR :: GithubRequest 'True [DetailedTeam] -listTeamsCurrentR = GithubGet ["user", "teams"] "" +listTeamsCurrentR = GithubGet ["user", "teams"] [] diff --git a/Github/PullRequests.hs b/Github/PullRequests.hs index 557e5441..985b92d4 100644 --- a/Github/PullRequests.hs +++ b/Github/PullRequests.hs @@ -34,6 +34,8 @@ import Github.Request import Data.Aeson.Compat (Value, encode, object, (.=)) import Network.HTTP.Types +import qualified Data.ByteString.Char8 as BS8 + -- | All pull requests for the repo, by owner, repo name, and pull request state. -- | With authentification -- @@ -65,7 +67,7 @@ pullRequestsForR :: Name GithubOwner -> Name Repo -> GithubRequest k [PullRequest] pullRequestsForR user repo state = GithubGet ["repos", untagName user, untagName repo, "pulls"] $ - maybe "" ("state=" ++) state + maybe [] (\s -> [("state", Just . BS8.pack $ s)]) 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. @@ -87,7 +89,7 @@ pullRequest = pullRequest' Nothing -- See pullRequestR :: Name GithubOwner -> Name Repo -> Id DetailedPullRequest -> GithubRequest k DetailedPullRequest pullRequestR user repo prid = - GithubGet ["repos", untagName user, untagName repo, "pulls", show $ untagId prid] "" + GithubGet ["repos", untagName user, untagName repo, "pulls", show $ untagId prid] [] createPullRequest :: GithubAuth -> Name GithubOwner @@ -141,7 +143,7 @@ pullRequestCommits = pullRequestCommits' Nothing -- See 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"] "" + 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. @@ -163,7 +165,7 @@ pullRequestFiles = pullRequestFiles' Nothing -- See 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"] "" + GithubGet ["repos", untagName user, untagName repo, "pulls", show $ untagId prid, "files"] [] -- | Check if pull request has been merged isPullRequestMerged :: GithubAuth -> Name GithubOwner -> Name Repo -> Id DetailedPullRequest -> IO (Either Error Status) @@ -174,7 +176,7 @@ isPullRequestMerged auth user repo prid = -- See 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"] "" + GithubGet ["repos", untagName user, untagName repo, "pulls", show $ untagId prid, "merge"] [] -- | Merge a pull request. mergePullRequest :: GithubAuth -> Name GithubOwner -> Name Repo -> Id DetailedPullRequest -> Maybe String -> IO (Either Error Status) diff --git a/Github/PullRequests/ReviewComments.hs b/Github/PullRequests/ReviewComments.hs index d33b7c24..257a9653 100644 --- a/Github/PullRequests/ReviewComments.hs +++ b/Github/PullRequests/ReviewComments.hs @@ -22,7 +22,7 @@ pullRequestReviewComments user repo prid = -- See 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"] "" + GithubGet ["repos", untagName user, untagName repo, "pulls", show $ untagId prid, "comments"] [] -- | One comment on a pull request, by the comment's ID. -- @@ -35,4 +35,4 @@ pullRequestReviewComment user repo cid = -- See 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] "" + GithubGet ["repos", untagName user, untagName repo, "pulls", "comments", show $ untagId cid] [] diff --git a/Github/Repos.hs b/Github/Repos.hs index d9e3070f..43cc2133 100644 --- a/Github/Repos.hs +++ b/Github/Repos.hs @@ -59,12 +59,14 @@ import Github.Auth import Github.Data import Github.Request -repoPublicityQueryString :: RepoPublicity -> String -repoPublicityQueryString All = "type=all" -repoPublicityQueryString Owner = "type=owner" -repoPublicityQueryString Member = "type=member" -repoPublicityQueryString Public = "type=public" -repoPublicityQueryString Private = "type=private" +import qualified Data.ByteString.Char8 as BS8 + +repoPublicityQueryString :: RepoPublicity -> QueryString +repoPublicityQueryString All = [("type", Just "all")] +repoPublicityQueryString Owner = [("type", Just "owner")] +repoPublicityQueryString Member = [("type", Just "member")] +repoPublicityQueryString Public = [("type", Just "public")] +repoPublicityQueryString Private = [("type", Just "private")] -- | The repos for a user, by their login. Can be restricted to just repos they -- own, are a member of, or publicize. Private repos will return empty list. @@ -129,7 +131,7 @@ repository' auth user repo = -- See repositoryR :: Name GithubOwner -> Name Repo -> GithubRequest k Repo repositoryR user repo = - GithubGet ["repos", untagName user, untagName repo] "" + GithubGet ["repos", untagName user, untagName repo] [] -- | Create a new repository. -- @@ -201,8 +203,8 @@ contributorsR :: Name GithubOwner contributorsR user repo anon = GithubGet ["repos", untagName user, untagName repo, "contributors"] qs where - qs | anon = "anon=true" - | otherwise = "" + qs | anon = [("anon", Just "true")] + | otherwise = [] -- | The contributors to a repo, including anonymous contributors (such as -- deleted users or git commits with unknown email addresses), given the owner @@ -242,7 +244,7 @@ languagesFor' auth user repo = -- See languagesForR :: Name GithubOwner -> Name Repo -> GithubRequest k Languages languagesForR user repo = - GithubGet ["repos", untagName user, untagName repo, "languages"] "" + GithubGet ["repos", untagName user, untagName repo, "languages"] [] -- | The git tags on a repo, given the repo owner and name. -- @@ -262,7 +264,7 @@ tagsFor' auth user repo = -- See tagsForR :: Name GithubOwner -> Name Repo -> GithubRequest k [Tag] tagsForR user repo = - GithubGet ["repos", untagName user, untagName repo, "tags"] "" + GithubGet ["repos", untagName user, untagName repo, "tags"] [] -- | The git branches on a repo, given the repo owner and name. -- @@ -282,7 +284,7 @@ branchesFor' auth user repo = -- See branchesForR :: Name GithubOwner -> Name Repo -> GithubRequest k [Branch] branchesForR user repo = - GithubGet ["repos", untagName user, untagName repo, "branches"] "" + GithubGet ["repos", untagName user, untagName repo, "branches"] [] -- | The contents of a file or directory in a repo, given the repo owner, name, and path to the file -- @@ -306,7 +308,7 @@ contentsForR :: Name GithubOwner contentsForR user repo path ref = GithubGet ["repos", untagName user, untagName repo, "contents", path] qs where - qs = maybe "" ("ref=" ++) ref + qs = maybe [] (\r -> [("ref", Just . BS8.pack $ r)]) ref -- | The contents of a README file in a repo, given the repo owner and name -- @@ -324,7 +326,7 @@ readmeFor' auth user repo = readmeForR :: Name GithubOwner -> Name Repo -> GithubRequest k Content readmeForR user repo = - GithubGet ["repos", untagName user, untagName repo, "readme"] "" + GithubGet ["repos", untagName user, untagName repo, "readme"] [] -- | Delete an existing repository. -- diff --git a/Github/Repos/Collaborators.hs b/Github/Repos/Collaborators.hs index e53c80aa..7d1a3e47 100644 --- a/Github/Repos/Collaborators.hs +++ b/Github/Repos/Collaborators.hs @@ -30,7 +30,7 @@ collaboratorsOn' auth user repo = -- See collaboratorsOnR :: Name GithubOwner -> Name Repo -> GithubRequest k [GithubOwner] collaboratorsOnR user repo = - GithubGet ["repos", untagName user, untagName repo, "collaborators"] "" + GithubGet ["repos", untagName user, untagName repo, "collaborators"] [] -- | Whether the user is collaborating on a repo. Takes the user in question, -- the user who owns the repo, and the repo name. @@ -54,4 +54,4 @@ isCollaboratorOnR :: Name GithubOwner -- ^ Repository owner -> Name GithubOwner -- ^ Collaborator? -> GithubRequest k Status isCollaboratorOnR user repo coll = GithubStatus $ - GithubGet ["repos", untagName user, untagName repo, "collaborators", untagName coll] "" + GithubGet ["repos", untagName user, untagName repo, "collaborators", untagName coll] [] diff --git a/Github/Repos/Comments.hs b/Github/Repos/Comments.hs index 442ef94e..e3eebdde 100644 --- a/Github/Repos/Comments.hs +++ b/Github/Repos/Comments.hs @@ -37,7 +37,7 @@ commentsFor' auth user repo = -- See commentsForR :: Name GithubOwner -> Name Repo -> GithubRequest k [Comment] commentsForR user repo = - GithubGet ["repos", untagName user, untagName repo, "comments"] "" + GithubGet ["repos", untagName user, untagName repo, "comments"] [] -- | Just the comments on a specific SHA for a given Github repo. -- @@ -57,7 +57,7 @@ commitCommentsFor' auth user repo sha = -- See commitCommentsForR :: Name GithubOwner -> Name Repo -> Name Commit -> GithubRequest k [Comment] commitCommentsForR user repo sha = - GithubGet ["repos", untagName user, untagName repo, "commits", untagName sha, "comments"] "" + GithubGet ["repos", untagName user, untagName repo, "commits", untagName sha, "comments"] [] -- | A comment, by its ID, relative to the Github repo. -- @@ -76,4 +76,4 @@ commitCommentFor' auth user repo cid = -- See commitCommentForR :: Name GithubOwner -> Name Repo -> Id Comment -> GithubRequest k Comment commitCommentForR user repo cid = - GithubGet ["repos", untagName user, untagName repo, "comments", show $ untagId cid] "" + GithubGet ["repos", untagName user, untagName repo, "comments", show $ untagId cid] [] diff --git a/Github/Repos/Commits.hs b/Github/Repos/Commits.hs index d8ebd08b..89fba032 100644 --- a/Github/Repos/Commits.hs +++ b/Github/Repos/Commits.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP, OverloadedStrings #-} -- | The repo commits API as described on -- . @@ -22,8 +22,11 @@ module Github.Repos.Commits ( import Github.Auth import Github.Data import Github.Request +import Data.Monoid ((<>)) -import qualified Data.Text as T +import qualified Data.Text.Encoding as TE +import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as BS8 import Data.Time.Format (formatTime) #if MIN_VERSION_time (1,5,0) @@ -32,7 +35,6 @@ import Data.Time.Format (iso8601DateFormat) #else import System.Locale (defaultTimeLocale) #endif -import Data.List (intercalate) githubFormat :: GithubDate -> String #if MIN_VERSION_time (1,5,0) @@ -41,13 +43,13 @@ githubFormat = formatTime defaultTimeLocale (iso8601DateFormat $ Just "%H:%M:%S" githubFormat = formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S" . fromGithubDate #endif -renderCommitQueryOption :: CommitQueryOption -> String -renderCommitQueryOption (CommitQuerySha sha) = "sha=" ++ T.unpack sha -renderCommitQueryOption (CommitQueryPath path) = "path=" ++ T.unpack path -renderCommitQueryOption (CommitQueryAuthor author) = "author=" ++ T.unpack author -renderCommitQueryOption (CommitQuerySince date) = "since=" ++ ds ++ "Z" +renderCommitQueryOption :: CommitQueryOption -> (BS.ByteString, Maybe BS.ByteString) +renderCommitQueryOption (CommitQuerySha sha) = ("sha", Just $ TE.encodeUtf8 sha) +renderCommitQueryOption (CommitQueryPath path) = ("path", Just $ TE.encodeUtf8 path) +renderCommitQueryOption (CommitQueryAuthor author) = ("author", Just $ TE.encodeUtf8 author) +renderCommitQueryOption (CommitQuerySince date) = ("since", Just $ BS8.pack ds <> "Z") where ds = show $ githubFormat date -renderCommitQueryOption (CommitQueryUntil date) = "until=" ++ ds ++ "Z" +renderCommitQueryOption (CommitQueryUntil date) = ("until", Just $ BS8.pack ds <> "Z") where ds = show $ githubFormat date -- | The commit history for a repo. @@ -87,7 +89,7 @@ commitsWithOptionsForR :: Name GithubOwner -> Name Repo -> [CommitQueryOption] - commitsWithOptionsForR user repo opts = GithubGet ["repos", untagName user, untagName repo, "commits"] qs where - qs = intercalate "&" $ map renderCommitQueryOption opts + qs = map renderCommitQueryOption opts -- | Details on a specific SHA1 for a repo. @@ -108,7 +110,7 @@ commit' auth user repo sha = -- See commitR :: Name GithubOwner -> Name Repo -> Name Commit -> GithubRequest k Commit commitR user repo sha = - GithubGet ["repos", untagName user, untagName repo, "commits", untagName sha] "" + GithubGet ["repos", untagName user, untagName repo, "commits", untagName sha] [] -- | The diff between two treeishes on a repo. -- @@ -127,4 +129,4 @@ diff' auth user repo base headref = -- See diffR :: Name GithubOwner -> Name Repo -> Name Commit -> Name Commit -> GithubRequest k Diff diffR user repo base headref = - GithubGet ["repos", untagName user, untagName repo, "compare", untagName base ++ "..." ++ untagName headref] "" + GithubGet ["repos", untagName user, untagName repo, "compare", untagName base ++ "..." ++ untagName headref] [] diff --git a/Github/Repos/Forks.hs b/Github/Repos/Forks.hs index 1e210c69..78bf5a88 100644 --- a/Github/Repos/Forks.hs +++ b/Github/Repos/Forks.hs @@ -29,4 +29,4 @@ forksFor' auth user repo = -- See forksForR :: Name GithubOwner -> Name Repo -> GithubRequest k [Repo] forksForR user repo = - GithubGet ["repos", untagName user, untagName repo, "forks"] "" + GithubGet ["repos", untagName user, untagName repo, "forks"] [] diff --git a/Github/Repos/Webhooks.hs b/Github/Repos/Webhooks.hs index ae276445..b2ba135d 100644 --- a/Github/Repos/Webhooks.hs +++ b/Github/Repos/Webhooks.hs @@ -44,7 +44,7 @@ webhooksFor' auth user repo = -- See webhooksForR :: Name GithubOwner -> Name Repo -> GithubRequest k [RepoWebhook] webhooksForR user repo = - GithubGet ["repos", untagName user, untagName repo, "hooks"] "" + GithubGet ["repos", untagName user, untagName repo, "hooks"] [] webhookFor' :: GithubAuth -> Name GithubOwner -> Name Repo -> Id RepoWebhook -> IO (Either Error RepoWebhook) webhookFor' auth user repo hookId = @@ -54,7 +54,7 @@ webhookFor' auth user repo hookId = -- See webhookForR :: Name GithubOwner -> Name Repo -> Id RepoWebhook -> GithubRequest k RepoWebhook webhookForR user repo hookId = - GithubGet ["repos", untagName user, untagName repo, "hooks", show $ untagId hookId] "" + GithubGet ["repos", untagName user, untagName repo, "hooks", show $ untagId hookId] [] createRepoWebhook' :: GithubAuth -> Name GithubOwner -> Name Repo -> NewRepoWebhook -> IO (Either Error RepoWebhook) createRepoWebhook' auth user repo hook = diff --git a/Github/Request.hs b/Github/Request.hs index 9a89240c..c86f9f08 100644 --- a/Github/Request.hs +++ b/Github/Request.hs @@ -141,12 +141,12 @@ makeHttpRequest :: MonadThrow m -> m Request makeHttpRequest auth r = case r of GithubStatus req -> makeHttpRequest auth req - GithubGet paths _qs -> do + GithubGet paths qs -> do req <- parseUrl $ url paths pure $ setReqHeaders . setCheckStatus . setAuthRequest auth - . setQueryString [] + . setQueryString qs $ req GithubPost m paths body -> do req <- parseUrl $ url paths diff --git a/Github/Search.hs b/Github/Search.hs index d400ce93..4ab3ef4f 100644 --- a/Github/Search.hs +++ b/Github/Search.hs @@ -21,58 +21,58 @@ import Github.Request -- With authentication. -- -- > searchRepos' (Just $ GithubBasicAuth "github-username" "github-password') "q=a in%3Aname language%3Ahaskell created%3A>2013-10-01&per_page=100" -searchRepos' :: Maybe GithubAuth -> String -> IO (Either Error SearchReposResult) +searchRepos' :: Maybe GithubAuth -> QueryString -> IO (Either Error SearchReposResult) searchRepos' auth = executeRequestMaybe auth . searchReposR -- | Perform a repository search. -- Without authentication. -- -- > searchRepos "q=a in%3Aname language%3Ahaskell created%3A>2013-10-01&per_page=100" -searchRepos :: String -> IO (Either Error SearchReposResult) +searchRepos :: QueryString -> IO (Either Error SearchReposResult) searchRepos = searchRepos' Nothing -- | Search repositories. -- -- See -searchReposR :: String -> GithubRequest k SearchReposResult +searchReposR :: QueryString -> GithubRequest k SearchReposResult searchReposR queryString = GithubGet ["search", "repositories"] queryString -- | Perform a code search. -- With authentication. -- -- > searchCode' (Just $ GithubBasicAuth "github-username" "github-password') "q=a in%3Aname language%3Ahaskell created%3A>2013-10-01&per_page=100" -searchCode' :: Maybe GithubAuth -> String -> IO (Either Error SearchCodeResult) +searchCode' :: Maybe GithubAuth -> QueryString -> IO (Either Error SearchCodeResult) searchCode' auth = executeRequestMaybe auth . searchCodeR -- | Perform a code search. -- Without authentication. -- -- > searchCode "q=addClass+in:file+language:js+repo:jquery/jquery" -searchCode :: String -> IO (Either Error SearchCodeResult) +searchCode :: QueryString -> IO (Either Error SearchCodeResult) searchCode = searchCode' Nothing -- | Search code. -- -- See -searchCodeR :: String -> GithubRequest k SearchCodeResult +searchCodeR :: QueryString -> GithubRequest k SearchCodeResult searchCodeR queryString = GithubGet ["search", "code"] queryString -- | Perform an issue search. -- With authentication. -- -- > searchIssues' (Just $ GithubBasicAuth "github-username" "github-password') "q=a repo%3Aphadej%2Fgithub&per_page=100" -searchIssues' :: Maybe GithubAuth -> String -> IO (Either Error SearchIssuesResult) +searchIssues' :: Maybe GithubAuth -> QueryString -> IO (Either Error SearchIssuesResult) searchIssues' auth = executeRequestMaybe auth . searchIssuesR -- | Perform an issue search. -- Without authentication. -- -- > searchIssues "q=a repo%3Aphadej%2Fgithub&per_page=100" -searchIssues :: String -> IO (Either Error SearchIssuesResult) +searchIssues :: QueryString -> IO (Either Error SearchIssuesResult) searchIssues = searchIssues' Nothing -- | Search issues. -- -- See -searchIssuesR :: String -> GithubRequest k SearchIssuesResult +searchIssuesR :: QueryString -> GithubRequest k SearchIssuesResult searchIssuesR queryString = GithubGet ["search", "issues"] queryString diff --git a/Github/Users.hs b/Github/Users.hs index bcac4eba..76a0dfa6 100644 --- a/Github/Users.hs +++ b/Github/Users.hs @@ -31,7 +31,7 @@ userInfoFor = executeRequest' . userInfoForR -- -- See userInfoForR :: Name DetailedOwner -> GithubRequest k DetailedOwner -userInfoForR userName = GithubGet ["users", untagName userName] "" +userInfoForR userName = GithubGet ["users", untagName userName] [] -- | Retrieve information about the user associated with the supplied authentication. -- @@ -46,4 +46,4 @@ userInfoCurrent' auth = -- -- See userInfoCurrentR :: GithubRequest 'True DetailedOwner -userInfoCurrentR = GithubGet ["user"] "" +userInfoCurrentR = GithubGet ["user"] [] diff --git a/Github/Users/Followers.hs b/Github/Users/Followers.hs index 467a2d87..ac457c9d 100644 --- a/Github/Users/Followers.hs +++ b/Github/Users/Followers.hs @@ -21,7 +21,7 @@ usersFollowing = executeRequest' . usersFollowingR -- -- See usersFollowingR :: Name GithubOwner -> GithubRequest k [GithubOwner] -usersFollowingR userName = GithubGet ["users", untagName userName, "followers"] "" -- TODO: use paged get +usersFollowingR userName = GithubGet ["users", untagName userName, "followers"] [] -- TODO: use paged get -- | All the users that the given user follows. -- @@ -33,4 +33,4 @@ usersFollowedBy = executeRequest' . usersFollowedByR -- -- See usersFollowedByR :: Name GithubOwner -> GithubRequest k [GithubOwner] -usersFollowedByR userName = GithubGet ["users", untagName userName, "following"] "" -- TODO: use paged get +usersFollowedByR userName = GithubGet ["users", untagName userName, "following"] [] -- TODO: use paged get diff --git a/spec/Github/SearchSpec.hs b/spec/Github/SearchSpec.hs index 0ea812cb..32dff7e0 100644 --- a/spec/Github/SearchSpec.hs +++ b/spec/Github/SearchSpec.hs @@ -40,7 +40,7 @@ spec = do issueState issue2 `shouldBe` "open" it "performs an issue search via the API" $ do - let query = "q=Decouple in:title repo:phadej/github created:<=2015-12-01" + let query = [("q", Just "Decouple in:title repo:phadej/github created:<=2015-12-01")] issues <- searchIssuesIssues . fromRightS <$> searchIssues query length issues `shouldBe` 1 issueId (head issues) `shouldBe` Id 119694665 From 571ff9a74018c206d20e85a6755ed77278ffd765 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Fri, 8 Jan 2016 15:20:33 +0200 Subject: [PATCH 128/510] Implement GithubPagedGet --- Github/Data/Request.hs | 20 +++-- Github/Repos/Commits.hs | 24 +++--- Github/Request.hs | 151 ++++++++++++++++++++++++++----------- github.cabal | 31 +++++--- spec/Github/CommitsSpec.hs | 34 +++++++++ stack-lts-2.yaml | 1 + stack-lts-3.yaml | 3 +- 7 files changed, 187 insertions(+), 77 deletions(-) create mode 100644 spec/Github/CommitsSpec.hs diff --git a/Github/Data/Request.hs b/Github/Data/Request.hs index 6011fc03..cc26b27f 100644 --- a/Github/Data/Request.hs +++ b/Github/Data/Request.hs @@ -2,6 +2,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE OverloadedStrings #-} @@ -14,14 +15,11 @@ module Github.Data.Request ( QueryString, ) where -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative -#endif - -import Data.Aeson.Compat (FromJSON) -import Data.Typeable (Typeable) -import GHC.Generics (Generic) -import Network.HTTP.Types (Status,) +import Data.Aeson.Compat (FromJSON) +import Data.Typeable (Typeable) +import Data.Vector (Vector) +import GHC.Generics (Generic) +import Network.HTTP.Types (Status) import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS @@ -57,6 +55,7 @@ toMethod Put = Method.methodPut -- TODO: Add constructor for collection fetches. data GithubRequest (k :: Bool) a where GithubGet :: FromJSON a => Paths -> QueryString -> GithubRequest k a + GithubPagedGet :: FromJSON (Vector a) => Paths -> QueryString -> GithubRequest k (Vector a) GithubPost :: FromJSON a => PostMethod -> Paths -> LBS.ByteString -> GithubRequest 'True a GithubDelete :: Paths -> GithubRequest 'True () GithubStatus :: GithubRequest k () -> GithubRequest k Status @@ -72,6 +71,11 @@ instance Show (GithubRequest k a) where . showsPrec (appPrec + 1) ps . showString " " . showsPrec (appPrec + 1) qs + GithubPagedGet ps qs -> showParen (d > appPrec) $ + showString "GithubPagedGet " + . showsPrec (appPrec + 1) ps + . showString " " + . showsPrec (appPrec + 1) qs GithubPost m ps body -> showParen (d > appPrec) $ showString "GithubPost " . showsPrec (appPrec + 1) m diff --git a/Github/Repos/Commits.hs b/Github/Repos/Commits.hs index 89fba032..3ae99d3f 100644 --- a/Github/Repos/Commits.hs +++ b/Github/Repos/Commits.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE CPP, OverloadedStrings #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} -- | The repo commits API as described on -- . @@ -19,14 +20,15 @@ module Github.Repos.Commits ( module Github.Data, ) where +import Data.Monoid ((<>)) +import Data.Vector (Vector) import Github.Auth import Github.Data import Github.Request -import Data.Monoid ((<>)) -import qualified Data.Text.Encoding as TE -import qualified Data.ByteString as BS +import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BS8 +import qualified Data.Text.Encoding as TE import Data.Time.Format (formatTime) #if MIN_VERSION_time (1,5,0) @@ -55,23 +57,23 @@ renderCommitQueryOption (CommitQueryUntil date) = ("until", Just $ BS8.pack d -- | The commit history for a repo. -- -- > commitsFor "mike-burns" "github" -commitsFor :: Name GithubOwner -> Name Repo -> IO (Either Error [Commit]) +commitsFor :: Name GithubOwner -> Name Repo -> IO (Either Error (Vector Commit)) commitsFor = commitsFor' Nothing -- | The commit history for a repo. -- With authentication. -- -- > commitsFor' (Just (GithubBasicAuth (user, password))) "mike-burns" "github" -commitsFor' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error [Commit]) +commitsFor' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error (Vector Commit)) commitsFor' auth user repo = commitsWithOptionsFor' auth user repo [] -- | List commits on a repository. -- See -commitsForR :: Name GithubOwner -> Name Repo -> GithubRequest k [Commit] +commitsForR :: Name GithubOwner -> Name Repo -> GithubRequest k (Vector Commit) commitsForR user repo = commitsWithOptionsForR user repo [] -commitsWithOptionsFor :: Name GithubOwner -> Name Repo -> [CommitQueryOption] -> IO (Either Error [Commit]) +commitsWithOptionsFor :: Name GithubOwner -> Name Repo -> [CommitQueryOption] -> IO (Either Error (Vector Commit)) commitsWithOptionsFor = commitsWithOptionsFor' Nothing -- | The commit history for a repo, with commits filtered to satisfy a list of @@ -79,15 +81,15 @@ commitsWithOptionsFor = commitsWithOptionsFor' Nothing -- With authentication. -- -- > commitsWithOptionsFor' (Just (GithubBasicAuth (user, password))) "mike-burns" "github" [CommitQueryAuthor "djeik"] -commitsWithOptionsFor' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> [CommitQueryOption] -> IO (Either Error [Commit]) +commitsWithOptionsFor' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> [CommitQueryOption] -> IO (Either Error (Vector Commit)) commitsWithOptionsFor' auth user repo opts = executeRequestMaybe auth $ commitsWithOptionsForR user repo opts -- | List commits on a repository. -- See -commitsWithOptionsForR :: Name GithubOwner -> Name Repo -> [CommitQueryOption] -> GithubRequest k [Commit] +commitsWithOptionsForR :: Name GithubOwner -> Name Repo -> [CommitQueryOption] -> GithubRequest k (Vector Commit) commitsWithOptionsForR user repo opts = - GithubGet ["repos", untagName user, untagName repo, "commits"] qs + GithubPagedGet ["repos", untagName user, untagName repo, "commits"] qs where qs = map renderCommitQueryOption opts diff --git a/Github/Request.hs b/Github/Request.hs index c86f9f08..2da53b6f 100644 --- a/Github/Request.hs +++ b/Github/Request.hs @@ -1,11 +1,13 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} module Github.Request ( -- * Types GithubRequest(..), @@ -22,22 +24,38 @@ module Github.Request ( unsafeDropAuthRequirements, -- * Tools makeHttpRequest, + getNextUrl, ) where -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative +import Prelude () +import Prelude.Compat + +#if MIN_VERSION_mtl(2,2,0) +import Control.Monad.Except (MonadError(..)) +#else +import Control.Monad.Error (MonadError(..)) #endif -import Control.Monad.Catch (MonadThrow) -import Data.Aeson.Compat (eitherDecode) -import Data.List (intercalate) -import Data.Monoid ((<>)) -import Network.HTTP.Client (HttpException (..), Manager, Request (..), - RequestBody (..), Response (..), applyBasicAuth, - httpLbs, newManager, parseUrl, setQueryString) -import Network.HTTP.Client.TLS (tlsManagerSettings) -import Network.HTTP.Types (Method, RequestHeaders, Status (..), - methodDelete) +import Control.Monad.Catch (MonadThrow) +import Control.Monad.Trans.Except (ExceptT (..), runExceptT) +import Control.Monad.Trans.Class (lift) +import Data.Aeson.Compat (FromJSON, eitherDecode) +import Data.List (find, intercalate) +import Data.Monoid ((<>)) +import Data.Text (Text) + +import Network.HTTP.Client (HttpException (..), Manager, Request (..), + RequestBody (..), Response (..), + applyBasicAuth, httpLbs, newManager, + parseUrl, setQueryString) +import Network.HTTP.Client.Internal (setUri) +import Network.HTTP.Client.TLS (tlsManagerSettings) +import Network.HTTP.Link.Parser (parseLinkHeaderBS) +import Network.HTTP.Link.Types (Link (..), LinkParam (..), href, + linkParams) +import Network.HTTP.Types (Method, RequestHeaders, Status (..), + methodDelete) +import Network.URI (URI) import qualified Control.Exception as E import qualified Data.ByteString.Char8 as BS8 @@ -70,15 +88,14 @@ executeRequestWithMgr mgr auth req = GithubGet {} -> do httpReq <- makeHttpRequest (Just auth) req res <- httpLbs httpReq mgr - case eitherDecode (responseBody res) of - Right x -> pure . Right $ x - Left err -> pure . Left . ParseError . T.pack $ err + pure $ parseResponse res + GithubPagedGet {} -> do + httpReq <- makeHttpRequest (Just auth) req + performPagedRequest (flip httpLbs mgr) httpReq GithubPost {} -> do httpReq <- makeHttpRequest (Just auth) req res <- httpLbs httpReq mgr - case eitherDecode (responseBody res) of - Right x -> pure . Right $ x - Left err -> pure . Left . ParseError . T.pack $ err + pure $ parseResponse res GithubDelete {} -> do httpReq <- makeHttpRequest (Just auth) req _ <- httpLbs httpReq mgr @@ -109,9 +126,10 @@ executeRequestWithMgr' mgr req = GithubGet {} -> do httpReq <- makeHttpRequest Nothing req res <- httpLbs httpReq mgr - case eitherDecode (responseBody res) of - Right x -> pure . Right $ x - Left err -> pure . Left . ParseError . T.pack $ err + pure $ parseResponse res + GithubPagedGet {} -> do + httpReq <- makeHttpRequest Nothing req + performPagedRequest (flip httpLbs mgr) httpReq GithubStatus {} -> do httpReq <- makeHttpRequest Nothing req res <- httpLbs httpReq mgr @@ -143,26 +161,33 @@ makeHttpRequest auth r = case r of GithubStatus req -> makeHttpRequest auth req GithubGet paths qs -> do req <- parseUrl $ url paths - pure $ setReqHeaders - . setCheckStatus - . setAuthRequest auth - . setQueryString qs - $ req + return $ setReqHeaders + . setCheckStatus + . setAuthRequest auth + . setQueryString qs + $ req + GithubPagedGet paths qs -> do + req <- parseUrl $ url paths + return $ setReqHeaders + . setCheckStatus + . setAuthRequest auth + . setQueryString qs + $ req GithubPost m paths body -> do req <- parseUrl $ url paths - pure $ setReqHeaders - . setCheckStatus - . setAuthRequest auth - . setBody body - . setMethod (toMethod m) - $ req + return $ setReqHeaders + . setCheckStatus + . setAuthRequest auth + . setBody body + . setMethod (toMethod m) + $ req GithubDelete paths -> do req <- parseUrl $ url paths - pure $ setReqHeaders - . setCheckStatus - . setAuthRequest auth - . setMethod methodDelete - $ req + return $ setReqHeaders + . setCheckStatus + . setAuthRequest auth + . setMethod methodDelete + $ req where url :: Paths -> String url paths = baseUrl ++ '/' : intercalate "/" paths @@ -200,3 +225,39 @@ makeHttpRequest auth r = case r of successOrMissing s@(Status sci _) hs cookiejar | (200 <= sci && sci < 300) || sci == 404 = Nothing | otherwise = Just $ E.toException $ StatusCodeException s hs cookiejar + +-- | Get Link rel=next from request headers. +getNextUrl :: Response a -> Maybe URI +getNextUrl req = do + linkHeader <- lookup "Link" (responseHeaders req) + links <- parseLinkHeaderBS linkHeader + nextURI <- find isRelNext links + return $ href nextURI + where + isRelNext :: Link -> Bool + isRelNext = any (== relNextLinkParam) . linkParams + + relNextLinkParam :: (LinkParam, Text) + relNextLinkParam = (Rel, "next") + +parseResponse :: (FromJSON a, MonadError Error m) => Response LBS.ByteString -> m a +parseResponse res = case eitherDecode (responseBody res) of + Right x -> return x + Left err -> throwError . ParseError . T.pack $ err + +performPagedRequest :: forall a m. (FromJSON a, Monoid a, MonadThrow m) + => (Request -> m (Response LBS.ByteString)) -- ^ `httpLbs` analogue + -> Request -- ^ initial request + -> m (Either Error a) +performPagedRequest httpLbs' = runExceptT . go + where + go :: Request -> ExceptT Error m a + go req = do + res <- lift $ httpLbs' req + m <- parseResponse res + case getNextUrl res of + Nothing -> return m + Just uri -> do + req' <- setUri req uri + rest <- go req' + return $ m <> rest diff --git a/github.cabal b/github.cabal index 0b987919..1fbdde80 100644 --- a/github.cabal +++ b/github.cabal @@ -155,28 +155,33 @@ 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, + base-compat, + base16-bytestring >= 0.1.1.6, + byteable >= 0.1.0, bytestring, case-insensitive >= 0.4.0.4, containers, + cryptohash >= 0.11, + data-default, deepseq, - hashable, exceptions, - text, - old-locale, - http-conduit >= 1.8, + hashable, http-client, http-client-tls, + http-conduit >= 1.8, + http-link-header >=1.0.1 && <1.1, http-types, - data-default, - vector, + mtl, + network-uri, + old-locale, + text, + time >=1.4 && <1.6, + transformers, + transformers-compat, unordered-containers >= 0.2 && < 0.3, - cryptohash >= 0.11, - byteable >= 0.1.0, - base16-bytestring >= 0.1.1.6 + vector if flag(aeson-compat) Build-depends: aeson-compat >= 0.3.0.0 && <0.4 @@ -188,14 +193,16 @@ test-suite github-test type: exitcode-stdio-1.0 hs-source-dirs: spec other-modules: + Github.CommitsSpec + Github.OrganizationsSpec Github.SearchSpec Github.UsersSpec - Github.OrganizationsSpec main-is: Spec.hs ghc-options: -Wall build-depends: base >= 4.0 && < 5.0, base-compat, github, + vector, file-embed, hspec if flag(aeson-compat) diff --git a/spec/Github/CommitsSpec.hs b/spec/Github/CommitsSpec.hs new file mode 100644 index 00000000..b4bdb798 --- /dev/null +++ b/spec/Github/CommitsSpec.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +module Github.CommitsSpec where + +import Github.Auth (GithubAuth (..)) +import Github.Repos.Commits (commitsFor') + +-- import Data.Aeson.Compat (eitherDecodeStrict) +import Data.Either.Compat (isRight) +-- import Data.FileEmbed (embedFile) +import System.Environment (lookupEnv) +import Test.Hspec (Spec, describe, it, pendingWith, + shouldSatisfy) + +import qualified Data.Vector as V + +fromRightS :: Show a => Either a b -> b +fromRightS (Right b) = b +fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a + +withAuth :: (GithubAuth -> IO ()) -> IO () +withAuth action = do + mtoken <- lookupEnv "GITHUB_TOKEN" + case mtoken of + Nothing -> pendingWith "no GITHUB_TOKEN" + Just token -> action (GithubOAuth token) + +spec :: Spec +spec = do + describe "commitsFor" $ do + it "works" $ withAuth $ \auth -> do + cs <- commitsFor' (Just auth) "phadej" "github" + V.length (fromRightS cs) `shouldSatisfy` (> 300) + cs `shouldSatisfy` isRight diff --git a/stack-lts-2.yaml b/stack-lts-2.yaml index 20d0a524..7b4d4912 100644 --- a/stack-lts-2.yaml +++ b/stack-lts-2.yaml @@ -2,6 +2,7 @@ packages: - '.' extra-deps: - aeson-extra-0.2.3.0 +- http-link-header-1.0.1 resolver: lts-2.22 flags: github: diff --git a/stack-lts-3.yaml b/stack-lts-3.yaml index bffb1600..57e0ec95 100644 --- a/stack-lts-3.yaml +++ b/stack-lts-3.yaml @@ -1,6 +1,7 @@ packages: - '.' -extra-deps: [] +extra-deps: +- http-link-header-1.0.1 resolver: lts-3.20 flags: github: From 359b179b21fd70423104a695bc654822a85d7dbc Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Fri, 8 Jan 2016 15:21:13 +0200 Subject: [PATCH 129/510] Remove Private --- Github/Private.hs | 268 ---------------------------------------------- Github/Request.hs | 1 + 2 files changed, 1 insertion(+), 268 deletions(-) delete mode 100644 Github/Private.hs diff --git a/Github/Private.hs b/Github/Private.hs deleted file mode 100644 index a625a33b..00000000 --- a/Github/Private.hs +++ /dev/null @@ -1,268 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE CPP, FlexibleContexts #-} - --- | This module is /private/. It is exposed to facilitate customization --- and extension of the /public/ API of this package without explicitely --- forking the package. --- --- This module is not part of the /public/ API and as such changes in this --- module may not be reflected in the version of the package. --- -module Github.Private where - -import Prelude () -import Prelude.Compat - -import Data.Aeson -import Data.Attoparsec.ByteString.Lazy -import Data.Monoid -import Data.List -import Data.CaseInsensitive (mk) -import Network.HTTP.Types (Status(..), notFound404) -import Network.HTTP.Conduit -import Data.Maybe (fromMaybe) - -import qualified Data.Text as T - -import qualified Control.Exception as E -import qualified Data.ByteString.Char8 as BS -import qualified Data.ByteString.Lazy.Char8 as LBS - -import Github.Data -import Github.Auth - -githubGet :: (FromJSON b, Show b) => [String] -> IO (Either Error b) -githubGet = githubGet' Nothing - -githubGet' :: (FromJSON b, Show b) => Maybe GithubAuth -> [String] -> IO (Either Error b) -githubGet' auth paths = - githubAPI (BS.pack "GET") - (buildPath paths) - auth - (Nothing :: Maybe Value) - -githubGetWithQueryString :: (FromJSON b, Show b) => [String] -> String -> IO (Either Error b) -githubGetWithQueryString = githubGetWithQueryString' Nothing - -githubGetWithQueryString' :: (FromJSON b, Show b) => Maybe GithubAuth -> [String] -> String -> IO (Either Error b) -githubGetWithQueryString' auth paths qs = - githubAPI (BS.pack "GET") - (buildPath paths ++ "?" ++ qs) - auth - (Nothing :: Maybe Value) - -githubPost :: (ToJSON a, Show a, FromJSON b, Show b) => GithubAuth -> [String] -> a -> IO (Either Error b) -githubPost auth paths body = - githubAPI (BS.pack "POST") - (buildPath paths) - (Just auth) - (Just body) - -githubPatch :: (ToJSON a, Show a, FromJSON b, Show b) => GithubAuth -> [String] -> a -> IO (Either Error b) -githubPatch auth paths body = - githubAPI (BS.pack "PATCH") - (buildPath paths) - (Just auth) - (Just body) - -githubPut :: (ToJSON a, Show a, FromJSON b, Show b) => GithubAuth -> [String] -> a -> IO (Either Error b) -githubPut auth paths body = - githubAPI (BS.pack "PUT") - (buildPath paths) - (Just auth) - (Just body) - -githubDelete :: GithubAuth -> [String] -> IO (Either Error ()) -githubDelete auth paths = - githubAPIDelete auth (buildPath paths) - -apiEndpoint :: Maybe GithubAuth -> String -apiEndpoint (Just (GithubEnterpriseOAuth endpoint _)) = endpoint -apiEndpoint _ = "https://api.github.com" - -buildPath :: [String] -> String -buildPath paths = '/' : intercalate "/" paths - -githubAPI :: (ToJSON a, Show a, FromJSON b, Show b) => BS.ByteString -> String - -> Maybe GithubAuth -> Maybe a -> IO (Either Error b) -githubAPI apimethod p auth body = - githubAPI' getResponseNewManager apimethod p auth (encode . toJSON <$> body) - -githubAPI' :: (FromJSON b, Show b) - => (Request -> IO (Response LBS.ByteString)) - -> BS.ByteString -- ^ method - -> String -- ^ paths - -> Maybe GithubAuth -- ^ auth - -> Maybe LBS.ByteString -- ^ body - -> IO (Either Error b) -githubAPI' getResponse apimethod p auth body = do - result <- doHttps getResponse apimethod (apiEndpoint auth ++ p) auth (RequestBodyLBS <$> body) - case result of - Left e -> return (Left (HTTPConnectionError e)) - Right resp -> either Left (\x -> jsonResultToE (LBS.pack (show x)) - (fromJSON x)) - <$> handleBody resp - - where - handleBody resp = either (return . Left) (handleJson resp) - (parseJsonRaw (responseBody resp)) - - -- This is an "escaping" version of "for", which returns (Right esc) if - -- the value 'v' is Nothing; otherwise, it extracts the value from the - -- Maybe, applies f, and return an IO (Either Error b). - forE :: b -> Maybe a -> (a -> IO (Either Error b)) - -> IO (Either Error b) - forE = flip . maybe . return . Right - - handleJson resp gotjson@(Array ary) = - -- Determine whether the output was paginated, and if so, we must - -- recurse to obtain the subsequent pages, and append those result - -- bodies to the current one. The aggregate will then be parsed. - forE gotjson (lookup "Link" (responseHeaders resp)) $ \l -> - forE gotjson (getNextUrl (BS.unpack l)) $ \nu -> - either (return . Left . HTTPConnectionError) - (\nextResp -> do - nextJson <- handleBody nextResp - return $ (\(Array x) -> Array (ary <> x)) - <$> nextJson) - =<< doHttps getResponse apimethod nu auth Nothing - handleJson _ gotjson = return (Right gotjson) - - getNextUrl l = - if "rel=\"next\"" `isInfixOf` l - then let s = l - s' = Data.List.tail $ Data.List.dropWhile (/= '<') s - in Just (Data.List.takeWhile (/= '>') s') - else Nothing - -getResponseNewManager :: Request -> IO (Response LBS.ByteString) -getResponseNewManager request = do - manager <- newManager tlsManagerSettings - x <- httpLbs request manager -#if !MIN_VERSION_http_client(0, 4, 18) - closeManager manager -#endif - pure x - -doHttps :: (Request -> IO (Response LBS.ByteString)) - -> BS.ByteString - -> [Char] - -> Maybe GithubAuth - -> Maybe RequestBody - -> IO (Either E.SomeException (Response LBS.ByteString)) -doHttps getResponse reqMethod url auth body = do - let reqBody = fromMaybe (RequestBodyBS $ BS.pack "") body - reqHeaders = maybe [] getOAuth auth - Just uri = parseUrl url - request = uri { method = reqMethod - , secure = True - , port = 443 - , requestBody = reqBody - , responseTimeout = Just 20000000 - , requestHeaders = reqHeaders <> - [("User-Agent", "github.hs/0.7.4")] - <> [("Accept", "application/vnd.github.preview")] - , checkStatus = successOrMissing - } - authRequest = getAuthRequest auth request - - (getResponse authRequest >>= return . Right) `E.catches` [ - -- Re-throw AsyncException, otherwise execution will not terminate on - -- SIGINT (ctrl-c). All AsyncExceptions are re-thrown (not just - -- UserInterrupt) because all of them indicate severe conditions and - -- should not occur during normal operation. - E.Handler (\e -> E.throw (e :: E.AsyncException)), - E.Handler (\e -> (return . Left) (e :: E.SomeException)) - ] - where - getAuthRequest (Just (GithubBasicAuth user pass)) = applyBasicAuth user pass - getAuthRequest _ = id - getOAuth (GithubOAuth token) = [(mk (BS.pack "Authorization"), - BS.pack ("token " ++ token))] - getOAuth _ = [] - -#if MIN_VERSION_http_conduit(1, 9, 0) - successOrMissing s@(Status sci _) hs cookiejar -#else - successOrMissing s@(Status sci _) hs -#endif - | (200 <= sci && sci < 300) || sci == 404 = Nothing -#if MIN_VERSION_http_conduit(1, 9, 0) - | otherwise = Just $ E.toException $ StatusCodeException s hs cookiejar -#else - | otherwise = Just $ E.toException $ StatusCodeException s hs -#endif - -doHttpsStatus :: BS.ByteString -> String -> GithubAuth -> Maybe RequestBody -> IO (Either Error Status) -doHttpsStatus reqMethod p auth payload = do - result <- doHttps getResponseNewManager reqMethod (apiEndpoint (Just auth) ++ p) (Just auth) payload - case result of - Left e -> return (Left (HTTPConnectionError e)) - Right resp -> - let status = responseStatus resp - headers = responseHeaders resp - in if status == notFound404 - -- doHttps silently absorbs 404 errors, but for this operation - -- we want the user to know if they've tried to delete a - -- non-existent repository - then return (Left (HTTPConnectionError - (E.toException - (StatusCodeException status headers -#if MIN_VERSION_http_conduit(1, 9, 0) - (responseCookieJar resp) -#endif - )))) - else return (Right status) - -parseJsonRaw :: LBS.ByteString -> Either Error Value -parseJsonRaw jsonString = - let parsed = parse json jsonString in - case parsed of - Data.Attoparsec.ByteString.Lazy.Done _ jsonResult -> Right jsonResult - (Fail _ _ e) -> Left $ ParseError (T.pack e) - -jsonResultToE :: Show b => LBS.ByteString -> Data.Aeson.Result b - -> Either Error b -jsonResultToE jsonString result = case result of - Success s -> Right s - Error e -> Left $ JsonError $ T.pack $ - e ++ " on the JSON: " ++ LBS.unpack jsonString - -parseJson :: (FromJSON b, Show b) => LBS.ByteString -> Either Error b -parseJson jsonString = either Left (jsonResultToE jsonString . fromJSON) - (parseJsonRaw jsonString) - --- | Generically delete something --- --- > githubApiDelete (GithubBasicAuth (user, password)) ["some", "path"] -githubAPIDelete :: GithubAuth - -> String -- ^ paths - -> IO (Either Error ()) -githubAPIDelete = githubAPIDelete' getResponseNewManager - -githubAPIDelete' :: (Request -> IO (Response LBS.ByteString)) - -> GithubAuth - -> String -- ^ paths - -> IO (Either Error ()) -githubAPIDelete' getResponse auth paths = do - result <- doHttps getResponse "DELETE" - (apiEndpoint (Just auth) ++ paths) - (Just auth) - Nothing - case result of - Left e -> return (Left (HTTPConnectionError e)) - Right resp -> - let status = responseStatus resp - headers = responseHeaders resp - in if status == notFound404 - -- doHttps silently absorbs 404 errors, but for this operation - -- we want the user to know if they've tried to delete a - -- non-existent repository - then return (Left (HTTPConnectionError - (E.toException - (StatusCodeException status headers -#if MIN_VERSION_http_conduit(1, 9, 0) - (responseCookieJar resp) -#endif - )))) - else return (Right ()) diff --git a/Github/Request.hs b/Github/Request.hs index 2da53b6f..2bee7ab8 100644 --- a/Github/Request.hs +++ b/Github/Request.hs @@ -24,6 +24,7 @@ module Github.Request ( unsafeDropAuthRequirements, -- * Tools makeHttpRequest, + parseResponse, getNextUrl, ) where From 6857f45bcce632a9d14d5e12a8d3f8b6968095f4 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Fri, 8 Jan 2016 15:29:53 +0200 Subject: [PATCH 130/510] Prettify Github.All haddocks --- Github/All.hs | 1 + Github/Organizations.hs | 6 ++---- Github/Organizations/Teams.hs | 2 +- Github/PullRequests.hs | 4 ++-- Github/Repos/Comments.hs | 2 +- Github/Repos/Commits.hs | 4 ++-- Github/Search.hs | 3 --- Github/Users.hs | 6 ++---- Github/Users/Followers.hs | 6 ++---- 9 files changed, 13 insertions(+), 21 deletions(-) diff --git a/Github/All.hs b/Github/All.hs index b0b2955f..07b460bc 100644 --- a/Github/All.hs +++ b/Github/All.hs @@ -202,6 +202,7 @@ module Github.All ( -- | See -- -- Missing endpoints: + -- -- * List your repositories -- * List all public repositories -- * List Teams diff --git a/Github/Organizations.hs b/Github/Organizations.hs index 991b2db7..56a0d041 100644 --- a/Github/Organizations.hs +++ b/Github/Organizations.hs @@ -25,8 +25,7 @@ publicOrganizationsFor' auth = executeRequestMaybe auth . publicOrganizationsFor publicOrganizationsFor :: Name GithubOwner -> IO (Either Error [SimpleOrganization]) publicOrganizationsFor = publicOrganizationsFor' Nothing --- | List user organizations. The public organizations for a user, given the user's login. --- +-- | List user organizations. -- See publicOrganizationsForR :: Name GithubOwner -> GithubRequest k [SimpleOrganization] publicOrganizationsForR userName = GithubGet ["users", untagName userName, "orgs"] [] -- TODO: Use PagedGet @@ -43,8 +42,7 @@ publicOrganization' auth = executeRequestMaybe auth . publicOrganizationR publicOrganization :: Name Organization -> IO (Either Error Organization) publicOrganization = publicOrganization' Nothing --- | Get an organization. Details on a public organization. Takes the organization's login. --- +-- | Get an organization. -- See publicOrganizationR :: Name Organization -> GithubRequest k Organization publicOrganizationR reqOrganizationName = GithubGet ["orgs", untagName reqOrganizationName] [] diff --git a/Github/Organizations/Teams.hs b/Github/Organizations/Teams.hs index ab31b060..17b330ca 100644 --- a/Github/Organizations/Teams.hs +++ b/Github/Organizations/Teams.hs @@ -155,7 +155,7 @@ deleteTeamMembershipFor' :: GithubAuth -> Id Team -> Name GithubOwner -> IO (Eit deleteTeamMembershipFor' auth tid user = executeRequest auth $ deleteTeamMembershipForR tid user --- | Remove team membership +-- | Remove team membership. -- See deleteTeamMembershipForR :: Id Team -> Name GithubOwner -> GithubRequest 'True () deleteTeamMembershipForR tid user = diff --git a/Github/PullRequests.hs b/Github/PullRequests.hs index 985b92d4..6dc4d84f 100644 --- a/Github/PullRequests.hs +++ b/Github/PullRequests.hs @@ -167,7 +167,7 @@ pullRequestFilesR :: Name GithubOwner -> Name Repo -> Id DetailedPullRequest -> pullRequestFilesR user repo prid = GithubGet ["repos", untagName user, untagName repo, "pulls", show $ untagId prid, "files"] [] --- | Check if pull request has been merged +-- | Check if pull request has been merged. isPullRequestMerged :: GithubAuth -> Name GithubOwner -> Name Repo -> Id DetailedPullRequest -> IO (Either Error Status) isPullRequestMerged auth user repo prid = executeRequest auth $ isPullRequestMergedR user repo prid @@ -183,7 +183,7 @@ mergePullRequest :: GithubAuth -> Name GithubOwner -> Name Repo -> Id DetailedPu mergePullRequest auth user repo prid commitMessage = executeRequest auth $ mergePullRequestR user repo prid commitMessage --- | Merge a pull request (Merge Button) +-- | 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 $ diff --git a/Github/Repos/Comments.hs b/Github/Repos/Comments.hs index e3eebdde..c831ac6d 100644 --- a/Github/Repos/Comments.hs +++ b/Github/Repos/Comments.hs @@ -53,7 +53,7 @@ commitCommentsFor' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> Name commitCommentsFor' auth user repo sha = executeRequestMaybe auth $ commitCommentsForR user repo sha --- | List comments for a single commit +-- | List comments for a single commit. -- See commitCommentsForR :: Name GithubOwner -> Name Repo -> Name Commit -> GithubRequest k [Comment] commitCommentsForR user repo sha = diff --git a/Github/Repos/Commits.hs b/Github/Repos/Commits.hs index 3ae99d3f..d6ccfd90 100644 --- a/Github/Repos/Commits.hs +++ b/Github/Repos/Commits.hs @@ -108,7 +108,7 @@ commit' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> Name Commit -> I commit' auth user repo sha = executeRequestMaybe auth $ commitR user repo sha --- | Get a single commit +-- | Get a single commit. -- See commitR :: Name GithubOwner -> Name Repo -> Name Commit -> GithubRequest k Commit commitR user repo sha = @@ -127,7 +127,7 @@ diff' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> Name Commit -> Nam diff' auth user repo base headref = executeRequestMaybe auth $ diffR user repo base headref --- | Compare two commits +-- | Compare two commits. -- See diffR :: Name GithubOwner -> Name Repo -> Name Commit -> Name Commit -> GithubRequest k Diff diffR user repo base headref = diff --git a/Github/Search.hs b/Github/Search.hs index 4ab3ef4f..8cfd9e8d 100644 --- a/Github/Search.hs +++ b/Github/Search.hs @@ -32,7 +32,6 @@ searchRepos :: QueryString -> IO (Either Error SearchReposResult) searchRepos = searchRepos' Nothing -- | Search repositories. --- -- See searchReposR :: QueryString -> GithubRequest k SearchReposResult searchReposR queryString = GithubGet ["search", "repositories"] queryString @@ -52,7 +51,6 @@ searchCode :: QueryString -> IO (Either Error SearchCodeResult) searchCode = searchCode' Nothing -- | Search code. --- -- See searchCodeR :: QueryString -> GithubRequest k SearchCodeResult searchCodeR queryString = GithubGet ["search", "code"] queryString @@ -72,7 +70,6 @@ searchIssues :: QueryString -> IO (Either Error SearchIssuesResult) searchIssues = searchIssues' Nothing -- | Search issues. --- -- See searchIssuesR :: QueryString -> GithubRequest k SearchIssuesResult searchIssuesR queryString = GithubGet ["search", "issues"] queryString diff --git a/Github/Users.hs b/Github/Users.hs index 76a0dfa6..0a4cd4bd 100644 --- a/Github/Users.hs +++ b/Github/Users.hs @@ -27,8 +27,7 @@ userInfoFor' auth = executeRequestMaybe auth . userInfoForR userInfoFor :: Name DetailedOwner -> IO (Either Error DetailedOwner) userInfoFor = executeRequest' . userInfoForR --- | Get a single user. The information for a single user, by login name. The request --- +-- | Get a single user. -- See userInfoForR :: Name DetailedOwner -> GithubRequest k DetailedOwner userInfoForR userName = GithubGet ["users", untagName userName] [] @@ -42,8 +41,7 @@ userInfoCurrent' :: Maybe GithubAuth -> IO (Either Error DetailedOwner) userInfoCurrent' auth = executeRequestMaybe auth . unsafeDropAuthRequirements $ userInfoCurrentR --- | Get the authenticated user. Retrieve information about the user associated with the supplied authentication. --- +-- | Get the authenticated user. -- See userInfoCurrentR :: GithubRequest 'True DetailedOwner userInfoCurrentR = GithubGet ["user"] [] diff --git a/Github/Users/Followers.hs b/Github/Users/Followers.hs index ac457c9d..f2d795db 100644 --- a/Github/Users/Followers.hs +++ b/Github/Users/Followers.hs @@ -17,8 +17,7 @@ import Github.Request usersFollowing :: Name GithubOwner -> IO (Either Error [GithubOwner]) usersFollowing = executeRequest' . usersFollowingR --- | List followers of a user. All the users following the given user. --- +-- | List followers of a user. -- See usersFollowingR :: Name GithubOwner -> GithubRequest k [GithubOwner] usersFollowingR userName = GithubGet ["users", untagName userName, "followers"] [] -- TODO: use paged get @@ -29,8 +28,7 @@ usersFollowingR userName = GithubGet ["users", untagName userName, "followers"] usersFollowedBy :: Name GithubOwner -> IO (Either Error [GithubOwner]) usersFollowedBy = executeRequest' . usersFollowedByR --- | List users followed by another user. All the users that the given user follows. --- +-- | List users followed by another user. -- See usersFollowedByR :: Name GithubOwner -> GithubRequest k [GithubOwner] usersFollowedByR userName = GithubGet ["users", untagName userName, "following"] [] -- TODO: use paged get From e4e424464dd2f236664bbbe53b803b8fc210a0dc Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sat, 9 Jan 2016 11:16:17 +0200 Subject: [PATCH 131/510] Support paged get soft limit --- Github/Data/Request.hs | 8 ++++-- Github/Repos/Commits.hs | 12 ++++---- Github/Request.hs | 57 +++++++++++++++++++++++--------------- spec/Github/CommitsSpec.hs | 14 +++++++--- 4 files changed, 56 insertions(+), 35 deletions(-) diff --git a/Github/Data/Request.hs b/Github/Data/Request.hs index cc26b27f..c3dee9df 100644 --- a/Github/Data/Request.hs +++ b/Github/Data/Request.hs @@ -13,6 +13,7 @@ module Github.Data.Request ( toMethod, Paths, QueryString, + Count, ) where import Data.Aeson.Compat (FromJSON) @@ -31,6 +32,7 @@ import qualified Network.HTTP.Types.Method as Method type Paths = [String] type QueryString = [(BS.ByteString, Maybe BS.ByteString)] +type Count = Int -- | Http method of requests with body. data PostMethod = Post | Patch | Put @@ -55,7 +57,7 @@ toMethod Put = Method.methodPut -- TODO: Add constructor for collection fetches. data GithubRequest (k :: Bool) a where GithubGet :: FromJSON a => Paths -> QueryString -> GithubRequest k a - GithubPagedGet :: FromJSON (Vector a) => Paths -> QueryString -> GithubRequest k (Vector a) + GithubPagedGet :: FromJSON (Vector a) => Paths -> QueryString -> Maybe Count -> GithubRequest k (Vector a) GithubPost :: FromJSON a => PostMethod -> Paths -> LBS.ByteString -> GithubRequest 'True a GithubDelete :: Paths -> GithubRequest 'True () GithubStatus :: GithubRequest k () -> GithubRequest k Status @@ -71,11 +73,13 @@ instance Show (GithubRequest k a) where . showsPrec (appPrec + 1) ps . showString " " . showsPrec (appPrec + 1) qs - GithubPagedGet ps qs -> showParen (d > appPrec) $ + GithubPagedGet ps qs l -> showParen (d > appPrec) $ showString "GithubPagedGet " . showsPrec (appPrec + 1) ps . showString " " . showsPrec (appPrec + 1) qs + . showString " " + . showsPrec (appPrec + 1) l GithubPost m ps body -> showParen (d > appPrec) $ showString "GithubPost " . showsPrec (appPrec + 1) m diff --git a/Github/Repos/Commits.hs b/Github/Repos/Commits.hs index d6ccfd90..c0de61fd 100644 --- a/Github/Repos/Commits.hs +++ b/Github/Repos/Commits.hs @@ -70,8 +70,8 @@ commitsFor' auth user repo = -- | List commits on a repository. -- See -commitsForR :: Name GithubOwner -> Name Repo -> GithubRequest k (Vector Commit) -commitsForR user repo = commitsWithOptionsForR user repo [] +commitsForR :: Name GithubOwner -> Name Repo -> Maybe Count -> GithubRequest k (Vector Commit) +commitsForR user repo limit = commitsWithOptionsForR user repo limit [] commitsWithOptionsFor :: Name GithubOwner -> Name Repo -> [CommitQueryOption] -> IO (Either Error (Vector Commit)) commitsWithOptionsFor = commitsWithOptionsFor' Nothing @@ -83,13 +83,13 @@ commitsWithOptionsFor = commitsWithOptionsFor' Nothing -- > commitsWithOptionsFor' (Just (GithubBasicAuth (user, password))) "mike-burns" "github" [CommitQueryAuthor "djeik"] commitsWithOptionsFor' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> [CommitQueryOption] -> IO (Either Error (Vector Commit)) commitsWithOptionsFor' auth user repo opts = - executeRequestMaybe auth $ commitsWithOptionsForR user repo opts + executeRequestMaybe auth $ commitsWithOptionsForR user repo Nothing opts -- | List commits on a repository. -- See -commitsWithOptionsForR :: Name GithubOwner -> Name Repo -> [CommitQueryOption] -> GithubRequest k (Vector Commit) -commitsWithOptionsForR user repo opts = - GithubPagedGet ["repos", untagName user, untagName repo, "commits"] qs +commitsWithOptionsForR :: Name GithubOwner -> Name Repo -> Maybe Count -> [CommitQueryOption] -> GithubRequest k (Vector Commit) +commitsWithOptionsForR user repo limit opts = + GithubPagedGet ["repos", untagName user, untagName repo, "commits"] qs limit where qs = map renderCommitQueryOption opts diff --git a/Github/Request.hs b/Github/Request.hs index 2bee7ab8..22e79576 100644 --- a/Github/Request.hs +++ b/Github/Request.hs @@ -28,22 +28,22 @@ module Github.Request ( getNextUrl, ) where -import Prelude () +import Prelude () import Prelude.Compat #if MIN_VERSION_mtl(2,2,0) -import Control.Monad.Except (MonadError(..)) +import Control.Monad.Except (MonadError (..)) #else -import Control.Monad.Error (MonadError(..)) +import Control.Monad.Error (MonadError (..)) #endif -import Control.Monad.Catch (MonadThrow) -import Control.Monad.Trans.Except (ExceptT (..), runExceptT) -import Control.Monad.Trans.Class (lift) -import Data.Aeson.Compat (FromJSON, eitherDecode) -import Data.List (find, intercalate) -import Data.Monoid ((<>)) -import Data.Text (Text) +import Control.Monad.Catch (MonadThrow) +import Control.Monad.Trans.Class (lift) +import Control.Monad.Trans.Except (ExceptT (..), runExceptT) +import Data.Aeson.Compat (FromJSON, eitherDecode) +import Data.List (find, intercalate) +import Data.Monoid ((<>)) +import Data.Text (Text) import Network.HTTP.Client (HttpException (..), Manager, Request (..), RequestBody (..), Response (..), @@ -62,11 +62,14 @@ import qualified Control.Exception as E import qualified Data.ByteString.Char8 as BS8 import qualified Data.ByteString.Lazy as LBS import qualified Data.Text as T +import qualified Data.Vector as V import Github.Auth (GithubAuth (..)) import Github.Data (Error (..)) import Github.Data.Request +import Debug.Trace + -- | Execute 'GithubRequest' in 'IO' executeRequest :: Show a => GithubAuth -> GithubRequest k a -> IO (Either Error a) @@ -90,9 +93,11 @@ executeRequestWithMgr mgr auth req = httpReq <- makeHttpRequest (Just auth) req res <- httpLbs httpReq mgr pure $ parseResponse res - GithubPagedGet {} -> do + GithubPagedGet _ _ l -> do httpReq <- makeHttpRequest (Just auth) req - performPagedRequest (flip httpLbs mgr) httpReq + performPagedRequest (flip httpLbs mgr) predicate httpReq + where + predicate = maybe (const True) (\l' -> (< l') . V.length ) l GithubPost {} -> do httpReq <- makeHttpRequest (Just auth) req res <- httpLbs httpReq mgr @@ -128,14 +133,19 @@ executeRequestWithMgr' mgr req = httpReq <- makeHttpRequest Nothing req res <- httpLbs httpReq mgr pure $ parseResponse res - GithubPagedGet {} -> do + GithubPagedGet _ _ l -> do httpReq <- makeHttpRequest Nothing req - performPagedRequest (flip httpLbs mgr) httpReq + performPagedRequest (flip httpLbs mgr) predicate httpReq + where + predicate = maybe (const True) (\l' -> (< l') . V.length . xxx) l GithubStatus {} -> do httpReq <- makeHttpRequest Nothing req res <- httpLbs httpReq mgr pure . Right . responseStatus $ res +xxx :: V.Vector a -> V.Vector a +xxx v = traceShow (V.length v) v + -- | Helper for picking between 'executeRequest' and 'executeRequest''. -- -- The use is discouraged. @@ -167,7 +177,7 @@ makeHttpRequest auth r = case r of . setAuthRequest auth . setQueryString qs $ req - GithubPagedGet paths qs -> do + GithubPagedGet paths qs _ -> do req <- parseUrl $ url paths return $ setReqHeaders . setCheckStatus @@ -248,17 +258,18 @@ parseResponse res = case eitherDecode (responseBody res) of performPagedRequest :: forall a m. (FromJSON a, Monoid a, MonadThrow m) => (Request -> m (Response LBS.ByteString)) -- ^ `httpLbs` analogue + -> (a -> Bool) -- ^ predicate to continue iteration -> Request -- ^ initial request -> m (Either Error a) -performPagedRequest httpLbs' = runExceptT . go +performPagedRequest httpLbs' predicate = runExceptT . go mempty where - go :: Request -> ExceptT Error m a - go req = do + go :: a -> Request -> ExceptT Error m a + go acc req = do res <- lift $ httpLbs' req m <- parseResponse res - case getNextUrl res of - Nothing -> return m - Just uri -> do + let m' = acc <> m + case (predicate m', getNextUrl res) of + (True, Just uri) -> do req' <- setUri req uri - rest <- go req' - return $ m <> rest + go m' req' + (_, _) -> return m' diff --git a/spec/Github/CommitsSpec.hs b/spec/Github/CommitsSpec.hs index b4bdb798..ce9dd981 100644 --- a/spec/Github/CommitsSpec.hs +++ b/spec/Github/CommitsSpec.hs @@ -2,15 +2,15 @@ {-# LANGUAGE TemplateHaskell #-} module Github.CommitsSpec where -import Github.Auth (GithubAuth (..)) -import Github.Repos.Commits (commitsFor') +import Github.Auth (GithubAuth (..)) +import Github.Repos.Commits (commitsFor', commitsForR) +import Github.Request (executeRequest) -- import Data.Aeson.Compat (eitherDecodeStrict) import Data.Either.Compat (isRight) -- import Data.FileEmbed (embedFile) import System.Environment (lookupEnv) -import Test.Hspec (Spec, describe, it, pendingWith, - shouldSatisfy) +import Test.Hspec (Spec, describe, it, pendingWith, shouldSatisfy) import qualified Data.Vector as V @@ -30,5 +30,11 @@ spec = do describe "commitsFor" $ do it "works" $ withAuth $ \auth -> do cs <- commitsFor' (Just auth) "phadej" "github" + cs `shouldSatisfy` isRight V.length (fromRightS cs) `shouldSatisfy` (> 300) + + -- Page size is 30, so we get 60 commits + it "limits the response" $ withAuth $ \auth -> do + cs <- executeRequest auth $ commitsForR "phadej" "github" (Just 40) cs `shouldSatisfy` isRight + V.length (fromRightS cs) `shouldSatisfy` (< 70) From f1939f9d8854aa62f6fa3b2ceb24afc1a33e77eb Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sat, 9 Jan 2016 12:03:39 +0200 Subject: [PATCH 132/510] Use GithubPagedGet --- Github/Activity/Starring.hs | 25 ++++++------ Github/Activity/Watching.hs | 23 ++++++----- Github/Gists.hs | 11 ++--- Github/Gists/Comments.hs | 9 +++-- Github/GitData/Commits.hs | 1 - Github/GitData/References.hs | 11 ++--- Github/Issues.hs | 11 ++--- Github/Issues/Comments.hs | 11 ++--- Github/Issues/Events.hs | 21 +++++----- Github/Issues/Labels.hs | 39 +++++++++--------- Github/Issues/Milestones.hs | 11 ++--- Github/Organizations.hs | 12 +++--- Github/Organizations/Members.hs | 12 +++--- Github/Organizations/Teams.hs | 20 ++++----- Github/PullRequests.hs | 37 +++++++++-------- Github/PullRequests/ReviewComments.hs | 9 +++-- Github/Repos.hs | 58 ++++++++++++++------------- Github/Repos/Collaborators.hs | 11 ++--- Github/Repos/Comments.hs | 21 +++++----- Github/Repos/Forks.hs | 11 ++--- Github/Repos/Webhooks.hs | 9 +++-- Github/Users/Followers.hs | 19 +++++---- spec/Github/UsersSpec.hs | 4 +- 23 files changed, 212 insertions(+), 184 deletions(-) diff --git a/Github/Activity/Starring.hs b/Github/Activity/Starring.hs index 3d11e231..941d3fc5 100644 --- a/Github/Activity/Starring.hs +++ b/Github/Activity/Starring.hs @@ -11,6 +11,7 @@ module Github.Activity.Starring ( module Github.Data, ) where +import Data.Vector (Vector) import Github.Auth import Github.Data import Github.Request @@ -18,34 +19,34 @@ import Github.Request -- | The list of users that have starred the specified Github repo. -- -- > userInfoFor' Nothing "mike-burns" -stargazersFor :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error [GithubOwner]) +stargazersFor :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error (Vector GithubOwner)) stargazersFor auth user repo = - executeRequestMaybe auth $ stargazersForR user repo + executeRequestMaybe auth $ stargazersForR user repo Nothing -- | List Stargazers. -- See -stargazersForR :: Name GithubOwner -> Name Repo -> GithubRequest k [GithubOwner] +stargazersForR :: Name GithubOwner -> Name Repo -> Maybe Count -> GithubRequest k (Vector GithubOwner) stargazersForR user repo = - GithubGet ["repos", untagName user, untagName repo, "stargazers"] [] + GithubPagedGet ["repos", untagName user, untagName repo, "stargazers"] [] -- | All the public repos starred by the specified user. -- -- > reposStarredBy Nothing "croaky" -reposStarredBy :: Maybe GithubAuth -> Name GithubOwner -> IO (Either Error [Repo]) +reposStarredBy :: Maybe GithubAuth -> Name GithubOwner -> IO (Either Error (Vector Repo)) reposStarredBy auth user = - executeRequestMaybe auth $ reposStarredByR user + executeRequestMaybe auth $ reposStarredByR user Nothing -- | List repositories being starred. -- See -reposStarredByR :: Name GithubOwner -> GithubRequest k [Repo] +reposStarredByR :: Name GithubOwner -> Maybe Count -> GithubRequest k (Vector Repo) reposStarredByR user = - GithubGet ["users", untagName user, "starred"] [] + GithubPagedGet ["users", untagName user, "starred"] [] -- | All the repos starred by the authenticated user. -myStarred :: GithubAuth -> IO (Either Error [Repo]) +myStarred :: GithubAuth -> IO (Either Error (Vector Repo)) myStarred auth = - executeRequest auth $ myStarredR + executeRequest auth $ myStarredR Nothing -- | All the repos starred by the authenticated user. -myStarredR :: GithubRequest 'True [Repo] -myStarredR = GithubGet ["user", "starred"] [] +myStarredR :: Maybe Count -> GithubRequest 'True (Vector Repo) +myStarredR = GithubPagedGet ["user", "starred"] [] diff --git a/Github/Activity/Watching.hs b/Github/Activity/Watching.hs index 76b2d98e..abdcb565 100644 --- a/Github/Activity/Watching.hs +++ b/Github/Activity/Watching.hs @@ -10,6 +10,7 @@ module Github.Activity.Watching ( module Github.Data, ) where +import Data.Vector (Vector) import Github.Auth import Github.Data import Github.Request @@ -17,39 +18,39 @@ import Github.Request -- | The list of users that are watching the specified Github repo. -- -- > watchersFor "thoughtbot" "paperclip" -watchersFor :: Name GithubOwner -> Name Repo -> IO (Either Error [GithubOwner]) +watchersFor :: Name GithubOwner -> Name Repo -> IO (Either Error (Vector GithubOwner)) watchersFor = watchersFor' Nothing -- | The list of users that are watching the specified Github repo. -- With authentication -- -- > watchersFor' (Just (GithubUser (user, password))) "thoughtbot" "paperclip" -watchersFor' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error [GithubOwner]) +watchersFor' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error (Vector GithubOwner)) watchersFor' auth user repo = - executeRequestMaybe auth $ watchersForR user repo + executeRequestMaybe auth $ watchersForR user repo Nothing -- | List watchers. -- See -watchersForR :: Name GithubOwner -> Name Repo -> GithubRequest k [GithubOwner] -watchersForR user repo = - GithubGet ["repos", untagName user, untagName repo, "watchers"] [] +watchersForR :: Name GithubOwner -> Name Repo -> Maybe Count -> GithubRequest k (Vector GithubOwner) +watchersForR user repo limit = + GithubPagedGet ["repos", untagName user, untagName repo, "watchers"] [] limit -- | All the public repos watched by the specified user. -- -- > reposWatchedBy "croaky" -reposWatchedBy :: Name GithubOwner -> IO (Either Error [Repo]) +reposWatchedBy :: Name GithubOwner -> IO (Either Error (Vector Repo)) reposWatchedBy = reposWatchedBy' Nothing -- | All the public repos watched by the specified user. -- With authentication -- -- > reposWatchedBy' (Just (GithubUser (user, password))) "croaky" -reposWatchedBy' :: Maybe GithubAuth -> Name GithubOwner -> IO (Either Error [Repo]) +reposWatchedBy' :: Maybe GithubAuth -> Name GithubOwner -> IO (Either Error (Vector Repo)) reposWatchedBy' auth user = - executeRequestMaybe auth $ reposWatchedByR user + executeRequestMaybe auth $ reposWatchedByR user Nothing -- | List repositories being watched. -- See -reposWatchedByR :: Name GithubOwner -> GithubRequest k [Repo] +reposWatchedByR :: Name GithubOwner -> Maybe Count -> GithubRequest k (Vector Repo) reposWatchedByR user = - GithubGet ["users", untagName user, "subscriptions"] [] + GithubPagedGet ["users", untagName user, "subscriptions"] [] diff --git a/Github/Gists.hs b/Github/Gists.hs index 45809066..b9d7413b 100644 --- a/Github/Gists.hs +++ b/Github/Gists.hs @@ -9,6 +9,7 @@ module Github.Gists ( module Github.Data, ) where +import Data.Vector (Vector) import Github.Auth import Github.Data import Github.Request @@ -16,20 +17,20 @@ import Github.Request -- | The list of all gists created by the user -- -- > gists' (Just ("github-username", "github-password")) "mike-burns" -gists' :: Maybe GithubAuth -> Name GithubOwner -> IO (Either Error [Gist]) +gists' :: Maybe GithubAuth -> Name GithubOwner -> IO (Either Error (Vector Gist)) gists' auth user = - executeRequestMaybe auth $ gistsR user + executeRequestMaybe auth $ gistsR user Nothing -- | The list of all public gists created by the user. -- -- > gists "mike-burns" -gists :: Name GithubOwner -> IO (Either Error [Gist]) +gists :: Name GithubOwner -> IO (Either Error (Vector Gist)) gists = gists' Nothing -- | List gists. -- See -gistsR :: Name GithubOwner -> GithubRequest k [Gist] -gistsR user = GithubGet ["users", untagName user, "gists"] [] +gistsR :: Name GithubOwner -> Maybe Count -> GithubRequest k (Vector Gist) +gistsR user = GithubPagedGet ["users", untagName user, "gists"] [] -- | A specific gist, given its id, with authentication credentials -- diff --git a/Github/Gists/Comments.hs b/Github/Gists/Comments.hs index cfd25c6f..3557b860 100644 --- a/Github/Gists/Comments.hs +++ b/Github/Gists/Comments.hs @@ -8,21 +8,22 @@ module Github.Gists.Comments ( module Github.Data, ) where +import Data.Vector (Vector) import Github.Data import Github.Request -- | All the comments on a Gist, given the Gist ID. -- -- > commentsOn "1174060" -commentsOn :: Name Gist -> IO (Either Error [GistComment]) +commentsOn :: Name Gist -> IO (Either Error (Vector GistComment)) commentsOn gid = - executeRequest' $ commentsOnR gid + executeRequest' $ commentsOnR gid Nothing -- | List comments on a gist. -- See -commentsOnR :: Name Gist -> GithubRequest k [GistComment] +commentsOnR :: Name Gist -> Maybe Count -> GithubRequest k (Vector GistComment) commentsOnR gid = - GithubGet ["gists", untagName gid, "comments"] [] + GithubPagedGet ["gists", untagName gid, "comments"] [] -- | A specific comment, by the comment ID. -- diff --git a/Github/GitData/Commits.hs b/Github/GitData/Commits.hs index 1609264c..f7f406bd 100644 --- a/Github/GitData/Commits.hs +++ b/Github/GitData/Commits.hs @@ -16,7 +16,6 @@ commit :: Name GithubOwner -> Name Repo -> Name GitCommit -> IO (Either Error Gi commit user repo sha = executeRequest' $ gitCommitR user repo sha - -- | Get a commit. -- See gitCommitR :: Name GithubOwner -> Name Repo -> Name GitCommit -> GithubRequest k GitCommit diff --git a/Github/GitData/References.hs b/Github/GitData/References.hs index 82a8c941..7567d3f2 100644 --- a/Github/GitData/References.hs +++ b/Github/GitData/References.hs @@ -16,6 +16,7 @@ module Github.GitData.References ( ) where import Data.Aeson.Compat (encode) +import Data.Vector (Vector) import Github.Auth import Github.Data import Github.Request @@ -42,21 +43,21 @@ referenceR user repo ref = -- | The history of references for a repo. -- -- > references "mike-burns" "github" -references' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error [GitReference]) +references' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error (Vector GitReference)) references' auth user repo = - executeRequestMaybe auth $ referencesR user repo + executeRequestMaybe auth $ referencesR user repo Nothing -- | The history of references for a repo. -- -- > references "mike-burns" "github" -references :: Name GithubOwner -> Name Repo -> IO (Either Error [GitReference]) +references :: Name GithubOwner -> Name Repo -> IO (Either Error (Vector GitReference)) references = references' Nothing -- | Get all References. -- See -referencesR :: Name GithubOwner -> Name Repo -> GithubRequest k [GitReference] +referencesR :: Name GithubOwner -> Name Repo -> Maybe Count -> GithubRequest k (Vector GitReference) referencesR user repo = - GithubGet ["repos", untagName user, untagName repo, "git", "refs"] [] + GithubPagedGet ["repos", untagName user, untagName repo, "git", "refs"] [] -- | Create a reference. createReference :: GithubAuth -> Name GithubOwner -> Name Repo -> NewGitReference -> IO (Either Error GitReference) diff --git a/Github/Issues.hs b/Github/Issues.hs index 6c4f4eaa..b9a89fed 100644 --- a/Github/Issues.hs +++ b/Github/Issues.hs @@ -26,6 +26,7 @@ import Github.Request import Data.Aeson.Compat (encode) import Data.List (intercalate) import Data.Text (Text) +import Data.Vector (Vector) #if MIN_VERSION_time(1,5,0) import Data.Time (defaultTimeLocale) #else @@ -61,22 +62,22 @@ issueR user reqRepoName reqIssueNumber = -- restrictions as described in the @IssueLimitation@ data type. -- -- > issuesForRepo' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" [NoMilestone, OnlyClosed, Mentions "jyurek", Ascending] -issuesForRepo' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> [IssueLimitation] -> IO (Either Error [Issue]) +issuesForRepo' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> [IssueLimitation] -> IO (Either Error (Vector Issue)) issuesForRepo' auth user reqRepoName issueLimitations = - executeRequestMaybe auth $ issuesForRepoR user reqRepoName issueLimitations + executeRequestMaybe auth $ issuesForRepoR user reqRepoName issueLimitations Nothing -- | 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 :: Name GithubOwner -> Name Repo -> [IssueLimitation] -> IO (Either Error (Vector Issue)) issuesForRepo = issuesForRepo' Nothing -- | List issues for a repository. -- See -issuesForRepoR :: Name GithubOwner -> Name Repo -> [IssueLimitation] -> GithubRequest k [Issue] +issuesForRepoR :: Name GithubOwner -> Name Repo -> [IssueLimitation] -> Maybe Count -> GithubRequest k (Vector Issue) issuesForRepoR user reqRepoName issueLimitations = - GithubGet ["repos", untagName user, untagName reqRepoName, "issues"] qs + GithubPagedGet ["repos", untagName user, untagName reqRepoName, "issues"] qs where qs = map convert issueLimitations diff --git a/Github/Issues/Comments.hs b/Github/Issues/Comments.hs index 92e08cef..697abd44 100644 --- a/Github/Issues/Comments.hs +++ b/Github/Issues/Comments.hs @@ -19,6 +19,7 @@ import Data.Text (Text) import Github.Auth import Github.Data import Github.Request +import Data.Vector (Vector) -- | A specific comment, by ID. -- @@ -36,21 +37,21 @@ commentR user repo cid = -- | All comments on an issue, by the issue's number. -- -- > comments "thoughtbot" "paperclip" 635 -comments :: Name GithubOwner -> Name Repo -> Id Issue -> IO (Either Error [IssueComment]) +comments :: Name GithubOwner -> Name Repo -> Id Issue -> IO (Either Error (Vector 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 -> Name GithubOwner -> Name Repo -> Id Issue -> IO (Either Error [IssueComment]) +comments' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> Id Issue -> IO (Either Error (Vector IssueComment)) comments' auth user repo iid = - executeRequestMaybe auth $ commentsR user repo iid + executeRequestMaybe auth $ commentsR user repo iid Nothing -- | List comments on an issue. -- See -commentsR :: Name GithubOwner -> Name Repo -> Id Issue -> GithubRequest k [IssueComment] +commentsR :: Name GithubOwner -> Name Repo -> Id Issue -> Maybe Count -> GithubRequest k (Vector IssueComment) commentsR user repo iid = - GithubGet ["repos", untagName user, untagName repo, "issues", show $ untagId iid, "comments"] [] + GithubPagedGet ["repos", untagName user, untagName repo, "issues", show $ untagId iid, "comments"] [] -- | Create a new comment. -- diff --git a/Github/Issues/Events.hs b/Github/Issues/Events.hs index 40ce7c47..7d32ddee 100644 --- a/Github/Issues/Events.hs +++ b/Github/Issues/Events.hs @@ -16,44 +16,45 @@ module Github.Issues.Events ( import Github.Auth import Github.Data import Github.Request +import Data.Vector (Vector) -- | All events that have happened on an issue. -- -- > eventsForIssue "thoughtbot" "paperclip" 49 -eventsForIssue :: Name GithubOwner -> Name Repo -> Id Issue -> IO (Either Error [Event]) +eventsForIssue :: Name GithubOwner -> Name Repo -> Id Issue -> IO (Either Error (Vector Event)) eventsForIssue = eventsForIssue' Nothing -- | All events that have happened on an issue, using authentication. -- -- > eventsForIssue' (GithubUser (user, password)) "thoughtbot" "paperclip" 49 -eventsForIssue' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> Id Issue -> IO (Either Error [Event]) +eventsForIssue' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> Id Issue -> IO (Either Error (Vector Event)) eventsForIssue' auth user repo iid = - executeRequestMaybe auth $ eventsForIssueR user repo iid + executeRequestMaybe auth $ eventsForIssueR user repo iid Nothing -- | List events for an issue. -- See -eventsForIssueR :: Name GithubOwner -> Name Repo -> Id Issue -> GithubRequest k [Event] +eventsForIssueR :: Name GithubOwner -> Name Repo -> Id Issue -> Maybe Count -> GithubRequest k (Vector Event) eventsForIssueR user repo iid = - GithubGet ["repos", untagName user, untagName repo, "issues", show $ untagId iid, "events"] [] + GithubPagedGet ["repos", untagName user, untagName repo, "issues", show $ untagId iid, "events"] [] -- | All the events for all issues in a repo. -- -- > eventsForRepo "thoughtbot" "paperclip" -eventsForRepo :: Name GithubOwner -> Name Repo -> IO (Either Error [Event]) +eventsForRepo :: Name GithubOwner -> Name Repo -> IO (Either Error (Vector Event)) eventsForRepo = eventsForRepo' Nothing -- | All the events for all issues in a repo, using authentication. -- -- > eventsForRepo' (GithubUser (user, password)) "thoughtbot" "paperclip" -eventsForRepo' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error [Event]) +eventsForRepo' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error (Vector Event)) eventsForRepo' auth user repo = - executeRequestMaybe auth $ eventsForRepoR user repo + executeRequestMaybe auth $ eventsForRepoR user repo Nothing -- | List events for a repository. -- See -eventsForRepoR :: Name GithubOwner -> Name Repo -> GithubRequest k [Event] +eventsForRepoR :: Name GithubOwner -> Name Repo -> Maybe Count -> GithubRequest k (Vector Event) eventsForRepoR user repo = - GithubGet ["repos", untagName user, untagName repo, "issues", "events"] [] + GithubPagedGet ["repos", untagName user, untagName repo, "issues", "events"] [] -- | Details on a specific event, by the event's ID. -- diff --git a/Github/Issues/Labels.hs b/Github/Issues/Labels.hs index 32d55fc7..b436d650 100644 --- a/Github/Issues/Labels.hs +++ b/Github/Issues/Labels.hs @@ -40,25 +40,26 @@ import Data.Foldable (toList) import Github.Auth import Github.Data import Github.Request +import Data.Vector (Vector) -- | All the labels available to use on any issue in the repo. -- -- > labelsOnRepo "thoughtbot" "paperclip" -labelsOnRepo :: Name GithubOwner -> Name Repo -> IO (Either Error [IssueLabel]) +labelsOnRepo :: Name GithubOwner -> Name Repo -> IO (Either Error (Vector IssueLabel)) labelsOnRepo = labelsOnRepo' Nothing -- | All the labels available to use on any issue in the repo using authentication. -- -- > labelsOnRepo' (Just (GithubUser (user password))) "thoughtbot" "paperclip" -labelsOnRepo' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error [IssueLabel]) +labelsOnRepo' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error (Vector IssueLabel)) labelsOnRepo' auth user repo = - executeRequestMaybe auth $ labelsOnRepoR user repo + executeRequestMaybe auth $ labelsOnRepoR user repo Nothing -- | List all labels for this repository. -- See -labelsOnRepoR :: Name GithubOwner -> Name Repo -> GithubRequest k [IssueLabel] +labelsOnRepoR :: Name GithubOwner -> Name Repo -> Maybe Count -> GithubRequest k (Vector IssueLabel) labelsOnRepoR user repo = - GithubGet ["repos", untagName user, untagName repo, "labels"] [] + GithubPagedGet ["repos", untagName user, untagName repo, "labels"] [] -- | A label by name. -- @@ -138,21 +139,21 @@ deleteLabelR user repo lbl = -- | The labels on an issue in a repo. -- -- > labelsOnIssue "thoughtbot" "paperclip" 585 -labelsOnIssue :: Name GithubOwner -> Name Repo -> Id Issue -> IO (Either Error [IssueLabel]) +labelsOnIssue :: Name GithubOwner -> Name Repo -> Id Issue -> IO (Either Error (Vector IssueLabel)) labelsOnIssue = labelsOnIssue' Nothing -- | The labels on an issue in a repo using authentication. -- -- > labelsOnIssue' (Just (GithubUser (user password))) "thoughtbot" "paperclip" (Id 585) -labelsOnIssue' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> Id Issue -> IO (Either Error [IssueLabel]) +labelsOnIssue' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> Id Issue -> IO (Either Error (Vector IssueLabel)) labelsOnIssue' auth user repo iid = - executeRequestMaybe auth $ labelsOnIssueR user repo iid + executeRequestMaybe auth $ labelsOnIssueR user repo iid Nothing -- | List labels on an issue. -- See -labelsOnIssueR :: Name GithubOwner -> Name Repo -> Id Issue -> GithubRequest k [IssueLabel] +labelsOnIssueR :: Name GithubOwner -> Name Repo -> Id Issue -> Maybe Count -> GithubRequest k (Vector IssueLabel) labelsOnIssueR user repo iid = - GithubGet ["repos", untagName user, untagName repo, "issues", show $ untagId iid, "labels"] [] + GithubPagedGet ["repos", untagName user, untagName repo, "issues", show $ untagId iid, "labels"] [] -- | Add labels to an issue. -- @@ -163,7 +164,7 @@ addLabelsToIssue :: Foldable f -> Name Repo -> Id Issue -> f (Name IssueLabel) - -> IO (Either Error [IssueLabel]) + -> IO (Either Error (Vector IssueLabel)) addLabelsToIssue auth user repo iid lbls = executeRequest auth $ addLabelsToIssueR user repo iid lbls @@ -174,7 +175,7 @@ addLabelsToIssueR :: Foldable f -> Name Repo -> Id Issue -> f (Name IssueLabel) - -> GithubRequest 'True [IssueLabel] + -> GithubRequest 'True (Vector IssueLabel) addLabelsToIssueR user repo iid lbls = GithubPost Post paths (encode $ toList lbls) where @@ -202,7 +203,7 @@ replaceAllLabelsForIssue :: Foldable f -> Name Repo -> Id Issue -> f (Name IssueLabel) - -> IO (Either Error [IssueLabel]) + -> IO (Either Error (Vector IssueLabel)) replaceAllLabelsForIssue auth user repo iid lbls = executeRequest auth $ replaceAllLabelsForIssueR user repo iid lbls @@ -215,7 +216,7 @@ replaceAllLabelsForIssueR :: Foldable f -> Name Repo -> Id Issue -> f (Name IssueLabel) - -> GithubRequest 'True [IssueLabel] + -> GithubRequest 'True (Vector IssueLabel) replaceAllLabelsForIssueR user repo iid lbls = GithubPost Put paths (encode $ toList lbls) where @@ -237,18 +238,18 @@ removeAllLabelsFromIssueR user repo iid = -- | All the labels on a repo's milestone given the milestone ID. -- -- > labelsOnMilestone "thoughtbot" "paperclip" (Id 2) -labelsOnMilestone :: Name GithubOwner -> Name Repo -> Id Milestone -> IO (Either Error [IssueLabel]) +labelsOnMilestone :: Name GithubOwner -> Name Repo -> Id Milestone -> IO (Either Error (Vector IssueLabel)) labelsOnMilestone = labelsOnMilestone' Nothing -- | All the labels on a repo's milestone given the milestone ID using authentication. -- -- > labelsOnMilestone' (Just (GithubUser (user password))) "thoughtbot" "paperclip" (Id 2) -labelsOnMilestone' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> Id Milestone -> IO (Either Error [IssueLabel]) +labelsOnMilestone' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> Id Milestone -> IO (Either Error (Vector IssueLabel)) labelsOnMilestone' auth user repo mid = - executeRequestMaybe auth $ labelsOnMilestoneR user repo mid + executeRequestMaybe auth $ labelsOnMilestoneR user repo mid Nothing -- | Get labels for every issue in a milestone. -- See -labelsOnMilestoneR :: Name GithubOwner -> Name Repo -> Id Milestone -> GithubRequest k [IssueLabel] +labelsOnMilestoneR :: Name GithubOwner -> Name Repo -> Id Milestone -> Maybe Count -> GithubRequest k (Vector IssueLabel) labelsOnMilestoneR user repo mid = - GithubGet ["repos", untagName user, untagName repo, "milestones", show $ untagId mid, "labels"] [] + GithubPagedGet ["repos", untagName user, untagName repo, "milestones", show $ untagId mid, "labels"] [] diff --git a/Github/Issues/Milestones.hs b/Github/Issues/Milestones.hs index 560578db..1fb7f4ef 100644 --- a/Github/Issues/Milestones.hs +++ b/Github/Issues/Milestones.hs @@ -12,24 +12,25 @@ module Github.Issues.Milestones ( import Github.Auth import Github.Data import Github.Request +import Data.Vector (Vector) -- | All milestones in the repo. -- -- > milestones "thoughtbot" "paperclip" -milestones :: Name GithubOwner -> Name Repo -> IO (Either Error [Milestone]) +milestones :: Name GithubOwner -> Name Repo -> IO (Either Error (Vector Milestone)) milestones = milestones' Nothing -- | All milestones in the repo, using authentication. -- -- > milestones' (GithubUser (user, passwordG) "thoughtbot" "paperclip" -milestones' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error [Milestone]) +milestones' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error (Vector Milestone)) milestones' auth user repo = - executeRequestMaybe auth $ milestonesR user repo + executeRequestMaybe auth $ milestonesR user repo Nothing -- | List milestones for a repository. -- See -milestonesR :: Name GithubOwner -> Name Repo -> GithubRequest k [Milestone] -milestonesR user repo = GithubGet ["repos", untagName user, untagName repo, "milestones"] [] +milestonesR :: Name GithubOwner -> Name Repo -> Maybe Count -> GithubRequest k (Vector Milestone) +milestonesR user repo = GithubPagedGet ["repos", untagName user, untagName repo, "milestones"] [] -- | Details on a specific milestone, given it's milestone number. -- diff --git a/Github/Organizations.hs b/Github/Organizations.hs index 56a0d041..f444b94d 100644 --- a/Github/Organizations.hs +++ b/Github/Organizations.hs @@ -9,6 +9,7 @@ module Github.Organizations ( module Github.Data, ) where +import Data.Vector (Vector) import Github.Auth import Github.Data import Github.Request @@ -16,19 +17,20 @@ import Github.Request -- | The public organizations for a user, given the user's login, with authorization -- -- > publicOrganizationsFor' (Just ("github-username", "github-password")) "mike-burns" -publicOrganizationsFor' :: Maybe GithubAuth -> Name GithubOwner -> IO (Either Error [SimpleOrganization]) -publicOrganizationsFor' auth = executeRequestMaybe auth . publicOrganizationsForR +publicOrganizationsFor' :: Maybe GithubAuth -> Name GithubOwner -> IO (Either Error (Vector SimpleOrganization)) +publicOrganizationsFor' auth org = + executeRequestMaybe auth $ publicOrganizationsForR org Nothing -- | List user organizations. The public organizations for a user, given the user's login. -- -- > publicOrganizationsFor "mike-burns" -publicOrganizationsFor :: Name GithubOwner -> IO (Either Error [SimpleOrganization]) +publicOrganizationsFor :: Name GithubOwner -> IO (Either Error (Vector SimpleOrganization)) publicOrganizationsFor = publicOrganizationsFor' Nothing -- | List user organizations. -- See -publicOrganizationsForR :: Name GithubOwner -> GithubRequest k [SimpleOrganization] -publicOrganizationsForR userName = GithubGet ["users", untagName userName, "orgs"] [] -- TODO: Use PagedGet +publicOrganizationsForR :: Name GithubOwner -> Maybe Count -> GithubRequest k (Vector SimpleOrganization) +publicOrganizationsForR userName = GithubPagedGet ["users", untagName userName, "orgs"] [] -- | Details on a public organization. Takes the organization's login. -- diff --git a/Github/Organizations/Members.hs b/Github/Organizations/Members.hs index 2845b930..01c874fe 100644 --- a/Github/Organizations/Members.hs +++ b/Github/Organizations/Members.hs @@ -10,23 +10,25 @@ module Github.Organizations.Members ( import Github.Auth import Github.Data import Github.Request +import Data.Vector (Vector) -- | All the users who are members of the specified organization, -- | with or without authentication. -- -- > membersOf' (Just $ GithubOAuth "token") "thoughtbot" -membersOf' :: Maybe GithubAuth -> Name Organization -> IO (Either Error [GithubOwner]) -membersOf' auth = executeRequestMaybe auth . membersOfR +membersOf' :: Maybe GithubAuth -> Name Organization -> IO (Either Error (Vector GithubOwner)) +membersOf' auth org = + executeRequestMaybe auth $ membersOfR org Nothing -- | All the users who are members of the specified organization, -- | without authentication. -- -- > membersOf "thoughtbot" -membersOf :: Name Organization -> IO (Either Error [GithubOwner]) +membersOf :: Name Organization -> IO (Either Error (Vector GithubOwner)) membersOf = membersOf' Nothing -- | All the users who are members of the specified organization. -- -- See -membersOfR :: Name Organization -> GithubRequest k [GithubOwner] -membersOfR organization = GithubGet ["orgs", untagName organization, "members"] [] +membersOfR :: Name Organization -> Maybe Count -> GithubRequest k (Vector GithubOwner) +membersOfR organization = GithubPagedGet ["orgs", untagName organization, "members"] [] diff --git a/Github/Organizations/Teams.hs b/Github/Organizations/Teams.hs index 17b330ca..df49c65d 100644 --- a/Github/Organizations/Teams.hs +++ b/Github/Organizations/Teams.hs @@ -30,25 +30,27 @@ import Data.Aeson.Compat (encode) import Github.Auth import Github.Data import Github.Request +import Data.Vector (Vector) -- | List teams. List the teams of an organization. -- When authenticated, lists private teams visible to the authenticated user. -- When unauthenticated, lists only public teams for an organization. -- -- > teamsOf' (Just $ GithubOAuth "token") "thoughtbot" -teamsOf' :: Maybe GithubAuth -> Name Organization -> IO (Either Error [Team]) -teamsOf' auth = executeRequestMaybe auth . teamsOfR +teamsOf' :: Maybe GithubAuth -> Name Organization -> IO (Either Error (Vector Team)) +teamsOf' auth org = + executeRequestMaybe auth $ teamsOfR org Nothing -- | List the public teams of an organization. -- -- > teamsOf "thoughtbot" -teamsOf :: Name Organization -> IO (Either Error [Team]) +teamsOf :: Name Organization -> IO (Either Error (Vector Team)) teamsOf = teamsOf' Nothing -- | List teams. -- See -teamsOfR :: Name Organization -> GithubRequest k [Team] -teamsOfR organization = GithubGet ["orgs", untagName organization, "teams"] [] +teamsOfR :: Name Organization -> Maybe Count -> GithubRequest k (Vector Team) +teamsOfR organization = GithubPagedGet ["orgs", untagName organization, "teams"] [] -- | The information for a single team, by team id. -- | With authentication @@ -164,10 +166,10 @@ deleteTeamMembershipForR tid user = -- | List teams for current authenticated user -- -- > listTeamsCurrent' (GithubOAuth "token") -listTeamsCurrent' :: GithubAuth -> IO (Either Error [DetailedTeam]) -listTeamsCurrent' auth = executeRequest auth $ listTeamsCurrentR +listTeamsCurrent' :: GithubAuth -> IO (Either Error (Vector DetailedTeam)) +listTeamsCurrent' auth = executeRequest auth $ listTeamsCurrentR Nothing -- | List user teams. -- See -listTeamsCurrentR :: GithubRequest 'True [DetailedTeam] -listTeamsCurrentR = GithubGet ["user", "teams"] [] +listTeamsCurrentR :: Maybe Count -> GithubRequest 'True (Vector DetailedTeam) +listTeamsCurrentR = GithubPagedGet ["user", "teams"] [] diff --git a/Github/PullRequests.hs b/Github/PullRequests.hs index 6dc4d84f..f5de4658 100644 --- a/Github/PullRequests.hs +++ b/Github/PullRequests.hs @@ -32,6 +32,7 @@ import Github.Data import Github.Request import Data.Aeson.Compat (Value, encode, object, (.=)) +import Data.Vector (Vector) import Network.HTTP.Types import qualified Data.ByteString.Char8 as BS8 @@ -43,31 +44,33 @@ import qualified Data.ByteString.Char8 as BS8 -- -- State can be one of @all@, @open@, or @closed@. Default is @open@. -- -pullRequestsFor'' :: Maybe GithubAuth -> Maybe String -> Name GithubOwner -> Name Repo -> IO (Either Error [PullRequest]) +pullRequestsFor'' :: Maybe GithubAuth -> Maybe String -> Name GithubOwner -> Name Repo -> IO (Either Error (Vector PullRequest)) pullRequestsFor'' auth state user repo = - executeRequestMaybe auth $ pullRequestsForR user repo state + executeRequestMaybe auth $ pullRequestsForR user repo state Nothing -- | All pull requests for the repo, by owner and repo name. -- | With authentification -- -- > pullRequestsFor' (Just ("github-username", "github-password")) "rails" "rails" -pullRequestsFor' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error [PullRequest]) +pullRequestsFor' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error (Vector PullRequest)) pullRequestsFor' auth = pullRequestsFor'' auth Nothing -- | All pull requests for the repo, by owner and repo name. -- -- > pullRequestsFor "rails" "rails" -pullRequestsFor :: Name GithubOwner -> Name Repo -> IO (Either Error [PullRequest]) +pullRequestsFor :: Name GithubOwner -> Name Repo -> IO (Either Error (Vector PullRequest)) pullRequestsFor = pullRequestsFor'' Nothing Nothing -- | List pull requests. -- See pullRequestsForR :: Name GithubOwner -> Name Repo -> Maybe String -- ^ State - -> GithubRequest k [PullRequest] + -> Maybe Count + -> GithubRequest k (Vector PullRequest) pullRequestsForR user repo state = - GithubGet ["repos", untagName user, untagName repo, "pulls"] $ - maybe [] (\s -> [("state", Just . BS8.pack $ s)]) state + GithubPagedGet ["repos", untagName user, untagName repo, "pulls"] qs + where + qs = maybe [] (\s -> [("state", Just . BS8.pack $ s)]) 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. @@ -128,44 +131,44 @@ updatePullRequestR user repo prid epr = -- | With authentification -- -- > pullRequestCommits' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" 688 -pullRequestCommits' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> Id DetailedPullRequest -> IO (Either Error [Commit]) +pullRequestCommits' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> Id DetailedPullRequest -> IO (Either Error (Vector Commit)) pullRequestCommits' auth user repo prid = - executeRequestMaybe auth $ pullRequestCommitsR user repo prid + executeRequestMaybe auth $ pullRequestCommitsR user repo prid Nothing -- | 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 :: Name GithubOwner -> Name Repo -> Id DetailedPullRequest -> IO (Either Error [Commit]) +pullRequestCommits :: Name GithubOwner -> Name Repo -> Id DetailedPullRequest -> IO (Either Error (Vector Commit)) pullRequestCommits = pullRequestCommits' Nothing -- | List commits on a pull request. -- See -pullRequestCommitsR :: Name GithubOwner -> Name Repo -> Id DetailedPullRequest -> GithubRequest k [Commit] +pullRequestCommitsR :: Name GithubOwner -> Name Repo -> Id DetailedPullRequest -> Maybe Count -> GithubRequest k (Vector Commit) pullRequestCommitsR user repo prid = - GithubGet ["repos", untagName user, untagName repo, "pulls", show $ untagId prid, "commits"] [] + GithubPagedGet ["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 -> Name GithubOwner -> Name Repo -> Id DetailedPullRequest -> IO (Either Error [File]) +pullRequestFiles' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> Id DetailedPullRequest -> IO (Either Error (Vector File)) pullRequestFiles' auth user repo prid = - executeRequestMaybe auth $ pullRequestFilesR user repo prid + executeRequestMaybe auth $ pullRequestFilesR user repo prid Nothing -- | 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 :: Name GithubOwner -> Name Repo -> Id DetailedPullRequest -> IO (Either Error [File]) +pullRequestFiles :: Name GithubOwner -> Name Repo -> Id DetailedPullRequest -> IO (Either Error (Vector File)) pullRequestFiles = pullRequestFiles' Nothing -- | List pull requests files. -- See -pullRequestFilesR :: Name GithubOwner -> Name Repo -> Id DetailedPullRequest -> GithubRequest k [File] +pullRequestFilesR :: Name GithubOwner -> Name Repo -> Id DetailedPullRequest -> Maybe Count -> GithubRequest k (Vector File) pullRequestFilesR user repo prid = - GithubGet ["repos", untagName user, untagName repo, "pulls", show $ untagId prid, "files"] [] + GithubPagedGet ["repos", untagName user, untagName repo, "pulls", show $ untagId prid, "files"] [] -- | Check if pull request has been merged. isPullRequestMerged :: GithubAuth -> Name GithubOwner -> Name Repo -> Id DetailedPullRequest -> IO (Either Error Status) diff --git a/Github/PullRequests/ReviewComments.hs b/Github/PullRequests/ReviewComments.hs index 257a9653..5dea8cfa 100644 --- a/Github/PullRequests/ReviewComments.hs +++ b/Github/PullRequests/ReviewComments.hs @@ -10,19 +10,20 @@ module Github.PullRequests.ReviewComments ( import Github.Data import Github.Request +import Data.Vector (Vector) -- | All the comments on a pull request with the given ID. -- -- > pullRequestReviewComments "thoughtbot" "factory_girl" (Id 256) -pullRequestReviewComments :: Name GithubOwner -> Name Repo -> Id PullRequest -> IO (Either Error [Comment]) +pullRequestReviewComments :: Name GithubOwner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector Comment)) pullRequestReviewComments user repo prid = - executeRequest' $ pullRequestReviewCommentsR user repo prid + executeRequest' $ pullRequestReviewCommentsR user repo prid Nothing -- | List comments on a pull request. -- See -pullRequestReviewCommentsR :: Name GithubOwner -> Name Repo -> Id PullRequest -> GithubRequest k [Comment] +pullRequestReviewCommentsR :: Name GithubOwner -> Name Repo -> Id PullRequest -> Maybe Count -> GithubRequest k (Vector Comment) pullRequestReviewCommentsR user repo prid = - GithubGet ["repos", untagName user, untagName repo, "pulls", show $ untagId prid, "comments"] [] + GithubPagedGet ["repos", untagName user, untagName repo, "pulls", show $ untagId prid, "comments"] [] -- | One comment on a pull request, by the comment's ID. -- diff --git a/Github/Repos.hs b/Github/Repos.hs index 43cc2133..8326ad1d 100644 --- a/Github/Repos.hs +++ b/Github/Repos.hs @@ -55,6 +55,7 @@ module Github.Repos ( import Control.Applicative ((<|>)) import Data.Aeson.Compat (encode) +import Data.Vector (Vector) import Github.Auth import Github.Data import Github.Request @@ -72,44 +73,44 @@ repoPublicityQueryString Private = [("type", Just "private")] -- own, are a member of, or publicize. Private repos will return empty list. -- -- > userRepos "mike-burns" All -userRepos :: Name GithubOwner -> RepoPublicity -> IO (Either Error [Repo]) +userRepos :: Name GithubOwner -> RepoPublicity -> IO (Either Error (Vector Repo)) userRepos = userRepos' Nothing -- | The repos for a user, by their login. -- With authentication. -- -- > userRepos' (Just (GithubBasicAuth (user, password))) "mike-burns" All -userRepos' :: Maybe GithubAuth -> Name GithubOwner -> RepoPublicity -> IO (Either Error [Repo]) +userRepos' :: Maybe GithubAuth -> Name GithubOwner -> RepoPublicity -> IO (Either Error (Vector Repo)) userRepos' auth user publicity = - executeRequestMaybe auth $ userReposR user publicity + executeRequestMaybe auth $ userReposR user publicity Nothing -- | List user repositories. -- See -userReposR :: Name GithubOwner -> RepoPublicity -> GithubRequest k [Repo] +userReposR :: Name GithubOwner -> RepoPublicity -> Maybe Count -> GithubRequest k(Vector Repo) userReposR user publicity = - GithubGet ["users", untagName user, "repos"] qs + GithubPagedGet ["users", untagName user, "repos"] qs where qs = repoPublicityQueryString publicity -- | The repos for an organization, by the organization name. -- -- > organizationRepos "thoughtbot" -organizationRepos :: Name Organization -> IO (Either Error [Repo]) +organizationRepos :: Name Organization -> IO (Either Error (Vector Repo)) organizationRepos org = organizationRepos' Nothing org All -- | The repos for an organization, by the organization name. -- With authentication. -- -- > organizationRepos (Just (GithubBasicAuth (user, password))) "thoughtbot" All -organizationRepos' :: Maybe GithubAuth -> Name Organization -> RepoPublicity -> IO (Either Error [Repo]) +organizationRepos' :: Maybe GithubAuth -> Name Organization -> RepoPublicity -> IO (Either Error (Vector Repo)) organizationRepos' auth org publicity = - executeRequestMaybe auth $ organizationReposR org publicity + executeRequestMaybe auth $ organizationReposR org publicity Nothing -- | List organization repositories. -- See -organizationReposR :: Name Organization -> RepoPublicity -> GithubRequest k [Repo] +organizationReposR :: Name Organization -> RepoPublicity -> Maybe Count -> GithubRequest k (Vector Repo) organizationReposR org publicity = - GithubGet ["orgs", untagName org, "repos"] qs + GithubPagedGet ["orgs", untagName org, "repos"] qs where qs = repoPublicityQueryString publicity @@ -183,25 +184,26 @@ editRepoR user repo body = -- | The contributors to a repo, given the owner and repo name. -- -- > contributors "thoughtbot" "paperclip" -contributors :: Name GithubOwner -> Name Repo -> IO (Either Error [Contributor]) +contributors :: Name GithubOwner -> Name Repo -> IO (Either Error (Vector Contributor)) contributors = contributors' Nothing -- | The contributors to a repo, given the owner and repo name. -- With authentication. -- -- > contributors' (Just (GithubBasicAuth (user, password))) "thoughtbot" "paperclip" -contributors' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error [Contributor]) +contributors' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error (Vector Contributor)) contributors' auth user repo = - executeRequestMaybe auth $ contributorsR user repo False + executeRequestMaybe auth $ contributorsR user repo False Nothing -- | List contributors. -- See contributorsR :: Name GithubOwner -> Name Repo -> Bool -- ^ Include anonymous - -> GithubRequest k [Contributor] + -> Maybe Count + -> GithubRequest k (Vector Contributor) contributorsR user repo anon = - GithubGet ["repos", untagName user, untagName repo, "contributors"] qs + GithubPagedGet ["repos", untagName user, untagName repo, "contributors"] qs where qs | anon = [("anon", Just "true")] | otherwise = [] @@ -211,7 +213,7 @@ contributorsR user repo anon = -- and repo name. -- -- > contributorsWithAnonymous "thoughtbot" "paperclip" -contributorsWithAnonymous :: Name GithubOwner -> Name Repo -> IO (Either Error [Contributor]) +contributorsWithAnonymous :: Name GithubOwner -> Name Repo -> IO (Either Error (Vector Contributor)) contributorsWithAnonymous = contributorsWithAnonymous' Nothing -- | The contributors to a repo, including anonymous contributors (such as @@ -220,9 +222,9 @@ contributorsWithAnonymous = contributorsWithAnonymous' Nothing -- With authentication. -- -- > contributorsWithAnonymous' (Just (GithubBasicAuth (user, password))) "thoughtbot" "paperclip" -contributorsWithAnonymous' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error [Contributor]) +contributorsWithAnonymous' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error (Vector Contributor)) contributorsWithAnonymous' auth user repo = - executeRequestMaybe auth $ contributorsR user repo True + executeRequestMaybe auth $ contributorsR user repo True Nothing -- | The programming languages used in a repo along with the number of -- characters written in that language. Takes the repo owner and name. @@ -249,42 +251,42 @@ languagesForR user repo = -- | The git tags on a repo, given the repo owner and name. -- -- > tagsFor "thoughtbot" "paperclip" -tagsFor :: Name GithubOwner -> Name Repo -> IO (Either Error [Tag]) +tagsFor :: Name GithubOwner -> Name Repo -> IO (Either Error (Vector Tag)) tagsFor = tagsFor' Nothing -- | The git tags on a repo, given the repo owner and name. -- With authentication. -- -- > tagsFor' (Just (GithubBasicAuth (user, password))) "thoughtbot" "paperclip" -tagsFor' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error [Tag]) +tagsFor' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error (Vector Tag)) tagsFor' auth user repo = - executeRequestMaybe auth $ tagsForR user repo + executeRequestMaybe auth $ tagsForR user repo Nothing -- | List tags. -- See -tagsForR :: Name GithubOwner -> Name Repo -> GithubRequest k [Tag] +tagsForR :: Name GithubOwner -> Name Repo -> Maybe Count -> GithubRequest k (Vector Tag) tagsForR user repo = - GithubGet ["repos", untagName user, untagName repo, "tags"] [] + GithubPagedGet ["repos", untagName user, untagName repo, "tags"] [] -- | The git branches on a repo, given the repo owner and name. -- -- > branchesFor "thoughtbot" "paperclip" -branchesFor :: Name GithubOwner -> Name Repo -> IO (Either Error [Branch]) +branchesFor :: Name GithubOwner -> Name Repo -> IO (Either Error (Vector Branch)) branchesFor = branchesFor' Nothing -- | The git branches on a repo, given the repo owner and name. -- With authentication. -- -- > branchesFor' (Just (GithubBasicAuth (user, password))) "thoughtbot" "paperclip" -branchesFor' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error [Branch]) +branchesFor' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error (Vector Branch)) branchesFor' auth user repo = - executeRequestMaybe auth $ branchesForR user repo + executeRequestMaybe auth $ branchesForR user repo Nothing -- | List branches. -- See -branchesForR :: Name GithubOwner -> Name Repo -> GithubRequest k [Branch] +branchesForR :: Name GithubOwner -> Name Repo -> Maybe Count -> GithubRequest k (Vector Branch) branchesForR user repo = - GithubGet ["repos", untagName user, untagName repo, "branches"] [] + GithubPagedGet ["repos", untagName user, untagName repo, "branches"] [] -- | The contents of a file or directory in a repo, given the repo owner, name, and path to the file -- diff --git a/Github/Repos/Collaborators.hs b/Github/Repos/Collaborators.hs index 7d1a3e47..e35f2471 100644 --- a/Github/Repos/Collaborators.hs +++ b/Github/Repos/Collaborators.hs @@ -9,6 +9,7 @@ module Github.Repos.Collaborators ( module Github.Data, ) where +import Data.Vector (Vector) import Github.Auth import Github.Data import Github.Request @@ -17,20 +18,20 @@ import Network.HTTP.Types (Status) -- | All the users who have collaborated on a repo. -- -- > collaboratorsOn "thoughtbot" "paperclip" -collaboratorsOn :: Name GithubOwner -> Name Repo -> IO (Either Error [GithubOwner]) +collaboratorsOn :: Name GithubOwner -> Name Repo -> IO (Either Error (Vector GithubOwner)) collaboratorsOn = collaboratorsOn' Nothing -- | All the users who have collaborated on a repo. -- With authentication. -collaboratorsOn' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error [GithubOwner]) +collaboratorsOn' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error (Vector GithubOwner)) collaboratorsOn' auth user repo = - executeRequestMaybe auth $ collaboratorsOnR user repo + executeRequestMaybe auth $ collaboratorsOnR user repo Nothing -- | List collaborators. -- See -collaboratorsOnR :: Name GithubOwner -> Name Repo -> GithubRequest k [GithubOwner] +collaboratorsOnR :: Name GithubOwner -> Name Repo -> Maybe Count -> GithubRequest k (Vector GithubOwner) collaboratorsOnR user repo = - GithubGet ["repos", untagName user, untagName repo, "collaborators"] [] + GithubPagedGet ["repos", untagName user, untagName repo, "collaborators"] [] -- | Whether the user is collaborating on a repo. Takes the user in question, -- the user who owns the repo, and the repo name. diff --git a/Github/Repos/Comments.hs b/Github/Repos/Comments.hs index c831ac6d..d09252cf 100644 --- a/Github/Repos/Comments.hs +++ b/Github/Repos/Comments.hs @@ -15,6 +15,7 @@ module Github.Repos.Comments ( module Github.Data, ) where +import Data.Vector (Vector) import Github.Auth import Github.Data import Github.Request @@ -22,42 +23,42 @@ import Github.Request -- | All the comments on a Github repo. -- -- > commentsFor "thoughtbot" "paperclip" -commentsFor :: Name GithubOwner -> Name Repo -> IO (Either Error [Comment]) +commentsFor :: Name GithubOwner -> Name Repo -> IO (Either Error (Vector Comment)) commentsFor = commentsFor' Nothing -- | All the comments on a Github repo. -- With authentication. -- -- > commentsFor "thoughtbot" "paperclip" -commentsFor' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error [Comment]) +commentsFor' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error (Vector Comment)) commentsFor' auth user repo = - executeRequestMaybe auth $ commentsForR user repo + executeRequestMaybe auth $ commentsForR user repo Nothing -- | List commit comments for a repository. -- See -commentsForR :: Name GithubOwner -> Name Repo -> GithubRequest k [Comment] +commentsForR :: Name GithubOwner -> Name Repo -> Maybe Count -> GithubRequest k (Vector Comment) commentsForR user repo = - GithubGet ["repos", untagName user, untagName repo, "comments"] [] + GithubPagedGet ["repos", untagName user, untagName repo, "comments"] [] -- | Just the comments on a specific SHA for a given Github repo. -- -- > commitCommentsFor "thoughtbot" "paperclip" "41f685f6e01396936bb8cd98e7cca517e2c7d96b" -commitCommentsFor :: Name GithubOwner -> Name Repo -> Name Commit -> IO (Either Error [Comment]) +commitCommentsFor :: Name GithubOwner -> Name Repo -> Name Commit -> IO (Either Error (Vector Comment)) commitCommentsFor = commitCommentsFor' Nothing -- | Just the comments on a specific SHA for a given Github repo. -- With authentication. -- -- > commitCommentsFor "thoughtbot" "paperclip" "41f685f6e01396936bb8cd98e7cca517e2c7d96b" -commitCommentsFor' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> Name Commit -> IO (Either Error [Comment]) +commitCommentsFor' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> Name Commit -> IO (Either Error (Vector Comment)) commitCommentsFor' auth user repo sha = - executeRequestMaybe auth $ commitCommentsForR user repo sha + executeRequestMaybe auth $ commitCommentsForR user repo sha Nothing -- | List comments for a single commit. -- See -commitCommentsForR :: Name GithubOwner -> Name Repo -> Name Commit -> GithubRequest k [Comment] +commitCommentsForR :: Name GithubOwner -> Name Repo -> Name Commit -> Maybe Count -> GithubRequest k (Vector Comment) commitCommentsForR user repo sha = - GithubGet ["repos", untagName user, untagName repo, "commits", untagName sha, "comments"] [] + GithubPagedGet ["repos", untagName user, untagName repo, "commits", untagName sha, "comments"] [] -- | A comment, by its ID, relative to the Github repo. -- diff --git a/Github/Repos/Forks.hs b/Github/Repos/Forks.hs index 78bf5a88..fea2df29 100644 --- a/Github/Repos/Forks.hs +++ b/Github/Repos/Forks.hs @@ -7,6 +7,7 @@ module Github.Repos.Forks ( module Github.Data, ) where +import Data.Vector (Vector) import Github.Auth import Github.Data import Github.Request @@ -14,19 +15,19 @@ import Github.Request -- | All the repos that are forked off the given repo. -- -- > forksFor "thoughtbot" "paperclip" -forksFor :: Name GithubOwner -> Name Repo -> IO (Either Error [Repo]) +forksFor :: Name GithubOwner -> Name Repo -> IO (Either Error (Vector Repo)) forksFor = forksFor' Nothing -- | All the repos that are forked off the given repo. -- | With authentication -- -- > forksFor' (Just (GithubUser (user, password))) "thoughtbot" "paperclip" -forksFor' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error [Repo]) +forksFor' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error (Vector Repo)) forksFor' auth user repo = - executeRequestMaybe auth $ forksForR user repo + executeRequestMaybe auth $ forksForR user repo Nothing -- | List forks. -- See -forksForR :: Name GithubOwner -> Name Repo -> GithubRequest k [Repo] +forksForR :: Name GithubOwner -> Name Repo -> Maybe Count -> GithubRequest k (Vector Repo) forksForR user repo = - GithubGet ["repos", untagName user, untagName repo, "forks"] [] + GithubPagedGet ["repos", untagName user, untagName repo, "forks"] [] diff --git a/Github/Repos/Webhooks.hs b/Github/Repos/Webhooks.hs index b2ba135d..ca8a99e8 100644 --- a/Github/Repos/Webhooks.hs +++ b/Github/Repos/Webhooks.hs @@ -34,17 +34,18 @@ import Github.Data import Github.Request import Data.Aeson.Compat (encode) +import Data.Vector (Vector) import Network.HTTP.Types (Status) -webhooksFor' :: GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error [RepoWebhook]) +webhooksFor' :: GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error (Vector RepoWebhook)) webhooksFor' auth user repo = - executeRequest auth $ webhooksForR user repo + executeRequest auth $ webhooksForR user repo Nothing -- | List hooks. -- See -webhooksForR :: Name GithubOwner -> Name Repo -> GithubRequest k [RepoWebhook] +webhooksForR :: Name GithubOwner -> Name Repo -> Maybe Count -> GithubRequest k (Vector RepoWebhook) webhooksForR user repo = - GithubGet ["repos", untagName user, untagName repo, "hooks"] [] + GithubPagedGet ["repos", untagName user, untagName repo, "hooks"] [] webhookFor' :: GithubAuth -> Name GithubOwner -> Name Repo -> Id RepoWebhook -> IO (Either Error RepoWebhook) webhookFor' auth user repo hookId = diff --git a/Github/Users/Followers.hs b/Github/Users/Followers.hs index f2d795db..b1a3b90c 100644 --- a/Github/Users/Followers.hs +++ b/Github/Users/Followers.hs @@ -8,27 +8,30 @@ module Github.Users.Followers ( module Github.Data, ) where +import Data.Vector (Vector) import Github.Data import Github.Request -- | All the users following the given user. -- -- > usersFollowing "mike-burns" -usersFollowing :: Name GithubOwner -> IO (Either Error [GithubOwner]) -usersFollowing = executeRequest' . usersFollowingR +usersFollowing :: Name GithubOwner -> IO (Either Error (Vector GithubOwner)) +usersFollowing user = + executeRequest' $ usersFollowingR user Nothing -- | List followers of a user. -- See -usersFollowingR :: Name GithubOwner -> GithubRequest k [GithubOwner] -usersFollowingR userName = GithubGet ["users", untagName userName, "followers"] [] -- TODO: use paged get +usersFollowingR :: Name GithubOwner -> Maybe Count -> GithubRequest k (Vector GithubOwner) +usersFollowingR userName = GithubPagedGet ["users", untagName userName, "followers"] [] -- | All the users that the given user follows. -- -- > usersFollowedBy "mike-burns" -usersFollowedBy :: Name GithubOwner -> IO (Either Error [GithubOwner]) -usersFollowedBy = executeRequest' . usersFollowedByR +usersFollowedBy :: Name GithubOwner -> IO (Either Error (Vector GithubOwner)) +usersFollowedBy user = + executeRequest' $ usersFollowedByR user Nothing -- | List users followed by another user. -- See -usersFollowedByR :: Name GithubOwner -> GithubRequest k [GithubOwner] -usersFollowedByR userName = GithubGet ["users", untagName userName, "following"] [] -- TODO: use paged get +usersFollowedByR :: Name GithubOwner -> Maybe Count -> GithubRequest k (Vector GithubOwner) +usersFollowedByR userName = GithubPagedGet ["users", untagName userName, "following"] [] diff --git a/spec/Github/UsersSpec.hs b/spec/Github/UsersSpec.hs index b97bae3c..43adaee5 100644 --- a/spec/Github/UsersSpec.hs +++ b/spec/Github/UsersSpec.hs @@ -44,10 +44,10 @@ spec = do describe "usersFollowing" $ do it "works" $ withAuth $ \auth -> do - us <- executeRequest auth $ usersFollowingR "phadej" + us <- executeRequest auth $ usersFollowingR "phadej" (Just 10) us `shouldSatisfy` isRight describe "usersFollowedBy" $ do it "works" $ withAuth $ \auth -> do - us <- executeRequest auth $ usersFollowedByR "phadej" + us <- executeRequest auth $ usersFollowedByR "phadej" (Just 10) us `shouldSatisfy` isRight From 63696ad9578670cdbf4eac220d235860662ce7dd Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sat, 9 Jan 2016 13:06:03 +0200 Subject: [PATCH 133/510] Add lts-4.0 matrix rows --- .travis.yml | 26 ++++++++++++++++---------- stack-lts-3.yaml | 2 +- stack-lts-4.yaml | 7 +++++++ stack-nightly.yaml | 2 +- travis-install.sh | 2 +- 5 files changed, 26 insertions(+), 13 deletions(-) create mode 100644 stack-lts-4.yaml diff --git a/.travis.yml b/.travis.yml index cf9f04ac..0b9fbb0e 100644 --- a/.travis.yml +++ b/.travis.yml @@ -24,23 +24,29 @@ matrix: - env: BUILD=cabal CABALVER=1.18 GHCVER=7.8.4 STACKAGESNAPSHOT=lts-2.22 compiler: ": #GHC 7.8.4 lts-2.22" addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4], sources: [hvr-ghc]}} - - env: BUILD=cabal CABALVER=1.22 GHCVER=7.10.2 - compiler: ": #GHC 7.10.2" + - env: BUILD=cabal CABALVER=1.22 GHCVER=7.10.2 STACKAGESNAPSHOT=lts-3.21 + compiler: ": #GHC 7.10.2 lts-3.21" addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.2], sources: [hvr-ghc]}} - - env: BUILD=cabal CABALVER=1.22 GHCVER=7.10.2 STACKAGESNAPSHOT=lts-3 - compiler: ": #GHC 7.10.2 lts-3" - addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.2], sources: [hvr-ghc]}} - - env: BUILD=stack STACK_YAML=stack-lts-2.yaml + - env: BUILD=cabal CABALVER=1.22 GHCVER=7.10.3 + compiler: ": #GHC 7.10.3" + addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3], sources: [hvr-ghc]}} + - env: BUILD=cabal CABALVER=1.22 GHCVER=7.10.3 STACKAGESNAPSHOT=lts-4.0 + compiler: ": #GHC 7.10.3 lts-4.0" + addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3], sources: [hvr-ghc]}} + - env: BUILD=stack STACK_YAML=stack-lts-2.yaml GHCVER=7.8.4 compiler: ": #STACK LTS2" addons: {apt: {packages: [ghc-7.8.4], sources: [hvr-ghc]}} - - env: BUILD=stack STACK_YAML=stack-lts-3.yaml + - env: BUILD=stack STACK_YAML=stack-lts-3.yaml GHCVER=7.10.2 compiler: ": #STACK LTS3" addons: {apt: {packages: [ghc-7.10.2], sources: [hvr-ghc]}} - - env: BUILD=stack STACK_YAML=stack-nightly.yaml + - env: BUILD=stack STACK_YAML=stack-lts-4.yaml GHCVER=7.10.3 + compiler: ": #STACK LTS4" + addons: {apt: {packages: [ghc-7.10.3], sources: [hvr-ghc]}} + - env: BUILD=stack STACK_YAML=stack-nightly.yaml GHCVER=7.10.3 compiler: ": #STACK nightly" addons: {apt: {packages: [ghc-7.10.3], sources: [hvr-ghc]}} - - env: BUILD=stack STACK_YAML=stack-lts-3.yaml - compiler: ": #stack LTS3 OSX" + - env: BUILD=stack STACK_YAML=stack-lts-4.yaml + compiler: ": #stack LTS4 OSX" os: osx before_install: diff --git a/stack-lts-3.yaml b/stack-lts-3.yaml index 57e0ec95..c1727240 100644 --- a/stack-lts-3.yaml +++ b/stack-lts-3.yaml @@ -2,7 +2,7 @@ packages: - '.' extra-deps: - http-link-header-1.0.1 -resolver: lts-3.20 +resolver: lts-3.21 flags: github: aeson-compat: false diff --git a/stack-lts-4.yaml b/stack-lts-4.yaml new file mode 100644 index 00000000..d4812958 --- /dev/null +++ b/stack-lts-4.yaml @@ -0,0 +1,7 @@ +packages: +- '.' +extra-deps: [] +resolver: lts-4.0 +flags: + github: + aeson-compat: true diff --git a/stack-nightly.yaml b/stack-nightly.yaml index 5c4307ba..f2717c47 100644 --- a/stack-nightly.yaml +++ b/stack-nightly.yaml @@ -1,4 +1,4 @@ -resolver: nightly-2016-01-03 +resolver: nightly-2016-01-08 packages: - '.' extra-deps: [] diff --git a/travis-install.sh b/travis-install.sh index 7f360094..c060dbb7 100644 --- a/travis-install.sh +++ b/travis-install.sh @@ -16,7 +16,7 @@ case $BUILD in if [ -f $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz ]; then zcat $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz > $HOME/.cabal/packages/hackage.haskell.org/00-index.tar fi - travis_retry cabal update -v + cabal update -v sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config cabal install --only-dependencies --enable-tests --enable-benchmarks --dry -v > installplan.txt sed -i -e '1,/^Resolving /d' installplan.txt; cat installplan.txt From cc43728d307e00149c096927d33544baf36d8be0 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sat, 9 Jan 2016 21:39:33 +0200 Subject: [PATCH 134/510] Use Vector in data definitions --- Github/Data.hs | 19 +++++++++---------- Github/Data/Definitions.hs | 14 ++++++++------ Github/Data/Gists.hs | 3 ++- Github/Data/GitData.hs | 16 +++++++++------- Github/Data/Id.hs | 2 +- Github/Data/Issues.hs | 7 ++++--- Github/Data/Repos.hs | 3 ++- Github/Data/Search.hs | 11 ++++++----- Github/Data/Teams.hs | 8 +++++--- Github/Data/Webhooks.hs | 11 ++++++----- spec/Github/SearchSpec.hs | 10 ++++++---- 11 files changed, 58 insertions(+), 46 deletions(-) diff --git a/Github/Data.hs b/Github/Data.hs index 1df82e65..f31a6eea 100644 --- a/Github/Data.hs +++ b/Github/Data.hs @@ -31,10 +31,9 @@ module Github.Data ( untagId, ) where -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative -#endif -import Control.Monad +import Prelude () +import Prelude.Compat + import Data.Aeson.Compat import Data.Aeson.Types (Parser) import Data.Hashable (Hashable) @@ -675,7 +674,7 @@ instance FromJSON Contributor where instance FromJSON Languages where parseJSON (Object o) = - Languages <$> + Languages . V.fromList <$> mapM (\name -> Language name <$> o .: name) (Map.keys o) parseJSON _ = fail "Could not build Languages" @@ -903,7 +902,7 @@ instance ToJSON EditRepoWebhook where instance FromJSON Content where parseJSON o@(Object _) = ContentFile <$> parseJSON o - parseJSON (Array os) = ContentDirectory <$> (mapM parseJSON $ V.toList os) + parseJSON (Array os) = ContentDirectory <$> (V.mapM parseJSON os) parseJSON _ = fail "Could not build a Content" instance FromJSON ContentFileData where @@ -935,11 +934,11 @@ instance FromJSON ContentInfo where <*> o .: "html_url" parseJSON _ = fail "Could not build a ContentInfo" --- | A slightly more generic version of Aeson's @(.:?)@, using `mzero' instead --- of `Nothing'. -(.:<) :: (FromJSON a) => Object -> T.Text -> Parser [a] +-- | A slightly less generic version of Aeson's '.:?', using `V.empty' instead +-- of 'Nothing'. +(.:<) :: (FromJSON a) => Object -> T.Text -> Parser (V.Vector a) obj .:< key = case Map.lookup key obj of - Nothing -> pure mzero + Nothing -> pure V.empty Just v -> parseJSON v -- | Produce all values for the given key. diff --git a/Github/Data/Definitions.hs b/Github/Data/Definitions.hs index 1980992d..1d31f8e6 100644 --- a/Github/Data/Definitions.hs +++ b/Github/Data/Definitions.hs @@ -3,12 +3,14 @@ module Github.Data.Definitions where -import Control.DeepSeq (NFData) +import Control.DeepSeq (NFData) +import Data.Data (Data, Typeable) +import Data.Text (Text) +import Data.Time (UTCTime) +import Data.Vector (Vector) +import GHC.Generics (Generic) + import qualified Control.Exception as E -import Data.Data -import Data.Text (Text) -import Data.Time -import GHC.Generics (Generic) import Github.Data.Id import Github.Data.Name @@ -120,7 +122,7 @@ instance NFData Organization data Content = ContentFile ContentFileData - | ContentDirectory [ContentItem] + | ContentDirectory (Vector ContentItem) deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Content diff --git a/Github/Data/Gists.hs b/Github/Data/Gists.hs index b87f154e..aa30dab7 100644 --- a/Github/Data/Gists.hs +++ b/Github/Data/Gists.hs @@ -9,6 +9,7 @@ import Github.Data.Name (Name) import Control.DeepSeq (NFData) import Data.Data (Data, Typeable) import Data.Text (Text) +import Data.Vector (Vector) import GHC.Generics (Generic) data Gist = Gist { @@ -22,7 +23,7 @@ data Gist = Gist { ,gistUpdatedAt :: !GithubDate ,gistHtmlUrl :: !Text ,gistId :: !(Name Gist) - ,gistFiles :: ![GistFile] + ,gistFiles :: !(Vector GistFile) ,gistGitPullUrl :: !Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) diff --git a/Github/Data/GitData.hs b/Github/Data/GitData.hs index b519b393..2cc668ca 100644 --- a/Github/Data/GitData.hs +++ b/Github/Data/GitData.hs @@ -7,16 +7,18 @@ import Github.Data.Definitions import Control.DeepSeq (NFData) import Data.Data (Data, Typeable) import Data.Text (Text) +import Data.Time (UTCTime) +import Data.Vector (Vector) import GHC.Generics (Generic) data Commit = Commit { commitSha :: !Text - ,commitParents :: ![Tree] + ,commitParents :: !(Vector Tree) ,commitUrl :: !Text ,commitGitCommit :: !GitCommit ,commitCommitter :: !(Maybe GithubOwner) ,commitAuthor :: !(Maybe GithubOwner) - ,commitFiles :: ![File] + ,commitFiles :: !(Vector File) ,commitStats :: !(Maybe Stats) } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -25,7 +27,7 @@ instance NFData Commit data Tree = Tree { treeSha :: !Text ,treeUrl :: !Text - ,treeGitTrees :: ![GitTree] + ,treeGitTrees :: !(Vector GitTree) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Tree @@ -49,7 +51,7 @@ data GitCommit = GitCommit { ,gitCommitAuthor :: !GitUser ,gitCommitTree :: !Tree ,gitCommitSha :: !(Maybe Text) - ,gitCommitParents :: ![Tree] + ,gitCommitParents :: !(Vector Tree) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData GitCommit @@ -93,10 +95,10 @@ data Diff = Diff { ,diffPatchUrl :: !Text ,diffUrl :: !Text ,diffBaseCommit :: !Commit - ,diffCommits :: ![Commit] + ,diffCommits :: !(Vector Commit) ,diffTotalCommits :: !Int ,diffHtmlUrl :: !Text - ,diffFiles :: ![File] + ,diffFiles :: !(Vector File) ,diffAheadBy :: !Int ,diffDiffUrl :: !Text ,diffPermalinkUrl :: !Text @@ -130,7 +132,7 @@ instance NFData GitObject data GitUser = GitUser { gitUserName :: !Text ,gitUserEmail :: !Text - ,gitUserDate :: !GithubDate + ,gitUserDate :: !UTCTime } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData GitUser diff --git a/Github/Data/Id.hs b/Github/Data/Id.hs index 0883b856..554073c6 100644 --- a/Github/Data/Id.hs +++ b/Github/Data/Id.hs @@ -16,7 +16,7 @@ import GHC.Generics (Generic) newtype Id entity = Id Int deriving (Eq, Ord, Show, Read, Generic, Typeable, Data) --- | Smart constructor for 'Id' +-- | Smart constructor for 'Id'. mkId :: proxy entity -> Int -> Id entity mkId _ = Id diff --git a/Github/Data/Issues.hs b/Github/Data/Issues.hs index 9cb69baa..640873cb 100644 --- a/Github/Data/Issues.hs +++ b/Github/Data/Issues.hs @@ -10,6 +10,7 @@ import Control.DeepSeq (NFData) import Data.Data (Data, Typeable) import Data.Text (Text) import Data.Time (UTCTime) +import Data.Vector (Vector) import GHC.Generics (Generic) data Issue = Issue { @@ -18,7 +19,7 @@ data Issue = Issue { ,issueEventsUrl :: Text ,issueHtmlUrl :: Maybe Text ,issueClosedBy :: Maybe GithubOwner - ,issueLabels :: [IssueLabel] + ,issueLabels :: (Vector IssueLabel) ,issueNumber :: Int ,issueAssignee :: Maybe GithubOwner ,issueUser :: GithubOwner @@ -40,7 +41,7 @@ data NewIssue = NewIssue { , newIssueBody :: Maybe Text , newIssueAssignee :: Maybe Text , newIssueMilestone :: Maybe Int -, newIssueLabels :: Maybe [Text] +, newIssueLabels :: Maybe (Vector Text) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData NewIssue @@ -51,7 +52,7 @@ data EditIssue = EditIssue { , editIssueAssignee :: Maybe Text , editIssueState :: Maybe Text , editIssueMilestone :: Maybe Int -, editIssueLabels :: Maybe [Text] +, editIssueLabels :: Maybe (Vector Text) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData EditIssue diff --git a/Github/Data/Repos.hs b/Github/Data/Repos.hs index b3dea17a..eac88645 100644 --- a/Github/Data/Repos.hs +++ b/Github/Data/Repos.hs @@ -9,6 +9,7 @@ import Github.Data.Name (Name) import Control.DeepSeq (NFData) import Data.Data (Data, Typeable) import Data.Text (Text) +import Data.Vector (Vector) import GHC.Generics (Generic) data Repo = Repo { @@ -87,7 +88,7 @@ data RepoPublicity = deriving (Show, Eq, Ord, Typeable, Data, Generic) -- | This is only used for the FromJSON instance. -data Languages = Languages { getLanguages :: [Language] } +data Languages = Languages { getLanguages :: Vector Language } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Languages diff --git a/Github/Data/Search.hs b/Github/Data/Search.hs index fdc35856..c84fa6a0 100644 --- a/Github/Data/Search.hs +++ b/Github/Data/Search.hs @@ -2,17 +2,18 @@ {-# LANGUAGE DeriveGeneric #-} module Github.Data.Search where -import Github.Data.Repos (Repo) import Github.Data.Issues (Issue) +import Github.Data.Repos (Repo) import Control.DeepSeq (NFData) import Data.Data (Data, Typeable) import Data.Text (Text) +import Data.Vector (Vector) import GHC.Generics (Generic) data SearchReposResult = SearchReposResult { searchReposTotalCount :: !Int - ,searchReposRepos :: ![Repo] + ,searchReposRepos :: !(Vector Repo) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData SearchReposResult @@ -31,14 +32,14 @@ instance NFData Code data SearchCodeResult = SearchCodeResult { searchCodeTotalCount :: !Int - ,searchCodeCodes :: ![Code] + ,searchCodeCodes :: !(Vector Code) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData SearchCodeResult data SearchIssuesResult = SearchIssuesResult { - searchIssuesTotalCount :: Int - ,searchIssuesIssues :: [Issue] + searchIssuesTotalCount :: !Int + ,searchIssuesIssues :: !(Vector Issue) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData SearchIssuesResult diff --git a/Github/Data/Teams.hs b/Github/Data/Teams.hs index ed4659dc..2fb79b5c 100644 --- a/Github/Data/Teams.hs +++ b/Github/Data/Teams.hs @@ -7,10 +7,12 @@ import Github.Data.Definitions import Control.DeepSeq (NFData) import Data.Data (Data, Typeable) import Data.Text (Text) +import Data.Vector (Vector) import GHC.Generics (Generic) -import Github.Data.Id (Id) -import Github.Data.Name (Name) +import Github.Data.Id (Id) +import Github.Data.Name (Name) +import Github.Data.Repos (Repo) data Privacy = PrivacyClosed @@ -61,7 +63,7 @@ instance NFData DetailedTeam data CreateTeam = CreateTeam { createTeamName :: !(Name Team) ,createTeamDescription :: !(Maybe Text) - ,createRepoNames :: ![Text] + ,createTeamRepoNames :: !(Vector (Name Repo)) {-,createTeamPrivacy :: Privacy-} ,createTeamPermission :: Permission } deriving (Show, Data, Typeable, Eq, Ord, Generic) diff --git a/Github/Data/Webhooks.hs b/Github/Data/Webhooks.hs index f7a68285..99275459 100644 --- a/Github/Data/Webhooks.hs +++ b/Github/Data/Webhooks.hs @@ -9,6 +9,7 @@ import Github.Data.Id (Id) import Control.DeepSeq (NFData) import Data.Data (Data, Typeable) import Data.Text (Text) +import Data.Vector (Vector) import GHC.Generics (Generic) import qualified Data.Map as M @@ -19,7 +20,7 @@ data RepoWebhook = RepoWebhook { ,repoWebhookId :: !(Id RepoWebhook) ,repoWebhookName :: !Text ,repoWebhookActive :: !Bool - ,repoWebhookEvents :: ![RepoWebhookEvent] + ,repoWebhookEvents :: !(Vector RepoWebhookEvent) ,repoWebhookConfig :: !(M.Map Text Text) ,repoWebhookLastResponse :: !RepoWebhookResponse ,repoWebhookUpdatedAt :: !GithubDate @@ -72,7 +73,7 @@ instance NFData PingEvent data NewRepoWebhook = NewRepoWebhook { newRepoWebhookName :: !Text ,newRepoWebhookConfig :: !(M.Map Text Text) - ,newRepoWebhookEvents :: !(Maybe [RepoWebhookEvent]) + ,newRepoWebhookEvents :: !(Maybe (Vector RepoWebhookEvent)) ,newRepoWebhookActive :: !(Maybe Bool) } deriving (Eq, Ord, Show, Typeable, Data, Generic) @@ -80,9 +81,9 @@ instance NFData NewRepoWebhook data EditRepoWebhook = EditRepoWebhook { editRepoWebhookConfig :: !(Maybe (M.Map Text Text)) - ,editRepoWebhookEvents :: !(Maybe [RepoWebhookEvent]) - ,editRepoWebhookAddEvents :: !(Maybe [RepoWebhookEvent]) - ,editRepoWebhookRemoveEvents :: !(Maybe [RepoWebhookEvent]) + ,editRepoWebhookEvents :: !(Maybe (Vector RepoWebhookEvent)) + ,editRepoWebhookAddEvents :: !(Maybe (Vector RepoWebhookEvent)) + ,editRepoWebhookRemoveEvents :: !(Maybe (Vector RepoWebhookEvent)) ,editRepoWebhookActive :: !(Maybe Bool) } deriving (Eq, Ord, Show, Typeable, Data, Generic) diff --git a/spec/Github/SearchSpec.hs b/spec/Github/SearchSpec.hs index 32dff7e0..c1a5ba9e 100644 --- a/spec/Github/SearchSpec.hs +++ b/spec/Github/SearchSpec.hs @@ -9,6 +9,8 @@ import Data.Aeson.Compat (eitherDecodeStrict) import Data.FileEmbed (embedFile) import Test.Hspec (Spec, describe, it, shouldBe) +import qualified Data.Vector as V + import Github.Data.Id (Id (..)) import Github.Data.Issues (Issue (..)) import Github.Search (SearchIssuesResult (..), searchIssues) @@ -25,15 +27,15 @@ spec = do searchIssuesTotalCount searchIssuesResult `shouldBe` 2 let issues = searchIssuesIssues searchIssuesResult - length issues `shouldBe` 2 + V.length issues `shouldBe` 2 - let issue1 = head issues + let issue1 = issues V.! 0 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 + let issue2 = issues V.! 1 issueId issue2 `shouldBe` Id 119694665 issueNumber issue2 `shouldBe` 127 issueTitle issue2 `shouldBe` "Decouple request creation from execution" @@ -43,4 +45,4 @@ spec = do let query = [("q", Just "Decouple in:title repo:phadej/github created:<=2015-12-01")] issues <- searchIssuesIssues . fromRightS <$> searchIssues query length issues `shouldBe` 1 - issueId (head issues) `shouldBe` Id 119694665 + issueId (V.head issues) `shouldBe` Id 119694665 From 5c1968469ab05142ba5eff0df7c1961846e39a58 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sun, 10 Jan 2016 13:04:23 +0200 Subject: [PATCH 135/510] Use UTCTime --- Github/Data.hs | 22 +------------ Github/Data/Definitions.hs | 16 +++------ Github/Data/Gists.hs | 9 ++--- Github/Data/Issues.hs | 16 ++++----- Github/Data/PullRequests.hs | 17 +++++----- Github/Data/Repos.hs | 7 ++-- Github/Data/Webhooks.hs | 8 ++--- Github/Issues.hs | 11 ++----- Github/Repos/Commits.hs | 30 ++++------------- github.cabal | 65 ++++++++++++++++++------------------- stack-lts-2.yaml | 5 ++- stack-lts-3.yaml | 1 + 12 files changed, 82 insertions(+), 125 deletions(-) diff --git a/Github/Data.hs b/Github/Data.hs index f31a6eea..993db2db 100644 --- a/Github/Data.hs +++ b/Github/Data.hs @@ -31,7 +31,7 @@ module Github.Data ( untagId, ) where -import Prelude () +import Prelude () import Prelude.Compat import Data.Aeson.Compat @@ -41,13 +41,6 @@ import qualified Data.HashMap.Lazy as Map import qualified Data.Text as T import qualified Data.Vector as V -#if MIN_VERSION_time(1,5,0) -import Data.Time -#else -import Data.Time -import System.Locale (defaultTimeLocale) -#endif - import Github.Data.Definitions import Github.Data.Gists import Github.Data.GitData @@ -61,19 +54,6 @@ import Github.Data.Search import Github.Data.Teams import Github.Data.Webhooks -instance FromJSON GithubDate where - parseJSON (String t) = - case pt defaultTimeLocale "%FT%T%Z" (T.unpack t) of - Just d -> pure $ GithubDate d - _ -> fail "could not parse Github datetime" - where -#if MIN_VERSION_time(1,5,0) - pt = parseTimeM True -#else - pt = parseTime -#endif - parseJSON _ = fail "Given something besides a String" - instance FromJSON Commit where parseJSON (Object o) = Commit <$> o .: "sha" diff --git a/Github/Data/Definitions.hs b/Github/Data/Definitions.hs index 1d31f8e6..525fc804 100644 --- a/Github/Data/Definitions.hs +++ b/Github/Data/Definitions.hs @@ -19,8 +19,8 @@ import Github.Data.Name data CommitQueryOption = CommitQuerySha !Text | CommitQueryPath !Text | CommitQueryAuthor !Text - | CommitQuerySince !GithubDate - | CommitQueryUntil !GithubDate + | CommitQuerySince !UTCTime + | CommitQueryUntil !UTCTime deriving (Show, Eq, Ord) -- | Errors have been tagged according to their source, so you can more easily @@ -32,12 +32,6 @@ data Error = | UserError Text -- ^ Incorrect input. deriving Show --- | A date in the Github format, which is a special case of ISO-8601. -newtype GithubDate = GithubDate { fromGithubDate :: UTCTime } - deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData GithubDate - data GithubOwner = GithubUser { githubOwnerAvatarUrl :: !Text ,githubOwnerLogin :: !(Name GithubOwner) @@ -113,7 +107,7 @@ data Organization = Organization { ,organizationFollowing :: !Int ,organizationPublicRepos :: !Int ,organizationUrl :: !Text - ,organizationCreatedAt :: !GithubDate + ,organizationCreatedAt :: !UTCTime ,organizationName :: !(Maybe Text) ,organizationId :: !(Id Organization) } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -172,7 +166,7 @@ data Contributor instance NFData Contributor data DetailedOwner = DetailedUser { - detailedOwnerCreatedAt :: !GithubDate + detailedOwnerCreatedAt :: !UTCTime ,detailedOwnerType :: !Text ,detailedOwnerPublicGists :: !Int ,detailedOwnerAvatarUrl :: !Text @@ -193,7 +187,7 @@ data DetailedOwner = DetailedUser { ,detailedOwnerLogin :: !(Name GithubOwner) } | DetailedOrganization { - detailedOwnerCreatedAt :: !GithubDate + detailedOwnerCreatedAt :: !UTCTime ,detailedOwnerType :: !Text ,detailedOwnerPublicGists :: !Int ,detailedOwnerAvatarUrl :: !Text diff --git a/Github/Data/Gists.hs b/Github/Data/Gists.hs index aa30dab7..e2608bdc 100644 --- a/Github/Data/Gists.hs +++ b/Github/Data/Gists.hs @@ -9,6 +9,7 @@ import Github.Data.Name (Name) import Control.DeepSeq (NFData) import Data.Data (Data, Typeable) import Data.Text (Text) +import Data.Time (UTCTime) import Data.Vector (Vector) import GHC.Generics (Generic) @@ -17,10 +18,10 @@ data Gist = Gist { ,gistGitPushUrl :: !Text ,gistUrl :: !Text ,gistDescription :: !(Maybe Text) - ,gistCreatedAt :: !GithubDate + ,gistCreatedAt :: !UTCTime ,gistPublic :: !Bool ,gistComments :: !Int - ,gistUpdatedAt :: !GithubDate + ,gistUpdatedAt :: !UTCTime ,gistHtmlUrl :: !Text ,gistId :: !(Name Gist) ,gistFiles :: !(Vector GistFile) @@ -43,9 +44,9 @@ instance NFData GistFile data GistComment = GistComment { gistCommentUser :: !GithubOwner ,gistCommentUrl :: !Text - ,gistCommentCreatedAt :: !GithubDate + ,gistCommentCreatedAt :: !UTCTime ,gistCommentBody :: !Text - ,gistCommentUpdatedAt :: !GithubDate + ,gistCommentUpdatedAt :: !UTCTime ,gistCommentId :: !(Id GistComment) } deriving (Show, Data, Typeable, Eq, Ord, Generic) diff --git a/Github/Data/Issues.hs b/Github/Data/Issues.hs index 640873cb..f0467288 100644 --- a/Github/Data/Issues.hs +++ b/Github/Data/Issues.hs @@ -14,8 +14,8 @@ import Data.Vector (Vector) import GHC.Generics (Generic) data Issue = Issue { - issueClosedAt :: Maybe GithubDate - ,issueUpdatedAt :: GithubDate + issueClosedAt :: Maybe UTCTime + ,issueUpdatedAt :: UTCTime ,issueEventsUrl :: Text ,issueHtmlUrl :: Maybe Text ,issueClosedBy :: Maybe GithubOwner @@ -26,7 +26,7 @@ data Issue = Issue { ,issueTitle :: Text ,issuePullRequest :: Maybe PullRequestReference ,issueUrl :: Text - ,issueCreatedAt :: GithubDate + ,issueCreatedAt :: UTCTime ,issueBody :: Maybe Text ,issueState :: Text ,issueId :: Id Issue @@ -59,14 +59,14 @@ instance NFData EditIssue data Milestone = Milestone { milestoneCreator :: GithubOwner - ,milestoneDueOn :: Maybe GithubDate + ,milestoneDueOn :: Maybe UTCTime ,milestoneOpenIssues :: Int ,milestoneNumber :: Int ,milestoneClosedIssues :: Int ,milestoneDescription :: Maybe Text ,milestoneTitle :: Text ,milestoneUrl :: Text - ,milestoneCreatedAt :: GithubDate + ,milestoneCreatedAt :: UTCTime ,milestoneState :: Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -81,11 +81,11 @@ data IssueLabel = IssueLabel { instance NFData IssueLabel data IssueComment = IssueComment { - issueCommentUpdatedAt :: GithubDate + issueCommentUpdatedAt :: UTCTime ,issueCommentUser :: GithubOwner ,issueCommentUrl :: Text ,issueCommentHtmlUrl :: Text - ,issueCommentCreatedAt :: GithubDate + ,issueCommentCreatedAt :: UTCTime ,issueCommentBody :: Text ,issueCommentId :: Int } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -121,7 +121,7 @@ data Event = Event { ,eventType :: !EventType ,eventCommitId :: !(Maybe Text) ,eventUrl :: !Text - ,eventCreatedAt :: !GithubDate + ,eventCreatedAt :: !UTCTime ,eventId :: !Int ,eventIssue :: !(Maybe Issue) } deriving (Show, Data, Typeable, Eq, Ord, Generic) diff --git a/Github/Data/PullRequests.hs b/Github/Data/PullRequests.hs index 6b946a29..40fc8018 100644 --- a/Github/Data/PullRequests.hs +++ b/Github/Data/PullRequests.hs @@ -8,23 +8,24 @@ import Github.Data.Repos (Repo) import Control.DeepSeq (NFData) import Data.Data (Data, Typeable) import Data.Text (Text) +import Data.Time (UTCTime) import GHC.Generics (Generic) data PullRequest = PullRequest { - pullRequestClosedAt :: !(Maybe GithubDate) - ,pullRequestCreatedAt :: !GithubDate + pullRequestClosedAt :: !(Maybe UTCTime) + ,pullRequestCreatedAt :: !UTCTime ,pullRequestUser :: !GithubOwner ,pullRequestPatchUrl :: !Text ,pullRequestState :: !Text ,pullRequestNumber :: !Int ,pullRequestHtmlUrl :: !Text - ,pullRequestUpdatedAt :: !GithubDate + ,pullRequestUpdatedAt :: !UTCTime ,pullRequestBody :: !Text ,pullRequestIssueUrl :: !Text ,pullRequestDiffUrl :: !Text ,pullRequestUrl :: !Text ,pullRequestLinks :: !PullRequestLinks - ,pullRequestMergedAt :: !(Maybe GithubDate) + ,pullRequestMergedAt :: !(Maybe UTCTime) ,pullRequestTitle :: !Text ,pullRequestId :: !Int } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -33,20 +34,20 @@ instance NFData PullRequest data DetailedPullRequest = DetailedPullRequest { -- this is a duplication of a PullRequest - detailedPullRequestClosedAt :: !(Maybe GithubDate) - ,detailedPullRequestCreatedAt :: !GithubDate + detailedPullRequestClosedAt :: !(Maybe UTCTime) + ,detailedPullRequestCreatedAt :: !UTCTime ,detailedPullRequestUser :: !GithubOwner ,detailedPullRequestPatchUrl :: !Text ,detailedPullRequestState :: !Text ,detailedPullRequestNumber :: !Int ,detailedPullRequestHtmlUrl :: !Text - ,detailedPullRequestUpdatedAt :: !GithubDate + ,detailedPullRequestUpdatedAt :: !UTCTime ,detailedPullRequestBody :: !Text ,detailedPullRequestIssueUrl :: !Text ,detailedPullRequestDiffUrl :: !Text ,detailedPullRequestUrl :: !Text ,detailedPullRequestLinks :: !PullRequestLinks - ,detailedPullRequestMergedAt :: !(Maybe GithubDate) + ,detailedPullRequestMergedAt :: !(Maybe UTCTime) ,detailedPullRequestTitle :: !Text ,detailedPullRequestId :: !Int diff --git a/Github/Data/Repos.hs b/Github/Data/Repos.hs index eac88645..4fc406ec 100644 --- a/Github/Data/Repos.hs +++ b/Github/Data/Repos.hs @@ -9,13 +9,14 @@ import Github.Data.Name (Name) import Control.DeepSeq (NFData) import Data.Data (Data, Typeable) import Data.Text (Text) +import Data.Time (UTCTime) import Data.Vector (Vector) import GHC.Generics (Generic) data Repo = Repo { repoSshUrl :: !(Maybe Text) ,repoDescription :: !(Maybe Text) - ,repoCreatedAt :: !(Maybe GithubDate) + ,repoCreatedAt :: !(Maybe UTCTime) ,repoHtmlUrl :: !Text ,repoSvnUrl :: !(Maybe Text) ,repoForks :: !(Maybe Int) @@ -25,13 +26,13 @@ data Repo = Repo { ,repoPrivate :: !Bool ,repoCloneUrl :: !(Maybe Text) ,repoSize :: !(Maybe Int) - ,repoUpdatedAt :: !(Maybe GithubDate) + ,repoUpdatedAt :: !(Maybe UTCTime) ,repoWatchers :: !(Maybe Int) ,repoOwner :: !GithubOwner ,repoName :: !(Name Repo) ,repoLanguage :: !(Maybe Text) ,repoMasterBranch :: !(Maybe Text) - ,repoPushedAt :: !(Maybe GithubDate) -- ^ this is Nothing for new repositories + ,repoPushedAt :: !(Maybe UTCTime) -- ^ this is Nothing for new repositories ,repoId :: !(Id Repo) ,repoUrl :: !Text ,repoOpenIssues :: !(Maybe Int) diff --git a/Github/Data/Webhooks.hs b/Github/Data/Webhooks.hs index 99275459..2a15470c 100644 --- a/Github/Data/Webhooks.hs +++ b/Github/Data/Webhooks.hs @@ -3,12 +3,12 @@ {-# LANGUAGE OverloadedStrings #-} module Github.Data.Webhooks where -import Github.Data.Definitions -import Github.Data.Id (Id) +import Github.Data.Id (Id) import Control.DeepSeq (NFData) import Data.Data (Data, Typeable) import Data.Text (Text) +import Data.Time (UTCTime) import Data.Vector (Vector) import GHC.Generics (Generic) @@ -23,8 +23,8 @@ data RepoWebhook = RepoWebhook { ,repoWebhookEvents :: !(Vector RepoWebhookEvent) ,repoWebhookConfig :: !(M.Map Text Text) ,repoWebhookLastResponse :: !RepoWebhookResponse - ,repoWebhookUpdatedAt :: !GithubDate - ,repoWebhookCreatedAt :: !GithubDate + ,repoWebhookUpdatedAt :: !UTCTime + ,repoWebhookCreatedAt :: !UTCTime } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData RepoWebhook diff --git a/Github/Issues.hs b/Github/Issues.hs index b9a89fed..226049f0 100644 --- a/Github/Issues.hs +++ b/Github/Issues.hs @@ -26,14 +26,8 @@ import Github.Request import Data.Aeson.Compat (encode) import Data.List (intercalate) import Data.Text (Text) +import Data.Time.ISO8601 (formatISO8601) import Data.Vector (Vector) -#if MIN_VERSION_time(1,5,0) -import Data.Time (defaultTimeLocale) -#else -import System.Locale (defaultTimeLocale) -#endif - -import Data.Time.Format (formatTime) import qualified Data.ByteString.Char8 as BS8 @@ -94,8 +88,7 @@ issuesForRepoR user reqRepoName issueLimitations = convert Ascending = ("direction", Just "asc") convert Descending = ("direction", Just "desc") convert (PerPage n) = ("per_page", Just . BS8.pack $ show n) - convert (Since t) = - ("since", Just . BS8.pack $ formatTime defaultTimeLocale "%FT%TZ" t) + convert (Since t) = ("since", Just . BS8.pack $ formatISO8601 t) -- Creating new issues. diff --git a/Github/Repos/Commits.hs b/Github/Repos/Commits.hs index c0de61fd..9c9ce017 100644 --- a/Github/Repos/Commits.hs +++ b/Github/Repos/Commits.hs @@ -20,39 +20,23 @@ module Github.Repos.Commits ( module Github.Data, ) where -import Data.Monoid ((<>)) -import Data.Vector (Vector) -import Github.Auth -import Github.Data -import Github.Request +import Data.Time.ISO8601 (formatISO8601) +import Data.Vector (Vector) import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BS8 import qualified Data.Text.Encoding as TE -import Data.Time.Format (formatTime) -#if MIN_VERSION_time (1,5,0) -import Data.Time (defaultTimeLocale) -import Data.Time.Format (iso8601DateFormat) -#else -import System.Locale (defaultTimeLocale) -#endif - -githubFormat :: GithubDate -> String -#if MIN_VERSION_time (1,5,0) -githubFormat = formatTime defaultTimeLocale (iso8601DateFormat $ Just "%H:%M:%S") . fromGithubDate -#else -githubFormat = formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S" . fromGithubDate -#endif +import Github.Auth +import Github.Data +import Github.Request renderCommitQueryOption :: CommitQueryOption -> (BS.ByteString, Maybe BS.ByteString) renderCommitQueryOption (CommitQuerySha sha) = ("sha", Just $ TE.encodeUtf8 sha) renderCommitQueryOption (CommitQueryPath path) = ("path", Just $ TE.encodeUtf8 path) renderCommitQueryOption (CommitQueryAuthor author) = ("author", Just $ TE.encodeUtf8 author) -renderCommitQueryOption (CommitQuerySince date) = ("since", Just $ BS8.pack ds <> "Z") - where ds = show $ githubFormat date -renderCommitQueryOption (CommitQueryUntil date) = ("until", Just $ BS8.pack ds <> "Z") - where ds = show $ githubFormat date +renderCommitQueryOption (CommitQuerySince date) = ("since", Just $ BS8.pack $ formatISO8601 date) +renderCommitQueryOption (CommitQueryUntil date) = ("until", Just $ BS8.pack $ formatISO8601 date) -- | The commit history for a repo. -- diff --git a/github.cabal b/github.cabal index 1fbdde80..b268041e 100644 --- a/github.cabal +++ b/github.cabal @@ -154,39 +154,38 @@ Library Github.Request -- Packages needed in order to build this package. - Build-depends: base >= 4.0 && < 5.0, - aeson >= 0.6.1.0, - attoparsec >= 0.10.3.0, - base-compat, - base16-bytestring >= 0.1.1.6, - byteable >= 0.1.0, - bytestring, - case-insensitive >= 0.4.0.4, - containers, - cryptohash >= 0.11, - data-default, - deepseq, - exceptions, - hashable, - http-client, - http-client-tls, - http-conduit >= 1.8, - http-link-header >=1.0.1 && <1.1, - http-types, - mtl, - network-uri, - old-locale, - text, - time >=1.4 && <1.6, - transformers, - transformers-compat, - unordered-containers >= 0.2 && < 0.3, - vector + Build-depends: base >= 4.7 && <4.9, + aeson >=0.7.0.6 && <0.11, + attoparsec >=0.11.3.4 && <0.14, + base-compat >=0.6.0 && <0.9, + base16-bytestring >=0.1.1.6 && <0.2, + byteable >=0.1.1 && <0.2, + bytestring >=0.10.4.0 && <0.11, + case-insensitive >=1.2.0.4 && <1.3, + containers >=0.5.5.1 && <0.6, + cryptohash >=0.11 && <0.12, + deepseq >=1.3.0.2 && <1.5, + deepseq-generics >=0.1.1.2 && <0.3, + exceptions >=0.8.0.2 && <0.9, + hashable >=1.2.3.3 && <1.3, + http-client >=0.4.8.1 && <0.5, + http-client-tls >=0.2.2 && <0.3, + http-link-header >=1.0.1 && <1.1, + http-types >=0.8.6 && <0.10, + iso8601-time >=0.1.4 && <0.2, + mtl >=2.1.3.1 && <2.3, + network-uri >=2.6.0.3 && <2.7, + text >=1.2.0.6 && <1.3, + time >=1.4 && <1.7, + transformers >=0.3.0.0 && <0.6, + transformers-compat >=0.4.0.3 && <0.6, + unordered-containers >=0.2 && <0.3, + vector >=0.10.12.3 && <0.12 if flag(aeson-compat) - Build-depends: aeson-compat >= 0.3.0.0 && <0.4 + Build-depends: aeson-compat >=0.3.0.0 && <0.4 else - Build-depends: aeson-extra >= 0.2.0.0 && <0.3 + Build-depends: aeson-extra >=0.2.0.0 && <0.3 test-suite github-test default-language: Haskell2010 @@ -199,14 +198,14 @@ test-suite github-test Github.UsersSpec main-is: Spec.hs ghc-options: -Wall - build-depends: base >= 4.0 && < 5.0, + build-depends: base, base-compat, github, vector, file-embed, hspec if flag(aeson-compat) - build-depends: aeson-compat >= 0.3.0.0 && <0.4 + build-depends: aeson-compat else - build-depends: aeson-extra >= 0.2.0.0 && <0.3 + build-depends: aeson-extra diff --git a/stack-lts-2.yaml b/stack-lts-2.yaml index 7b4d4912..636aa05a 100644 --- a/stack-lts-2.yaml +++ b/stack-lts-2.yaml @@ -3,7 +3,10 @@ packages: extra-deps: - aeson-extra-0.2.3.0 - http-link-header-1.0.1 +- iso8601-time-0.1.4 resolver: lts-2.22 flags: github: - aeson-compat: false + aeson-compat: false + iso8601-time: + new-time: false diff --git a/stack-lts-3.yaml b/stack-lts-3.yaml index c1727240..6e2f2657 100644 --- a/stack-lts-3.yaml +++ b/stack-lts-3.yaml @@ -2,6 +2,7 @@ packages: - '.' extra-deps: - http-link-header-1.0.1 +- iso8601-time-0.1.4 resolver: lts-3.21 flags: github: From dc4622a5c0406cc2f03c64312dba35904f0d7d94 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sun, 10 Jan 2016 14:48:33 +0200 Subject: [PATCH 136/510] Search functoons takes query, not querystring --- Github/Search.hs | 35 ++++++++++++++++++++--------------- spec/Github/SearchSpec.hs | 2 +- 2 files changed, 21 insertions(+), 16 deletions(-) diff --git a/Github/Search.hs b/Github/Search.hs index 8cfd9e8d..645940a8 100644 --- a/Github/Search.hs +++ b/Github/Search.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedStrings #-} -- | The Github Search API, as described at -- . module Github.Search( @@ -13,6 +14,10 @@ module Github.Search( module Github.Data, ) where +import Data.Text (Text) + +import qualified Data.Text.Encoding as TE + import Github.Auth import Github.Data import Github.Request @@ -20,56 +25,56 @@ import Github.Request -- | Perform a repository search. -- With authentication. -- --- > searchRepos' (Just $ GithubBasicAuth "github-username" "github-password') "q=a in%3Aname language%3Ahaskell created%3A>2013-10-01&per_page=100" -searchRepos' :: Maybe GithubAuth -> QueryString -> IO (Either Error SearchReposResult) +-- > searchRepos' (Just $ GithubBasicAuth "github-username" "github-password') "a in%3Aname language%3Ahaskell created%3A>2013-10-01&per_page=100" +searchRepos' :: Maybe GithubAuth -> Text -> IO (Either Error SearchReposResult) searchRepos' auth = executeRequestMaybe auth . searchReposR -- | Perform a repository search. -- Without authentication. -- -- > searchRepos "q=a in%3Aname language%3Ahaskell created%3A>2013-10-01&per_page=100" -searchRepos :: QueryString -> IO (Either Error SearchReposResult) +searchRepos :: Text -> IO (Either Error SearchReposResult) searchRepos = searchRepos' Nothing -- | Search repositories. -- See -searchReposR :: QueryString -> GithubRequest k SearchReposResult -searchReposR queryString = GithubGet ["search", "repositories"] queryString +searchReposR :: Text -> GithubRequest k SearchReposResult +searchReposR searchString = GithubGet ["search", "repositories"] [("q", Just $ TE.encodeUtf8 searchString)] -- | Perform a code search. -- With authentication. -- --- > searchCode' (Just $ GithubBasicAuth "github-username" "github-password') "q=a in%3Aname language%3Ahaskell created%3A>2013-10-01&per_page=100" -searchCode' :: Maybe GithubAuth -> QueryString -> IO (Either Error SearchCodeResult) +-- > searchCode' (Just $ GithubBasicAuth "github-username" "github-password') "a in%3Aname language%3Ahaskell created%3A>2013-10-01&per_page=100" +searchCode' :: Maybe GithubAuth -> Text -> IO (Either Error SearchCodeResult) searchCode' auth = executeRequestMaybe auth . searchCodeR -- | Perform a code search. -- Without authentication. -- -- > searchCode "q=addClass+in:file+language:js+repo:jquery/jquery" -searchCode :: QueryString -> IO (Either Error SearchCodeResult) +searchCode :: Text -> IO (Either Error SearchCodeResult) searchCode = searchCode' Nothing -- | Search code. -- See -searchCodeR :: QueryString -> GithubRequest k SearchCodeResult -searchCodeR queryString = GithubGet ["search", "code"] queryString +searchCodeR :: Text -> GithubRequest k SearchCodeResult +searchCodeR searchString = GithubGet ["search", "code"] [("q", Just $ TE.encodeUtf8 searchString)] -- | Perform an issue search. -- With authentication. -- --- > searchIssues' (Just $ GithubBasicAuth "github-username" "github-password') "q=a repo%3Aphadej%2Fgithub&per_page=100" -searchIssues' :: Maybe GithubAuth -> QueryString -> IO (Either Error SearchIssuesResult) +-- > searchIssues' (Just $ GithubBasicAuth "github-username" "github-password') "a repo%3Aphadej%2Fgithub&per_page=100" +searchIssues' :: Maybe GithubAuth -> Text -> IO (Either Error SearchIssuesResult) searchIssues' auth = executeRequestMaybe auth . searchIssuesR -- | Perform an issue search. -- Without authentication. -- -- > searchIssues "q=a repo%3Aphadej%2Fgithub&per_page=100" -searchIssues :: QueryString -> IO (Either Error SearchIssuesResult) +searchIssues :: Text -> IO (Either Error SearchIssuesResult) searchIssues = searchIssues' Nothing -- | Search issues. -- See -searchIssuesR :: QueryString -> GithubRequest k SearchIssuesResult -searchIssuesR queryString = GithubGet ["search", "issues"] queryString +searchIssuesR :: Text -> GithubRequest k SearchIssuesResult +searchIssuesR searchString = GithubGet ["search", "issues"] [("q", Just $ TE.encodeUtf8 searchString)] diff --git a/spec/Github/SearchSpec.hs b/spec/Github/SearchSpec.hs index c1a5ba9e..e8f4dacd 100644 --- a/spec/Github/SearchSpec.hs +++ b/spec/Github/SearchSpec.hs @@ -42,7 +42,7 @@ spec = do issueState issue2 `shouldBe` "open" it "performs an issue search via the API" $ do - let query = [("q", Just "Decouple in:title repo:phadej/github created:<=2015-12-01")] + let query = "Decouple in:title repo:phadej/github created:<=2015-12-01" issues <- searchIssuesIssues . fromRightS <$> searchIssues query length issues `shouldBe` 1 issueId (V.head issues) `shouldBe` Id 119694665 From e8d4997a90981717aec2cf203b34901c5fc92cc2 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sun, 10 Jan 2016 14:59:05 +0200 Subject: [PATCH 137/510] use deepseq generics --- Github/Auth.hs | 9 ++++---- Github/Data/Definitions.hs | 41 +++++++++++++++++++------------------ Github/Data/Gists.hs | 19 +++++++++-------- Github/Data/GitData.hs | 31 ++++++++++++++-------------- Github/Data/Issues.hs | 21 ++++++++++--------- Github/Data/PullRequests.hs | 23 +++++++++++---------- Github/Data/Repos.hs | 17 +++++++-------- Github/Data/Search.hs | 11 +++++----- Github/Data/Teams.hs | 19 +++++++++-------- Github/Data/Webhooks.hs | 25 +++++++++++----------- 10 files changed, 113 insertions(+), 103 deletions(-) diff --git a/Github/Auth.hs b/Github/Auth.hs index e7303de0..c7200c28 100644 --- a/Github/Auth.hs +++ b/Github/Auth.hs @@ -2,9 +2,10 @@ {-# LANGUAGE DeriveGeneric #-} module Github.Auth where -import Control.DeepSeq (NFData) -import Data.Data (Data, Typeable) -import GHC.Generics (Generic) +import Control.DeepSeq (NFData (..)) +import Control.DeepSeq.Generics (genericRnf) +import Data.Data (Data, Typeable) +import GHC.Generics (Generic) import qualified Data.ByteString as BS @@ -16,4 +17,4 @@ data GithubAuth = GithubBasicAuth BS.ByteString BS.ByteString String -- token deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData GithubAuth +instance NFData GithubAuth where rnf = genericRnf diff --git a/Github/Data/Definitions.hs b/Github/Data/Definitions.hs index 525fc804..ea180f8b 100644 --- a/Github/Data/Definitions.hs +++ b/Github/Data/Definitions.hs @@ -3,12 +3,13 @@ module Github.Data.Definitions where -import Control.DeepSeq (NFData) -import Data.Data (Data, Typeable) -import Data.Text (Text) -import Data.Time (UTCTime) -import Data.Vector (Vector) -import GHC.Generics (Generic) +import Control.DeepSeq (NFData (..)) +import Control.DeepSeq.Generics (genericRnf) +import Data.Data (Data, Typeable) +import Data.Text (Text) +import Data.Time (UTCTime) +import Data.Vector (Vector) +import GHC.Generics (Generic) import qualified Control.Exception as E @@ -46,7 +47,7 @@ data GithubOwner = GithubUser { ,githubOwnerId :: !(Id GithubOwner) } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData GithubOwner +instance NFData GithubOwner where rnf = genericRnf data Stats = Stats { statsAdditions :: !Int @@ -54,7 +55,7 @@ data Stats = Stats { ,statsDeletions :: !Int } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Stats +instance NFData Stats where rnf = genericRnf data Comment = Comment { commentPosition :: !(Maybe Int) @@ -70,19 +71,19 @@ data Comment = Comment { ,commentId :: !(Id Comment) } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Comment +instance NFData Comment where rnf = genericRnf data NewComment = NewComment { newCommentBody :: !Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData NewComment +instance NFData NewComment where rnf = genericRnf data EditComment = EditComment { editCommentBody :: !Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData EditComment +instance NFData EditComment where rnf = genericRnf data SimpleOrganization = SimpleOrganization { simpleOrganizationUrl :: !Text @@ -91,7 +92,7 @@ data SimpleOrganization = SimpleOrganization { ,simpleOrganizationLogin :: !Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData SimpleOrganization +instance NFData SimpleOrganization where rnf = genericRnf data Organization = Organization { organizationType :: !Text @@ -112,14 +113,14 @@ data Organization = Organization { ,organizationId :: !(Id Organization) } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Organization +instance NFData Organization where rnf = genericRnf data Content = ContentFile ContentFileData | ContentDirectory (Vector ContentItem) deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Content +instance NFData Content where rnf = genericRnf data ContentFileData = ContentFileData { contentFileInfo :: !ContentInfo @@ -128,7 +129,7 @@ data ContentFileData = ContentFileData { ,contentFileContent :: !Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData ContentFileData +instance NFData ContentFileData where rnf = genericRnf -- | An item in a directory listing. data ContentItem = ContentItem { @@ -136,12 +137,12 @@ data ContentItem = ContentItem { ,contentItemInfo :: !ContentInfo } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData ContentItem +instance NFData ContentItem where rnf = genericRnf data ContentItemType = ItemFile | ItemDir deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData ContentItemType +instance NFData ContentItemType where rnf = genericRnf -- | Information common to both kinds of Content: files and directories. data ContentInfo = ContentInfo { @@ -153,7 +154,7 @@ data ContentInfo = ContentInfo { ,contentHtmlUrl :: !Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData ContentInfo +instance NFData ContentInfo where rnf = genericRnf data Contributor -- | An existing Github user, with their number of contributions, avatar @@ -163,7 +164,7 @@ data Contributor | AnonymousContributor Int Text deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Contributor +instance NFData Contributor where rnf = genericRnf data DetailedOwner = DetailedUser { detailedOwnerCreatedAt :: !UTCTime @@ -205,4 +206,4 @@ data DetailedOwner = DetailedUser { ,detailedOwnerLogin :: !(Name GithubOwner) } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData DetailedOwner +instance NFData DetailedOwner where rnf = genericRnf diff --git a/Github/Data/Gists.hs b/Github/Data/Gists.hs index e2608bdc..c62a8878 100644 --- a/Github/Data/Gists.hs +++ b/Github/Data/Gists.hs @@ -6,12 +6,13 @@ import Github.Data.Definitions import Github.Data.Id (Id) import Github.Data.Name (Name) -import Control.DeepSeq (NFData) -import Data.Data (Data, Typeable) -import Data.Text (Text) -import Data.Time (UTCTime) -import Data.Vector (Vector) -import GHC.Generics (Generic) +import Control.DeepSeq (NFData (..)) +import Control.DeepSeq.Generics (genericRnf) +import Data.Data (Data, Typeable) +import Data.Text (Text) +import Data.Time (UTCTime) +import Data.Vector (Vector) +import GHC.Generics (Generic) data Gist = Gist { gistUser :: !GithubOwner @@ -28,7 +29,7 @@ data Gist = Gist { ,gistGitPullUrl :: !Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Gist +instance NFData Gist where rnf = genericRnf data GistFile = GistFile { gistFileType :: !Text @@ -39,7 +40,7 @@ data GistFile = GistFile { ,gistFileContent :: !(Maybe Text) } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData GistFile +instance NFData GistFile where rnf = genericRnf data GistComment = GistComment { gistCommentUser :: !GithubOwner @@ -50,4 +51,4 @@ data GistComment = GistComment { ,gistCommentId :: !(Id GistComment) } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData GistComment +instance NFData GistComment where rnf = genericRnf diff --git a/Github/Data/GitData.hs b/Github/Data/GitData.hs index 2cc668ca..fd39eeab 100644 --- a/Github/Data/GitData.hs +++ b/Github/Data/GitData.hs @@ -4,7 +4,8 @@ module Github.Data.GitData where import Github.Data.Definitions -import Control.DeepSeq (NFData) +import Control.DeepSeq (NFData(..)) +import Control.DeepSeq.Generics (genericRnf) import Data.Data (Data, Typeable) import Data.Text (Text) import Data.Time (UTCTime) @@ -22,7 +23,7 @@ data Commit = Commit { ,commitStats :: !(Maybe Stats) } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Commit +instance NFData Commit where rnf = genericRnf data Tree = Tree { treeSha :: !Text @@ -30,7 +31,7 @@ data Tree = Tree { ,treeGitTrees :: !(Vector GitTree) } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Tree +instance NFData Tree where rnf = genericRnf data GitTree = GitTree { gitTreeType :: !Text @@ -42,7 +43,7 @@ data GitTree = GitTree { ,gitTreeMode :: !Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData GitTree +instance NFData GitTree where rnf = genericRnf data GitCommit = GitCommit { gitCommitMessage :: !Text @@ -54,7 +55,7 @@ data GitCommit = GitCommit { ,gitCommitParents :: !(Vector Tree) } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData GitCommit +instance NFData GitCommit where rnf = genericRnf data Blob = Blob { blobUrl :: !Text @@ -64,7 +65,7 @@ data Blob = Blob { ,blobSize :: !Int } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Blob +instance NFData Blob where rnf = genericRnf data Tag = Tag { tagName :: !Text @@ -73,21 +74,21 @@ data Tag = Tag { ,tagCommit :: !BranchCommit } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Tag +instance NFData Tag where rnf = genericRnf data Branch = Branch { branchName :: !Text ,branchCommit :: !BranchCommit } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Branch +instance NFData Branch where rnf = genericRnf data BranchCommit = BranchCommit { branchCommitSha :: !Text ,branchCommitUrl :: !Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData BranchCommit +instance NFData BranchCommit where rnf = genericRnf data Diff = Diff { diffStatus :: !Text @@ -104,14 +105,14 @@ data Diff = Diff { ,diffPermalinkUrl :: !Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Diff +instance NFData Diff where rnf = genericRnf data NewGitReference = NewGitReference { newGitReferenceRef :: !Text ,newGitReferenceSha :: !Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData NewGitReference +instance NFData NewGitReference where rnf = genericRnf data GitReference = GitReference { gitReferenceObject :: !GitObject @@ -119,7 +120,7 @@ data GitReference = GitReference { ,gitReferenceRef :: !Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData GitReference +instance NFData GitReference where rnf = genericRnf data GitObject = GitObject { gitObjectType :: !Text @@ -127,7 +128,7 @@ data GitObject = GitObject { ,gitObjectUrl :: !Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData GitObject +instance NFData GitObject where rnf = genericRnf data GitUser = GitUser { gitUserName :: !Text @@ -135,7 +136,7 @@ data GitUser = GitUser { ,gitUserDate :: !UTCTime } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData GitUser +instance NFData GitUser where rnf = genericRnf data File = File { fileBlobUrl :: !Text @@ -149,4 +150,4 @@ data File = File { ,fileDeletions :: !Int } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData File +instance NFData File where rnf = genericRnf diff --git a/Github/Data/Issues.hs b/Github/Data/Issues.hs index f0467288..8b2df916 100644 --- a/Github/Data/Issues.hs +++ b/Github/Data/Issues.hs @@ -6,7 +6,8 @@ import Github.Data.Definitions import Github.Data.Id (Id) import Github.Data.PullRequests -import Control.DeepSeq (NFData) +import Control.DeepSeq (NFData(..)) +import Control.DeepSeq.Generics (genericRnf) import Data.Data (Data, Typeable) import Data.Text (Text) import Data.Time (UTCTime) @@ -34,7 +35,7 @@ data Issue = Issue { ,issueMilestone :: Maybe Milestone } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Issue +instance NFData Issue where rnf = genericRnf data NewIssue = NewIssue { newIssueTitle :: Text @@ -44,7 +45,7 @@ data NewIssue = NewIssue { , newIssueLabels :: Maybe (Vector Text) } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData NewIssue +instance NFData NewIssue where rnf = genericRnf data EditIssue = EditIssue { editIssueTitle :: Maybe Text @@ -55,7 +56,7 @@ data EditIssue = EditIssue { , editIssueLabels :: Maybe (Vector Text) } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData EditIssue +instance NFData EditIssue where rnf = genericRnf data Milestone = Milestone { milestoneCreator :: GithubOwner @@ -70,7 +71,7 @@ data Milestone = Milestone { ,milestoneState :: Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Milestone +instance NFData Milestone where rnf = genericRnf data IssueLabel = IssueLabel { labelColor :: Text @@ -78,7 +79,7 @@ data IssueLabel = IssueLabel { ,labelName :: Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData IssueLabel +instance NFData IssueLabel where rnf = genericRnf data IssueComment = IssueComment { issueCommentUpdatedAt :: UTCTime @@ -90,7 +91,7 @@ data IssueComment = IssueComment { ,issueCommentId :: Int } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData IssueComment +instance NFData IssueComment where rnf = genericRnf data EventType = Mentioned -- ^ The actor was @mentioned in an issue body. @@ -113,7 +114,7 @@ data EventType = | HeadRefRestored -- ^ The pull request’s branch was restored. deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData EventType +instance NFData EventType where rnf = genericRnf -- | Issue event data Event = Event { @@ -126,7 +127,7 @@ data Event = Event { ,eventIssue :: !(Maybe Issue) } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Event +instance NFData Event where rnf = genericRnf -- | A data structure for describing how to filter issues. This is used by -- @issuesForRepo@. @@ -147,4 +148,4 @@ data IssueLimitation = | PerPage Int -- ^ Download this many issues per query deriving (Eq, Ord, Show, Typeable, Data, Generic) -instance NFData IssueLimitation +instance NFData IssueLimitation where rnf = genericRnf diff --git a/Github/Data/PullRequests.hs b/Github/Data/PullRequests.hs index 40fc8018..edab4db7 100644 --- a/Github/Data/PullRequests.hs +++ b/Github/Data/PullRequests.hs @@ -5,7 +5,8 @@ module Github.Data.PullRequests where import Github.Data.Definitions import Github.Data.Repos (Repo) -import Control.DeepSeq (NFData) +import Control.DeepSeq (NFData(..)) +import Control.DeepSeq.Generics (genericRnf) import Data.Data (Data, Typeable) import Data.Text (Text) import Data.Time (UTCTime) @@ -30,7 +31,7 @@ data PullRequest = PullRequest { ,pullRequestId :: !Int } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData PullRequest +instance NFData PullRequest where rnf = genericRnf data DetailedPullRequest = DetailedPullRequest { -- this is a duplication of a PullRequest @@ -64,7 +65,7 @@ data DetailedPullRequest = DetailedPullRequest { ,detailedPullRequestMergeable :: !(Maybe Bool) } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData DetailedPullRequest +instance NFData DetailedPullRequest where rnf = genericRnf data EditPullRequest = EditPullRequest { editPullRequestTitle :: !(Maybe Text) @@ -72,7 +73,7 @@ data EditPullRequest = EditPullRequest { ,editPullRequestState :: !(Maybe EditPullRequestState) } deriving (Show, Generic) -instance NFData EditPullRequest +instance NFData EditPullRequest where rnf = genericRnf data CreatePullRequest = CreatePullRequest @@ -88,7 +89,7 @@ data CreatePullRequest = } deriving (Show, Generic) -instance NFData CreatePullRequest +instance NFData CreatePullRequest where rnf = genericRnf data PullRequestLinks = PullRequestLinks { pullRequestLinksReviewComments :: !Text @@ -97,7 +98,7 @@ data PullRequestLinks = PullRequestLinks { ,pullRequestLinksSelf :: !Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData PullRequestLinks +instance NFData PullRequestLinks where rnf = genericRnf data PullRequestCommit = PullRequestCommit { pullRequestCommitLabel :: !Text @@ -107,7 +108,7 @@ data PullRequestCommit = PullRequestCommit { ,pullRequestCommitRepo :: !Repo } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData PullRequestCommit +instance NFData PullRequestCommit where rnf = genericRnf data PullRequestEvent = PullRequestEvent { pullRequestEventAction :: !PullRequestEventType @@ -117,7 +118,7 @@ data PullRequestEvent = PullRequestEvent { ,pullRequestSender :: !GithubOwner } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData PullRequestEvent +instance NFData PullRequestEvent where rnf = genericRnf data PullRequestEventType = PullRequestOpened @@ -130,7 +131,7 @@ data PullRequestEventType = | PullRequestUnlabeled deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData PullRequestEventType +instance NFData PullRequestEventType where rnf = genericRnf data PullRequestReference = PullRequestReference { pullRequestReferenceHtmlUrl :: !(Maybe Text) @@ -138,11 +139,11 @@ data PullRequestReference = PullRequestReference { ,pullRequestReferenceDiffUrl :: !(Maybe Text) } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData PullRequestReference +instance NFData PullRequestReference where rnf = genericRnf data EditPullRequestState = EditPullRequestStateOpen | EditPullRequestStateClosed deriving (Show, Generic) -instance NFData EditPullRequestState +instance NFData EditPullRequestState where rnf = genericRnf diff --git a/Github/Data/Repos.hs b/Github/Data/Repos.hs index 4fc406ec..b265f9e2 100644 --- a/Github/Data/Repos.hs +++ b/Github/Data/Repos.hs @@ -6,7 +6,8 @@ import Github.Data.Definitions import Github.Data.Id (Id) import Github.Data.Name (Name) -import Control.DeepSeq (NFData) +import Control.DeepSeq (NFData(..)) +import Control.DeepSeq.Generics (genericRnf) import Data.Data (Data, Typeable) import Data.Text (Text) import Data.Time (UTCTime) @@ -45,12 +46,12 @@ data Repo = Repo { ,repoStargazersCount :: !Int } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Repo +instance NFData Repo where rnf = genericRnf data RepoRef = RepoRef GithubOwner (Name Repo) -- Repo owner and name deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData RepoRef +instance NFData RepoRef where rnf = genericRnf data NewRepo = NewRepo { newRepoName :: !(Name Repo) @@ -62,7 +63,7 @@ data NewRepo = NewRepo { , newRepoAutoInit :: !(Maybe Bool) } deriving (Eq, Ord, Show, Data, Typeable, Generic) -instance NFData NewRepo +instance NFData NewRepo where rnf = genericRnf newRepo :: Name Repo -> NewRepo newRepo name = NewRepo name Nothing Nothing Nothing Nothing Nothing Nothing @@ -77,7 +78,7 @@ data EditRepo = EditRepo { , editHasDownloads :: !(Maybe Bool) } deriving (Eq, Ord, Show, Data, Typeable, Generic) -instance NFData EditRepo +instance NFData EditRepo where rnf = genericRnf -- | Filter the list of the user's repos using any of these constructors. data RepoPublicity = @@ -92,11 +93,11 @@ data RepoPublicity = data Languages = Languages { getLanguages :: Vector Language } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Languages +instance NFData Languages where rnf = genericRnf -- | A programming language with the name and number of characters written in -- it. -data Language = Language Text Int +data Language = Language !Text !Int deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Language +instance NFData Language where rnf = genericRnf diff --git a/Github/Data/Search.hs b/Github/Data/Search.hs index c84fa6a0..a13ba4f7 100644 --- a/Github/Data/Search.hs +++ b/Github/Data/Search.hs @@ -5,7 +5,8 @@ module Github.Data.Search where import Github.Data.Issues (Issue) import Github.Data.Repos (Repo) -import Control.DeepSeq (NFData) +import Control.DeepSeq (NFData(..)) +import Control.DeepSeq.Generics (genericRnf) import Data.Data (Data, Typeable) import Data.Text (Text) import Data.Vector (Vector) @@ -16,7 +17,7 @@ data SearchReposResult = SearchReposResult { ,searchReposRepos :: !(Vector Repo) } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData SearchReposResult +instance NFData SearchReposResult where rnf = genericRnf data Code = Code { codeName :: !Text @@ -28,18 +29,18 @@ data Code = Code { ,codeRepo :: !Repo } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Code +instance NFData Code where rnf = genericRnf data SearchCodeResult = SearchCodeResult { searchCodeTotalCount :: !Int ,searchCodeCodes :: !(Vector Code) } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData SearchCodeResult +instance NFData SearchCodeResult where rnf = genericRnf data SearchIssuesResult = SearchIssuesResult { searchIssuesTotalCount :: !Int ,searchIssuesIssues :: !(Vector Issue) } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData SearchIssuesResult +instance NFData SearchIssuesResult where rnf = genericRnf diff --git a/Github/Data/Teams.hs b/Github/Data/Teams.hs index 2fb79b5c..3c3d952f 100644 --- a/Github/Data/Teams.hs +++ b/Github/Data/Teams.hs @@ -4,7 +4,8 @@ module Github.Data.Teams where import Github.Data.Definitions -import Control.DeepSeq (NFData) +import Control.DeepSeq (NFData(..)) +import Control.DeepSeq.Generics (genericRnf) import Data.Data (Data, Typeable) import Data.Text (Text) import Data.Vector (Vector) @@ -19,7 +20,7 @@ data Privacy = | PrivacySecret deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Privacy +instance NFData Privacy where rnf = genericRnf data Permission = PermissionPull @@ -27,7 +28,7 @@ data Permission = | PermissionAdmin deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Permission +instance NFData Permission where rnf = genericRnf data Team = Team { teamId :: !(Id Team) @@ -41,7 +42,7 @@ data Team = Team { ,teamRepositoriesUrl :: !Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Team +instance NFData Team where rnf = genericRnf data DetailedTeam = DetailedTeam { detailedTeamId :: !(Id Team) @@ -58,7 +59,7 @@ data DetailedTeam = DetailedTeam { ,detailedTeamOrganization :: !GithubOwner } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData DetailedTeam +instance NFData DetailedTeam where rnf = genericRnf data CreateTeam = CreateTeam { createTeamName :: !(Name Team) @@ -77,7 +78,7 @@ data EditTeam = EditTeam { ,editTeamPermission :: !Permission } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData EditTeam +instance NFData EditTeam where rnf = genericRnf data Role = RoleMaintainer @@ -91,7 +92,7 @@ data ReqState = | StateActive deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData ReqState +instance NFData ReqState where rnf = genericRnf data TeamMembership = TeamMembership { teamMembershipUrl :: !Text, @@ -99,10 +100,10 @@ data TeamMembership = TeamMembership { teamMembershipReqState :: !ReqState } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData TeamMembership +instance NFData TeamMembership where rnf = genericRnf data CreateTeamMembership = CreateTeamMembership { createTeamMembershipRole :: !Role } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData CreateTeamMembership +instance NFData CreateTeamMembership where rnf = genericRnf diff --git a/Github/Data/Webhooks.hs b/Github/Data/Webhooks.hs index 2a15470c..92b68cea 100644 --- a/Github/Data/Webhooks.hs +++ b/Github/Data/Webhooks.hs @@ -5,12 +5,13 @@ module Github.Data.Webhooks where import Github.Data.Id (Id) -import Control.DeepSeq (NFData) -import Data.Data (Data, Typeable) -import Data.Text (Text) -import Data.Time (UTCTime) -import Data.Vector (Vector) -import GHC.Generics (Generic) +import Control.DeepSeq (NFData (..)) +import Control.DeepSeq.Generics (genericRnf) +import Data.Data (Data, Typeable) +import Data.Text (Text) +import Data.Time (UTCTime) +import Data.Vector (Vector) +import GHC.Generics (Generic) import qualified Data.Map as M @@ -27,7 +28,7 @@ data RepoWebhook = RepoWebhook { ,repoWebhookCreatedAt :: !UTCTime } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData RepoWebhook +instance NFData RepoWebhook where rnf = genericRnf data RepoWebhookEvent = WebhookWildcardEvent @@ -52,7 +53,7 @@ data RepoWebhookEvent = | WebhookWatchEvent deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData RepoWebhookEvent +instance NFData RepoWebhookEvent where rnf = genericRnf data RepoWebhookResponse = RepoWebhookResponse { repoWebhookResponseCode :: !(Maybe Int) @@ -60,7 +61,7 @@ data RepoWebhookResponse = RepoWebhookResponse { ,repoWebhookResponseMessage :: !(Maybe Text) } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData RepoWebhookResponse +instance NFData RepoWebhookResponse where rnf = genericRnf data PingEvent = PingEvent { pingEventZen :: !Text @@ -68,7 +69,7 @@ data PingEvent = PingEvent { ,pingEventHookId :: !(Id RepoWebhook) } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData PingEvent +instance NFData PingEvent where rnf = genericRnf data NewRepoWebhook = NewRepoWebhook { newRepoWebhookName :: !Text @@ -77,7 +78,7 @@ data NewRepoWebhook = NewRepoWebhook { ,newRepoWebhookActive :: !(Maybe Bool) } deriving (Eq, Ord, Show, Typeable, Data, Generic) -instance NFData NewRepoWebhook +instance NFData NewRepoWebhook where rnf = genericRnf data EditRepoWebhook = EditRepoWebhook { editRepoWebhookConfig :: !(Maybe (M.Map Text Text)) @@ -87,4 +88,4 @@ data EditRepoWebhook = EditRepoWebhook { ,editRepoWebhookActive :: !(Maybe Bool) } deriving (Eq, Ord, Show, Typeable, Data, Generic) -instance NFData EditRepoWebhook +instance NFData EditRepoWebhook where rnf = genericRnf From d464d8e4b3265ed331d5831c69f9e49b41a1954a Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sun, 10 Jan 2016 17:28:46 +0200 Subject: [PATCH 138/510] Detailed -> Simple --- Github/Data.hs | 85 +++++++++---------- Github/Data/Definitions.hs | 102 +++++++++++------------ Github/Data/Gists.hs | 4 +- Github/Data/GitData.hs | 16 ++-- Github/Data/Issues.hs | 24 +++--- Github/Data/PullRequests.hs | 113 +++++++++++++------------- Github/Data/Repos.hs | 16 ++-- Github/Data/Search.hs | 10 +-- Github/Data/Teams.hs | 48 +++++------ Github/Issues/Comments.hs | 2 +- Github/Issues/Events.hs | 2 +- Github/Issues/Labels.hs | 2 +- Github/Issues/Milestones.hs | 2 +- Github/Organizations/Members.hs | 8 +- Github/Organizations/Teams.hs | 46 +++++------ Github/PullRequests.hs | 48 +++++------ Github/PullRequests/ReviewComments.hs | 8 +- Github/Users.hs | 10 +-- Github/Users/Followers.hs | 8 +- spec/Github/OrganizationsSpec.hs | 8 +- spec/Github/UsersSpec.hs | 6 +- 21 files changed, 285 insertions(+), 283 deletions(-) diff --git a/Github/Data.hs b/Github/Data.hs index 993db2db..7e0da87f 100644 --- a/Github/Data.hs +++ b/Github/Data.hs @@ -34,9 +34,10 @@ module Github.Data ( import Prelude () import Prelude.Compat -import Data.Aeson.Compat -import Data.Aeson.Types (Parser) -import Data.Hashable (Hashable) +import Data.Aeson.Compat +import Data.Aeson.Types (Parser) +import Data.Hashable (Hashable) + import qualified Data.HashMap.Lazy as Map import qualified Data.Text as T import qualified Data.Vector as V @@ -94,20 +95,22 @@ instance FromJSON GitCommit where <*> o .:< "parents" parseJSON _ = fail "Could not build a GitCommit" -instance FromJSON GithubOwner where +instance FromJSON SimpleOwner where parseJSON (Object o) | o `at` "gravatar_id" == Nothing = - GithubOrganization <$> o .: "avatar_url" - <*> o .: "login" - <*> o .: "url" - <*> o .: "id" + SimpleOrganizationOwner + <$> o .: "avatar_url" + <*> o .: "login" + <*> o .: "url" + <*> o .: "id" | otherwise = - GithubUser <$> o .: "avatar_url" - <*> o .: "login" - <*> o .: "url" - <*> o .: "id" - <*> o .: "gravatar_id" - parseJSON v = fail $ "Could not build a GithubOwner out of " ++ (show v) + SimpleUserOwner + <$> o .: "avatar_url" + <*> o .: "login" + <*> o .: "url" + <*> o .: "id" + <*> o .: "gravatar_id" + parseJSON v = fail $ "Could not build a SimpleGithubOwner out of " ++ (show v) instance FromJSON GitUser where parseJSON (Object o) = @@ -376,9 +379,9 @@ instance FromJSON Organization where <*> o .: "id" parseJSON _ = fail "Could not build an Organization" -instance FromJSON PullRequest where +instance FromJSON SimplePullRequest where parseJSON (Object o) = - PullRequest + SimplePullRequest <$> o .:? "closed_at" <*> o .: "created_at" <*> o .: "user" @@ -395,7 +398,7 @@ instance FromJSON PullRequest where <*> o .:? "merged_at" <*> o .: "title" <*> o .: "id" - parseJSON _ = fail "Could not build a PullRequest" + parseJSON _ = fail "Could not build a SimplePullRequest" instance ToJSON EditPullRequestState where toJSON (EditPullRequestStateOpen) = String "open" @@ -413,9 +416,9 @@ instance ToJSON CreatePullRequest where toJSON (CreatePullRequestIssue issueNum headPR basePR) = object [ "issue" .= issueNum, "head" .= headPR, "base" .= basePR] -instance FromJSON DetailedPullRequest where +instance FromJSON PullRequest where parseJSON (Object o) = - DetailedPullRequest + PullRequest <$> o .:? "closed_at" <*> o .: "created_at" <*> o .: "user" @@ -443,7 +446,7 @@ instance FromJSON DetailedPullRequest where <*> o .: "commits" <*> o .: "merged" <*> o .:? "mergeable" - parseJSON _ = fail "Could not build a DetailedPullRequest" + parseJSON _ = fail "Could not build a PullRequest" instance FromJSON PullRequestLinks where parseJSON (Object o) = @@ -675,10 +678,10 @@ instance FromJSON BranchCommit where parseJSON (Object o) = BranchCommit <$> o .: "sha" <*> o .: "url" parseJSON _ = fail "Could not build a BranchCommit" -instance FromJSON DetailedOwner where +instance FromJSON GithubOwner where parseJSON (Object o) | o `at` "gravatar_id" == Nothing = - DetailedOrganization <$> o .: "created_at" + GithubOrganization <$> o .: "created_at" <*> o .: "type" <*> o .: "public_gists" <*> o .: "avatar_url" @@ -695,7 +698,7 @@ instance FromJSON DetailedOwner where <*> o .: "html_url" <*> o .: "login" | otherwise = - DetailedUser <$> o .: "created_at" + GithubUser <$> o .: "created_at" <*> o .: "type" <*> o .: "public_gists" <*> o .: "avatar_url" @@ -714,7 +717,7 @@ instance FromJSON DetailedOwner where <*> o .: "id" <*> o .: "html_url" <*> o .: "login" - parseJSON _ = fail "Could not build a DetailedOwner" + parseJSON _ = fail "Could not build a GithubOwner" instance FromJSON Privacy where parseJSON (String attr) = @@ -748,6 +751,19 @@ instance ToJSON Permission where PermissionPush -> "push" PermissionAdmin -> "admin" +instance FromJSON SimpleTeam where + parseJSON (Object o) = + SimpleTeam <$> o .: "id" + <*> o .: "url" + <*> o .: "name" + <*> o .: "slug" + <*> o .:?"description" .!= Nothing + <*> o .:?"privacy" .!= Nothing + <*> o .: "permission" + <*> o .: "members_url" + <*> o .: "repositories_url" + parseJSON _ = fail "Could not build SimpleTeam" + instance FromJSON Team where parseJSON (Object o) = Team <$> o .: "id" @@ -759,23 +775,10 @@ instance FromJSON Team where <*> o .: "permission" <*> o .: "members_url" <*> o .: "repositories_url" - parseJSON _ = fail "Could not build Team" - -instance FromJSON DetailedTeam where - parseJSON (Object o) = - DetailedTeam <$> o .: "id" - <*> o .: "url" - <*> o .: "name" - <*> o .: "slug" - <*> o .:?"description" .!= Nothing - <*> o .:?"privacy" .!= Nothing - <*> o .: "permission" - <*> o .: "members_url" - <*> o .: "repositories_url" - <*> o .: "members_count" - <*> o .: "repos_count" - <*> o .: "organization" - parseJSON _ = fail "Could not build a DetailedTeam" + <*> o .: "members_count" + <*> o .: "repos_count" + <*> o .: "organization" + parseJSON _ = fail "Could not build a Team" instance ToJSON CreateTeam where toJSON (CreateTeam name desc repo_names {-privacy-} permissions) = diff --git a/Github/Data/Definitions.hs b/Github/Data/Definitions.hs index ea180f8b..74ee7fd3 100644 --- a/Github/Data/Definitions.hs +++ b/Github/Data/Definitions.hs @@ -33,21 +33,21 @@ data Error = | UserError Text -- ^ Incorrect input. deriving Show -data GithubOwner = GithubUser { - githubOwnerAvatarUrl :: !Text - ,githubOwnerLogin :: !(Name GithubOwner) - ,githubOwnerUrl :: !Text - ,githubOwnerId :: !(Id GithubOwner) - ,githubOwnerGravatarId :: !(Maybe Text) +data SimpleOwner = SimpleUserOwner { + simpleOwnerAvatarUrl :: !Text + ,simpleOwnerLogin :: !(Name SimpleOwner) + ,simpleOwnerUrl :: !Text + ,simpleOwnerId :: !(Id SimpleOwner) + ,simpleOwnerGravatarId :: !(Maybe Text) } - | GithubOrganization { - githubOwnerAvatarUrl :: !Text - ,githubOwnerLogin :: !(Name GithubOwner) - ,githubOwnerUrl :: !Text - ,githubOwnerId :: !(Id GithubOwner) + | SimpleOrganizationOwner { + simpleOwnerAvatarUrl :: !Text + ,simpleOwnerLogin :: !(Name SimpleOwner) + ,simpleOwnerUrl :: !Text + ,simpleOwnerId :: !(Id SimpleOwner) } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData GithubOwner where rnf = genericRnf +instance NFData SimpleOwner where rnf = genericRnf data Stats = Stats { statsAdditions :: !Int @@ -67,7 +67,7 @@ data Comment = Comment { ,commentUrl :: !Text ,commentCreatedAt :: !(Maybe UTCTime) ,commentPath :: !(Maybe Text) - ,commentUser :: !GithubOwner + ,commentUser :: !SimpleOwner ,commentId :: !(Id Comment) } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -166,44 +166,44 @@ data Contributor instance NFData Contributor where rnf = genericRnf -data DetailedOwner = DetailedUser { - detailedOwnerCreatedAt :: !UTCTime - ,detailedOwnerType :: !Text - ,detailedOwnerPublicGists :: !Int - ,detailedOwnerAvatarUrl :: !Text - ,detailedOwnerFollowers :: !Int - ,detailedOwnerFollowing :: !Int - ,detailedOwnerHireable :: !(Maybe Bool) - ,detailedOwnerGravatarId :: !(Maybe Text) - ,detailedOwnerBlog :: !(Maybe Text) - ,detailedOwnerBio :: !(Maybe Text) - ,detailedOwnerPublicRepos :: !Int - ,detailedOwnerName :: !(Maybe Text) - ,detailedOwnerLocation :: !(Maybe Text) - ,detailedOwnerCompany :: !(Maybe Text) - ,detailedOwnerEmail :: !(Maybe Text) - ,detailedOwnerUrl :: !Text - ,detailedOwnerId :: !(Id GithubOwner) - ,detailedOwnerHtmlUrl :: !Text - ,detailedOwnerLogin :: !(Name GithubOwner) +data GithubOwner = GithubUser { + githubOwnerCreatedAt :: !UTCTime + ,githubOwnerType :: !Text + ,githubOwnerPublicGists :: !Int + ,githubOwnerAvatarUrl :: !Text + ,githubOwnerFollowers :: !Int + ,githubOwnerFollowing :: !Int + ,githubOwnerHireable :: !(Maybe Bool) + ,githubOwnerGravatarId :: !(Maybe Text) + ,githubOwnerBlog :: !(Maybe Text) + ,githubOwnerBio :: !(Maybe Text) + ,githubOwnerPublicRepos :: !Int + ,githubOwnerName :: !(Maybe Text) + ,githubOwnerLocation :: !(Maybe Text) + ,githubOwnerCompany :: !(Maybe Text) + ,githubOwnerEmail :: !(Maybe Text) + ,githubOwnerUrl :: !Text + ,githubOwnerId :: !(Id SimpleOwner) + ,githubOwnerHtmlUrl :: !Text + ,githubOwnerLogin :: !(Name SimpleOwner) } - | DetailedOrganization { - detailedOwnerCreatedAt :: !UTCTime - ,detailedOwnerType :: !Text - ,detailedOwnerPublicGists :: !Int - ,detailedOwnerAvatarUrl :: !Text - ,detailedOwnerFollowers :: !Int - ,detailedOwnerFollowing :: !Int - ,detailedOwnerBlog :: !(Maybe Text) - ,detailedOwnerBio :: !(Maybe Text) - ,detailedOwnerPublicRepos :: !Int - ,detailedOwnerName :: !(Maybe Text) - ,detailedOwnerLocation :: !(Maybe Text) - ,detailedOwnerCompany :: !(Maybe Text) - ,detailedOwnerUrl :: !Text - ,detailedOwnerId :: !(Id GithubOwner) - ,detailedOwnerHtmlUrl :: !Text - ,detailedOwnerLogin :: !(Name GithubOwner) + | GithubOrganization { + githubOwnerCreatedAt :: !UTCTime + ,githubOwnerType :: !Text + ,githubOwnerPublicGists :: !Int + ,githubOwnerAvatarUrl :: !Text + ,githubOwnerFollowers :: !Int + ,githubOwnerFollowing :: !Int + ,githubOwnerBlog :: !(Maybe Text) + ,githubOwnerBio :: !(Maybe Text) + ,githubOwnerPublicRepos :: !Int + ,githubOwnerName :: !(Maybe Text) + ,githubOwnerLocation :: !(Maybe Text) + ,githubOwnerCompany :: !(Maybe Text) + ,githubOwnerUrl :: !Text + ,githubOwnerId :: !(Id SimpleOwner) + ,githubOwnerHtmlUrl :: !Text + ,githubOwnerLogin :: !(Name SimpleOwner) } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData DetailedOwner where rnf = genericRnf +instance NFData GithubOwner where rnf = genericRnf diff --git a/Github/Data/Gists.hs b/Github/Data/Gists.hs index c62a8878..737607a0 100644 --- a/Github/Data/Gists.hs +++ b/Github/Data/Gists.hs @@ -15,7 +15,7 @@ import Data.Vector (Vector) import GHC.Generics (Generic) data Gist = Gist { - gistUser :: !GithubOwner + gistUser :: !SimpleOwner ,gistGitPushUrl :: !Text ,gistUrl :: !Text ,gistDescription :: !(Maybe Text) @@ -43,7 +43,7 @@ data GistFile = GistFile { instance NFData GistFile where rnf = genericRnf data GistComment = GistComment { - gistCommentUser :: !GithubOwner + gistCommentUser :: !SimpleOwner ,gistCommentUrl :: !Text ,gistCommentCreatedAt :: !UTCTime ,gistCommentBody :: !Text diff --git a/Github/Data/GitData.hs b/Github/Data/GitData.hs index fd39eeab..1f8548f3 100644 --- a/Github/Data/GitData.hs +++ b/Github/Data/GitData.hs @@ -4,21 +4,21 @@ module Github.Data.GitData where import Github.Data.Definitions -import Control.DeepSeq (NFData(..)) +import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) -import Data.Data (Data, Typeable) -import Data.Text (Text) -import Data.Time (UTCTime) -import Data.Vector (Vector) -import GHC.Generics (Generic) +import Data.Data (Data, Typeable) +import Data.Text (Text) +import Data.Time (UTCTime) +import Data.Vector (Vector) +import GHC.Generics (Generic) data Commit = Commit { commitSha :: !Text ,commitParents :: !(Vector Tree) ,commitUrl :: !Text ,commitGitCommit :: !GitCommit - ,commitCommitter :: !(Maybe GithubOwner) - ,commitAuthor :: !(Maybe GithubOwner) + ,commitCommitter :: !(Maybe SimpleOwner) + ,commitAuthor :: !(Maybe SimpleOwner) ,commitFiles :: !(Vector File) ,commitStats :: !(Maybe Stats) } deriving (Show, Data, Typeable, Eq, Ord, Generic) diff --git a/Github/Data/Issues.hs b/Github/Data/Issues.hs index 8b2df916..9e380895 100644 --- a/Github/Data/Issues.hs +++ b/Github/Data/Issues.hs @@ -6,24 +6,24 @@ import Github.Data.Definitions import Github.Data.Id (Id) import Github.Data.PullRequests -import Control.DeepSeq (NFData(..)) +import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) -import Data.Data (Data, Typeable) -import Data.Text (Text) -import Data.Time (UTCTime) -import Data.Vector (Vector) -import GHC.Generics (Generic) +import Data.Data (Data, Typeable) +import Data.Text (Text) +import Data.Time (UTCTime) +import Data.Vector (Vector) +import GHC.Generics (Generic) data Issue = Issue { issueClosedAt :: Maybe UTCTime ,issueUpdatedAt :: UTCTime ,issueEventsUrl :: Text ,issueHtmlUrl :: Maybe Text - ,issueClosedBy :: Maybe GithubOwner + ,issueClosedBy :: Maybe SimpleOwner ,issueLabels :: (Vector IssueLabel) ,issueNumber :: Int - ,issueAssignee :: Maybe GithubOwner - ,issueUser :: GithubOwner + ,issueAssignee :: Maybe SimpleOwner + ,issueUser :: SimpleOwner ,issueTitle :: Text ,issuePullRequest :: Maybe PullRequestReference ,issueUrl :: Text @@ -59,7 +59,7 @@ data EditIssue = EditIssue { instance NFData EditIssue where rnf = genericRnf data Milestone = Milestone { - milestoneCreator :: GithubOwner + milestoneCreator :: SimpleOwner ,milestoneDueOn :: Maybe UTCTime ,milestoneOpenIssues :: Int ,milestoneNumber :: Int @@ -83,7 +83,7 @@ instance NFData IssueLabel where rnf = genericRnf data IssueComment = IssueComment { issueCommentUpdatedAt :: UTCTime - ,issueCommentUser :: GithubOwner + ,issueCommentUser :: SimpleOwner ,issueCommentUrl :: Text ,issueCommentHtmlUrl :: Text ,issueCommentCreatedAt :: UTCTime @@ -118,7 +118,7 @@ instance NFData EventType where rnf = genericRnf -- | Issue event data Event = Event { - eventActor :: !GithubOwner + eventActor :: !SimpleOwner ,eventType :: !EventType ,eventCommitId :: !(Maybe Text) ,eventUrl :: !Text diff --git a/Github/Data/PullRequests.hs b/Github/Data/PullRequests.hs index edab4db7..12c4b441 100644 --- a/Github/Data/PullRequests.hs +++ b/Github/Data/PullRequests.hs @@ -5,67 +5,66 @@ module Github.Data.PullRequests where import Github.Data.Definitions import Github.Data.Repos (Repo) -import Control.DeepSeq (NFData(..)) +import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) -import Data.Data (Data, Typeable) -import Data.Text (Text) -import Data.Time (UTCTime) -import GHC.Generics (Generic) - -data PullRequest = PullRequest { - pullRequestClosedAt :: !(Maybe UTCTime) - ,pullRequestCreatedAt :: !UTCTime - ,pullRequestUser :: !GithubOwner - ,pullRequestPatchUrl :: !Text - ,pullRequestState :: !Text - ,pullRequestNumber :: !Int - ,pullRequestHtmlUrl :: !Text - ,pullRequestUpdatedAt :: !UTCTime - ,pullRequestBody :: !Text - ,pullRequestIssueUrl :: !Text - ,pullRequestDiffUrl :: !Text - ,pullRequestUrl :: !Text - ,pullRequestLinks :: !PullRequestLinks - ,pullRequestMergedAt :: !(Maybe UTCTime) - ,pullRequestTitle :: !Text - ,pullRequestId :: !Int +import Data.Data (Data, Typeable) +import Data.Text (Text) +import Data.Time (UTCTime) +import GHC.Generics (Generic) + +data SimplePullRequest = SimplePullRequest { + simplePullRequestClosedAt :: !(Maybe UTCTime) + ,simplePullRequestCreatedAt :: !UTCTime + ,simplePullRequestUser :: !SimpleOwner + ,simplePullRequestPatchUrl :: !Text + ,simplePullRequestState :: !Text + ,simplePullRequestNumber :: !Int + ,simplePullRequestHtmlUrl :: !Text + ,simplePullRequestUpdatedAt :: !UTCTime + ,simplePullRequestBody :: !Text + ,simplePullRequestIssueUrl :: !Text + ,simplePullRequestDiffUrl :: !Text + ,simplePullRequestUrl :: !Text + ,simplePullRequestLinks :: !PullRequestLinks + ,simplePullRequestMergedAt :: !(Maybe UTCTime) + ,simplePullRequestTitle :: !Text + ,simplePullRequestId :: !Int } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData PullRequest where rnf = genericRnf +instance NFData SimplePullRequest where rnf = genericRnf -data DetailedPullRequest = DetailedPullRequest { +data PullRequest = PullRequest { -- this is a duplication of a PullRequest - detailedPullRequestClosedAt :: !(Maybe UTCTime) - ,detailedPullRequestCreatedAt :: !UTCTime - ,detailedPullRequestUser :: !GithubOwner - ,detailedPullRequestPatchUrl :: !Text - ,detailedPullRequestState :: !Text - ,detailedPullRequestNumber :: !Int - ,detailedPullRequestHtmlUrl :: !Text - ,detailedPullRequestUpdatedAt :: !UTCTime - ,detailedPullRequestBody :: !Text - ,detailedPullRequestIssueUrl :: !Text - ,detailedPullRequestDiffUrl :: !Text - ,detailedPullRequestUrl :: !Text - ,detailedPullRequestLinks :: !PullRequestLinks - ,detailedPullRequestMergedAt :: !(Maybe UTCTime) - ,detailedPullRequestTitle :: !Text - ,detailedPullRequestId :: !Int - - ,detailedPullRequestMergedBy :: !(Maybe GithubOwner) - ,detailedPullRequestChangedFiles :: !Int - ,detailedPullRequestHead :: !PullRequestCommit - ,detailedPullRequestComments :: !Int - ,detailedPullRequestDeletions :: !Int - ,detailedPullRequestAdditions :: !Int - ,detailedPullRequestReviewComments :: !Int - ,detailedPullRequestBase :: !PullRequestCommit - ,detailedPullRequestCommits :: !Int - ,detailedPullRequestMerged :: !Bool - ,detailedPullRequestMergeable :: !(Maybe Bool) + pullRequestClosedAt :: !(Maybe UTCTime) + ,pullRequestCreatedAt :: !UTCTime + ,pullRequestUser :: !SimpleOwner + ,pullRequestPatchUrl :: !Text + ,pullRequestState :: !Text + ,pullRequestNumber :: !Int + ,pullRequestHtmlUrl :: !Text + ,pullRequestUpdatedAt :: !UTCTime + ,pullRequestBody :: !Text + ,pullRequestIssueUrl :: !Text + ,pullRequestDiffUrl :: !Text + ,pullRequestUrl :: !Text + ,pullRequestLinks :: !PullRequestLinks + ,pullRequestMergedAt :: !(Maybe UTCTime) + ,pullRequestTitle :: !Text + ,pullRequestId :: !Int + ,pullRequestMergedBy :: !(Maybe SimpleOwner) + ,pullRequestChangedFiles :: !Int + ,pullRequestHead :: !PullRequestCommit + ,pullRequestComments :: !Int + ,pullRequestDeletions :: !Int + ,pullRequestAdditions :: !Int + ,pullRequestReviewComments :: !Int + ,pullRequestBase :: !PullRequestCommit + ,pullRequestCommits :: !Int + ,pullRequestMerged :: !Bool + ,pullRequestMergeable :: !(Maybe Bool) } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData DetailedPullRequest where rnf = genericRnf +instance NFData PullRequest where rnf = genericRnf data EditPullRequest = EditPullRequest { editPullRequestTitle :: !(Maybe Text) @@ -104,7 +103,7 @@ data PullRequestCommit = PullRequestCommit { pullRequestCommitLabel :: !Text ,pullRequestCommitRef :: !Text ,pullRequestCommitSha :: !Text - ,pullRequestCommitUser :: !GithubOwner + ,pullRequestCommitUser :: !SimpleOwner ,pullRequestCommitRepo :: !Repo } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -113,9 +112,9 @@ instance NFData PullRequestCommit where rnf = genericRnf data PullRequestEvent = PullRequestEvent { pullRequestEventAction :: !PullRequestEventType ,pullRequestEventNumber :: !Int - ,pullRequestEventPullRequest :: !DetailedPullRequest + ,pullRequestEventPullRequest :: !PullRequest ,pullRequestRepository :: !Repo - ,pullRequestSender :: !GithubOwner + ,pullRequestSender :: !SimpleOwner } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData PullRequestEvent where rnf = genericRnf diff --git a/Github/Data/Repos.hs b/Github/Data/Repos.hs index b265f9e2..e28df361 100644 --- a/Github/Data/Repos.hs +++ b/Github/Data/Repos.hs @@ -6,13 +6,13 @@ import Github.Data.Definitions import Github.Data.Id (Id) import Github.Data.Name (Name) -import Control.DeepSeq (NFData(..)) +import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) -import Data.Data (Data, Typeable) -import Data.Text (Text) -import Data.Time (UTCTime) -import Data.Vector (Vector) -import GHC.Generics (Generic) +import Data.Data (Data, Typeable) +import Data.Text (Text) +import Data.Time (UTCTime) +import Data.Vector (Vector) +import GHC.Generics (Generic) data Repo = Repo { repoSshUrl :: !(Maybe Text) @@ -29,7 +29,7 @@ data Repo = Repo { ,repoSize :: !(Maybe Int) ,repoUpdatedAt :: !(Maybe UTCTime) ,repoWatchers :: !(Maybe Int) - ,repoOwner :: !GithubOwner + ,repoOwner :: !SimpleOwner ,repoName :: !(Name Repo) ,repoLanguage :: !(Maybe Text) ,repoMasterBranch :: !(Maybe Text) @@ -48,7 +48,7 @@ data Repo = Repo { instance NFData Repo where rnf = genericRnf -data RepoRef = RepoRef GithubOwner (Name Repo) -- Repo owner and name +data RepoRef = RepoRef SimpleOwner (Name Repo) -- Repo owner and name deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData RepoRef where rnf = genericRnf diff --git a/Github/Data/Search.hs b/Github/Data/Search.hs index a13ba4f7..d9fdfaa5 100644 --- a/Github/Data/Search.hs +++ b/Github/Data/Search.hs @@ -5,12 +5,12 @@ module Github.Data.Search where import Github.Data.Issues (Issue) import Github.Data.Repos (Repo) -import Control.DeepSeq (NFData(..)) +import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) -import Data.Data (Data, Typeable) -import Data.Text (Text) -import Data.Vector (Vector) -import GHC.Generics (Generic) +import Data.Data (Data, Typeable) +import Data.Text (Text) +import Data.Vector (Vector) +import GHC.Generics (Generic) data SearchReposResult = SearchReposResult { searchReposTotalCount :: !Int diff --git a/Github/Data/Teams.hs b/Github/Data/Teams.hs index 3c3d952f..8c6661b5 100644 --- a/Github/Data/Teams.hs +++ b/Github/Data/Teams.hs @@ -4,12 +4,12 @@ module Github.Data.Teams where import Github.Data.Definitions -import Control.DeepSeq (NFData(..)) +import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) -import Data.Data (Data, Typeable) -import Data.Text (Text) -import Data.Vector (Vector) -import GHC.Generics (Generic) +import Data.Data (Data, Typeable) +import Data.Text (Text) +import Data.Vector (Vector) +import GHC.Generics (Generic) import Github.Data.Id (Id) import Github.Data.Name (Name) @@ -30,37 +30,37 @@ data Permission = instance NFData Permission where rnf = genericRnf +data SimpleTeam = SimpleTeam { + simpleTeamId :: !(Id Team) + ,simpleTeamUrl :: !Text + ,simpleTeamName :: !Text + ,simpleTeamSlug :: !(Name Team) + ,simpleTeamDescription :: !(Maybe Text) + ,simpleTeamPrivacy :: !(Maybe Privacy) + ,simpleTeamPermission :: !Permission + ,simpleTeamMembersUrl :: !Text + ,simpleTeamRepositoriesUrl :: !Text +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData SimpleTeam where rnf = genericRnf + data Team = Team { teamId :: !(Id Team) ,teamUrl :: !Text - ,teamName :: !Text - ,teamSlug :: !(Name Team) + ,teamName :: !(Name Team) + ,teamSlug :: !Text ,teamDescription :: !(Maybe Text) ,teamPrivacy :: !(Maybe Privacy) ,teamPermission :: !Permission ,teamMembersUrl :: !Text ,teamRepositoriesUrl :: !Text + ,teamMembersCount :: !Int + ,teamReposCount :: !Int + ,teamOrganization :: !SimpleOwner } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Team where rnf = genericRnf -data DetailedTeam = DetailedTeam { - detailedTeamId :: !(Id Team) - ,detailedTeamUrl :: !Text - ,detailedTeamName :: !(Name Team) - ,detailedTeamSlug :: !Text - ,detailedTeamDescription :: !(Maybe Text) - ,detailedTeamPrivacy :: !(Maybe Privacy) - ,detailedTeamPermission :: !Permission - ,detailedTeamMembersUrl :: !Text - ,detailedTeamRepositoriesUrl :: !Text - ,detailedTeamMembersCount :: !Int - ,detailedTeamReposCount :: !Int - ,detailedTeamOrganization :: !GithubOwner -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData DetailedTeam where rnf = genericRnf - data CreateTeam = CreateTeam { createTeamName :: !(Name Team) ,createTeamDescription :: !(Maybe Text) diff --git a/Github/Issues/Comments.hs b/Github/Issues/Comments.hs index 697abd44..fe057fc9 100644 --- a/Github/Issues/Comments.hs +++ b/Github/Issues/Comments.hs @@ -16,10 +16,10 @@ module Github.Issues.Comments ( import Data.Aeson.Compat (encode) import Data.Text (Text) +import Data.Vector (Vector) import Github.Auth import Github.Data import Github.Request -import Data.Vector (Vector) -- | A specific comment, by ID. -- diff --git a/Github/Issues/Events.hs b/Github/Issues/Events.hs index 7d32ddee..cdb30b90 100644 --- a/Github/Issues/Events.hs +++ b/Github/Issues/Events.hs @@ -13,10 +13,10 @@ module Github.Issues.Events ( module Github.Data, ) where +import Data.Vector (Vector) import Github.Auth import Github.Data import Github.Request -import Data.Vector (Vector) -- | All events that have happened on an issue. -- diff --git a/Github/Issues/Labels.hs b/Github/Issues/Labels.hs index b436d650..db338828 100644 --- a/Github/Issues/Labels.hs +++ b/Github/Issues/Labels.hs @@ -37,10 +37,10 @@ import Prelude.Compat import Data.Aeson.Compat (encode, object, (.=)) import Data.Foldable (toList) +import Data.Vector (Vector) import Github.Auth import Github.Data import Github.Request -import Data.Vector (Vector) -- | All the labels available to use on any issue in the repo. -- diff --git a/Github/Issues/Milestones.hs b/Github/Issues/Milestones.hs index 1fb7f4ef..6dee480d 100644 --- a/Github/Issues/Milestones.hs +++ b/Github/Issues/Milestones.hs @@ -9,10 +9,10 @@ module Github.Issues.Milestones ( module Github.Data, ) where +import Data.Vector (Vector) import Github.Auth import Github.Data import Github.Request -import Data.Vector (Vector) -- | All milestones in the repo. -- diff --git a/Github/Organizations/Members.hs b/Github/Organizations/Members.hs index 01c874fe..70bfb325 100644 --- a/Github/Organizations/Members.hs +++ b/Github/Organizations/Members.hs @@ -7,16 +7,16 @@ module Github.Organizations.Members ( module Github.Data, ) where +import Data.Vector (Vector) import Github.Auth import Github.Data import Github.Request -import Data.Vector (Vector) -- | All the users who are members of the specified organization, -- | with or without authentication. -- -- > membersOf' (Just $ GithubOAuth "token") "thoughtbot" -membersOf' :: Maybe GithubAuth -> Name Organization -> IO (Either Error (Vector GithubOwner)) +membersOf' :: Maybe GithubAuth -> Name Organization -> IO (Either Error (Vector SimpleOwner)) membersOf' auth org = executeRequestMaybe auth $ membersOfR org Nothing @@ -24,11 +24,11 @@ membersOf' auth org = -- | without authentication. -- -- > membersOf "thoughtbot" -membersOf :: Name Organization -> IO (Either Error (Vector GithubOwner)) +membersOf :: Name Organization -> IO (Either Error (Vector SimpleOwner)) membersOf = membersOf' Nothing -- | All the users who are members of the specified organization. -- -- See -membersOfR :: Name Organization -> Maybe Count -> GithubRequest k (Vector GithubOwner) +membersOfR :: Name Organization -> Maybe Count -> GithubRequest k (Vector SimpleOwner) membersOfR organization = GithubPagedGet ["orgs", untagName organization, "members"] [] diff --git a/Github/Organizations/Teams.hs b/Github/Organizations/Teams.hs index df49c65d..af2201a4 100644 --- a/Github/Organizations/Teams.hs +++ b/Github/Organizations/Teams.hs @@ -1,5 +1,5 @@ {-# LANGUAGE DataKinds #-} --- | The organization teams API as described on +-- | The GithubOwner teams API as described on -- . module Github.Organizations.Teams ( teamsOf, @@ -27,64 +27,64 @@ module Github.Organizations.Teams ( ) where import Data.Aeson.Compat (encode) +import Data.Vector (Vector) import Github.Auth import Github.Data import Github.Request -import Data.Vector (Vector) --- | List teams. List the teams of an organization. +-- | List teams. List the teams of an GithubOwner. -- When authenticated, lists private teams visible to the authenticated user. --- When unauthenticated, lists only public teams for an organization. +-- When unauthenticated, lists only public teams for an GithubOwner. -- -- > teamsOf' (Just $ GithubOAuth "token") "thoughtbot" -teamsOf' :: Maybe GithubAuth -> Name Organization -> IO (Either Error (Vector Team)) +teamsOf' :: Maybe GithubAuth -> Name Organization -> IO (Either Error (Vector SimpleTeam)) teamsOf' auth org = executeRequestMaybe auth $ teamsOfR org Nothing --- | List the public teams of an organization. +-- | List the public teams of an GithubOwner. -- -- > teamsOf "thoughtbot" -teamsOf :: Name Organization -> IO (Either Error (Vector Team)) +teamsOf :: Name Organization -> IO (Either Error (Vector SimpleTeam)) teamsOf = teamsOf' Nothing -- | List teams. -- See -teamsOfR :: Name Organization -> Maybe Count -> GithubRequest k (Vector Team) -teamsOfR organization = GithubPagedGet ["orgs", untagName organization, "teams"] [] +teamsOfR :: Name Organization -> Maybe Count -> GithubRequest k (Vector SimpleTeam) +teamsOfR org = GithubPagedGet ["orgs", untagName org, "teams"] [] -- | The information for a single team, by team id. -- | With authentication -- -- > teamInfoFor' (Just $ GithubOAuth "token") 1010101 -teamInfoFor' :: Maybe GithubAuth -> Id Team -> IO (Either Error DetailedTeam) +teamInfoFor' :: Maybe GithubAuth -> Id Team -> IO (Either Error Team) teamInfoFor' auth tid = executeRequestMaybe auth $ teamInfoForR tid -- | The information for a single team, by team id. -- -- > teamInfoFor' (Just $ GithubOAuth "token") 1010101 -teamInfoFor :: Id Team -> IO (Either Error DetailedTeam) +teamInfoFor :: Id Team -> IO (Either Error Team) teamInfoFor = teamInfoFor' Nothing -- | Get team. -- See -teamInfoForR :: Id Team -> GithubRequest k DetailedTeam +teamInfoForR :: Id Team -> GithubRequest k Team teamInfoForR tid = GithubGet ["teams", show $ untagId tid] [] --- | Create a team under an organization +-- | Create a team under an GithubOwner -- --- > createTeamFor' (GithubOAuth "token") "organization" (CreateTeam "newteamname" "some description" [] PermssionPull) +-- > createTeamFor' (GithubOAuth "token") "GithubOwner" (CreateTeam "newteamname" "some description" [] PermssionPull) createTeamFor' :: GithubAuth -> Name Organization -> CreateTeam - -> IO (Either Error DetailedTeam) + -> IO (Either Error Team) createTeamFor' auth org cteam = executeRequest auth $ createTeamForR org cteam -- | Create team. -- See -createTeamForR :: Name Organization -> CreateTeam -> GithubRequest 'True DetailedTeam +createTeamForR :: Name Organization -> CreateTeam -> GithubRequest 'True Team createTeamForR org cteam = GithubPost Post ["orgs", untagName org, "teams"] (encode cteam) @@ -92,28 +92,28 @@ createTeamForR org cteam = -- -- > editTeamFor' editTeam' :: GithubAuth - -> Id DetailedTeam + -> Id Team -> EditTeam - -> IO (Either Error DetailedTeam) + -> IO (Either Error Team) editTeam' auth tid eteam = executeRequest auth $ editTeamR tid eteam -- | Edit team. -- See -editTeamR :: Id DetailedTeam -> EditTeam -> GithubRequest 'True DetailedTeam +editTeamR :: Id Team -> EditTeam -> GithubRequest 'True Team editTeamR tid eteam = GithubPost Patch ["teams", show $ untagId tid] (encode eteam) -- | Delete a team, by id. -- -- > deleteTeam' (GithubOAuth "token") 1010101 -deleteTeam' :: GithubAuth -> Id DetailedTeam -> IO (Either Error ()) +deleteTeam' :: GithubAuth -> Id Team -> IO (Either Error ()) deleteTeam' auth tid = executeRequest auth $ deleteTeamR tid -- | Delete team. -- See -deleteTeamR :: Id DetailedTeam -> GithubRequest 'True () +deleteTeamR :: Id Team -> GithubRequest 'True () deleteTeamR tid = GithubDelete ["teams", show $ untagId tid] @@ -166,10 +166,10 @@ deleteTeamMembershipForR tid user = -- | List teams for current authenticated user -- -- > listTeamsCurrent' (GithubOAuth "token") -listTeamsCurrent' :: GithubAuth -> IO (Either Error (Vector DetailedTeam)) +listTeamsCurrent' :: GithubAuth -> IO (Either Error (Vector Team)) listTeamsCurrent' auth = executeRequest auth $ listTeamsCurrentR Nothing -- | List user teams. -- See -listTeamsCurrentR :: Maybe Count -> GithubRequest 'True (Vector DetailedTeam) +listTeamsCurrentR :: Maybe Count -> GithubRequest 'True (Vector Team) listTeamsCurrentR = GithubPagedGet ["user", "teams"] [] diff --git a/Github/PullRequests.hs b/Github/PullRequests.hs index f5de4658..27e73b85 100644 --- a/Github/PullRequests.hs +++ b/Github/PullRequests.hs @@ -15,7 +15,7 @@ module Github.PullRequests ( updatePullRequest, updatePullRequestR, pullRequestCommits', - pullRequestCommits, + pullRequestCommitsIO, pullRequestCommitsR, pullRequestFiles', pullRequestFiles, @@ -44,7 +44,7 @@ import qualified Data.ByteString.Char8 as BS8 -- -- State can be one of @all@, @open@, or @closed@. Default is @open@. -- -pullRequestsFor'' :: Maybe GithubAuth -> Maybe String -> Name GithubOwner -> Name Repo -> IO (Either Error (Vector PullRequest)) +pullRequestsFor'' :: Maybe GithubAuth -> Maybe String -> Name GithubOwner -> Name Repo -> IO (Either Error (Vector SimplePullRequest)) pullRequestsFor'' auth state user repo = executeRequestMaybe auth $ pullRequestsForR user repo state Nothing @@ -52,13 +52,13 @@ pullRequestsFor'' auth state user repo = -- | With authentification -- -- > pullRequestsFor' (Just ("github-username", "github-password")) "rails" "rails" -pullRequestsFor' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error (Vector PullRequest)) +pullRequestsFor' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error (Vector SimplePullRequest)) pullRequestsFor' auth = pullRequestsFor'' auth Nothing -- | All pull requests for the repo, by owner and repo name. -- -- > pullRequestsFor "rails" "rails" -pullRequestsFor :: Name GithubOwner -> Name Repo -> IO (Either Error (Vector PullRequest)) +pullRequestsFor :: Name GithubOwner -> Name Repo -> IO (Either Error (Vector SimplePullRequest)) pullRequestsFor = pullRequestsFor'' Nothing Nothing -- | List pull requests. @@ -66,7 +66,7 @@ pullRequestsFor = pullRequestsFor'' Nothing Nothing pullRequestsForR :: Name GithubOwner -> Name Repo -> Maybe String -- ^ State -> Maybe Count - -> GithubRequest k (Vector PullRequest) + -> GithubRequest k (Vector SimplePullRequest) pullRequestsForR user repo state = GithubPagedGet ["repos", untagName user, untagName repo, "pulls"] qs where @@ -77,7 +77,7 @@ pullRequestsForR user repo state = -- | With authentification -- -- > pullRequest' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" 562 -pullRequest' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> Id DetailedPullRequest -> IO (Either Error DetailedPullRequest) +pullRequest' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> Id PullRequest -> IO (Either Error PullRequest) pullRequest' auth user repo prid = executeRequestMaybe auth $ pullRequestR user repo prid @@ -85,12 +85,12 @@ pullRequest' auth user repo prid = -- repo owner and name along with the number assigned to the pull request. -- -- > pullRequest "thoughtbot" "paperclip" 562 -pullRequest :: Name GithubOwner -> Name Repo -> Id DetailedPullRequest -> IO (Either Error DetailedPullRequest) +pullRequest :: Name GithubOwner -> Name Repo -> Id PullRequest -> IO (Either Error PullRequest) pullRequest = pullRequest' Nothing -- | Get a single pull request. -- See -pullRequestR :: Name GithubOwner -> Name Repo -> Id DetailedPullRequest -> GithubRequest k DetailedPullRequest +pullRequestR :: Name GithubOwner -> Name Repo -> Id PullRequest -> GithubRequest k PullRequest pullRequestR user repo prid = GithubGet ["repos", untagName user, untagName repo, "pulls", show $ untagId prid] [] @@ -98,7 +98,7 @@ createPullRequest :: GithubAuth -> Name GithubOwner -> Name Repo -> CreatePullRequest - -> IO (Either Error DetailedPullRequest) + -> IO (Either Error PullRequest) createPullRequest auth user repo cpr = executeRequest auth $ createPullRequestR user repo cpr @@ -107,12 +107,12 @@ createPullRequest auth user repo cpr = createPullRequestR :: Name GithubOwner -> Name Repo -> CreatePullRequest - -> GithubRequest 'True DetailedPullRequest + -> GithubRequest 'True PullRequest 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 :: GithubAuth -> Name GithubOwner -> Name Repo -> Id PullRequest -> EditPullRequest -> IO (Either Error PullRequest) updatePullRequest auth user repo prid epr = executeRequest auth $ updatePullRequestR user repo prid epr @@ -120,9 +120,9 @@ updatePullRequest auth user repo prid epr = -- See updatePullRequestR :: Name GithubOwner -> Name Repo - -> Id DetailedPullRequest + -> Id PullRequest -> EditPullRequest - -> GithubRequest 'True DetailedPullRequest + -> GithubRequest 'True PullRequest updatePullRequestR user repo prid epr = GithubPost Patch ["repos", untagName user, untagName repo, "pulls", show $ untagId prid] (encode epr) @@ -131,7 +131,7 @@ updatePullRequestR user repo prid epr = -- | With authentification -- -- > pullRequestCommits' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" 688 -pullRequestCommits' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> Id DetailedPullRequest -> IO (Either Error (Vector Commit)) +pullRequestCommits' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector Commit)) pullRequestCommits' auth user repo prid = executeRequestMaybe auth $ pullRequestCommitsR user repo prid Nothing @@ -139,12 +139,12 @@ pullRequestCommits' auth user repo prid = -- the number of the pull request. -- -- > pullRequestCommits "thoughtbot" "paperclip" 688 -pullRequestCommits :: Name GithubOwner -> Name Repo -> Id DetailedPullRequest -> IO (Either Error (Vector Commit)) -pullRequestCommits = pullRequestCommits' Nothing +pullRequestCommitsIO :: Name GithubOwner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector Commit)) +pullRequestCommitsIO = pullRequestCommits' Nothing -- | List commits on a pull request. -- See -pullRequestCommitsR :: Name GithubOwner -> Name Repo -> Id DetailedPullRequest -> Maybe Count -> GithubRequest k (Vector Commit) +pullRequestCommitsR :: Name GithubOwner -> Name Repo -> Id PullRequest -> Maybe Count -> GithubRequest k (Vector Commit) pullRequestCommitsR user repo prid = GithubPagedGet ["repos", untagName user, untagName repo, "pulls", show $ untagId prid, "commits"] [] @@ -153,7 +153,7 @@ pullRequestCommitsR user repo prid = -- | With authentification -- -- > pullRequestFiles' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" 688 -pullRequestFiles' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> Id DetailedPullRequest -> IO (Either Error (Vector File)) +pullRequestFiles' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector File)) pullRequestFiles' auth user repo prid = executeRequestMaybe auth $ pullRequestFilesR user repo prid Nothing @@ -161,34 +161,34 @@ pullRequestFiles' auth user repo prid = -- name, plus the number assigned to the pull request. -- -- > pullRequestFiles "thoughtbot" "paperclip" 688 -pullRequestFiles :: Name GithubOwner -> Name Repo -> Id DetailedPullRequest -> IO (Either Error (Vector File)) +pullRequestFiles :: Name GithubOwner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector File)) pullRequestFiles = pullRequestFiles' Nothing -- | List pull requests files. -- See -pullRequestFilesR :: Name GithubOwner -> Name Repo -> Id DetailedPullRequest -> Maybe Count -> GithubRequest k (Vector File) +pullRequestFilesR :: Name GithubOwner -> Name Repo -> Id PullRequest -> Maybe Count -> GithubRequest k (Vector File) pullRequestFilesR user repo prid = GithubPagedGet ["repos", untagName user, untagName repo, "pulls", show $ untagId prid, "files"] [] -- | Check if pull request has been merged. -isPullRequestMerged :: GithubAuth -> Name GithubOwner -> Name Repo -> Id DetailedPullRequest -> IO (Either Error Status) +isPullRequestMerged :: GithubAuth -> Name GithubOwner -> Name Repo -> Id PullRequest -> IO (Either Error Status) isPullRequestMerged auth user repo prid = executeRequest auth $ isPullRequestMergedR user repo prid -- | Get if a pull request has been merged. -- See -isPullRequestMergedR :: Name GithubOwner -> Name Repo -> Id DetailedPullRequest -> GithubRequest k Status +isPullRequestMergedR :: Name GithubOwner -> Name Repo -> Id PullRequest -> GithubRequest k Status isPullRequestMergedR user repo prid = GithubStatus $ GithubGet ["repos", untagName user, untagName repo, "pulls", show $ untagId prid, "merge"] [] -- | Merge a pull request. -mergePullRequest :: GithubAuth -> Name GithubOwner -> Name Repo -> Id DetailedPullRequest -> Maybe String -> IO (Either Error Status) +mergePullRequest :: GithubAuth -> Name GithubOwner -> Name Repo -> Id PullRequest -> 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 :: Name GithubOwner -> Name Repo -> Id PullRequest -> Maybe String -> GithubRequest 'True Status mergePullRequestR user repo prid commitMessage = GithubStatus $ GithubPost Put paths (encode $ buildCommitMessageMap commitMessage) where diff --git a/Github/PullRequests/ReviewComments.hs b/Github/PullRequests/ReviewComments.hs index 5dea8cfa..391e1aa5 100644 --- a/Github/PullRequests/ReviewComments.hs +++ b/Github/PullRequests/ReviewComments.hs @@ -1,22 +1,22 @@ -- | The pull request review comments API as described at -- . module Github.PullRequests.ReviewComments ( - pullRequestReviewComments, + pullRequestReviewCommentsIO, pullRequestReviewCommentsR, pullRequestReviewComment, pullRequestReviewCommentR, module Github.Data, ) where +import Data.Vector (Vector) import Github.Data import Github.Request -import Data.Vector (Vector) -- | All the comments on a pull request with the given ID. -- -- > pullRequestReviewComments "thoughtbot" "factory_girl" (Id 256) -pullRequestReviewComments :: Name GithubOwner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector Comment)) -pullRequestReviewComments user repo prid = +pullRequestReviewCommentsIO :: Name GithubOwner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector Comment)) +pullRequestReviewCommentsIO user repo prid = executeRequest' $ pullRequestReviewCommentsR user repo prid Nothing -- | List comments on a pull request. diff --git a/Github/Users.hs b/Github/Users.hs index 0a4cd4bd..b1bd0e1a 100644 --- a/Github/Users.hs +++ b/Github/Users.hs @@ -18,18 +18,18 @@ import Github.Request -- With authentification -- -- > userInfoFor' (Just ("github-username", "github-password")) "mike-burns" -userInfoFor' :: Maybe GithubAuth -> Name DetailedOwner -> IO (Either Error DetailedOwner) +userInfoFor' :: Maybe GithubAuth -> Name GithubOwner -> IO (Either Error GithubOwner) userInfoFor' auth = executeRequestMaybe auth . userInfoForR -- | The information for a single user, by login name. -- -- > userInfoFor "mike-burns" -userInfoFor :: Name DetailedOwner -> IO (Either Error DetailedOwner) +userInfoFor :: Name GithubOwner -> IO (Either Error GithubOwner) userInfoFor = executeRequest' . userInfoForR -- | Get a single user. -- See -userInfoForR :: Name DetailedOwner -> GithubRequest k DetailedOwner +userInfoForR :: Name GithubOwner -> GithubRequest k GithubOwner userInfoForR userName = GithubGet ["users", untagName userName] [] -- | Retrieve information about the user associated with the supplied authentication. @@ -37,11 +37,11 @@ userInfoForR userName = GithubGet ["users", untagName userName] [] -- > userInfoCurrent' (GithubOAuth "...") -- -- TODO: Change to require 'GithubAuth'? -userInfoCurrent' :: Maybe GithubAuth -> IO (Either Error DetailedOwner) +userInfoCurrent' :: Maybe GithubAuth -> IO (Either Error GithubOwner) userInfoCurrent' auth = executeRequestMaybe auth . unsafeDropAuthRequirements $ userInfoCurrentR -- | Get the authenticated user. -- See -userInfoCurrentR :: GithubRequest 'True DetailedOwner +userInfoCurrentR :: GithubRequest 'True GithubOwner userInfoCurrentR = GithubGet ["user"] [] diff --git a/Github/Users/Followers.hs b/Github/Users/Followers.hs index b1a3b90c..09887ad1 100644 --- a/Github/Users/Followers.hs +++ b/Github/Users/Followers.hs @@ -15,23 +15,23 @@ import Github.Request -- | All the users following the given user. -- -- > usersFollowing "mike-burns" -usersFollowing :: Name GithubOwner -> IO (Either Error (Vector GithubOwner)) +usersFollowing :: Name GithubOwner -> IO (Either Error (Vector SimpleOwner)) usersFollowing user = executeRequest' $ usersFollowingR user Nothing -- | List followers of a user. -- See -usersFollowingR :: Name GithubOwner -> Maybe Count -> GithubRequest k (Vector GithubOwner) +usersFollowingR :: Name GithubOwner -> Maybe Count -> GithubRequest k (Vector SimpleOwner) usersFollowingR userName = GithubPagedGet ["users", untagName userName, "followers"] [] -- | All the users that the given user follows. -- -- > usersFollowedBy "mike-burns" -usersFollowedBy :: Name GithubOwner -> IO (Either Error (Vector GithubOwner)) +usersFollowedBy :: Name GithubOwner -> IO (Either Error (Vector SimpleOwner)) usersFollowedBy user = executeRequest' $ usersFollowedByR user Nothing -- | List users followed by another user. -- See -usersFollowedByR :: Name GithubOwner -> Maybe Count -> GithubRequest k (Vector GithubOwner) +usersFollowedByR :: Name GithubOwner -> Maybe Count -> GithubRequest k (Vector SimpleOwner) usersFollowedByR userName = GithubPagedGet ["users", untagName userName, "following"] [] diff --git a/spec/Github/OrganizationsSpec.hs b/spec/Github/OrganizationsSpec.hs index 45b16048..3e756391 100644 --- a/spec/Github/OrganizationsSpec.hs +++ b/spec/Github/OrganizationsSpec.hs @@ -3,8 +3,8 @@ module Github.OrganizationsSpec where import Github.Auth (GithubAuth (..)) -import Github.Data (GithubOwner (..), SimpleOrganization (..), - Team (..)) +import Github.Data (SimpleOwner (..), SimpleOrganization (..), + SimpleTeam (..)) import Github.Organizations (publicOrganizationsFor') import Github.Organizations.Members (membersOf') @@ -40,12 +40,12 @@ spec = do describe "teamsOf" $ do it "parse" $ do let ts = eitherDecodeStrict $(embedFile "fixtures/list-teams.json") - teamName (head $ fromRightS ts) `shouldBe` "Justice League" + simpleTeamName (head $ fromRightS ts) `shouldBe` "Justice League" describe "membersOf" $ do it "parse" $ do let ms = eitherDecodeStrict $(embedFile "fixtures/members-list.json") - githubOwnerLogin (head $ fromRightS ms) `shouldBe` "octocat" + simpleOwnerLogin (head $ fromRightS ms) `shouldBe` "octocat" it "works" $ withAuth $ \auth -> do ms <- membersOf' (Just auth) "haskell" diff --git a/spec/Github/UsersSpec.hs b/spec/Github/UsersSpec.hs index 43adaee5..8f970f4f 100644 --- a/spec/Github/UsersSpec.hs +++ b/spec/Github/UsersSpec.hs @@ -10,7 +10,7 @@ import Test.Hspec (Spec, describe, it, pendingWith, shouldBe, shouldSatisfy) import Github.Auth (GithubAuth (..)) -import Github.Data.Definitions (DetailedOwner (..)) +import Github.Data.Definitions (GithubOwner (..)) import Github.Request (executeRequest) import Github.Users (userInfoCurrent', userInfoFor') import Github.Users.Followers (usersFollowedByR, usersFollowingR) @@ -31,11 +31,11 @@ spec = do describe "userInfoFor" $ do it "decodes user json" $ do let userInfo = eitherDecodeStrict $(embedFile "fixtures/user.json") - detailedOwnerLogin (fromRightS userInfo) `shouldBe` "mike-burns" + githubOwnerLogin (fromRightS userInfo) `shouldBe` "mike-burns" it "returns information about the user" $ withAuth $ \auth -> do userInfo <- userInfoFor' (Just auth) "mike-burns" - detailedOwnerLogin (fromRightS userInfo) `shouldBe` "mike-burns" + githubOwnerLogin (fromRightS userInfo) `shouldBe` "mike-burns" describe "userInfoCurrent'" $ do it "returns information about the autenticated user" $ withAuth $ \auth -> do From 874bd4a16400f0b87f4746de70c0001c1edb0604 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sun, 10 Jan 2016 23:44:31 +0200 Subject: [PATCH 139/510] Use stack to build samples (only one atm) --- Github/Activity/Starring.hs | 4 +- Github/Activity/Watching.hs | 4 +- Github/Data.hs | 2 + Github/Data/Definitions.hs | 16 ++-- Github/Data/Name.hs | 6 +- Github/Data/Request.hs | 14 ++++ Github/Gists.hs | 4 +- Github/Gists/Comments.hs | 4 +- Github/GitData/Blobs.hs | 2 +- Github/GitData/Commits.hs | 2 +- Github/GitData/References.hs | 8 +- Github/GitData/Trees.hs | 4 +- Github/Issues.hs | 8 +- Github/Issues/Comments.hs | 8 +- Github/Issues/Events.hs | 6 +- Github/Issues/Labels.hs | 22 +++--- Github/Issues/Milestones.hs | 4 +- Github/Organizations.hs | 4 +- Github/Organizations/Members.hs | 2 +- Github/Organizations/Teams.hs | 16 ++-- Github/PullRequests.hs | 16 ++-- Github/PullRequests/ReviewComments.hs | 4 +- Github/Repos.hs | 24 +++--- Github/Repos/Collaborators.hs | 4 +- Github/Repos/Comments.hs | 6 +- Github/Repos/Commits.hs | 6 +- Github/Repos/Forks.hs | 2 +- Github/Repos/Webhooks.hs | 10 +-- Github/Users.hs | 2 +- Github/Users/Followers.hs | 4 +- samples/Users/ShowUser.hs | 101 ++++++++++++++++---------- samples/github-samples.cabal | 23 ++++++ samples/package.yaml | 15 ++++ stack-lts-2.yaml | 1 + stack-lts-3.yaml | 1 + stack-lts-4.yaml | 1 + stack-nightly.yaml | 1 + travis-script.sh | 4 +- 38 files changed, 222 insertions(+), 143 deletions(-) create mode 100644 samples/github-samples.cabal create mode 100644 samples/package.yaml diff --git a/Github/Activity/Starring.hs b/Github/Activity/Starring.hs index 941d3fc5..7f4463ca 100644 --- a/Github/Activity/Starring.hs +++ b/Github/Activity/Starring.hs @@ -27,7 +27,7 @@ stargazersFor auth user repo = -- See stargazersForR :: Name GithubOwner -> Name Repo -> Maybe Count -> GithubRequest k (Vector GithubOwner) stargazersForR user repo = - GithubPagedGet ["repos", untagName user, untagName repo, "stargazers"] [] + GithubPagedGet ["repos", toPathPart user, toPathPart repo, "stargazers"] [] -- | All the public repos starred by the specified user. -- @@ -40,7 +40,7 @@ reposStarredBy auth user = -- See reposStarredByR :: Name GithubOwner -> Maybe Count -> GithubRequest k (Vector Repo) reposStarredByR user = - GithubPagedGet ["users", untagName user, "starred"] [] + GithubPagedGet ["users", toPathPart user, "starred"] [] -- | All the repos starred by the authenticated user. myStarred :: GithubAuth -> IO (Either Error (Vector Repo)) diff --git a/Github/Activity/Watching.hs b/Github/Activity/Watching.hs index abdcb565..ebbed127 100644 --- a/Github/Activity/Watching.hs +++ b/Github/Activity/Watching.hs @@ -33,7 +33,7 @@ watchersFor' auth user repo = -- See watchersForR :: Name GithubOwner -> Name Repo -> Maybe Count -> GithubRequest k (Vector GithubOwner) watchersForR user repo limit = - GithubPagedGet ["repos", untagName user, untagName repo, "watchers"] [] limit + GithubPagedGet ["repos", toPathPart user, toPathPart repo, "watchers"] [] limit -- | All the public repos watched by the specified user. -- @@ -53,4 +53,4 @@ reposWatchedBy' auth user = -- See reposWatchedByR :: Name GithubOwner -> Maybe Count -> GithubRequest k (Vector Repo) reposWatchedByR user = - GithubPagedGet ["users", untagName user, "subscriptions"] [] + GithubPagedGet ["users", toPathPart user, "subscriptions"] [] diff --git a/Github/Data.hs b/Github/Data.hs index 7e0da87f..57b3e801 100644 --- a/Github/Data.hs +++ b/Github/Data.hs @@ -9,6 +9,7 @@ module Github.Data ( -- * Module re-exports + module Github.Auth, module Github.Data.Definitions, module Github.Data.Gists, module Github.Data.GitData, @@ -42,6 +43,7 @@ import qualified Data.HashMap.Lazy as Map import qualified Data.Text as T import qualified Data.Vector as V +import Github.Auth import Github.Data.Definitions import Github.Data.Gists import Github.Data.GitData diff --git a/Github/Data/Definitions.hs b/Github/Data/Definitions.hs index 74ee7fd3..e4a66b9e 100644 --- a/Github/Data/Definitions.hs +++ b/Github/Data/Definitions.hs @@ -35,16 +35,16 @@ data Error = data SimpleOwner = SimpleUserOwner { simpleOwnerAvatarUrl :: !Text - ,simpleOwnerLogin :: !(Name SimpleOwner) + ,simpleOwnerLogin :: !(Name GithubOwner) ,simpleOwnerUrl :: !Text - ,simpleOwnerId :: !(Id SimpleOwner) + ,simpleOwnerId :: !(Id GithubOwner) ,simpleOwnerGravatarId :: !(Maybe Text) } | SimpleOrganizationOwner { simpleOwnerAvatarUrl :: !Text - ,simpleOwnerLogin :: !(Name SimpleOwner) + ,simpleOwnerLogin :: !(Name GithubOwner) ,simpleOwnerUrl :: !Text - ,simpleOwnerId :: !(Id SimpleOwner) + ,simpleOwnerId :: !(Id GithubOwner) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData SimpleOwner where rnf = genericRnf @@ -183,9 +183,9 @@ data GithubOwner = GithubUser { ,githubOwnerCompany :: !(Maybe Text) ,githubOwnerEmail :: !(Maybe Text) ,githubOwnerUrl :: !Text - ,githubOwnerId :: !(Id SimpleOwner) + ,githubOwnerId :: !(Id GithubOwner) ,githubOwnerHtmlUrl :: !Text - ,githubOwnerLogin :: !(Name SimpleOwner) + ,githubOwnerLogin :: !(Name GithubOwner) } | GithubOrganization { githubOwnerCreatedAt :: !UTCTime @@ -201,9 +201,9 @@ data GithubOwner = GithubUser { ,githubOwnerLocation :: !(Maybe Text) ,githubOwnerCompany :: !(Maybe Text) ,githubOwnerUrl :: !Text - ,githubOwnerId :: !(Id SimpleOwner) + ,githubOwnerId :: !(Id GithubOwner) ,githubOwnerHtmlUrl :: !Text - ,githubOwnerLogin :: !(Name SimpleOwner) + ,githubOwnerLogin :: !(Name GithubOwner) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData GithubOwner where rnf = genericRnf diff --git a/Github/Data/Name.hs b/Github/Data/Name.hs index 0c8f69c3..94c18740 100644 --- a/Github/Data/Name.hs +++ b/Github/Data/Name.hs @@ -14,8 +14,6 @@ import Data.String (IsString (..)) import Data.Text (Text) import GHC.Generics (Generic) -import qualified Data.Text as T - newtype Name entity = N Text deriving (Eq, Ord, Show, Read, Generic, Typeable, Data) @@ -23,8 +21,8 @@ newtype Name entity = N Text mkName :: proxy entity -> Text -> Name entity mkName _ = N -untagName :: Name entity -> String -untagName (N name) = T.unpack name +untagName :: Name entity -> Text +untagName (N name) = name instance Hashable (Name entity) diff --git a/Github/Data/Request.hs b/Github/Data/Request.hs index c3dee9df..e350605a 100644 --- a/Github/Data/Request.hs +++ b/Github/Data/Request.hs @@ -12,6 +12,7 @@ module Github.Data.Request ( PostMethod(..), toMethod, Paths, + IsPathPart(..), QueryString, Count, ) where @@ -24,8 +25,12 @@ import Network.HTTP.Types (Status) import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS +import qualified Data.Text as T import qualified Network.HTTP.Types.Method as Method +import Github.Data.Id (Id, untagId) +import Github.Data.Name (Name, untagName) + ------------------------------------------------------------------------------ -- Auxillary types ------------------------------------------------------------------------------ @@ -34,6 +39,15 @@ type Paths = [String] type QueryString = [(BS.ByteString, Maybe BS.ByteString)] type Count = Int +class IsPathPart a where + toPathPart :: a -> String + +instance IsPathPart (Name a) where + toPathPart = T.unpack . untagName + +instance IsPathPart (Id a) where + toPathPart = show . untagId + -- | Http method of requests with body. data PostMethod = Post | Patch | Put deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable) diff --git a/Github/Gists.hs b/Github/Gists.hs index b9d7413b..12e083f0 100644 --- a/Github/Gists.hs +++ b/Github/Gists.hs @@ -30,7 +30,7 @@ gists = gists' Nothing -- | List gists. -- See gistsR :: Name GithubOwner -> Maybe Count -> GithubRequest k (Vector Gist) -gistsR user = GithubPagedGet ["users", untagName user, "gists"] [] +gistsR user = GithubPagedGet ["users", toPathPart user, "gists"] [] -- | A specific gist, given its id, with authentication credentials -- @@ -49,4 +49,4 @@ gist = gist' Nothing -- See gistR :: Name Gist ->GithubRequest k Gist gistR gid = - GithubGet ["gists", untagName gid] [] + GithubGet ["gists", toPathPart gid] [] diff --git a/Github/Gists/Comments.hs b/Github/Gists/Comments.hs index 3557b860..1613933f 100644 --- a/Github/Gists/Comments.hs +++ b/Github/Gists/Comments.hs @@ -23,7 +23,7 @@ commentsOn gid = -- See commentsOnR :: Name Gist -> Maybe Count -> GithubRequest k (Vector GistComment) commentsOnR gid = - GithubPagedGet ["gists", untagName gid, "comments"] [] + GithubPagedGet ["gists", toPathPart gid, "comments"] [] -- | A specific comment, by the comment ID. -- @@ -36,4 +36,4 @@ comment cid = -- See gistCommentR :: Id GistComment -> GithubRequest k GistComment gistCommentR cid = - GithubGet ["gists", "comments", show $ untagId cid] [] + GithubGet ["gists", "comments", toPathPart cid] [] diff --git a/Github/GitData/Blobs.hs b/Github/GitData/Blobs.hs index 26dd94b0..a2c64a67 100644 --- a/Github/GitData/Blobs.hs +++ b/Github/GitData/Blobs.hs @@ -28,4 +28,4 @@ blob = blob' Nothing -- See blobR :: Name GithubOwner -> Name Repo -> Name Blob -> GithubRequest k Blob blobR user repo sha = - GithubGet ["repos", untagName user, untagName repo, "git", "blobs", untagName sha] [] + GithubGet ["repos", toPathPart user, toPathPart repo, "git", "blobs", toPathPart sha] [] diff --git a/Github/GitData/Commits.hs b/Github/GitData/Commits.hs index f7f406bd..c3affc6d 100644 --- a/Github/GitData/Commits.hs +++ b/Github/GitData/Commits.hs @@ -20,4 +20,4 @@ commit user repo sha = -- See gitCommitR :: Name GithubOwner -> Name Repo -> Name GitCommit -> GithubRequest k GitCommit gitCommitR user repo sha = - GithubGet ["repos", untagName user, untagName repo, "git", "commits", untagName sha] [] + GithubGet ["repos", toPathPart user, toPathPart repo, "git", "commits", toPathPart sha] [] diff --git a/Github/GitData/References.hs b/Github/GitData/References.hs index 7567d3f2..7006ebd2 100644 --- a/Github/GitData/References.hs +++ b/Github/GitData/References.hs @@ -38,7 +38,7 @@ reference = reference' Nothing -- See referenceR :: Name GithubOwner -> Name Repo -> Name GitReference -> GithubRequest k GitReference referenceR user repo ref = - GithubGet ["repos", untagName user, untagName repo, "git", "refs", untagName ref] [] + GithubGet ["repos", toPathPart user, toPathPart repo, "git", "refs", toPathPart ref] [] -- | The history of references for a repo. -- @@ -57,7 +57,7 @@ references = references' Nothing -- See referencesR :: Name GithubOwner -> Name Repo -> Maybe Count -> GithubRequest k (Vector GitReference) referencesR user repo = - GithubPagedGet ["repos", untagName user, untagName repo, "git", "refs"] [] + GithubPagedGet ["repos", toPathPart user, toPathPart repo, "git", "refs"] [] -- | Create a reference. createReference :: GithubAuth -> Name GithubOwner -> Name Repo -> NewGitReference -> IO (Either Error GitReference) @@ -68,7 +68,7 @@ createReference auth user repo newRef = -- See createReferenceR :: Name GithubOwner -> Name Repo -> NewGitReference -> GithubRequest 'True GitReference createReferenceR user repo newRef = - GithubPost Post ["repos", untagName user, untagName repo , "git", "refs"] (encode newRef) + GithubPost Post ["repos", toPathPart user, toPathPart repo , "git", "refs"] (encode newRef) -- | Limited references by a namespace. -- @@ -81,4 +81,4 @@ namespacedReferences user repo namespace = -- See namespacedReferencesR :: Name GithubOwner -> Name Repo -> String -> GithubRequest k [GitReference] namespacedReferencesR user repo namespace = - GithubGet ["repos", untagName user, untagName repo, "git", "refs", namespace] [] + GithubGet ["repos", toPathPart user, toPathPart repo, "git", "refs", namespace] [] diff --git a/Github/GitData/Trees.hs b/Github/GitData/Trees.hs index 5fcb47ea..1af6bbb5 100644 --- a/Github/GitData/Trees.hs +++ b/Github/GitData/Trees.hs @@ -32,7 +32,7 @@ tree = tree' Nothing -- See treeR :: Name GithubOwner -> Name Repo -> Name Tree -> GithubRequest k Tree treeR user repo sha = - GithubGet ["repos", untagName user, untagName repo, "git", "trees", untagName sha] [] + GithubGet ["repos", toPathPart user, toPathPart repo, "git", "trees", toPathPart sha] [] -- | A recursively-nested tree for a SHA1. -- @@ -51,4 +51,4 @@ nestedTree = nestedTree' Nothing -- See nestedTreeR :: Name GithubOwner -> Name Repo -> Name Tree -> GithubRequest k Tree nestedTreeR user repo sha = - GithubGet ["repos", untagName user, untagName repo, "git", "trees", untagName sha] [("recursive", Just "1")] + GithubGet ["repos", toPathPart user, toPathPart repo, "git", "trees", toPathPart sha] [("recursive", Just "1")] diff --git a/Github/Issues.hs b/Github/Issues.hs index 226049f0..0195fd12 100644 --- a/Github/Issues.hs +++ b/Github/Issues.hs @@ -50,7 +50,7 @@ issue = issue' Nothing -- 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] [] + GithubGet ["repos", toPathPart user, toPathPart reqRepoName, "issues", toPathPart reqIssueNumber] [] -- | All issues for a repo (given the repo owner and name), with optional -- restrictions as described in the @IssueLimitation@ data type. @@ -71,7 +71,7 @@ issuesForRepo = issuesForRepo' Nothing -- See issuesForRepoR :: Name GithubOwner -> Name Repo -> [IssueLimitation] -> Maybe Count -> GithubRequest k (Vector Issue) issuesForRepoR user reqRepoName issueLimitations = - GithubPagedGet ["repos", untagName user, untagName reqRepoName, "issues"] qs + GithubPagedGet ["repos", toPathPart user, toPathPart reqRepoName, "issues"] qs where qs = map convert issueLimitations @@ -109,7 +109,7 @@ createIssue auth user repo ni = -- See createIssueR :: Name GithubOwner -> Name Repo -> NewIssue -> GithubRequest 'True Issue createIssueR user repo = - GithubPost Post ["repos", untagName user, untagName repo, "issues"] . encode + GithubPost Post ["repos", toPathPart user, toPathPart repo, "issues"] . encode -- Editing issues. @@ -129,4 +129,4 @@ editIssue auth user repo iss edit = -- 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 + GithubPost Patch ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iss] . encode diff --git a/Github/Issues/Comments.hs b/Github/Issues/Comments.hs index fe057fc9..3dd39ef2 100644 --- a/Github/Issues/Comments.hs +++ b/Github/Issues/Comments.hs @@ -32,7 +32,7 @@ comment user repo cid = -- 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] [] + GithubGet ["repos", toPathPart user, toPathPart repo, "issues", "comments", toPathPart cid] [] -- | All comments on an issue, by the issue's number. -- @@ -51,7 +51,7 @@ comments' auth user repo iid = -- See commentsR :: Name GithubOwner -> Name Repo -> Id Issue -> Maybe Count -> GithubRequest k (Vector IssueComment) commentsR user repo iid = - GithubPagedGet ["repos", untagName user, untagName repo, "issues", show $ untagId iid, "comments"] [] + GithubPagedGet ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "comments"] [] -- | Create a new comment. -- @@ -68,7 +68,7 @@ createCommentR :: Name GithubOwner -> Name Repo -> Id Issue -> Text -> GithubReq createCommentR user repo iss body = GithubPost Post parts (encode $ NewComment body) where - parts = ["repos", untagName user, untagName repo, "issues", show $ untagId iss, "comments"] + parts = ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iss, "comments"] -- | Edit a comment. -- @@ -85,4 +85,4 @@ editCommentR :: Name GithubOwner -> Name Repo -> Id Comment -> Text -> GithubReq editCommentR user repo commid body = GithubPost Patch parts (encode $ EditComment body) where - parts = ["repos", untagName user, untagName repo, "issues", "comments", show $ untagId commid] + parts = ["repos", toPathPart user, toPathPart repo, "issues", "comments", toPathPart commid] diff --git a/Github/Issues/Events.hs b/Github/Issues/Events.hs index cdb30b90..413178ce 100644 --- a/Github/Issues/Events.hs +++ b/Github/Issues/Events.hs @@ -35,7 +35,7 @@ eventsForIssue' auth user repo iid = -- See eventsForIssueR :: Name GithubOwner -> Name Repo -> Id Issue -> Maybe Count -> GithubRequest k (Vector Event) eventsForIssueR user repo iid = - GithubPagedGet ["repos", untagName user, untagName repo, "issues", show $ untagId iid, "events"] [] + GithubPagedGet ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "events"] [] -- | All the events for all issues in a repo. -- @@ -54,7 +54,7 @@ eventsForRepo' auth user repo = -- See eventsForRepoR :: Name GithubOwner -> Name Repo -> Maybe Count -> GithubRequest k (Vector Event) eventsForRepoR user repo = - GithubPagedGet ["repos", untagName user, untagName repo, "issues", "events"] [] + GithubPagedGet ["repos", toPathPart user, toPathPart repo, "issues", "events"] [] -- | Details on a specific event, by the event's ID. -- @@ -73,4 +73,4 @@ event' auth user repo eid = -- 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] [] + GithubGet ["repos", toPathPart user, toPathPart repo, "issues", "events", show eid] [] diff --git a/Github/Issues/Labels.hs b/Github/Issues/Labels.hs index db338828..25e6153a 100644 --- a/Github/Issues/Labels.hs +++ b/Github/Issues/Labels.hs @@ -59,7 +59,7 @@ labelsOnRepo' auth user repo = -- See labelsOnRepoR :: Name GithubOwner -> Name Repo -> Maybe Count -> GithubRequest k (Vector IssueLabel) labelsOnRepoR user repo = - GithubPagedGet ["repos", untagName user, untagName repo, "labels"] [] + GithubPagedGet ["repos", toPathPart user, toPathPart repo, "labels"] [] -- | A label by name. -- @@ -78,7 +78,7 @@ label' auth user repo lbl = -- See labelR :: Name GithubOwner -> Name Repo -> Name IssueLabel -> GithubRequest k IssueLabel labelR user repo lbl = - GithubGet ["repos", untagName user, untagName repo, "labels", untagName lbl] [] + GithubGet ["repos", toPathPart user, toPathPart repo, "labels", toPathPart lbl] [] -- | Create a label -- @@ -93,7 +93,7 @@ createLabelR :: Name GithubOwner -> Name Repo -> Name IssueLabel -> String -> Gi createLabelR user repo lbl color = GithubPost Post paths $ encode body where - paths = ["repos", untagName user, untagName repo, "labels"] + paths = ["repos", toPathPart user, toPathPart repo, "labels"] body = object ["name" .= untagName lbl, "color" .= color] -- | Update a label @@ -120,7 +120,7 @@ updateLabelR :: Name GithubOwner updateLabelR user repo oldLbl newLbl color = GithubPost Patch paths (encode body) where - paths = ["repos", untagName user, untagName repo, "labels", untagName oldLbl] + paths = ["repos", toPathPart user, toPathPart repo, "labels", toPathPart oldLbl] body = object ["name" .= untagName newLbl, "color" .= color] -- | Delete a label @@ -134,7 +134,7 @@ deleteLabel auth user repo lbl = -- See deleteLabelR :: Name GithubOwner -> Name Repo -> Name IssueLabel -> GithubRequest 'True () deleteLabelR user repo lbl = - GithubDelete ["repos", untagName user, untagName repo, "labels", untagName lbl] + GithubDelete ["repos", toPathPart user, toPathPart repo, "labels", toPathPart lbl] -- | The labels on an issue in a repo. -- @@ -153,7 +153,7 @@ labelsOnIssue' auth user repo iid = -- See labelsOnIssueR :: Name GithubOwner -> Name Repo -> Id Issue -> Maybe Count -> GithubRequest k (Vector IssueLabel) labelsOnIssueR user repo iid = - GithubPagedGet ["repos", untagName user, untagName repo, "issues", show $ untagId iid, "labels"] [] + GithubPagedGet ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] [] -- | Add labels to an issue. -- @@ -179,7 +179,7 @@ addLabelsToIssueR :: Foldable f addLabelsToIssueR user repo iid lbls = GithubPost Post paths (encode $ toList lbls) where - paths = ["repos", untagName user, untagName repo, "issues", show $ untagId iid, "labels"] + paths = ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] -- | Remove a label from an issue. -- @@ -192,7 +192,7 @@ removeLabelFromIssue auth user repo iid lbl = -- 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] + GithubDelete ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels", toPathPart lbl] -- | Replace all labels on an issue. Sending an empty list will remove all labels from the issue. -- @@ -220,7 +220,7 @@ replaceAllLabelsForIssueR :: Foldable f replaceAllLabelsForIssueR user repo iid lbls = GithubPost Put paths (encode $ toList lbls) where - paths = ["repos", untagName user, untagName repo, "issues", show $ untagId iid, "labels"] + paths = ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] -- | Remove all labels from an issue. -- @@ -233,7 +233,7 @@ removeAllLabelsFromIssue auth user repo iid = -- 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"] + GithubDelete ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] -- | All the labels on a repo's milestone given the milestone ID. -- @@ -252,4 +252,4 @@ labelsOnMilestone' auth user repo mid = -- See labelsOnMilestoneR :: Name GithubOwner -> Name Repo -> Id Milestone -> Maybe Count -> GithubRequest k (Vector IssueLabel) labelsOnMilestoneR user repo mid = - GithubPagedGet ["repos", untagName user, untagName repo, "milestones", show $ untagId mid, "labels"] [] + GithubPagedGet ["repos", toPathPart user, toPathPart repo, "milestones", toPathPart mid, "labels"] [] diff --git a/Github/Issues/Milestones.hs b/Github/Issues/Milestones.hs index 6dee480d..977b8499 100644 --- a/Github/Issues/Milestones.hs +++ b/Github/Issues/Milestones.hs @@ -30,7 +30,7 @@ milestones' auth user repo = -- | List milestones for a repository. -- See milestonesR :: Name GithubOwner -> Name Repo -> Maybe Count -> GithubRequest k (Vector Milestone) -milestonesR user repo = GithubPagedGet ["repos", untagName user, untagName repo, "milestones"] [] +milestonesR user repo = GithubPagedGet ["repos", toPathPart user, toPathPart repo, "milestones"] [] -- | Details on a specific milestone, given it's milestone number. -- @@ -43,4 +43,4 @@ milestone user repo mid = -- 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] [] + GithubGet ["repos", toPathPart user, toPathPart repo, "milestones", toPathPart mid] [] diff --git a/Github/Organizations.hs b/Github/Organizations.hs index f444b94d..fed6a6a4 100644 --- a/Github/Organizations.hs +++ b/Github/Organizations.hs @@ -30,7 +30,7 @@ publicOrganizationsFor = publicOrganizationsFor' Nothing -- | List user organizations. -- See publicOrganizationsForR :: Name GithubOwner -> Maybe Count -> GithubRequest k (Vector SimpleOrganization) -publicOrganizationsForR userName = GithubPagedGet ["users", untagName userName, "orgs"] [] +publicOrganizationsForR userName = GithubPagedGet ["users", toPathPart userName, "orgs"] [] -- | Details on a public organization. Takes the organization's login. -- @@ -47,4 +47,4 @@ publicOrganization = publicOrganization' Nothing -- | Get an organization. -- See publicOrganizationR :: Name Organization -> GithubRequest k Organization -publicOrganizationR reqOrganizationName = GithubGet ["orgs", untagName reqOrganizationName] [] +publicOrganizationR reqOrganizationName = GithubGet ["orgs", toPathPart reqOrganizationName] [] diff --git a/Github/Organizations/Members.hs b/Github/Organizations/Members.hs index 70bfb325..a31bf9ef 100644 --- a/Github/Organizations/Members.hs +++ b/Github/Organizations/Members.hs @@ -31,4 +31,4 @@ membersOf = membersOf' Nothing -- -- See membersOfR :: Name Organization -> Maybe Count -> GithubRequest k (Vector SimpleOwner) -membersOfR organization = GithubPagedGet ["orgs", untagName organization, "members"] [] +membersOfR organization = GithubPagedGet ["orgs", toPathPart organization, "members"] [] diff --git a/Github/Organizations/Teams.hs b/Github/Organizations/Teams.hs index af2201a4..efe6118f 100644 --- a/Github/Organizations/Teams.hs +++ b/Github/Organizations/Teams.hs @@ -50,7 +50,7 @@ teamsOf = teamsOf' Nothing -- | List teams. -- See teamsOfR :: Name Organization -> Maybe Count -> GithubRequest k (Vector SimpleTeam) -teamsOfR org = GithubPagedGet ["orgs", untagName org, "teams"] [] +teamsOfR org = GithubPagedGet ["orgs", toPathPart org, "teams"] [] -- | The information for a single team, by team id. -- | With authentication @@ -70,7 +70,7 @@ teamInfoFor = teamInfoFor' Nothing -- See teamInfoForR :: Id Team -> GithubRequest k Team teamInfoForR tid = - GithubGet ["teams", show $ untagId tid] [] + GithubGet ["teams", toPathPart tid] [] -- | Create a team under an GithubOwner -- @@ -86,7 +86,7 @@ createTeamFor' auth org cteam = -- See createTeamForR :: Name Organization -> CreateTeam -> GithubRequest 'True Team createTeamForR org cteam = - GithubPost Post ["orgs", untagName org, "teams"] (encode cteam) + GithubPost Post ["orgs", toPathPart org, "teams"] (encode cteam) -- | Edit a team, by id. -- @@ -102,7 +102,7 @@ editTeam' auth tid eteam = -- See editTeamR :: Id Team -> EditTeam -> GithubRequest 'True Team editTeamR tid eteam = - GithubPost Patch ["teams", show $ untagId tid] (encode eteam) + GithubPost Patch ["teams", toPathPart tid] (encode eteam) -- | Delete a team, by id. -- @@ -115,7 +115,7 @@ deleteTeam' auth tid = -- See deleteTeamR :: Id Team -> GithubRequest 'True () deleteTeamR tid = - GithubDelete ["teams", show $ untagId tid] + GithubDelete ["teams", toPathPart tid] -- | Retrieve team mebership information for a user. -- | With authentication @@ -129,7 +129,7 @@ teamMembershipInfoFor' auth tid user = -- See Name GithubOwner -> GithubRequest k TeamMembership teamMembershipInfoForR tid user = - GithubGet ["teams", show $ untagId tid, "memberships", untagName user] [] + GithubGet ["teams", toPathPart tid, "memberships", toPathPart user] [] -- | Retrieve team mebership information for a user. -- @@ -148,7 +148,7 @@ addTeamMembershipFor' auth tid user role = -- See addTeamMembershipForR :: Id Team -> Name GithubOwner -> Role -> GithubRequest 'True TeamMembership addTeamMembershipForR tid user role = - GithubPost Put ["teams", show $ untagId tid, "memberships", untagName user] (encode $ CreateTeamMembership role) + GithubPost Put ["teams", toPathPart tid, "memberships", toPathPart user] (encode $ CreateTeamMembership role) -- | Delete a member of a team. -- @@ -161,7 +161,7 @@ deleteTeamMembershipFor' auth tid user = -- See deleteTeamMembershipForR :: Id Team -> Name GithubOwner -> GithubRequest 'True () deleteTeamMembershipForR tid user = - GithubDelete ["teams", show $ untagId tid, "memberships", untagName user] + GithubDelete ["teams", toPathPart tid, "memberships", toPathPart user] -- | List teams for current authenticated user -- diff --git a/Github/PullRequests.hs b/Github/PullRequests.hs index 27e73b85..be78956e 100644 --- a/Github/PullRequests.hs +++ b/Github/PullRequests.hs @@ -68,7 +68,7 @@ pullRequestsForR :: Name GithubOwner -> Name Repo -> Maybe Count -> GithubRequest k (Vector SimplePullRequest) pullRequestsForR user repo state = - GithubPagedGet ["repos", untagName user, untagName repo, "pulls"] qs + GithubPagedGet ["repos", toPathPart user, toPathPart repo, "pulls"] qs where qs = maybe [] (\s -> [("state", Just . BS8.pack $ s)]) state @@ -92,7 +92,7 @@ pullRequest = pullRequest' Nothing -- See pullRequestR :: Name GithubOwner -> Name Repo -> Id PullRequest -> GithubRequest k PullRequest pullRequestR user repo prid = - GithubGet ["repos", untagName user, untagName repo, "pulls", show $ untagId prid] [] + GithubGet ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid] [] createPullRequest :: GithubAuth -> Name GithubOwner @@ -109,7 +109,7 @@ createPullRequestR :: Name GithubOwner -> CreatePullRequest -> GithubRequest 'True PullRequest createPullRequestR user repo cpr = - GithubPost Post ["repos", untagName user, untagName repo, "pulls"] (encode cpr) + GithubPost Post ["repos", toPathPart user, toPathPart repo, "pulls"] (encode cpr) -- | Update a pull request updatePullRequest :: GithubAuth -> Name GithubOwner -> Name Repo -> Id PullRequest -> EditPullRequest -> IO (Either Error PullRequest) @@ -124,7 +124,7 @@ updatePullRequestR :: Name GithubOwner -> EditPullRequest -> GithubRequest 'True PullRequest updatePullRequestR user repo prid epr = - GithubPost Patch ["repos", untagName user, untagName repo, "pulls", show $ untagId prid] (encode epr) + GithubPost Patch ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid] (encode epr) -- | All the commits on a pull request, given the repo owner, repo name, and -- the number of the pull request. @@ -146,7 +146,7 @@ pullRequestCommitsIO = pullRequestCommits' Nothing -- See pullRequestCommitsR :: Name GithubOwner -> Name Repo -> Id PullRequest -> Maybe Count -> GithubRequest k (Vector Commit) pullRequestCommitsR user repo prid = - GithubPagedGet ["repos", untagName user, untagName repo, "pulls", show $ untagId prid, "commits"] [] + GithubPagedGet ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "commits"] [] -- | The individual files that a pull request patches. Takes the repo owner and -- name, plus the number assigned to the pull request. @@ -168,7 +168,7 @@ pullRequestFiles = pullRequestFiles' Nothing -- See pullRequestFilesR :: Name GithubOwner -> Name Repo -> Id PullRequest -> Maybe Count -> GithubRequest k (Vector File) pullRequestFilesR user repo prid = - GithubPagedGet ["repos", untagName user, untagName repo, "pulls", show $ untagId prid, "files"] [] + GithubPagedGet ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "files"] [] -- | Check if pull request has been merged. isPullRequestMerged :: GithubAuth -> Name GithubOwner -> Name Repo -> Id PullRequest -> IO (Either Error Status) @@ -179,7 +179,7 @@ isPullRequestMerged auth user repo prid = -- See isPullRequestMergedR :: Name GithubOwner -> Name Repo -> Id PullRequest -> GithubRequest k Status isPullRequestMergedR user repo prid = GithubStatus $ - GithubGet ["repos", untagName user, untagName repo, "pulls", show $ untagId prid, "merge"] [] + GithubGet ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "merge"] [] -- | Merge a pull request. mergePullRequest :: GithubAuth -> Name GithubOwner -> Name Repo -> Id PullRequest -> Maybe String -> IO (Either Error Status) @@ -192,7 +192,7 @@ mergePullRequestR :: Name GithubOwner -> Name Repo -> Id PullRequest -> Maybe St mergePullRequestR user repo prid commitMessage = GithubStatus $ GithubPost Put paths (encode $ buildCommitMessageMap commitMessage) where - paths = ["repos", untagName user, untagName repo, "pulls", show $ untagId prid, "merge"] + paths = ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "merge"] buildCommitMessageMap :: Maybe String -> Value buildCommitMessageMap (Just msg) = object ["commit_message" .= msg ] diff --git a/Github/PullRequests/ReviewComments.hs b/Github/PullRequests/ReviewComments.hs index 391e1aa5..54e97112 100644 --- a/Github/PullRequests/ReviewComments.hs +++ b/Github/PullRequests/ReviewComments.hs @@ -23,7 +23,7 @@ pullRequestReviewCommentsIO user repo prid = -- See pullRequestReviewCommentsR :: Name GithubOwner -> Name Repo -> Id PullRequest -> Maybe Count -> GithubRequest k (Vector Comment) pullRequestReviewCommentsR user repo prid = - GithubPagedGet ["repos", untagName user, untagName repo, "pulls", show $ untagId prid, "comments"] [] + GithubPagedGet ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "comments"] [] -- | One comment on a pull request, by the comment's ID. -- @@ -36,4 +36,4 @@ pullRequestReviewComment user repo cid = -- See 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] [] + GithubGet ["repos", toPathPart user, toPathPart repo, "pulls", "comments", toPathPart cid] [] diff --git a/Github/Repos.hs b/Github/Repos.hs index 8326ad1d..01ad8f7d 100644 --- a/Github/Repos.hs +++ b/Github/Repos.hs @@ -88,7 +88,7 @@ userRepos' auth user publicity = -- See userReposR :: Name GithubOwner -> RepoPublicity -> Maybe Count -> GithubRequest k(Vector Repo) userReposR user publicity = - GithubPagedGet ["users", untagName user, "repos"] qs + GithubPagedGet ["users", toPathPart user, "repos"] qs where qs = repoPublicityQueryString publicity @@ -110,7 +110,7 @@ organizationRepos' auth org publicity = -- See organizationReposR :: Name Organization -> RepoPublicity -> Maybe Count -> GithubRequest k (Vector Repo) organizationReposR org publicity = - GithubPagedGet ["orgs", untagName org, "repos"] qs + GithubPagedGet ["orgs", toPathPart org, "repos"] qs where qs = repoPublicityQueryString publicity @@ -132,7 +132,7 @@ repository' auth user repo = -- See repositoryR :: Name GithubOwner -> Name Repo -> GithubRequest k Repo repositoryR user repo = - GithubGet ["repos", untagName user, untagName repo] [] + GithubGet ["repos", toPathPart user, toPathPart repo] [] -- | Create a new repository. -- @@ -158,7 +158,7 @@ createOrganizationRepo' auth org nrepo = -- See createOrganizationRepoR :: Name Organization -> NewRepo -> GithubRequest 'True Repo createOrganizationRepoR org nrepo = - GithubPost Post ["orgs", untagName org, "repos"] (encode nrepo) + GithubPost Post ["orgs", toPathPart org, "repos"] (encode nrepo) -- | Edit an existing repository. -- @@ -176,7 +176,7 @@ editRepo auth user repo body = -- See editRepoR :: Name GithubOwner -> Name Repo -> EditRepo -> GithubRequest 'True Repo editRepoR user repo body = - GithubPost Patch ["repos", untagName user, untagName repo] (encode b) + GithubPost Patch ["repos", toPathPart user, toPathPart repo] (encode b) where -- if no name is given, use curent name b = body {editName = editName body <|> Just repo} @@ -203,7 +203,7 @@ contributorsR :: Name GithubOwner -> Maybe Count -> GithubRequest k (Vector Contributor) contributorsR user repo anon = - GithubPagedGet ["repos", untagName user, untagName repo, "contributors"] qs + GithubPagedGet ["repos", toPathPart user, toPathPart repo, "contributors"] qs where qs | anon = [("anon", Just "true")] | otherwise = [] @@ -246,7 +246,7 @@ languagesFor' auth user repo = -- See languagesForR :: Name GithubOwner -> Name Repo -> GithubRequest k Languages languagesForR user repo = - GithubGet ["repos", untagName user, untagName repo, "languages"] [] + GithubGet ["repos", toPathPart user, toPathPart repo, "languages"] [] -- | The git tags on a repo, given the repo owner and name. -- @@ -266,7 +266,7 @@ tagsFor' auth user repo = -- See tagsForR :: Name GithubOwner -> Name Repo -> Maybe Count -> GithubRequest k (Vector Tag) tagsForR user repo = - GithubPagedGet ["repos", untagName user, untagName repo, "tags"] [] + GithubPagedGet ["repos", toPathPart user, toPathPart repo, "tags"] [] -- | The git branches on a repo, given the repo owner and name. -- @@ -286,7 +286,7 @@ branchesFor' auth user repo = -- See branchesForR :: Name GithubOwner -> Name Repo -> Maybe Count -> GithubRequest k (Vector Branch) branchesForR user repo = - GithubPagedGet ["repos", untagName user, untagName repo, "branches"] [] + GithubPagedGet ["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 -- @@ -308,7 +308,7 @@ contentsForR :: Name GithubOwner -> Maybe String -- ^ Git commit -> GithubRequest k Content contentsForR user repo path ref = - GithubGet ["repos", untagName user, untagName repo, "contents", path] qs + GithubGet ["repos", toPathPart user, toPathPart repo, "contents", path] qs where qs = maybe [] (\r -> [("ref", Just . BS8.pack $ r)]) ref @@ -328,7 +328,7 @@ readmeFor' auth user repo = readmeForR :: Name GithubOwner -> Name Repo -> GithubRequest k Content readmeForR user repo = - GithubGet ["repos", untagName user, untagName repo, "readme"] [] + GithubGet ["repos", toPathPart user, toPathPart repo, "readme"] [] -- | Delete an existing repository. -- @@ -339,4 +339,4 @@ deleteRepo auth user repo = deleteRepoR :: Name GithubOwner -> Name Repo -> GithubRequest 'True () deleteRepoR user repo = - GithubDelete ["repos", untagName user, untagName repo] + GithubDelete ["repos", toPathPart user, toPathPart repo] diff --git a/Github/Repos/Collaborators.hs b/Github/Repos/Collaborators.hs index e35f2471..0f20f673 100644 --- a/Github/Repos/Collaborators.hs +++ b/Github/Repos/Collaborators.hs @@ -31,7 +31,7 @@ collaboratorsOn' auth user repo = -- See collaboratorsOnR :: Name GithubOwner -> Name Repo -> Maybe Count -> GithubRequest k (Vector GithubOwner) collaboratorsOnR user repo = - GithubPagedGet ["repos", untagName user, untagName repo, "collaborators"] [] + GithubPagedGet ["repos", toPathPart user, toPathPart repo, "collaborators"] [] -- | Whether the user is collaborating on a repo. Takes the user in question, -- the user who owns the repo, and the repo name. @@ -55,4 +55,4 @@ isCollaboratorOnR :: Name GithubOwner -- ^ Repository owner -> Name GithubOwner -- ^ Collaborator? -> GithubRequest k Status isCollaboratorOnR user repo coll = GithubStatus $ - GithubGet ["repos", untagName user, untagName repo, "collaborators", untagName coll] [] + GithubGet ["repos", toPathPart user, toPathPart repo, "collaborators", toPathPart coll] [] diff --git a/Github/Repos/Comments.hs b/Github/Repos/Comments.hs index d09252cf..803f6a45 100644 --- a/Github/Repos/Comments.hs +++ b/Github/Repos/Comments.hs @@ -38,7 +38,7 @@ commentsFor' auth user repo = -- See commentsForR :: Name GithubOwner -> Name Repo -> Maybe Count -> GithubRequest k (Vector Comment) commentsForR user repo = - GithubPagedGet ["repos", untagName user, untagName repo, "comments"] [] + GithubPagedGet ["repos", toPathPart user, toPathPart repo, "comments"] [] -- | Just the comments on a specific SHA for a given Github repo. -- @@ -58,7 +58,7 @@ commitCommentsFor' auth user repo sha = -- See commitCommentsForR :: Name GithubOwner -> Name Repo -> Name Commit -> Maybe Count -> GithubRequest k (Vector Comment) commitCommentsForR user repo sha = - GithubPagedGet ["repos", untagName user, untagName repo, "commits", untagName sha, "comments"] [] + GithubPagedGet ["repos", toPathPart user, toPathPart repo, "commits", toPathPart sha, "comments"] [] -- | A comment, by its ID, relative to the Github repo. -- @@ -77,4 +77,4 @@ commitCommentFor' auth user repo cid = -- See commitCommentForR :: Name GithubOwner -> Name Repo -> Id Comment -> GithubRequest k Comment commitCommentForR user repo cid = - GithubGet ["repos", untagName user, untagName repo, "comments", show $ untagId cid] [] + GithubGet ["repos", toPathPart user, toPathPart repo, "comments", toPathPart cid] [] diff --git a/Github/Repos/Commits.hs b/Github/Repos/Commits.hs index 9c9ce017..18abbeb7 100644 --- a/Github/Repos/Commits.hs +++ b/Github/Repos/Commits.hs @@ -73,7 +73,7 @@ commitsWithOptionsFor' auth user repo opts = -- See commitsWithOptionsForR :: Name GithubOwner -> Name Repo -> Maybe Count -> [CommitQueryOption] -> GithubRequest k (Vector Commit) commitsWithOptionsForR user repo limit opts = - GithubPagedGet ["repos", untagName user, untagName repo, "commits"] qs limit + GithubPagedGet ["repos", toPathPart user, toPathPart repo, "commits"] qs limit where qs = map renderCommitQueryOption opts @@ -96,7 +96,7 @@ commit' auth user repo sha = -- See commitR :: Name GithubOwner -> Name Repo -> Name Commit -> GithubRequest k Commit commitR user repo sha = - GithubGet ["repos", untagName user, untagName repo, "commits", untagName sha] [] + GithubGet ["repos", toPathPart user, toPathPart repo, "commits", toPathPart sha] [] -- | The diff between two treeishes on a repo. -- @@ -115,4 +115,4 @@ diff' auth user repo base headref = -- See diffR :: Name GithubOwner -> Name Repo -> Name Commit -> Name Commit -> GithubRequest k Diff diffR user repo base headref = - GithubGet ["repos", untagName user, untagName repo, "compare", untagName base ++ "..." ++ untagName headref] [] + GithubGet ["repos", toPathPart user, toPathPart repo, "compare", toPathPart base ++ "..." ++ toPathPart headref] [] diff --git a/Github/Repos/Forks.hs b/Github/Repos/Forks.hs index fea2df29..5e0896e6 100644 --- a/Github/Repos/Forks.hs +++ b/Github/Repos/Forks.hs @@ -30,4 +30,4 @@ forksFor' auth user repo = -- See forksForR :: Name GithubOwner -> Name Repo -> Maybe Count -> GithubRequest k (Vector Repo) forksForR user repo = - GithubPagedGet ["repos", untagName user, untagName repo, "forks"] [] + GithubPagedGet ["repos", toPathPart user, toPathPart repo, "forks"] [] diff --git a/Github/Repos/Webhooks.hs b/Github/Repos/Webhooks.hs index ca8a99e8..042ae370 100644 --- a/Github/Repos/Webhooks.hs +++ b/Github/Repos/Webhooks.hs @@ -45,7 +45,7 @@ webhooksFor' auth user repo = -- See webhooksForR :: Name GithubOwner -> Name Repo -> Maybe Count -> GithubRequest k (Vector RepoWebhook) webhooksForR user repo = - GithubPagedGet ["repos", untagName user, untagName repo, "hooks"] [] + GithubPagedGet ["repos", toPathPart user, toPathPart repo, "hooks"] [] webhookFor' :: GithubAuth -> Name GithubOwner -> Name Repo -> Id RepoWebhook -> IO (Either Error RepoWebhook) webhookFor' auth user repo hookId = @@ -55,7 +55,7 @@ webhookFor' auth user repo hookId = -- See webhookForR :: Name GithubOwner -> Name Repo -> Id RepoWebhook -> GithubRequest k RepoWebhook webhookForR user repo hookId = - GithubGet ["repos", untagName user, untagName repo, "hooks", show $ untagId hookId] [] + GithubGet ["repos", toPathPart user, toPathPart repo, "hooks", toPathPart hookId] [] createRepoWebhook' :: GithubAuth -> Name GithubOwner -> Name Repo -> NewRepoWebhook -> IO (Either Error RepoWebhook) createRepoWebhook' auth user repo hook = @@ -65,7 +65,7 @@ createRepoWebhook' auth user repo hook = -- See createRepoWebhookR :: Name GithubOwner -> Name Repo -> NewRepoWebhook -> GithubRequest 'True RepoWebhook createRepoWebhookR user repo hook = - GithubPost Post ["repos", untagName user, untagName repo, "hooks"] (encode hook) + GithubPost Post ["repos", toPathPart user, toPathPart repo, "hooks"] (encode hook) editRepoWebhook' :: GithubAuth -> Name GithubOwner -> Name Repo -> Id RepoWebhook -> EditRepoWebhook -> IO (Either Error RepoWebhook) editRepoWebhook' auth user repo hookId hookEdit = @@ -75,7 +75,7 @@ editRepoWebhook' auth user repo hookId hookEdit = -- See editRepoWebhookR :: Name GithubOwner -> Name Repo -> Id RepoWebhook -> EditRepoWebhook -> GithubRequest 'True RepoWebhook editRepoWebhookR user repo hookId hookEdit = - GithubPost Patch ["repos", untagName user, untagName repo, "hooks", show $ untagId hookId] (encode hookEdit) + GithubPost Patch ["repos", toPathPart user, toPathPart repo, "hooks", toPathPart hookId] (encode hookEdit) testPushRepoWebhook' :: GithubAuth -> Name GithubOwner -> Name Repo -> Id RepoWebhook -> IO (Either Error Status) testPushRepoWebhook' auth user repo hookId = @@ -109,7 +109,7 @@ deleteRepoWebhookR user repo hookId = createBaseWebhookPath :: Name GithubOwner -> Name Repo -> Id RepoWebhook -> [String] createBaseWebhookPath user repo hookId = - ["repos", untagName user, untagName repo, "hooks", show $ untagId hookId] + ["repos", toPathPart user, toPathPart repo, "hooks", toPathPart hookId] createWebhookOpPath :: Name GithubOwner -> Name Repo -> Id RepoWebhook -> Maybe String -> [String] createWebhookOpPath owner reqName webhookId Nothing = createBaseWebhookPath owner reqName webhookId diff --git a/Github/Users.hs b/Github/Users.hs index b1bd0e1a..49f667a6 100644 --- a/Github/Users.hs +++ b/Github/Users.hs @@ -30,7 +30,7 @@ userInfoFor = executeRequest' . userInfoForR -- | Get a single user. -- See userInfoForR :: Name GithubOwner -> GithubRequest k GithubOwner -userInfoForR userName = GithubGet ["users", untagName userName] [] +userInfoForR userName = GithubGet ["users", toPathPart userName] [] -- | Retrieve information about the user associated with the supplied authentication. -- diff --git a/Github/Users/Followers.hs b/Github/Users/Followers.hs index 09887ad1..4fe475b7 100644 --- a/Github/Users/Followers.hs +++ b/Github/Users/Followers.hs @@ -22,7 +22,7 @@ usersFollowing user = -- | List followers of a user. -- See usersFollowingR :: Name GithubOwner -> Maybe Count -> GithubRequest k (Vector SimpleOwner) -usersFollowingR userName = GithubPagedGet ["users", untagName userName, "followers"] [] +usersFollowingR userName = GithubPagedGet ["users", toPathPart userName, "followers"] [] -- | All the users that the given user follows. -- @@ -34,4 +34,4 @@ usersFollowedBy user = -- | List users followed by another user. -- See usersFollowedByR :: Name GithubOwner -> Maybe Count -> GithubRequest k (Vector SimpleOwner) -usersFollowedByR userName = GithubPagedGet ["users", untagName userName, "following"] [] +usersFollowedByR userName = GithubPagedGet ["users", toPathPart userName, "following"] [] diff --git a/samples/Users/ShowUser.hs b/samples/Users/ShowUser.hs index a33b805c..6354e70b 100644 --- a/samples/Users/ShowUser.hs +++ b/samples/Users/ShowUser.hs @@ -1,52 +1,73 @@ -module ShowUser where +{-# LANGUAGE OverloadedStrings #-} +module Main (main) where +import Prelude () +import Prelude.Compat + +import Data.Maybe (fromMaybe) +import Data.Monoid ((<>)) +import Data.Text (Text) +import System.Environment (lookupEnv) + +import qualified Data.Text as T +import qualified Data.Text.IO as T import qualified Github.Users as Github -import Data.Maybe (fromMaybe) +getAuth :: IO (Maybe (Github.GithubAuth)) +getAuth = do + token <- lookupEnv "GITHUB_TOKEN" + pure (Github.GithubOAuth <$> token) + +main :: IO () main = do - possibleUser <- Github.userInfoFor "mike-burns" - putStrLn $ either (("Error: "++) . show) formatUser possibleUser - -formatUser user@(Github.DetailedOrganization {}) = - "Organization: " ++ (formatName userName login) ++ "\t" ++ - (fromMaybe "" company) ++ "\t" ++ - (fromMaybe "" location) ++ "\n" ++ - (fromMaybe "" blog) ++ "\t" ++ "\n" ++ - htmlUrl ++ "\t" ++ (formatDate createdAt) ++ "\n\n" ++ + auth <- getAuth + possibleUser <- Github.userInfoFor' auth "mike-burns" + T.putStrLn $ either (("Error: " <>) . tshow) formatUser possibleUser + +formatUser :: Github.GithubOwner -> Text +formatUser user@(Github.GithubOrganization {}) = + "Organization: " <> (formatName userName login) <> "\t" <> + (fromMaybe "" company) <> "\t" <> + (fromMaybe "" location) <> "\n" <> + (fromMaybe "" blog) <> "\t" <> "\n" <> + htmlUrl <> "\t" <> tshow createdAt <> "\n\n" <> (fromMaybe "" bio) where - userName = Github.detailedOwnerName user - login = Github.detailedOwnerLogin user - company = Github.detailedOwnerCompany user - location = Github.detailedOwnerLocation user - blog = Github.detailedOwnerBlog user - htmlUrl = Github.detailedOwnerHtmlUrl user - createdAt = Github.detailedOwnerCreatedAt user - bio = Github.detailedOwnerBio user - -formatUser user@(Github.DetailedUser {}) = - (formatName userName login) ++ "\t" ++ (fromMaybe "" company) ++ "\t" ++ - (fromMaybe "" location) ++ "\n" ++ - (fromMaybe "" blog) ++ "\t" ++ "<" ++ (fromMaybe "" email) ++ ">" ++ "\n" ++ - htmlUrl ++ "\t" ++ (formatDate createdAt) ++ "\n" ++ - "hireable: " ++ (formatHireable (fromMaybe False isHireable)) ++ "\n\n" ++ + userName = Github.githubOwnerName user + login = Github.githubOwnerLogin user + company = Github.githubOwnerCompany user + location = Github.githubOwnerLocation user + blog = Github.githubOwnerBlog user + htmlUrl = Github.githubOwnerHtmlUrl user + createdAt = Github.githubOwnerCreatedAt user + bio = Github.githubOwnerBio user + +formatUser user@(Github.GithubUser {}) = + (formatName userName login) <> "\t" <> (fromMaybe "" company) <> "\t" <> + (fromMaybe "" location) <> "\n" <> + (fromMaybe "" blog) <> "\t" <> "<" <> (fromMaybe "" email) <> ">" <> "\n" <> + htmlUrl <> "\t" <> tshow createdAt <> "\n" <> + "hireable: " <> formatHireable (fromMaybe False isHireable) <> "\n\n" <> (fromMaybe "" bio) where - userName = Github.detailedOwnerName user - login = Github.detailedOwnerLogin user - company = Github.detailedOwnerCompany user - location = Github.detailedOwnerLocation user - blog = Github.detailedOwnerBlog user - email = Github.detailedOwnerEmail user - htmlUrl = Github.detailedOwnerHtmlUrl user - createdAt = Github.detailedOwnerCreatedAt user - isHireable = Github.detailedOwnerHireable user - bio = Github.detailedOwnerBio user - -formatName Nothing login = login -formatName (Just name) login = name ++ "(" ++ login ++ ")" + userName = Github.githubOwnerName user + login = Github.githubOwnerLogin user + company = Github.githubOwnerCompany user + location = Github.githubOwnerLocation user + blog = Github.githubOwnerBlog user + email = Github.githubOwnerEmail user + htmlUrl = Github.githubOwnerHtmlUrl user + createdAt = Github.githubOwnerCreatedAt user + isHireable = Github.githubOwnerHireable user + bio = Github.githubOwnerBio user + +formatName :: Maybe Text -> Github.Name Github.GithubOwner -> Text +formatName Nothing login = Github.untagName login +formatName (Just name) login = name <> "(" <> Github.untagName login <> ")" +formatHireable :: Bool -> Text formatHireable True = "yes" formatHireable False = "no" -formatDate = show . Github.fromGithubDate +tshow :: Show a => a -> Text +tshow = T.pack . show diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal new file mode 100644 index 00000000..8aa8e398 --- /dev/null +++ b/samples/github-samples.cabal @@ -0,0 +1,23 @@ +-- This file has been generated from package.yaml by hpack version 0.8.0. +-- +-- see: https://github.com/sol/hpack + +name: github-samples +version: 0.0.0 +build-type: Simple +cabal-version: >= 1.10 + +executable github-show-user + main-is: ShowUser.hs + hs-source-dirs: + Users + ghc-options: -Wall + build-depends: + base + , base-compat + , github + , text + other-modules: + Followers.ListFollowers + Followers.ListFollowing + default-language: Haskell2010 diff --git a/samples/package.yaml b/samples/package.yaml new file mode 100644 index 00000000..6dc46fce --- /dev/null +++ b/samples/package.yaml @@ -0,0 +1,15 @@ +name: github-samples + +ghc-options: -Wall + +dependencies: + - base + - base-compat + - github + - text + +executables: + github-show-user: + main: ShowUser.hs + source-dirs: Users + diff --git a/stack-lts-2.yaml b/stack-lts-2.yaml index 636aa05a..1c12f17b 100644 --- a/stack-lts-2.yaml +++ b/stack-lts-2.yaml @@ -1,5 +1,6 @@ packages: - '.' +- 'samples/' extra-deps: - aeson-extra-0.2.3.0 - http-link-header-1.0.1 diff --git a/stack-lts-3.yaml b/stack-lts-3.yaml index 6e2f2657..539d43cb 100644 --- a/stack-lts-3.yaml +++ b/stack-lts-3.yaml @@ -1,5 +1,6 @@ packages: - '.' +- 'samples/' extra-deps: - http-link-header-1.0.1 - iso8601-time-0.1.4 diff --git a/stack-lts-4.yaml b/stack-lts-4.yaml index d4812958..c6c28f11 100644 --- a/stack-lts-4.yaml +++ b/stack-lts-4.yaml @@ -1,5 +1,6 @@ packages: - '.' +- 'samples/' extra-deps: [] resolver: lts-4.0 flags: diff --git a/stack-nightly.yaml b/stack-nightly.yaml index f2717c47..04e05058 100644 --- a/stack-nightly.yaml +++ b/stack-nightly.yaml @@ -1,6 +1,7 @@ resolver: nightly-2016-01-08 packages: - '.' +- 'samples/' extra-deps: [] flags: github: diff --git a/travis-script.sh b/travis-script.sh index d8b86796..341d4afd 100644 --- a/travis-script.sh +++ b/travis-script.sh @@ -1,6 +1,8 @@ case $BUILD in stack) - stack --no-terminal test + stack --no-terminal test github + stack --no-terminal build github-samples + stack exec github-show-user ;; cabal) if [ -f configure.ac ]; then autoreconf -i; fi From a415448e6db453aeb27f4cb21c697745dc9ab6b1 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 11 Jan 2016 00:57:00 +0200 Subject: [PATCH 140/510] Fix Users/Follow* --- samples/Users/Followers/ListFollowers.hs | 21 +++++++---- samples/Users/Followers/ListFollowing.hs | 21 +++++++---- samples/Users/ShowUser.hs | 21 +++-------- samples/github-samples.cabal | 44 ++++++++++++++++++++++++ samples/package.yaml | 16 ++++++++- samples/src/Common.hs | 29 ++++++++++++++++ travis-install.sh | 2 ++ travis-script.sh | 5 +++ 8 files changed, 127 insertions(+), 32 deletions(-) create mode 100644 samples/src/Common.hs diff --git a/samples/Users/Followers/ListFollowers.hs b/samples/Users/Followers/ListFollowers.hs index b8a3a6d4..a83073a3 100644 --- a/samples/Users/Followers/ListFollowers.hs +++ b/samples/Users/Followers/ListFollowers.hs @@ -1,12 +1,19 @@ -module ListFollowers where +{-# LANGUAGE OverloadedStrings #-} +module Main (main) where +import Common +import Prelude () + +import qualified Github.Request as Github import qualified Github.Users.Followers as Github -import Data.List (intercalate) +main :: IO () main = do - possibleUsers <- Github.usersFollowing "mike-burns" - putStrLn $ either (("Error: "++) . show) - (intercalate "\n" . map formatUser) - possibleUsers + auth <- getAuth + possibleUsers <- Github.executeRequestMaybe auth $ Github.usersFollowingR "mike-burns" Nothing + putStrLn $ either (("Error: " <>) . tshow) + (foldMap ((<> "\n") . formatUser)) + possibleUsers -formatUser = Github.githubOwnerLogin +formatUser :: Github.SimpleOwner -> Text +formatUser = Github.untagName . Github.simpleOwnerLogin diff --git a/samples/Users/Followers/ListFollowing.hs b/samples/Users/Followers/ListFollowing.hs index 62c6c2dd..7a509dd2 100644 --- a/samples/Users/Followers/ListFollowing.hs +++ b/samples/Users/Followers/ListFollowing.hs @@ -1,13 +1,20 @@ -module ListFollowing where +{-# LANGUAGE OverloadedStrings #-} +module Main (main) where +import Common +import Prelude () + +import qualified Github.Request as Github import qualified Github.Users.Followers as Github -import Data.List (intercalate) +main :: IO () main = do - possibleUsers <- Github.usersFollowedBy "mike-burns" - putStrLn $ either (("Error: "++) . show) - (intercalate "\n" . map formatUser) - possibleUsers + auth <- getAuth + possibleUsers <- Github.executeRequestMaybe auth $ Github.usersFollowedByR "mike-burns" Nothing + putStrLn $ either (("Error: " <>) . tshow) + (foldMap ((<> "\n") . formatUser)) + possibleUsers -formatUser = Github.githubOwnerLogin +formatUser :: Github.SimpleOwner -> Text +formatUser = Github.untagName . Github.simpleOwnerLogin diff --git a/samples/Users/ShowUser.hs b/samples/Users/ShowUser.hs index 6354e70b..0ba94a10 100644 --- a/samples/Users/ShowUser.hs +++ b/samples/Users/ShowUser.hs @@ -1,28 +1,18 @@ {-# LANGUAGE OverloadedStrings #-} module Main (main) where -import Prelude () -import Prelude.Compat +import Common +import Prelude () -import Data.Maybe (fromMaybe) -import Data.Monoid ((<>)) -import Data.Text (Text) -import System.Environment (lookupEnv) +import Data.Maybe (fromMaybe) -import qualified Data.Text as T -import qualified Data.Text.IO as T import qualified Github.Users as Github -getAuth :: IO (Maybe (Github.GithubAuth)) -getAuth = do - token <- lookupEnv "GITHUB_TOKEN" - pure (Github.GithubOAuth <$> token) - main :: IO () main = do auth <- getAuth possibleUser <- Github.userInfoFor' auth "mike-burns" - T.putStrLn $ either (("Error: " <>) . tshow) formatUser possibleUser + putStrLn $ either (("Error: " <>) . tshow) formatUser possibleUser formatUser :: Github.GithubOwner -> Text formatUser user@(Github.GithubOrganization {}) = @@ -68,6 +58,3 @@ formatName (Just name) login = name <> "(" <> Github.untagName login <> ")" formatHireable :: Bool -> Text formatHireable True = "yes" formatHireable False = "no" - -tshow :: Show a => a -> Text -tshow = T.pack . show diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index 8aa8e398..d9551e00 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -7,6 +7,19 @@ version: 0.0.0 build-type: Simple cabal-version: >= 1.10 +library + hs-source-dirs: + src + ghc-options: -Wall + build-depends: + base + , base-compat + , github + , text + exposed-modules: + Common + default-language: Haskell2010 + executable github-show-user main-is: ShowUser.hs hs-source-dirs: @@ -17,7 +30,38 @@ executable github-show-user , base-compat , github , text + , github-samples other-modules: Followers.ListFollowers Followers.ListFollowing default-language: Haskell2010 + +executable github-list-following + main-is: ListFollowing.hs + hs-source-dirs: + Users/Followers + ghc-options: -Wall + build-depends: + base + , base-compat + , github + , text + , github-samples + other-modules: + ListFollowers + default-language: Haskell2010 + +executable github-list-followers + main-is: ListFollowers.hs + hs-source-dirs: + Users/Followers + ghc-options: -Wall + build-depends: + base + , base-compat + , github + , text + , github-samples + other-modules: + ListFollowing + default-language: Haskell2010 diff --git a/samples/package.yaml b/samples/package.yaml index 6dc46fce..b4eefbd0 100644 --- a/samples/package.yaml +++ b/samples/package.yaml @@ -8,8 +8,22 @@ dependencies: - github - text +library: + source-dirs: src + executables: github-show-user: main: ShowUser.hs source-dirs: Users - + dependencies: + - github-samples + github-list-followers: + main: ListFollowers.hs + source-dirs: Users/Followers + dependencies: + - github-samples + github-list-following: + main: ListFollowing.hs + source-dirs: Users/Followers + dependencies: + - github-samples \ No newline at end of file diff --git a/samples/src/Common.hs b/samples/src/Common.hs new file mode 100644 index 00000000..d8adf7b6 --- /dev/null +++ b/samples/src/Common.hs @@ -0,0 +1,29 @@ +module Common ( + -- * Common stuff + getAuth, + tshow, + -- * Re-exports + (<>), + Text, + putStrLn, + module Prelude.Compat, + ) where + +import Prelude () +import Prelude.Compat hiding (putStrLn) + +import Data.Monoid ((<>)) +import Data.Text (Text) +import Data.Text.IO (putStrLn) +import System.Environment (lookupEnv) + +import qualified Data.Text as T +import qualified Github.Data as Github + +getAuth :: IO (Maybe (Github.GithubAuth)) +getAuth = do + token <- lookupEnv "GITHUB_TOKEN" + pure (Github.GithubOAuth <$> token) + +tshow :: Show a => a -> Text +tshow = T.pack . show diff --git a/travis-install.sh b/travis-install.sh index c060dbb7..d973e6c7 100644 --- a/travis-install.sh +++ b/travis-install.sh @@ -1,3 +1,5 @@ +set -e + case $BUILD in stack) mkdir -p ~/.local/bin; diff --git a/travis-script.sh b/travis-script.sh index 341d4afd..e801f556 100644 --- a/travis-script.sh +++ b/travis-script.sh @@ -1,8 +1,13 @@ +set -e + case $BUILD in stack) stack --no-terminal test github stack --no-terminal build github-samples + # TODO: automatise this stack exec github-show-user + stack exec github-list-followers + stack exec github-list-following ;; cabal) if [ -f configure.ac ]; then autoreconf -i; fi From 36a6c079a1ac54732eccefaa2b86417b02c148cf Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 11 Jan 2016 01:48:11 +0200 Subject: [PATCH 141/510] Samples run script --- travis-script.sh | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/travis-script.sh b/travis-script.sh index e801f556..f9788d9c 100644 --- a/travis-script.sh +++ b/travis-script.sh @@ -4,10 +4,12 @@ case $BUILD in stack) stack --no-terminal test github stack --no-terminal build github-samples - # TODO: automatise this - stack exec github-show-user - stack exec github-list-followers - stack exec github-list-following + + # TODO: get executables from info + for testbin in show-user list-followers list-following; do + echo "Running " $testbin + stack exec github-$testbin + done ;; cabal) if [ -f configure.ac ]; then autoreconf -i; fi From 3153383ef58554a2ac8f0a14ed0dc495f3e30737 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 11 Jan 2016 01:59:14 +0200 Subject: [PATCH 142/510] Add teams samples --- samples/Teams/DeleteTeam.hs | 13 ++--- samples/Teams/EditTeam.hs | 15 +++--- samples/Teams/ListTeamsCurrent.hs | 13 ++--- samples/Teams/TeamInfoFor.hs | 13 ++--- samples/github-samples.cabal | 80 +++++++++++++++++++++++++++++++ samples/package.yaml | 22 ++++++++- samples/src/Common.hs | 6 +++ 7 files changed, 136 insertions(+), 26 deletions(-) diff --git a/samples/Teams/DeleteTeam.hs b/samples/Teams/DeleteTeam.hs index c619b5c9..8a0457e4 100644 --- a/samples/Teams/DeleteTeam.hs +++ b/samples/Teams/DeleteTeam.hs @@ -1,16 +1,17 @@ {-# LANGUAGE OverloadedStrings #-} +module Main (main) where -module DeleteTeam where +import Common +import Prelude () -import qualified Github.Auth as Github -import qualified Github.Teams as Github -import System.Environment (getArgs) +import qualified Github.Organizations.Teams as Github +main :: IO () main = do args <- getArgs result <- case args of [token, team_id] -> Github.deleteTeam' (Github.GithubOAuth token) (read team_id) _ -> error "usage: DeleteTeam " case result of - Left err -> putStrLn $ "Error: " ++ show err - Right team -> putStrLn $ show team + Left err -> putStrLn $ "Error: " <> tshow err + Right team -> putStrLn $ tshow team diff --git a/samples/Teams/EditTeam.hs b/samples/Teams/EditTeam.hs index d6c82319..c1a65803 100644 --- a/samples/Teams/EditTeam.hs +++ b/samples/Teams/EditTeam.hs @@ -1,11 +1,12 @@ {-# LANGUAGE OverloadedStrings #-} +module Main (main) where -module EditTeam where +import Common +import Prelude () -import qualified Github.Auth as Github -import qualified Github.Teams as Github -import System.Environment (getArgs) +import qualified Github.Organizations.Teams as Github +main :: IO () main = do args <- getArgs result <- case args of @@ -13,9 +14,9 @@ main = do Github.editTeam' (Github.GithubOAuth token) (read team_id) - (Github.EditTeam team_name (Just desc) Github.PermissionPull) + (Github.EditTeam (Github.mkName (Proxy :: Proxy Github.Team) $ fromString team_name) (Just $ fromString desc) Github.PermissionPull) _ -> error "usage: EditTeam " case result of - Left err -> putStrLn $ "Error: " ++ show err - Right team -> putStrLn $ show team + Left err -> putStrLn $ "Error: " <> tshow err + Right team -> putStrLn $ tshow team diff --git a/samples/Teams/ListTeamsCurrent.hs b/samples/Teams/ListTeamsCurrent.hs index 75e4aa4a..81e55ad9 100644 --- a/samples/Teams/ListTeamsCurrent.hs +++ b/samples/Teams/ListTeamsCurrent.hs @@ -1,16 +1,17 @@ {-# LANGUAGE OverloadedStrings #-} +module Main (main) where -module ListTeamsCurrent where +import Common +import Prelude () -import qualified Github.Auth as Github -import qualified Github.Teams as Github -import System.Environment (getArgs) +import qualified Github.Organizations.Teams as Github +main :: IO () main = do args <- getArgs result <- case args of [token] -> Github.listTeamsCurrent' (Github.GithubOAuth token) _ -> error "usage: ListTeamsCurrent " case result of - Left err -> putStrLn $ "Error: " ++ show err - Right teams -> mapM_ (putStrLn . show) teams + Left err -> putStrLn $ "Error: " <> tshow err + Right teams -> mapM_ (putStrLn . tshow) teams diff --git a/samples/Teams/TeamInfoFor.hs b/samples/Teams/TeamInfoFor.hs index 9f5fa0c4..dfda8691 100644 --- a/samples/Teams/TeamInfoFor.hs +++ b/samples/Teams/TeamInfoFor.hs @@ -1,11 +1,12 @@ {-# LANGUAGE OverloadedStrings #-} +module Main (main) where -module TeamInfoFor where +import Common +import Prelude () -import qualified Github.Auth as Github -import qualified Github.Teams as Github -import System.Environment (getArgs) +import qualified Github.Organizations.Teams as Github +main :: IO () main = do args <- getArgs result <- case args of @@ -13,5 +14,5 @@ main = do [team_id] -> Github.teamInfoFor (read team_id) _ -> error "usage: TeamInfoFor [auth token]" case result of - Left err -> putStrLn $ "Error: " ++ show err - Right team -> putStrLn $ show team + Left err -> putStrLn $ "Error: " <> tshow err + Right team -> putStrLn $ tshow team diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index d9551e00..244adc4d 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -20,6 +20,26 @@ library Common default-language: Haskell2010 +executable github-edit-team + main-is: EditTeam.hs + hs-source-dirs: + Teams + ghc-options: -Wall + build-depends: + base + , base-compat + , github + , text + , github-samples + other-modules: + DeleteTeam + ListTeamsCurrent + Memberships.AddTeamMembershipFor + Memberships.DeleteTeamMembershipFor + Memberships.TeamMembershipInfoFor + TeamInfoFor + default-language: Haskell2010 + executable github-show-user main-is: ShowUser.hs hs-source-dirs: @@ -65,3 +85,63 @@ executable github-list-followers other-modules: ListFollowing default-language: Haskell2010 + +executable github-list-team-current + main-is: ListTeamsCurrent.hs + hs-source-dirs: + Teams + ghc-options: -Wall + build-depends: + base + , base-compat + , github + , text + , github-samples + other-modules: + DeleteTeam + EditTeam + Memberships.AddTeamMembershipFor + Memberships.DeleteTeamMembershipFor + Memberships.TeamMembershipInfoFor + TeamInfoFor + default-language: Haskell2010 + +executable github-teaminfo-fir + main-is: TeamInfoFor.hs + hs-source-dirs: + Teams + ghc-options: -Wall + build-depends: + base + , base-compat + , github + , text + , github-samples + other-modules: + DeleteTeam + EditTeam + ListTeamsCurrent + Memberships.AddTeamMembershipFor + Memberships.DeleteTeamMembershipFor + Memberships.TeamMembershipInfoFor + default-language: Haskell2010 + +executable github-delete-team + main-is: DeleteTeam.hs + hs-source-dirs: + Teams + ghc-options: -Wall + build-depends: + base + , base-compat + , github + , text + , github-samples + other-modules: + EditTeam + ListTeamsCurrent + Memberships.AddTeamMembershipFor + Memberships.DeleteTeamMembershipFor + Memberships.TeamMembershipInfoFor + TeamInfoFor + default-language: Haskell2010 diff --git a/samples/package.yaml b/samples/package.yaml index b4eefbd0..baca8550 100644 --- a/samples/package.yaml +++ b/samples/package.yaml @@ -26,4 +26,24 @@ executables: main: ListFollowing.hs source-dirs: Users/Followers dependencies: - - github-samples \ No newline at end of file + - github-samples + github-delete-team: + main: DeleteTeam.hs + source-dirs: Teams + dependencies: + - github-samples + github-edit-team: + main: EditTeam.hs + source-dirs: Teams + dependencies: + - github-samples + github-list-team-current: + main: ListTeamsCurrent.hs + source-dirs: Teams + dependencies: + - github-samples + github-teaminfo-fir: + main: TeamInfoFor.hs + source-dirs: Teams + dependencies: + - github-samples diff --git a/samples/src/Common.hs b/samples/src/Common.hs index d8adf7b6..424cf590 100644 --- a/samples/src/Common.hs +++ b/samples/src/Common.hs @@ -4,8 +4,11 @@ module Common ( tshow, -- * Re-exports (<>), + fromString, Text, putStrLn, + getArgs, + Proxy(..), module Prelude.Compat, ) where @@ -13,9 +16,12 @@ import Prelude () import Prelude.Compat hiding (putStrLn) import Data.Monoid ((<>)) +import Data.Proxy (Proxy (..)) +import Data.String (fromString) import Data.Text (Text) import Data.Text.IO (putStrLn) import System.Environment (lookupEnv) +import System.Environment (getArgs) import qualified Data.Text as T import qualified Github.Data as Github From c1e3f2c1975f57de0c1ba9a3f7887d9634869190 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 11 Jan 2016 02:18:04 +0200 Subject: [PATCH 143/510] Add membership samples --- Github/Data.hs | 16 +++++ Github/Data/Id.hs | 2 +- Github/Data/Name.hs | 2 +- samples/Teams/DeleteTeam.hs | 2 +- samples/Teams/EditTeam.hs | 4 +- .../Teams/Memberships/AddTeamMembershipFor.hs | 19 +++--- .../Memberships/DeleteTeamMembershipFor.hs | 18 +++--- .../Memberships/TeamMembershipInfoFor.hs | 17 +++--- samples/Teams/TeamInfoFor.hs | 4 +- samples/github-samples.cabal | 60 +++++++++++++++++-- samples/package.yaml | 17 +++++- 11 files changed, 125 insertions(+), 36 deletions(-) diff --git a/Github/Data.hs b/Github/Data.hs index 57b3e801..d4322dbf 100644 --- a/Github/Data.hs +++ b/Github/Data.hs @@ -26,10 +26,14 @@ module Github.Data ( Name, mkName, untagName, + mkOwnerName, + mkTeamName, -- ** Id Id, mkId, untagId, + mkOwnerId, + mkTeamId, ) where import Prelude () @@ -57,6 +61,18 @@ import Github.Data.Search import Github.Data.Teams import Github.Data.Webhooks +mkOwnerId :: Int -> Id GithubOwner +mkOwnerId = Id + +mkOwnerName :: T.Text -> Name GithubOwner +mkOwnerName = N + +mkTeamId :: Int -> Id Team +mkTeamId = Id + +mkTeamName :: T.Text -> Name Team +mkTeamName = N + instance FromJSON Commit where parseJSON (Object o) = Commit <$> o .: "sha" diff --git a/Github/Data/Id.hs b/Github/Data/Id.hs index 554073c6..ce5b9eb3 100644 --- a/Github/Data/Id.hs +++ b/Github/Data/Id.hs @@ -14,7 +14,7 @@ import GHC.Generics (Generic) -- | Numeric identifier. newtype Id entity = Id Int - deriving (Eq, Ord, Show, Read, Generic, Typeable, Data) + deriving (Eq, Ord, Show, Generic, Typeable, Data) -- | Smart constructor for 'Id'. mkId :: proxy entity -> Int -> Id entity diff --git a/Github/Data/Name.hs b/Github/Data/Name.hs index 94c18740..df8ebb06 100644 --- a/Github/Data/Name.hs +++ b/Github/Data/Name.hs @@ -15,7 +15,7 @@ import Data.Text (Text) import GHC.Generics (Generic) newtype Name entity = N Text - deriving (Eq, Ord, Show, Read, Generic, Typeable, Data) + deriving (Eq, Ord, Show, Generic, Typeable, Data) -- | Smart constructor for 'Name' mkName :: proxy entity -> Text -> Name entity diff --git a/samples/Teams/DeleteTeam.hs b/samples/Teams/DeleteTeam.hs index 8a0457e4..62b7f2ce 100644 --- a/samples/Teams/DeleteTeam.hs +++ b/samples/Teams/DeleteTeam.hs @@ -10,7 +10,7 @@ main :: IO () main = do args <- getArgs result <- case args of - [token, team_id] -> Github.deleteTeam' (Github.GithubOAuth token) (read team_id) + [token, team_id] -> Github.deleteTeam' (Github.GithubOAuth token) (Github.mkTeamId $ read team_id) _ -> error "usage: DeleteTeam " case result of Left err -> putStrLn $ "Error: " <> tshow err diff --git a/samples/Teams/EditTeam.hs b/samples/Teams/EditTeam.hs index c1a65803..5cc007cb 100644 --- a/samples/Teams/EditTeam.hs +++ b/samples/Teams/EditTeam.hs @@ -13,8 +13,8 @@ main = do [token, team_id, team_name, desc] -> Github.editTeam' (Github.GithubOAuth token) - (read team_id) - (Github.EditTeam (Github.mkName (Proxy :: Proxy Github.Team) $ fromString team_name) (Just $ fromString desc) Github.PermissionPull) + (Github.mkTeamId $ read team_id) + (Github.EditTeam (Github.mkTeamName $ fromString team_name) (Just $ fromString desc) Github.PermissionPull) _ -> error "usage: EditTeam " case result of diff --git a/samples/Teams/Memberships/AddTeamMembershipFor.hs b/samples/Teams/Memberships/AddTeamMembershipFor.hs index d771ffb7..4d0b1f24 100644 --- a/samples/Teams/Memberships/AddTeamMembershipFor.hs +++ b/samples/Teams/Memberships/AddTeamMembershipFor.hs @@ -1,18 +1,23 @@ {-# LANGUAGE OverloadedStrings #-} +module Main (main) where -module AddTeamMembershipFor where +import Common +import Prelude () -import qualified Github.Auth as Github -import qualified Github.Teams.Memberships as Github -import System.Environment (getArgs) +import qualified Github.Organizations.Teams as Github +main :: IO () main = do args <- getArgs result <- case args of [token, team_id, username] -> - Github.addTeamMembershipFor' (Github.GithubOAuth token) (read team_id) username Github.RoleMember + Github.addTeamMembershipFor' + (Github.GithubOAuth token) + (Github.mkTeamId $ read team_id) + (Github.mkOwnerName $ fromString username) + Github.RoleMember _ -> error "usage: AddTeamMembershipFor " case result of - Left err -> putStrLn $ "Error: " ++ show err - Right team -> putStrLn $ show team + Left err -> putStrLn $ "Error: " <> tshow err + Right team -> putStrLn $ tshow team diff --git a/samples/Teams/Memberships/DeleteTeamMembershipFor.hs b/samples/Teams/Memberships/DeleteTeamMembershipFor.hs index c96d8ee6..4c9d3f16 100644 --- a/samples/Teams/Memberships/DeleteTeamMembershipFor.hs +++ b/samples/Teams/Memberships/DeleteTeamMembershipFor.hs @@ -1,18 +1,22 @@ {-# LANGUAGE OverloadedStrings #-} +module Main (main) where -module DeleteTeamMembershipFor where +import Common +import Prelude () -import qualified Github.Auth as Github -import qualified Github.Teams.Memberships as Github -import System.Environment (getArgs) +import qualified Github.Organizations.Teams as Github +main :: IO () main = do args <- getArgs result <- case args of [token, team_id, username] -> - Github.deleteTeamMembershipFor' (Github.GithubOAuth token) (read team_id) username + Github.deleteTeamMembershipFor' + (Github.GithubOAuth token) + (Github.mkTeamId $ read team_id) + (Github.mkOwnerName $ fromString username) _ -> error "usage: DeleteTeamMembershipFor " case result of - Left err -> putStrLn $ "Error: " ++ show err - Right team -> putStrLn $ show team + Left err -> putStrLn $ "Error: " <> tshow err + Right team -> putStrLn $ tshow team diff --git a/samples/Teams/Memberships/TeamMembershipInfoFor.hs b/samples/Teams/Memberships/TeamMembershipInfoFor.hs index 7c0ca251..967996b9 100644 --- a/samples/Teams/Memberships/TeamMembershipInfoFor.hs +++ b/samples/Teams/Memberships/TeamMembershipInfoFor.hs @@ -1,20 +1,21 @@ {-# LANGUAGE OverloadedStrings #-} +module Main (main) where -module TeamMembershipInfoFor where +import Common +import Prelude () -import qualified Github.Auth as Github -import qualified Github.Teams.Memberships as Github -import System.Environment (getArgs) +import qualified Github.Organizations.Teams as Github +main :: IO () main = do args <- getArgs result <- case args of [team_id, username, token] -> - Github.teamMembershipInfoFor' (Just $ Github.GithubOAuth token) (read team_id) username + Github.teamMembershipInfoFor' (Just $ Github.GithubOAuth token) (Github.mkTeamId $ read team_id) (Github.mkOwnerName $ fromString username) [team_id, username] -> - Github.teamMembershipInfoFor (read team_id) username + Github.teamMembershipInfoFor (Github.mkTeamId $ read team_id) (Github.mkOwnerName $ fromString username) _ -> error "usage: TeamMembershipInfoFor [token]" case result of - Left err -> putStrLn $ "Error: " ++ show err - Right team -> putStrLn $ show team + Left err -> putStrLn $ "Error: " <> tshow err + Right team -> putStrLn $ tshow team diff --git a/samples/Teams/TeamInfoFor.hs b/samples/Teams/TeamInfoFor.hs index dfda8691..f870cb60 100644 --- a/samples/Teams/TeamInfoFor.hs +++ b/samples/Teams/TeamInfoFor.hs @@ -10,8 +10,8 @@ main :: IO () main = do args <- getArgs result <- case args of - [team_id, token] -> Github.teamInfoFor' (Just $ Github.GithubOAuth token) (read team_id) - [team_id] -> Github.teamInfoFor (read team_id) + [team_id, token] -> Github.teamInfoFor' (Just $ Github.GithubOAuth token) (Github.mkTeamId $ read team_id) + [team_id] -> Github.teamInfoFor (Github.mkTeamId $ read team_id) _ -> error "usage: TeamInfoFor [auth token]" case result of Left err -> putStrLn $ "Error: " <> tshow err diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index 244adc4d..39e906de 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -40,6 +40,38 @@ executable github-edit-team TeamInfoFor default-language: Haskell2010 +executable github-team-membership-info-for + main-is: TeamMembershipInfoFor.hs + hs-source-dirs: + Teams/Memberships + ghc-options: -Wall + build-depends: + base + , base-compat + , github + , text + , github-samples + other-modules: + AddTeamMembershipFor + DeleteTeamMembershipFor + default-language: Haskell2010 + +executable github-delete-team-membership-for + main-is: DeleteTeamMembershipFor.hs + hs-source-dirs: + Teams/Memberships + ghc-options: -Wall + build-depends: + base + , base-compat + , github + , text + , github-samples + other-modules: + AddTeamMembershipFor + TeamMembershipInfoFor + default-language: Haskell2010 + executable github-show-user main-is: ShowUser.hs hs-source-dirs: @@ -71,6 +103,22 @@ executable github-list-following ListFollowers default-language: Haskell2010 +executable github-add-team-membership-for + main-is: AddTeamMembershipFor.hs + hs-source-dirs: + Teams/Memberships + ghc-options: -Wall + build-depends: + base + , base-compat + , github + , text + , github-samples + other-modules: + DeleteTeamMembershipFor + TeamMembershipInfoFor + default-language: Haskell2010 + executable github-list-followers main-is: ListFollowers.hs hs-source-dirs: @@ -106,8 +154,8 @@ executable github-list-team-current TeamInfoFor default-language: Haskell2010 -executable github-teaminfo-fir - main-is: TeamInfoFor.hs +executable github-delete-team + main-is: DeleteTeam.hs hs-source-dirs: Teams ghc-options: -Wall @@ -118,16 +166,16 @@ executable github-teaminfo-fir , text , github-samples other-modules: - DeleteTeam EditTeam ListTeamsCurrent Memberships.AddTeamMembershipFor Memberships.DeleteTeamMembershipFor Memberships.TeamMembershipInfoFor + TeamInfoFor default-language: Haskell2010 -executable github-delete-team - main-is: DeleteTeam.hs +executable github-teaminfo-for + main-is: TeamInfoFor.hs hs-source-dirs: Teams ghc-options: -Wall @@ -138,10 +186,10 @@ executable github-delete-team , text , github-samples other-modules: + DeleteTeam EditTeam ListTeamsCurrent Memberships.AddTeamMembershipFor Memberships.DeleteTeamMembershipFor Memberships.TeamMembershipInfoFor - TeamInfoFor default-language: Haskell2010 diff --git a/samples/package.yaml b/samples/package.yaml index baca8550..b2615b94 100644 --- a/samples/package.yaml +++ b/samples/package.yaml @@ -42,8 +42,23 @@ executables: source-dirs: Teams dependencies: - github-samples - github-teaminfo-fir: + github-teaminfo-for: main: TeamInfoFor.hs source-dirs: Teams dependencies: - github-samples + github-add-team-membership-for: + main: AddTeamMembershipFor.hs + source-dirs: Teams/Memberships + dependencies: + - github-samples + github-delete-team-membership-for: + main: DeleteTeamMembershipFor.hs + source-dirs: Teams/Memberships + dependencies: + - github-samples + github-team-membership-info-for: + main: TeamMembershipInfoFor.hs + source-dirs: Teams/Memberships + dependencies: + - github-samples From 7491ea638ce0d0f7122090ae0b8a4cd222993f29 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 11 Jan 2016 02:53:16 +0200 Subject: [PATCH 144/510] Update not-in-code documentation --- CONTRIBUTING.md | 2 +- NEWS.md | 9 ++++ README.md | 127 +++++++++--------------------------------------- github.cabal | 80 +----------------------------- 4 files changed, 36 insertions(+), 182 deletions(-) diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index b42a9c2e..c18ad2b4 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -4,7 +4,7 @@ Contributing When adding a new public function ================================= -* Write a sample in the appropriate place in the samples/ directory. +* Write a test (or sample) in the appropriate place in the samples/ directory. * Implement the function. * Submit a pull request. diff --git a/NEWS.md b/NEWS.md index 29ad1572..dacd168d 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,12 @@ +Changes for 0.14.0 + +Large API changes: + +- Use `Text` and `Vector` in place of `String` and `[]`. +- Use `Name` and `Id` tagged types for names and identifiers. +- Make detailed structures un-prefixed, simple ones prefixed with `Simple`. Example: `Team` and `SimpleTeam`. +- Decouple request creation from execution (`*R` and `executeRequest*` functions). + Changes for 0.5.0: * OAuth. diff --git a/README.md b/README.md index 49274db6..f052e8b0 100644 --- a/README.md +++ b/README.md @@ -12,12 +12,16 @@ Installation In your project's cabal file: - -- Packages needed in order to build this package. - Build-depends: github +```cabal +-- Packages needed in order to build this package. +Build-depends: github +``` Or from the command line: - cabal install github +```sh +cabal install github +``` Example Usage ============= @@ -33,111 +37,27 @@ For details see the reference documentation on Hackage. Each module lines up with the hierarchy of [documentation from the Github API](http://developer.github.com/v3/). -Each function has a sample written for it. +Request functions (ending with `R`) construct a data type with can be executed +in `IO` by `executeRequest` functions. They are all listed in `Github.All` module. -All functions produce an `IO (Either Error a)`, where `a` is the actual thing +IO functions produce an `IO (Either Error a)`, where `a` is the actual thing you want. You must call the function using IO goodness, then dispatch on the possible error message. Here's an example from the samples: - import qualified Github.Users.Followers as Github - import Data.List (intercalate) +Many function have samples under +[`samples/`](https://github.com/phadej/github/tree/master/samples) directory. - main = do - possibleUsers <- Github.usersFollowing "mike-burns" - putStrLn $ either (("Error: "++) . show) - (intercalate "\n" . map formatUser) - possibleUsers - - formatUser = Github.githubOwnerLogin - -API -> Module -============ - - - -## Gists - -[Gists module](https://github.com/jwiegley/github/blob/master/Github/Gists.hs) - -- Comments on gist by gist id -- Specific comment by comment id - -## Git Data - -[Git Data](https://github.com/jwiegley/github/tree/master/Github/GitData) - -- Blobs - - user/repo and commit sha -- Commits - - user/repo and commit sha -- References - - single reference by ref name - - history of references for a user/repo - - references by user/repo, limited by namespace (you can get tags by specifying "tags" here) -- Trees - -## Issues - -[Issues](https://github.com/jwiegley/github/blob/master/Github/Issues.hs) +```hs +import qualified Github.Users.Followers as Github -- Create issue -- Edit issue -- Get issues for repo - -## Organizations - -[Orgs](https://github.com/jwiegley/github/tree/master/Github/Organizations) - -- get members by organization - -## Pull Requests - -[Pull Requests](https://github.com/jwiegley/github/tree/master/Github/PullRequests) - -- Review Comments by PR id or comment id - - -## Repositories - -[Repos](https://github.com/jwiegley/github/tree/master/Github/Repos) - -- repos by user -- repos by organization - -## Search - -[Search](https://github.com/jwiegley/github/blob/master/Github/Search.hs) - -- Repo search w/ authentication -- Repo search w/o auth -- Code search w/ auth -- Code search w/o auth - -## Users - -[Users](https://github.com/jwiegley/github/blob/master/Github/Users.hs) - -- by name, with auth -- by name, with password -- by name, public info +main = do + possibleUsers <- Github.usersFollowing "mike-burns" + T.putStrLn $ either (("Error: " <>) . T.pack . show) + (foldMap (formatUser . (<> "\n"))) + possibleUsers -See `DetailedOwner` to know what data could be provided. +formatUser = Github.untagName . Github.githubOwnerLogin +``` Test setup ========== @@ -159,7 +79,8 @@ for details on how you can help. Copyright ========= -Copyright 2011, 2012 Mike Burns. -Copyright 2013-2014 John Wiegley. +Copyright 2011-2012 Mike Burns. +Copyright 2013-2015 John Wiegley. +Copyright 2016 Oleg Grenrus. Available under the BSD 3-clause license. diff --git a/github.cabal b/github.cabal index b268041e..c6ddbe68 100644 --- a/github.cabal +++ b/github.cabal @@ -6,7 +6,7 @@ Description: The Github API provides programmatic access to the full like references and trees. This library wraps all of that, exposing a basic but Haskell-friendly set of functions and data structures. . - For more of an overview please see the README: + For more of an overview please see the README: License: BSD3 License-file: LICENSE Author: Mike Burns, John Wiegley, Oleg Grenrus @@ -18,82 +18,6 @@ Build-type: Simple Tested-with: GHC==7.8.4, GHC==7.10.2 Cabal-version: >=1.10 Extra-source-files: README.md - ,samples/Gists/Comments/ShowComment.hs - ,samples/Gists/Comments/ShowComments.hs - ,samples/Gists/ListGists.hs - ,samples/Gists/ShowGist.hs - ,samples/GitData/Commits/GitShow.hs - ,samples/GitData/References/GitCreateReference.hs - ,samples/GitData/References/GitLsRemote.hs - ,samples/GitData/References/GitLsRemoteTags.hs - ,samples/GitData/References/GitLsRemoteWithRef.hs - ,samples/GitData/Trees/GitLsTree.hs - ,samples/GitData/Trees/GitLsTreeRecursively.hs - ,samples/Issues/Comments/ShowComment.hs - ,samples/Issues/Comments/ShowComments.hs - ,samples/Issues/Events/ShowEvent.hs - ,samples/Issues/Events/ShowIssueEvents.hs - ,samples/Issues/Events/ShowRepoEvents.hs - ,samples/Issues/Labels/ShowIssueLabels.hs - ,samples/Issues/Labels/ShowLabel.hs - ,samples/Issues/Labels/ShowMilestoneLabels.hs - ,samples/Issues/Labels/ShowRepoLabels.hs - ,samples/Issues/Labels/CreateLabels.hs - ,samples/Issues/Milestones/ShowMilestone.hs - ,samples/Issues/Milestones/ShowMilestones.hs - ,samples/Issues/ShowIssue.hs - ,samples/Issues/ShowRepoIssues.hs - ,samples/Organizations/Members/ShowMembers.hs - ,samples/Organizations/ShowPublicOrganization.hs - ,samples/Organizations/ShowPublicOrganizations.hs - ,samples/Organizations/Teams/CreateTeamFor.hs - ,samples/Organizations/Teams/ListTeamsForOrganization.hs - ,samples/Pulls/Diff.hs - ,samples/Pulls/ListPulls.hs - ,samples/Pulls/ReviewComments/ListComments.hs - ,samples/Pulls/ReviewComments/ShowComment.hs - ,samples/Pulls/ShowCommits.hs - ,samples/Pulls/ShowPull.hs - ,samples/Search/SearchRepos.hs - ,samples/Search/SearchIssues.hs - ,samples/Repos/Collaborators/IsCollaborator.hs - ,samples/Repos/Collaborators/ListCollaborators.hs - ,samples/Repos/Commits/CommitComment.hs - ,samples/Repos/Commits/CommitComments.hs - ,samples/Repos/Commits/GitDiff.hs - ,samples/Repos/Commits/GitLog.hs - ,samples/Repos/Commits/GitShow.hs - ,samples/Repos/Commits/RepoComments.hs - ,samples/Repos/Forks/ListForks.hs - ,samples/Repos/ListBranches.hs - ,samples/Repos/ListContributors.hs - ,samples/Repos/ListContributorsWithAnonymous.hs - ,samples/Repos/ListLanguages.hs - ,samples/Repos/ListOrgRepos.hs - ,samples/Repos/ListTags.hs - ,samples/Repos/ListUserRepos.hs - ,samples/Repos/ShowRepo.hs - ,samples/Repos/Watching/ListWatched.hs - ,samples/Repos/Watching/ListWatchers.hs - ,samples/Repos/Starring/ListStarred.hs - ,samples/Repos/Webhooks/CreateWebhook.hs - ,samples/Repos/Webhooks/DeleteWebhook.hs - ,samples/Repos/Webhooks/EditWebhook.hs - ,samples/Repos/Webhooks/ListWebhook.hs - ,samples/Repos/Webhooks/ListWebhooks.hs - ,samples/Repos/Webhooks/PingWebhook.hs - ,samples/Repos/Webhooks/TestPushWebhook.hs - ,samples/Teams/DeleteTeam.hs - ,samples/Teams/EditTeam.hs - ,samples/Teams/ListTeamsCurrent.hs - ,samples/Teams/TeamInfoFor.hs - ,samples/Teams/Memberships/AddTeamMembershipFor.hs - ,samples/Teams/Memberships/DeleteTeamMembershipFor.hs - ,samples/Teams/Memberships/TeamMembershipInfoFor.hs - ,samples/Users/Followers/ListFollowers.hs - ,samples/Users/Followers/ListFollowing.hs - ,samples/Users/ShowUser.hs - ,LICENSE flag aeson-compat description: Whether to use aeson-compat or aeson-extra @@ -102,7 +26,7 @@ flag aeson-compat source-repository head type: git - location: git://github.com/jwiegley/github.git + location: git://github.com/phadej/github.git Library -- Modules exported by the library. From 0e7c9440091930c4a84c0dea2d9980a7c85d02eb Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 11 Jan 2016 15:47:08 +0200 Subject: [PATCH 145/510] Resolve #94: Implement /user/repos --- Github/All.hs | 2 +- Github/Repos.hs | 15 +++++++++++++++ github.cabal | 1 + spec/Github/ReposSpec.hs | 35 +++++++++++++++++++++++++++++++++++ 4 files changed, 52 insertions(+), 1 deletion(-) create mode 100644 spec/Github/ReposSpec.hs diff --git a/Github/All.hs b/Github/All.hs index 07b460bc..2dd05705 100644 --- a/Github/All.hs +++ b/Github/All.hs @@ -203,11 +203,11 @@ module Github.All ( -- -- Missing endpoints: -- - -- * List your repositories -- * List all public repositories -- * List Teams -- * Get Branch -- * Enabling and disabling branch protection + currentUserReposR, userReposR, -- ** Collaborators diff --git a/Github/Repos.hs b/Github/Repos.hs index 01ad8f7d..7ace309c 100644 --- a/Github/Repos.hs +++ b/Github/Repos.hs @@ -6,6 +6,8 @@ -- module Github.Repos ( -- * Querying repositories + currentUserRepos, + currentUserReposR, userRepos, userRepos', userReposR, @@ -69,6 +71,19 @@ repoPublicityQueryString Member = [("type", Just "member")] repoPublicityQueryString Public = [("type", Just "public")] repoPublicityQueryString Private = [("type", Just "private")] +-- | List your repositories. +currentUserRepos :: GithubAuth -> RepoPublicity -> IO (Either Error (Vector Repo)) +currentUserRepos auth publicity = + executeRequest auth $ currentUserReposR publicity Nothing + +-- | List your repositories. +-- See +currentUserReposR :: RepoPublicity -> Maybe Count -> GithubRequest k(Vector Repo) +currentUserReposR publicity = + GithubPagedGet ["user", "repos"] qs + where + qs = repoPublicityQueryString publicity + -- | The repos for a user, by their login. Can be restricted to just repos they -- own, are a member of, or publicize. Private repos will return empty list. -- diff --git a/github.cabal b/github.cabal index c6ddbe68..c9e5767c 100644 --- a/github.cabal +++ b/github.cabal @@ -118,6 +118,7 @@ test-suite github-test other-modules: Github.CommitsSpec Github.OrganizationsSpec + Github.ReposSpec Github.SearchSpec Github.UsersSpec main-is: Spec.hs diff --git a/spec/Github/ReposSpec.hs b/spec/Github/ReposSpec.hs new file mode 100644 index 00000000..6b633073 --- /dev/null +++ b/spec/Github/ReposSpec.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +module Github.ReposSpec where + +import Github.Auth (GithubAuth (..)) +import Github.Repos (currentUserRepos, userRepos', RepoPublicity(..)) + +-- import Data.Aeson.Compat (eitherDecodeStrict) +import Data.Either.Compat (isRight) +-- import Data.FileEmbed (embedFile) +import System.Environment (lookupEnv) +import Test.Hspec (Spec, describe, it, pendingWith, shouldSatisfy) + +fromRightS :: Show a => Either a b -> b +fromRightS (Right b) = b +fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a + +withAuth :: (GithubAuth -> IO ()) -> IO () +withAuth action = do + mtoken <- lookupEnv "GITHUB_TOKEN" + case mtoken of + Nothing -> pendingWith "no GITHUB_TOKEN" + Just token -> action (GithubOAuth token) + +spec :: Spec +spec = do + describe "currentUserRepos" $ do + it "works" $ withAuth $ \auth -> do + cs <- currentUserRepos auth All + cs `shouldSatisfy` isRight + + describe "userRepos" $ do + it "works" $ withAuth $ \auth -> do + cs <- userRepos' (Just auth) "phadej" All + cs `shouldSatisfy` isRight From fc8359739437626589d38b988afcc9fc4a11e761 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 11 Jan 2016 17:58:15 +0200 Subject: [PATCH 146/510] Fix #59: gist has owner, not user --- Github/Data.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Github/Data.hs b/Github/Data.hs index d4322dbf..29203d18 100644 --- a/Github/Data.hs +++ b/Github/Data.hs @@ -196,7 +196,7 @@ instance FromJSON Diff where instance FromJSON Gist where parseJSON (Object o) = - Gist <$> o .: "user" + Gist <$> o .: "owner" <*> o .: "git_push_url" <*> o .: "url" <*> o .:? "description" From 04e554bb1bd8e9b9aafbcdb36c30a0d4b357e93e Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 11 Jan 2016 18:26:16 +0200 Subject: [PATCH 147/510] Fix #155. Fix diffs --- Github/Data.hs | 2 +- Github/Data/GitData.hs | 13 +++++++------ spec/Github/CommitsSpec.hs | 21 ++++++++++++++++++--- 3 files changed, 26 insertions(+), 10 deletions(-) diff --git a/Github/Data.hs b/Github/Data.hs index 29203d18..cf093c6d 100644 --- a/Github/Data.hs +++ b/Github/Data.hs @@ -145,7 +145,7 @@ instance FromJSON File where <*> o .: "additions" <*> o .: "sha" <*> o .: "changes" - <*> o .: "patch" + <*> o .:? "patch" <*> o .: "filename" <*> o .: "deletions" parseJSON _ = fail "Could not build a File" diff --git a/Github/Data/GitData.hs b/Github/Data/GitData.hs index 1f8548f3..b80b26bc 100644 --- a/Github/Data/GitData.hs +++ b/Github/Data/GitData.hs @@ -3,6 +3,7 @@ module Github.Data.GitData where import Github.Data.Definitions +import Github.Data.Name (Name) import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) @@ -13,7 +14,7 @@ import Data.Vector (Vector) import GHC.Generics (Generic) data Commit = Commit { - commitSha :: !Text + commitSha :: !(Name Commit) ,commitParents :: !(Vector Tree) ,commitUrl :: !Text ,commitGitCommit :: !GitCommit @@ -26,7 +27,7 @@ data Commit = Commit { instance NFData Commit where rnf = genericRnf data Tree = Tree { - treeSha :: !Text + treeSha :: !(Name Tree) ,treeUrl :: !Text ,treeGitTrees :: !(Vector GitTree) } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -35,7 +36,7 @@ instance NFData Tree where rnf = genericRnf data GitTree = GitTree { gitTreeType :: !Text - ,gitTreeSha :: !Text + ,gitTreeSha :: !(Name GitTree) -- Can be empty for submodule ,gitTreeUrl :: !(Maybe Text) ,gitTreeSize :: !(Maybe Int) @@ -51,7 +52,7 @@ data GitCommit = GitCommit { ,gitCommitCommitter :: !GitUser ,gitCommitAuthor :: !GitUser ,gitCommitTree :: !Tree - ,gitCommitSha :: !(Maybe Text) + ,gitCommitSha :: !(Maybe (Name GitCommit)) ,gitCommitParents :: !(Vector Tree) } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -61,7 +62,7 @@ data Blob = Blob { blobUrl :: !Text ,blobEncoding :: !Text ,blobContent :: !Text - ,blobSha :: !Text + ,blobSha :: !(Name Blob) ,blobSize :: !Int } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -145,7 +146,7 @@ data File = File { ,fileAdditions :: !Int ,fileSha :: !Text ,fileChanges :: !Int - ,filePatch :: !Text + ,filePatch :: !(Maybe Text) ,fileFilename :: !Text ,fileDeletions :: !Int } deriving (Show, Data, Typeable, Eq, Ord, Generic) diff --git a/spec/Github/CommitsSpec.hs b/spec/Github/CommitsSpec.hs index ce9dd981..a6a4e05f 100644 --- a/spec/Github/CommitsSpec.hs +++ b/spec/Github/CommitsSpec.hs @@ -3,12 +3,12 @@ module Github.CommitsSpec where import Github.Auth (GithubAuth (..)) -import Github.Repos.Commits (commitsFor', commitsForR) +import Github.Repos.Commits (Commit, mkName, commitSha, commitsFor', commitsForR, diffR) import Github.Request (executeRequest) --- import Data.Aeson.Compat (eitherDecodeStrict) +import Control.Monad (forM_) import Data.Either.Compat (isRight) --- import Data.FileEmbed (embedFile) +import Data.Proxy (Proxy (..)) import System.Environment (lookupEnv) import Test.Hspec (Spec, describe, it, pendingWith, shouldSatisfy) @@ -38,3 +38,18 @@ spec = do cs <- executeRequest auth $ commitsForR "phadej" "github" (Just 40) cs `shouldSatisfy` isRight V.length (fromRightS cs) `shouldSatisfy` (< 70) + + describe "diff" $ do + it "works" $ withAuth $ \auth -> do + cs <- executeRequest auth $ commitsForR "phadej" "github" (Just 30) + cs `shouldSatisfy` isRight + let commits = take 10 . V.toList . fromRightS $ cs + let pairs = zip commits $ drop 1 commits + forM_ pairs $ \(a, b) -> do + d <- executeRequest auth $ diffR "phadej" "github" (commitSha a) (commitSha b) + d `shouldSatisfy` isRight + + it "issue #155" $ withAuth $ \auth -> do + let mkCommitName = mkName (Proxy :: Proxy Commit) + d <- executeRequest auth $ diffR "nomeata" "codespeed" (mkCommitName "ghc") (mkCommitName "tobami:master") + d `shouldSatisfy` isRight From 4b0c8db632e8d716605c7c0b469531b44fa7d566 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 12 Jan 2016 11:46:26 +0200 Subject: [PATCH 148/510] Import repos stuff --- Github/All.hs | 6 ++++++ Github/Data.hs | 8 ++++++++ 2 files changed, 14 insertions(+) diff --git a/Github/All.hs b/Github/All.hs index 2dd05705..ce6ddcff 100644 --- a/Github/All.hs +++ b/Github/All.hs @@ -209,6 +209,12 @@ module Github.All ( -- * Enabling and disabling branch protection currentUserReposR, userReposR, + organizationReposR, + repositoryR, + contributorsR, + languagesForR, + tagsForR, + branchesForR, -- ** Collaborators -- | See diff --git a/Github/Data.hs b/Github/Data.hs index cf093c6d..0b426b5f 100644 --- a/Github/Data.hs +++ b/Github/Data.hs @@ -28,12 +28,14 @@ module Github.Data ( untagName, mkOwnerName, mkTeamName, + mkOrganizationName, -- ** Id Id, mkId, untagId, mkOwnerId, mkTeamId, + mkOrganizationId, ) where import Prelude () @@ -73,6 +75,12 @@ mkTeamId = Id mkTeamName :: T.Text -> Name Team mkTeamName = N +mkOrganizationId :: Int -> Id Organization +mkOrganizationId = Id + +mkOrganizationName :: T.Text -> Name Organization +mkOrganizationName = N + instance FromJSON Commit where parseJSON (Object o) = Commit <$> o .: "sha" From af947a4ee5d20be04c892192c9695b233dcf5541 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 12 Jan 2016 13:57:43 +0200 Subject: [PATCH 149/510] Fix watching and starring --- Github/Activity/Starring.hs | 4 ++-- Github/Activity/Watching.hs | 6 +++--- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/Github/Activity/Starring.hs b/Github/Activity/Starring.hs index 7f4463ca..5f83068b 100644 --- a/Github/Activity/Starring.hs +++ b/Github/Activity/Starring.hs @@ -19,13 +19,13 @@ import Github.Request -- | The list of users that have starred the specified Github repo. -- -- > userInfoFor' Nothing "mike-burns" -stargazersFor :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error (Vector GithubOwner)) +stargazersFor :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error (Vector SimpleOwner)) stargazersFor auth user repo = executeRequestMaybe auth $ stargazersForR user repo Nothing -- | List Stargazers. -- See -stargazersForR :: Name GithubOwner -> Name Repo -> Maybe Count -> GithubRequest k (Vector GithubOwner) +stargazersForR :: Name GithubOwner -> Name Repo -> Maybe Count -> GithubRequest k (Vector SimpleOwner) stargazersForR user repo = GithubPagedGet ["repos", toPathPart user, toPathPart repo, "stargazers"] [] diff --git a/Github/Activity/Watching.hs b/Github/Activity/Watching.hs index ebbed127..e1753eaf 100644 --- a/Github/Activity/Watching.hs +++ b/Github/Activity/Watching.hs @@ -18,20 +18,20 @@ import Github.Request -- | The list of users that are watching the specified Github repo. -- -- > watchersFor "thoughtbot" "paperclip" -watchersFor :: Name GithubOwner -> Name Repo -> IO (Either Error (Vector GithubOwner)) +watchersFor :: Name GithubOwner -> Name Repo -> IO (Either Error (Vector SimpleOwner)) watchersFor = watchersFor' Nothing -- | The list of users that are watching the specified Github repo. -- With authentication -- -- > watchersFor' (Just (GithubUser (user, password))) "thoughtbot" "paperclip" -watchersFor' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error (Vector GithubOwner)) +watchersFor' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error (Vector SimpleOwner)) watchersFor' auth user repo = executeRequestMaybe auth $ watchersForR user repo Nothing -- | List watchers. -- See -watchersForR :: Name GithubOwner -> Name Repo -> Maybe Count -> GithubRequest k (Vector GithubOwner) +watchersForR :: Name GithubOwner -> Name Repo -> Maybe Count -> GithubRequest k (Vector SimpleOwner) watchersForR user repo limit = GithubPagedGet ["repos", toPathPart user, toPathPart repo, "watchers"] [] limit From 8a57107db2dc77035e62a660d455e92c3e1b1057 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 12 Jan 2016 14:13:49 +0200 Subject: [PATCH 150/510] Fix collaborators --- Github/Repos/Collaborators.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/Github/Repos/Collaborators.hs b/Github/Repos/Collaborators.hs index 0f20f673..76c172eb 100644 --- a/Github/Repos/Collaborators.hs +++ b/Github/Repos/Collaborators.hs @@ -18,18 +18,18 @@ import Network.HTTP.Types (Status) -- | All the users who have collaborated on a repo. -- -- > collaboratorsOn "thoughtbot" "paperclip" -collaboratorsOn :: Name GithubOwner -> Name Repo -> IO (Either Error (Vector GithubOwner)) +collaboratorsOn :: Name GithubOwner -> Name Repo -> IO (Either Error (Vector SimpleOwner)) collaboratorsOn = collaboratorsOn' Nothing -- | All the users who have collaborated on a repo. -- With authentication. -collaboratorsOn' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error (Vector GithubOwner)) +collaboratorsOn' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error (Vector SimpleOwner)) collaboratorsOn' auth user repo = executeRequestMaybe auth $ collaboratorsOnR user repo Nothing -- | List collaborators. -- See -collaboratorsOnR :: Name GithubOwner -> Name Repo -> Maybe Count -> GithubRequest k (Vector GithubOwner) +collaboratorsOnR :: Name GithubOwner -> Name Repo -> Maybe Count -> GithubRequest k (Vector SimpleOwner) collaboratorsOnR user repo = GithubPagedGet ["repos", toPathPart user, toPathPart repo, "collaborators"] [] From b6faf3b3fbfbc03a78e2a89803e6217a04b4d7c5 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 12 Jan 2016 15:15:35 +0200 Subject: [PATCH 151/510] Add Hashable GithubRequest instance --- Github/Data/Request.hs | 25 +++++++++++++++++++++++++ 1 file changed, 25 insertions(+) diff --git a/Github/Data/Request.hs b/Github/Data/Request.hs index e350605a..6d52d5c4 100644 --- a/Github/Data/Request.hs +++ b/Github/Data/Request.hs @@ -18,6 +18,7 @@ module Github.Data.Request ( ) where import Data.Aeson.Compat (FromJSON) +import Data.Hashable (Hashable (..)) import Data.Typeable (Typeable) import Data.Vector (Vector) import GHC.Generics (Generic) @@ -57,6 +58,8 @@ toMethod Post = Method.methodPost toMethod Patch = Method.methodPatch toMethod Put = Method.methodPut +instance Hashable PostMethod + ------------------------------------------------------------------------------ -- Github request ------------------------------------------------------------------------------ @@ -108,3 +111,25 @@ instance Show (GithubRequest k a) where showString "GithubStatus " . showsPrec (appPrec + 1) req where appPrec = 10 :: Int + +instance Hashable (GithubRequest k a) where + hashWithSalt salt (GithubGet ps qs) = + salt `hashWithSalt` (0 :: Int) + `hashWithSalt` ps + `hashWithSalt` qs + hashWithSalt salt (GithubPagedGet ps qs l) = + salt `hashWithSalt` (1 :: Int) + `hashWithSalt` ps + `hashWithSalt` qs + `hashWithSalt` l + hashWithSalt salt (GithubPost m ps body) = + salt `hashWithSalt` (2 :: Int) + `hashWithSalt` m + `hashWithSalt` ps + `hashWithSalt` body + hashWithSalt salt (GithubDelete ps) = + salt `hashWithSalt` (3 :: Int) + `hashWithSalt` ps + hashWithSalt salt (GithubStatus req) = + salt `hashWithSalt` (4 :: Int) + `hashWithSalt` req From 32a1d6664ae893fd5be13751d7d69533f01e931c Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sat, 16 Jan 2016 12:08:41 +0200 Subject: [PATCH 152/510] Add Activity spec --- spec/Github/ActivitySpec.hs | 32 ++++++++++++++++++++++++++++++++ 1 file changed, 32 insertions(+) create mode 100644 spec/Github/ActivitySpec.hs diff --git a/spec/Github/ActivitySpec.hs b/spec/Github/ActivitySpec.hs new file mode 100644 index 00000000..9b776a18 --- /dev/null +++ b/spec/Github/ActivitySpec.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +module Github.ActivitySpec where + +import Github.Auth (GithubAuth (..)) +import Github.Activity.Watching (watchersForR) +import Github.Request (executeRequest) + +import Data.Either.Compat (isRight) +import System.Environment (lookupEnv) +import Test.Hspec (Spec, describe, it, pendingWith, shouldSatisfy) + +import qualified Data.Vector as V + +fromRightS :: Show a => Either a b -> b +fromRightS (Right b) = b +fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a + +withAuth :: (GithubAuth -> IO ()) -> IO () +withAuth action = do + mtoken <- lookupEnv "GITHUB_TOKEN" + case mtoken of + Nothing -> pendingWith "no GITHUB_TOKEN" + Just token -> action (GithubOAuth token) + +spec :: Spec +spec = do + describe "watchersForR" $ do + it "works" $ withAuth $ \auth -> do + cs <- executeRequest auth $ watchersForR "phadej" "github" Nothing + cs `shouldSatisfy` isRight + V.length (fromRightS cs) `shouldSatisfy` (> 10) From de0769557911c29f082657eb223a68707aca8620 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sat, 16 Jan 2016 12:10:17 +0200 Subject: [PATCH 153/510] Add Binary instances --- Github/Auth.hs | 2 ++ Github/Data/Definitions.hs | 19 ++++++++++++++++++- Github/Data/Gists.hs | 4 ++++ Github/Data/GitData.hs | 14 ++++++++++++++ Github/Data/Id.hs | 2 ++ Github/Data/Issues.hs | 10 ++++++++++ Github/Data/Name.hs | 16 +++++++++------- Github/Data/PullRequests.hs | 11 +++++++++++ Github/Data/Repos.hs | 7 +++++++ Github/Data/Search.hs | 5 +++++ Github/Data/Teams.hs | 13 ++++++++++++- Github/Data/Webhooks.hs | 7 +++++++ github.cabal | 2 ++ stack-lts-2.yaml | 1 + 14 files changed, 104 insertions(+), 9 deletions(-) diff --git a/Github/Auth.hs b/Github/Auth.hs index c7200c28..90b80343 100644 --- a/Github/Auth.hs +++ b/Github/Auth.hs @@ -4,6 +4,7 @@ module Github.Auth where import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) +import Data.Binary (Binary) import Data.Data (Data, Typeable) import GHC.Generics (Generic) @@ -18,3 +19,4 @@ data GithubAuth = GithubBasicAuth BS.ByteString BS.ByteString deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData GithubAuth where rnf = genericRnf +instance Binary GithubAuth diff --git a/Github/Data/Definitions.hs b/Github/Data/Definitions.hs index e4a66b9e..846fdac0 100644 --- a/Github/Data/Definitions.hs +++ b/Github/Data/Definitions.hs @@ -5,6 +5,7 @@ module Github.Data.Definitions where import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) +import Data.Binary.Orphans (Binary) import Data.Data (Data, Typeable) import Data.Text (Text) import Data.Time (UTCTime) @@ -31,7 +32,9 @@ data Error = | ParseError Text -- ^ An error in the parser itself. | JsonError Text -- ^ The JSON is malformed or unexpected. | UserError Text -- ^ Incorrect input. - deriving Show + deriving (Show, Typeable) + +instance E.Exception Error data SimpleOwner = SimpleUserOwner { simpleOwnerAvatarUrl :: !Text @@ -48,6 +51,7 @@ data SimpleOwner = SimpleUserOwner { } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData SimpleOwner where rnf = genericRnf +instance Binary SimpleOwner data Stats = Stats { statsAdditions :: !Int @@ -56,6 +60,7 @@ data Stats = Stats { } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Stats where rnf = genericRnf +instance Binary Stats data Comment = Comment { commentPosition :: !(Maybe Int) @@ -72,18 +77,21 @@ data Comment = Comment { } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Comment where rnf = genericRnf +instance Binary Comment data NewComment = NewComment { newCommentBody :: !Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData NewComment where rnf = genericRnf +instance Binary NewComment data EditComment = EditComment { editCommentBody :: !Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData EditComment where rnf = genericRnf +instance Binary EditComment data SimpleOrganization = SimpleOrganization { simpleOrganizationUrl :: !Text @@ -93,6 +101,7 @@ data SimpleOrganization = SimpleOrganization { } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData SimpleOrganization where rnf = genericRnf +instance Binary SimpleOrganization data Organization = Organization { organizationType :: !Text @@ -114,6 +123,7 @@ data Organization = Organization { } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Organization where rnf = genericRnf +instance Binary Organization data Content = ContentFile ContentFileData @@ -121,6 +131,7 @@ data Content deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Content where rnf = genericRnf +instance Binary Content data ContentFileData = ContentFileData { contentFileInfo :: !ContentInfo @@ -130,6 +141,7 @@ data ContentFileData = ContentFileData { } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData ContentFileData where rnf = genericRnf +instance Binary ContentFileData -- | An item in a directory listing. data ContentItem = ContentItem { @@ -138,11 +150,13 @@ data ContentItem = ContentItem { } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData ContentItem where rnf = genericRnf +instance Binary ContentItem data ContentItemType = ItemFile | ItemDir deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData ContentItemType where rnf = genericRnf +instance Binary ContentItemType -- | Information common to both kinds of Content: files and directories. data ContentInfo = ContentInfo { @@ -155,6 +169,7 @@ data ContentInfo = ContentInfo { } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData ContentInfo where rnf = genericRnf +instance Binary ContentInfo data Contributor -- | An existing Github user, with their number of contributions, avatar @@ -165,6 +180,7 @@ data Contributor deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Contributor where rnf = genericRnf +instance Binary Contributor data GithubOwner = GithubUser { githubOwnerCreatedAt :: !UTCTime @@ -207,3 +223,4 @@ data GithubOwner = GithubUser { } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData GithubOwner where rnf = genericRnf +instance Binary GithubOwner diff --git a/Github/Data/Gists.hs b/Github/Data/Gists.hs index 737607a0..52ad8461 100644 --- a/Github/Data/Gists.hs +++ b/Github/Data/Gists.hs @@ -8,6 +8,7 @@ import Github.Data.Name (Name) import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) +import Data.Binary (Binary) import Data.Data (Data, Typeable) import Data.Text (Text) import Data.Time (UTCTime) @@ -30,6 +31,7 @@ data Gist = Gist { } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Gist where rnf = genericRnf +instance Binary Gist data GistFile = GistFile { gistFileType :: !Text @@ -41,6 +43,7 @@ data GistFile = GistFile { } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData GistFile where rnf = genericRnf +instance Binary GistFile data GistComment = GistComment { gistCommentUser :: !SimpleOwner @@ -52,3 +55,4 @@ data GistComment = GistComment { } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData GistComment where rnf = genericRnf +instance Binary GistComment diff --git a/Github/Data/GitData.hs b/Github/Data/GitData.hs index b80b26bc..0b16450c 100644 --- a/Github/Data/GitData.hs +++ b/Github/Data/GitData.hs @@ -7,6 +7,7 @@ import Github.Data.Name (Name) import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) +import Data.Binary (Binary) import Data.Data (Data, Typeable) import Data.Text (Text) import Data.Time (UTCTime) @@ -25,6 +26,7 @@ data Commit = Commit { } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Commit where rnf = genericRnf +instance Binary Commit data Tree = Tree { treeSha :: !(Name Tree) @@ -33,6 +35,7 @@ data Tree = Tree { } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Tree where rnf = genericRnf +instance Binary Tree data GitTree = GitTree { gitTreeType :: !Text @@ -45,6 +48,7 @@ data GitTree = GitTree { } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData GitTree where rnf = genericRnf +instance Binary GitTree data GitCommit = GitCommit { gitCommitMessage :: !Text @@ -57,6 +61,7 @@ data GitCommit = GitCommit { } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData GitCommit where rnf = genericRnf +instance Binary GitCommit data Blob = Blob { blobUrl :: !Text @@ -67,6 +72,7 @@ data Blob = Blob { } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Blob where rnf = genericRnf +instance Binary Blob data Tag = Tag { tagName :: !Text @@ -76,6 +82,7 @@ data Tag = Tag { } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Tag where rnf = genericRnf +instance Binary Tag data Branch = Branch { branchName :: !Text @@ -90,6 +97,7 @@ data BranchCommit = BranchCommit { } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData BranchCommit where rnf = genericRnf +instance Binary BranchCommit data Diff = Diff { diffStatus :: !Text @@ -107,6 +115,7 @@ data Diff = Diff { } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Diff where rnf = genericRnf +instance Binary Diff data NewGitReference = NewGitReference { newGitReferenceRef :: !Text @@ -114,6 +123,7 @@ data NewGitReference = NewGitReference { } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData NewGitReference where rnf = genericRnf +instance Binary NewGitReference data GitReference = GitReference { gitReferenceObject :: !GitObject @@ -122,6 +132,7 @@ data GitReference = GitReference { } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData GitReference where rnf = genericRnf +instance Binary GitReference data GitObject = GitObject { gitObjectType :: !Text @@ -130,6 +141,7 @@ data GitObject = GitObject { } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData GitObject where rnf = genericRnf +instance Binary GitObject data GitUser = GitUser { gitUserName :: !Text @@ -138,6 +150,7 @@ data GitUser = GitUser { } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData GitUser where rnf = genericRnf +instance Binary GitUser data File = File { fileBlobUrl :: !Text @@ -152,3 +165,4 @@ data File = File { } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData File where rnf = genericRnf +instance Binary File diff --git a/Github/Data/Id.hs b/Github/Data/Id.hs index ce5b9eb3..b513de49 100644 --- a/Github/Data/Id.hs +++ b/Github/Data/Id.hs @@ -8,6 +8,7 @@ module Github.Data.Id ( import Control.DeepSeq (NFData (..)) import Data.Aeson.Compat (FromJSON (..), ToJSON (..)) +import Data.Binary (Binary) import Data.Data (Data, Typeable) import Data.Hashable (Hashable) import GHC.Generics (Generic) @@ -24,6 +25,7 @@ untagId :: Id entity -> Int untagId (Id name) = name instance Hashable (Id entity) +instance Binary (Id entity) instance NFData (Id entity) where rnf (Id s) = rnf s diff --git a/Github/Data/Issues.hs b/Github/Data/Issues.hs index 9e380895..848da553 100644 --- a/Github/Data/Issues.hs +++ b/Github/Data/Issues.hs @@ -8,6 +8,7 @@ import Github.Data.PullRequests import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) +import Data.Binary (Binary) import Data.Data (Data, Typeable) import Data.Text (Text) import Data.Time (UTCTime) @@ -36,6 +37,7 @@ data Issue = Issue { } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Issue where rnf = genericRnf +instance Binary Issue data NewIssue = NewIssue { newIssueTitle :: Text @@ -46,6 +48,7 @@ data NewIssue = NewIssue { } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData NewIssue where rnf = genericRnf +instance Binary NewIssue data EditIssue = EditIssue { editIssueTitle :: Maybe Text @@ -57,6 +60,7 @@ data EditIssue = EditIssue { } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData EditIssue where rnf = genericRnf +instance Binary EditIssue data Milestone = Milestone { milestoneCreator :: SimpleOwner @@ -72,6 +76,7 @@ data Milestone = Milestone { } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Milestone where rnf = genericRnf +instance Binary Milestone data IssueLabel = IssueLabel { labelColor :: Text @@ -80,6 +85,7 @@ data IssueLabel = IssueLabel { } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData IssueLabel where rnf = genericRnf +instance Binary IssueLabel data IssueComment = IssueComment { issueCommentUpdatedAt :: UTCTime @@ -92,6 +98,7 @@ data IssueComment = IssueComment { } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData IssueComment where rnf = genericRnf +instance Binary IssueComment data EventType = Mentioned -- ^ The actor was @mentioned in an issue body. @@ -115,6 +122,7 @@ data EventType = deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData EventType where rnf = genericRnf +instance Binary EventType -- | Issue event data Event = Event { @@ -128,6 +136,7 @@ data Event = Event { } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Event where rnf = genericRnf +instance Binary Event -- | A data structure for describing how to filter issues. This is used by -- @issuesForRepo@. @@ -149,3 +158,4 @@ data IssueLimitation = deriving (Eq, Ord, Show, Typeable, Data, Generic) instance NFData IssueLimitation where rnf = genericRnf +instance Binary IssueLimitation diff --git a/Github/Data/Name.hs b/Github/Data/Name.hs index df8ebb06..f61ecbd9 100644 --- a/Github/Data/Name.hs +++ b/Github/Data/Name.hs @@ -6,13 +6,14 @@ module Github.Data.Name ( untagName, ) where -import Control.DeepSeq (NFData (..)) -import Data.Aeson.Compat (FromJSON (..), ToJSON (..)) -import Data.Data (Data, Typeable) -import Data.Hashable (Hashable) -import Data.String (IsString (..)) -import Data.Text (Text) -import GHC.Generics (Generic) +import Control.DeepSeq (NFData (..)) +import Data.Aeson.Compat (FromJSON (..), ToJSON (..)) +import Data.Binary.Orphans (Binary) +import Data.Data (Data, Typeable) +import Data.Hashable (Hashable) +import Data.String (IsString (..)) +import Data.Text (Text) +import GHC.Generics (Generic) newtype Name entity = N Text deriving (Eq, Ord, Show, Generic, Typeable, Data) @@ -25,6 +26,7 @@ untagName :: Name entity -> Text untagName (N name) = name instance Hashable (Name entity) +instance Binary (Name entity) instance NFData (Name entity) where rnf (N s) = rnf s diff --git a/Github/Data/PullRequests.hs b/Github/Data/PullRequests.hs index 12c4b441..2226f60b 100644 --- a/Github/Data/PullRequests.hs +++ b/Github/Data/PullRequests.hs @@ -7,6 +7,7 @@ import Github.Data.Repos (Repo) import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) +import Data.Binary.Orphans (Binary) import Data.Data (Data, Typeable) import Data.Text (Text) import Data.Time (UTCTime) @@ -32,6 +33,7 @@ data SimplePullRequest = SimplePullRequest { } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData SimplePullRequest where rnf = genericRnf +instance Binary SimplePullRequest data PullRequest = PullRequest { -- this is a duplication of a PullRequest @@ -65,6 +67,7 @@ data PullRequest = PullRequest { } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData PullRequest where rnf = genericRnf +instance Binary PullRequest data EditPullRequest = EditPullRequest { editPullRequestTitle :: !(Maybe Text) @@ -73,6 +76,7 @@ data EditPullRequest = EditPullRequest { } deriving (Show, Generic) instance NFData EditPullRequest where rnf = genericRnf +instance Binary EditPullRequest data CreatePullRequest = CreatePullRequest @@ -89,6 +93,7 @@ data CreatePullRequest = deriving (Show, Generic) instance NFData CreatePullRequest where rnf = genericRnf +instance Binary CreatePullRequest data PullRequestLinks = PullRequestLinks { pullRequestLinksReviewComments :: !Text @@ -98,6 +103,7 @@ data PullRequestLinks = PullRequestLinks { } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData PullRequestLinks where rnf = genericRnf +instance Binary PullRequestLinks data PullRequestCommit = PullRequestCommit { pullRequestCommitLabel :: !Text @@ -108,6 +114,7 @@ data PullRequestCommit = PullRequestCommit { } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData PullRequestCommit where rnf = genericRnf +instance Binary PullRequestCommit data PullRequestEvent = PullRequestEvent { pullRequestEventAction :: !PullRequestEventType @@ -118,6 +125,7 @@ data PullRequestEvent = PullRequestEvent { } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData PullRequestEvent where rnf = genericRnf +instance Binary PullRequestEvent data PullRequestEventType = PullRequestOpened @@ -131,6 +139,7 @@ data PullRequestEventType = deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData PullRequestEventType where rnf = genericRnf +instance Binary PullRequestEventType data PullRequestReference = PullRequestReference { pullRequestReferenceHtmlUrl :: !(Maybe Text) @@ -139,6 +148,7 @@ data PullRequestReference = PullRequestReference { } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData PullRequestReference where rnf = genericRnf +instance Binary PullRequestReference data EditPullRequestState = EditPullRequestStateOpen @@ -146,3 +156,4 @@ data EditPullRequestState = deriving (Show, Generic) instance NFData EditPullRequestState where rnf = genericRnf +instance Binary EditPullRequestState diff --git a/Github/Data/Repos.hs b/Github/Data/Repos.hs index e28df361..75142ac7 100644 --- a/Github/Data/Repos.hs +++ b/Github/Data/Repos.hs @@ -8,6 +8,7 @@ import Github.Data.Name (Name) import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) +import Data.Binary (Binary) import Data.Data (Data, Typeable) import Data.Text (Text) import Data.Time (UTCTime) @@ -47,11 +48,13 @@ data Repo = Repo { } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Repo where rnf = genericRnf +instance Binary Repo data RepoRef = RepoRef SimpleOwner (Name Repo) -- Repo owner and name deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData RepoRef where rnf = genericRnf +instance Binary RepoRef data NewRepo = NewRepo { newRepoName :: !(Name Repo) @@ -64,6 +67,7 @@ data NewRepo = NewRepo { } deriving (Eq, Ord, Show, Data, Typeable, Generic) instance NFData NewRepo where rnf = genericRnf +instance Binary NewRepo newRepo :: Name Repo -> NewRepo newRepo name = NewRepo name Nothing Nothing Nothing Nothing Nothing Nothing @@ -79,6 +83,7 @@ data EditRepo = EditRepo { } deriving (Eq, Ord, Show, Data, Typeable, Generic) instance NFData EditRepo where rnf = genericRnf +instance Binary EditRepo -- | Filter the list of the user's repos using any of these constructors. data RepoPublicity = @@ -94,6 +99,7 @@ data Languages = Languages { getLanguages :: Vector Language } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Languages where rnf = genericRnf +instance Binary Languages -- | A programming language with the name and number of characters written in -- it. @@ -101,3 +107,4 @@ data Language = Language !Text !Int deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Language where rnf = genericRnf +instance Binary Language diff --git a/Github/Data/Search.hs b/Github/Data/Search.hs index d9fdfaa5..c3bcb61b 100644 --- a/Github/Data/Search.hs +++ b/Github/Data/Search.hs @@ -7,6 +7,7 @@ import Github.Data.Repos (Repo) import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) +import Data.Binary (Binary) import Data.Data (Data, Typeable) import Data.Text (Text) import Data.Vector (Vector) @@ -18,6 +19,7 @@ data SearchReposResult = SearchReposResult { } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData SearchReposResult where rnf = genericRnf +instance Binary SearchReposResult data Code = Code { codeName :: !Text @@ -30,6 +32,7 @@ data Code = Code { } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Code where rnf = genericRnf +instance Binary Code data SearchCodeResult = SearchCodeResult { searchCodeTotalCount :: !Int @@ -37,6 +40,7 @@ data SearchCodeResult = SearchCodeResult { } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData SearchCodeResult where rnf = genericRnf +instance Binary SearchCodeResult data SearchIssuesResult = SearchIssuesResult { searchIssuesTotalCount :: !Int @@ -44,3 +48,4 @@ data SearchIssuesResult = SearchIssuesResult { } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData SearchIssuesResult where rnf = genericRnf +instance Binary SearchIssuesResult diff --git a/Github/Data/Teams.hs b/Github/Data/Teams.hs index 8c6661b5..36177742 100644 --- a/Github/Data/Teams.hs +++ b/Github/Data/Teams.hs @@ -6,6 +6,7 @@ import Github.Data.Definitions import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) +import Data.Binary (Binary) import Data.Data (Data, Typeable) import Data.Text (Text) import Data.Vector (Vector) @@ -21,6 +22,7 @@ data Privacy = deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Privacy where rnf = genericRnf +instance Binary Privacy data Permission = PermissionPull @@ -29,6 +31,7 @@ data Permission = deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Permission where rnf = genericRnf +instance Binary Permission data SimpleTeam = SimpleTeam { simpleTeamId :: !(Id Team) @@ -43,6 +46,7 @@ data SimpleTeam = SimpleTeam { } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData SimpleTeam where rnf = genericRnf +instance Binary SimpleTeam data Team = Team { teamId :: !(Id Team) @@ -60,6 +64,7 @@ data Team = Team { } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Team where rnf = genericRnf +instance Binary Team data CreateTeam = CreateTeam { createTeamName :: !(Name Team) @@ -69,7 +74,8 @@ data CreateTeam = CreateTeam { ,createTeamPermission :: Permission } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData CreateTeam +instance NFData CreateTeam where rnf = genericRnf +instance Binary CreateTeam data EditTeam = EditTeam { editTeamName :: !(Name Team) @@ -79,6 +85,7 @@ data EditTeam = EditTeam { } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData EditTeam where rnf = genericRnf +instance Binary EditTeam data Role = RoleMaintainer @@ -86,6 +93,7 @@ data Role = deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Role +instance Binary Role data ReqState = StatePending @@ -93,6 +101,7 @@ data ReqState = deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData ReqState where rnf = genericRnf +instance Binary ReqState data TeamMembership = TeamMembership { teamMembershipUrl :: !Text, @@ -101,9 +110,11 @@ data TeamMembership = TeamMembership { } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData TeamMembership where rnf = genericRnf +instance Binary TeamMembership data CreateTeamMembership = CreateTeamMembership { createTeamMembershipRole :: !Role } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData CreateTeamMembership where rnf = genericRnf +instance Binary CreateTeamMembership diff --git a/Github/Data/Webhooks.hs b/Github/Data/Webhooks.hs index 92b68cea..7000a72e 100644 --- a/Github/Data/Webhooks.hs +++ b/Github/Data/Webhooks.hs @@ -7,6 +7,7 @@ import Github.Data.Id (Id) import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) +import Data.Binary.Orphans (Binary) import Data.Data (Data, Typeable) import Data.Text (Text) import Data.Time (UTCTime) @@ -29,6 +30,7 @@ data RepoWebhook = RepoWebhook { } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData RepoWebhook where rnf = genericRnf +instance Binary RepoWebhook data RepoWebhookEvent = WebhookWildcardEvent @@ -54,6 +56,7 @@ data RepoWebhookEvent = deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData RepoWebhookEvent where rnf = genericRnf +instance Binary RepoWebhookEvent data RepoWebhookResponse = RepoWebhookResponse { repoWebhookResponseCode :: !(Maybe Int) @@ -62,6 +65,7 @@ data RepoWebhookResponse = RepoWebhookResponse { } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData RepoWebhookResponse where rnf = genericRnf +instance Binary RepoWebhookResponse data PingEvent = PingEvent { pingEventZen :: !Text @@ -70,6 +74,7 @@ data PingEvent = PingEvent { } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData PingEvent where rnf = genericRnf +instance Binary PingEvent data NewRepoWebhook = NewRepoWebhook { newRepoWebhookName :: !Text @@ -79,6 +84,7 @@ data NewRepoWebhook = NewRepoWebhook { } deriving (Eq, Ord, Show, Typeable, Data, Generic) instance NFData NewRepoWebhook where rnf = genericRnf +instance Binary NewRepoWebhook data EditRepoWebhook = EditRepoWebhook { editRepoWebhookConfig :: !(Maybe (M.Map Text Text)) @@ -89,3 +95,4 @@ data EditRepoWebhook = EditRepoWebhook { } deriving (Eq, Ord, Show, Typeable, Data, Generic) instance NFData EditRepoWebhook where rnf = genericRnf +instance Binary EditRepoWebhook diff --git a/github.cabal b/github.cabal index c9e5767c..8ba08e26 100644 --- a/github.cabal +++ b/github.cabal @@ -83,6 +83,8 @@ Library attoparsec >=0.11.3.4 && <0.14, base-compat >=0.6.0 && <0.9, base16-bytestring >=0.1.1.6 && <0.2, + binary >=0.7.1.0 && <0.9, + binary-orphans >=0.1.0.0 && <0.2, byteable >=0.1.1 && <0.2, bytestring >=0.10.4.0 && <0.11, case-insensitive >=1.2.0.4 && <1.3, diff --git a/stack-lts-2.yaml b/stack-lts-2.yaml index 1c12f17b..5ae8c4cd 100644 --- a/stack-lts-2.yaml +++ b/stack-lts-2.yaml @@ -3,6 +3,7 @@ packages: - 'samples/' extra-deps: - aeson-extra-0.2.3.0 +- binary-orphans-0.1.3.0 - http-link-header-1.0.1 - iso8601-time-0.1.4 resolver: lts-2.22 From 30e6d7beb4f8b7e9ee981eb3dac42dec4aa3287e Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sat, 16 Jan 2016 14:55:21 +0200 Subject: [PATCH 154/510] Support base-compat-0.9 --- github.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/github.cabal b/github.cabal index 8ba08e26..99397485 100644 --- a/github.cabal +++ b/github.cabal @@ -81,7 +81,7 @@ Library Build-depends: base >= 4.7 && <4.9, aeson >=0.7.0.6 && <0.11, attoparsec >=0.11.3.4 && <0.14, - base-compat >=0.6.0 && <0.9, + base-compat >=0.6.0 && <0.10, base16-bytestring >=0.1.1.6 && <0.2, binary >=0.7.1.0 && <0.9, binary-orphans >=0.1.0.0 && <0.2, From c76d2a26c1daae622e53dbc3a0d63928bec27a2e Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 18 Jan 2016 09:24:03 +0200 Subject: [PATCH 155/510] Refactor search result --- Github/Data.hs | 21 ++++----------------- Github/Data/Search.hs | 26 +++++--------------------- Github/Search.hs | 18 +++++++++--------- spec/Github/SearchSpec.hs | 10 +++++----- 4 files changed, 23 insertions(+), 52 deletions(-) diff --git a/Github/Data.hs b/Github/Data.hs index 0b426b5f..9ba85541 100644 --- a/Github/Data.hs +++ b/Github/Data.hs @@ -563,17 +563,10 @@ instance FromJSON PingEvent where <*> o .: "hook_id" parseJSON _ = fail "Could not build a PingEvent" -instance FromJSON SearchReposResult where - parseJSON (Object o) = - SearchReposResult <$> o .: "total_count" - <*> o .:< "items" - parseJSON _ = fail "Could not build a SearchReposResult" - -instance FromJSON SearchIssuesResult where - parseJSON (Object o) = - SearchIssuesResult <$> o .: "total_count" - <*> o .:< "items" - parseJSON _ = fail "Could not build a SearchIssuesResult" +instance FromJSON entity => FromJSON (SearchResult entity) where + parseJSON = withObject "Searchresult" $ \o -> + SearchResult <$> o .: "total_count" + <*> o .:< "items" instance FromJSON Repo where parseJSON (Object o) = @@ -644,12 +637,6 @@ instance ToJSON EditRepo where , "has_downloads" .= hasDownloads ] -instance FromJSON SearchCodeResult where - parseJSON (Object o) = - SearchCodeResult <$> o .: "total_count" - <*> o .:< "items" - parseJSON _ = fail "Could not build a SearchCodeResult" - instance FromJSON Code where parseJSON (Object o ) = Code <$> o .: "name" diff --git a/Github/Data/Search.hs b/Github/Data/Search.hs index c3bcb61b..89bef5c9 100644 --- a/Github/Data/Search.hs +++ b/Github/Data/Search.hs @@ -13,13 +13,13 @@ import Data.Text (Text) import Data.Vector (Vector) import GHC.Generics (Generic) -data SearchReposResult = SearchReposResult { - searchReposTotalCount :: !Int - ,searchReposRepos :: !(Vector Repo) +data SearchResult entity = SearchResult { + searchResultTotalCount :: !Int + ,searchResultResults :: !(Vector entity) } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData SearchReposResult where rnf = genericRnf -instance Binary SearchReposResult +instance NFData entity => NFData (SearchResult entity) where rnf = genericRnf +instance Binary entity => Binary (SearchResult entity) data Code = Code { codeName :: !Text @@ -33,19 +33,3 @@ data Code = Code { instance NFData Code where rnf = genericRnf instance Binary Code - -data SearchCodeResult = SearchCodeResult { - searchCodeTotalCount :: !Int - ,searchCodeCodes :: !(Vector Code) -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData SearchCodeResult where rnf = genericRnf -instance Binary SearchCodeResult - -data SearchIssuesResult = SearchIssuesResult { - searchIssuesTotalCount :: !Int - ,searchIssuesIssues :: !(Vector Issue) -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData SearchIssuesResult where rnf = genericRnf -instance Binary SearchIssuesResult diff --git a/Github/Search.hs b/Github/Search.hs index 645940a8..f5319d77 100644 --- a/Github/Search.hs +++ b/Github/Search.hs @@ -26,55 +26,55 @@ import Github.Request -- With authentication. -- -- > searchRepos' (Just $ GithubBasicAuth "github-username" "github-password') "a in%3Aname language%3Ahaskell created%3A>2013-10-01&per_page=100" -searchRepos' :: Maybe GithubAuth -> Text -> IO (Either Error SearchReposResult) +searchRepos' :: Maybe GithubAuth -> Text -> IO (Either Error (SearchResult Repo)) searchRepos' auth = executeRequestMaybe auth . searchReposR -- | Perform a repository search. -- Without authentication. -- -- > searchRepos "q=a in%3Aname language%3Ahaskell created%3A>2013-10-01&per_page=100" -searchRepos :: Text -> IO (Either Error SearchReposResult) +searchRepos :: Text -> IO (Either Error (SearchResult Repo)) searchRepos = searchRepos' Nothing -- | Search repositories. -- See -searchReposR :: Text -> GithubRequest k SearchReposResult +searchReposR :: Text -> GithubRequest k (SearchResult Repo) searchReposR searchString = GithubGet ["search", "repositories"] [("q", Just $ TE.encodeUtf8 searchString)] -- | Perform a code search. -- With authentication. -- -- > searchCode' (Just $ GithubBasicAuth "github-username" "github-password') "a in%3Aname language%3Ahaskell created%3A>2013-10-01&per_page=100" -searchCode' :: Maybe GithubAuth -> Text -> IO (Either Error SearchCodeResult) +searchCode' :: Maybe GithubAuth -> Text -> IO (Either Error (SearchResult Code)) searchCode' auth = executeRequestMaybe auth . searchCodeR -- | Perform a code search. -- Without authentication. -- -- > searchCode "q=addClass+in:file+language:js+repo:jquery/jquery" -searchCode :: Text -> IO (Either Error SearchCodeResult) +searchCode :: Text -> IO (Either Error (SearchResult Code)) searchCode = searchCode' Nothing -- | Search code. -- See -searchCodeR :: Text -> GithubRequest k SearchCodeResult +searchCodeR :: Text -> GithubRequest k (SearchResult Code) searchCodeR searchString = GithubGet ["search", "code"] [("q", Just $ TE.encodeUtf8 searchString)] -- | Perform an issue search. -- With authentication. -- -- > searchIssues' (Just $ GithubBasicAuth "github-username" "github-password') "a repo%3Aphadej%2Fgithub&per_page=100" -searchIssues' :: Maybe GithubAuth -> Text -> IO (Either Error SearchIssuesResult) +searchIssues' :: Maybe GithubAuth -> Text -> IO (Either Error (SearchResult Issue)) searchIssues' auth = executeRequestMaybe auth . searchIssuesR -- | Perform an issue search. -- Without authentication. -- -- > searchIssues "q=a repo%3Aphadej%2Fgithub&per_page=100" -searchIssues :: Text -> IO (Either Error SearchIssuesResult) +searchIssues :: Text -> IO (Either Error (SearchResult Issue)) searchIssues = searchIssues' Nothing -- | Search issues. -- See -searchIssuesR :: Text -> GithubRequest k SearchIssuesResult +searchIssuesR :: Text -> GithubRequest k (SearchResult Issue) searchIssuesR searchString = GithubGet ["search", "issues"] [("q", Just $ TE.encodeUtf8 searchString)] diff --git a/spec/Github/SearchSpec.hs b/spec/Github/SearchSpec.hs index e8f4dacd..e8b63f0c 100644 --- a/spec/Github/SearchSpec.hs +++ b/spec/Github/SearchSpec.hs @@ -13,7 +13,7 @@ import qualified Data.Vector as V import Github.Data.Id (Id (..)) import Github.Data.Issues (Issue (..)) -import Github.Search (SearchIssuesResult (..), searchIssues) +import Github.Search (SearchResult (..), searchIssues) fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b @@ -23,10 +23,10 @@ spec :: Spec spec = do describe "searchIssues" $ do it "decodes issue search response JSON" $ do - let searchIssuesResult = fromRightS $ eitherDecodeStrict $(embedFile "fixtures/issueSearch.json") :: SearchIssuesResult - searchIssuesTotalCount searchIssuesResult `shouldBe` 2 + let searchIssuesResult = fromRightS $ eitherDecodeStrict $(embedFile "fixtures/issueSearch.json") :: SearchResult Issue + searchResultTotalCount searchIssuesResult `shouldBe` 2 - let issues = searchIssuesIssues searchIssuesResult + let issues = searchResultResults searchIssuesResult V.length issues `shouldBe` 2 let issue1 = issues V.! 0 @@ -43,6 +43,6 @@ spec = do it "performs an issue search via the API" $ do let query = "Decouple in:title repo:phadej/github created:<=2015-12-01" - issues <- searchIssuesIssues . fromRightS <$> searchIssues query + issues <- searchResultResults . fromRightS <$> searchIssues query length issues `shouldBe` 1 issueId (V.head issues) `shouldBe` Id 119694665 From b48274ed86dd7099496abc7aa3bf9eac485b1e49 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 18 Jan 2016 12:45:58 +0200 Subject: [PATCH 156/510] Update stack resolvers --- .travis.yml | 8 ++++---- stack-lts-3.yaml | 2 +- stack-lts-4.yaml | 2 +- 3 files changed, 6 insertions(+), 6 deletions(-) diff --git a/.travis.yml b/.travis.yml index 0b9fbb0e..72d81f5d 100644 --- a/.travis.yml +++ b/.travis.yml @@ -24,14 +24,14 @@ matrix: - env: BUILD=cabal CABALVER=1.18 GHCVER=7.8.4 STACKAGESNAPSHOT=lts-2.22 compiler: ": #GHC 7.8.4 lts-2.22" addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4], sources: [hvr-ghc]}} - - env: BUILD=cabal CABALVER=1.22 GHCVER=7.10.2 STACKAGESNAPSHOT=lts-3.21 - compiler: ": #GHC 7.10.2 lts-3.21" + - env: BUILD=cabal CABALVER=1.22 GHCVER=7.10.2 STACKAGESNAPSHOT=lts-3.22 + compiler: ": #GHC 7.10.2 lts-3.22" addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.2], sources: [hvr-ghc]}} - env: BUILD=cabal CABALVER=1.22 GHCVER=7.10.3 compiler: ": #GHC 7.10.3" addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3], sources: [hvr-ghc]}} - - env: BUILD=cabal CABALVER=1.22 GHCVER=7.10.3 STACKAGESNAPSHOT=lts-4.0 - compiler: ": #GHC 7.10.3 lts-4.0" + - env: BUILD=cabal CABALVER=1.22 GHCVER=7.10.3 STACKAGESNAPSHOT=lts-4.2 + compiler: ": #GHC 7.10.3 lts-4.2" addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3], sources: [hvr-ghc]}} - env: BUILD=stack STACK_YAML=stack-lts-2.yaml GHCVER=7.8.4 compiler: ": #STACK LTS2" diff --git a/stack-lts-3.yaml b/stack-lts-3.yaml index 539d43cb..99e61ab2 100644 --- a/stack-lts-3.yaml +++ b/stack-lts-3.yaml @@ -4,7 +4,7 @@ packages: extra-deps: - http-link-header-1.0.1 - iso8601-time-0.1.4 -resolver: lts-3.21 +resolver: lts-3.22 flags: github: aeson-compat: false diff --git a/stack-lts-4.yaml b/stack-lts-4.yaml index c6c28f11..d66950a2 100644 --- a/stack-lts-4.yaml +++ b/stack-lts-4.yaml @@ -2,7 +2,7 @@ packages: - '.' - 'samples/' extra-deps: [] -resolver: lts-4.0 +resolver: lts-4.2 flags: github: aeson-compat: true From ca3ed56556da6d44294d8e45bcd39f46c6745752 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 18 Jan 2016 12:46:34 +0200 Subject: [PATCH 157/510] userInfoCurrent' requires auth --- Github/Users.hs | 7 ++----- spec/Github/UsersSpec.hs | 2 +- 2 files changed, 3 insertions(+), 6 deletions(-) diff --git a/Github/Users.hs b/Github/Users.hs index 49f667a6..157ef847 100644 --- a/Github/Users.hs +++ b/Github/Users.hs @@ -10,7 +10,6 @@ module Github.Users ( ,module Github.Data ) where -import Github.Auth import Github.Data import Github.Request @@ -35,11 +34,9 @@ userInfoForR userName = GithubGet ["users", toPathPart userName] [] -- | Retrieve information about the user associated with the supplied authentication. -- -- > userInfoCurrent' (GithubOAuth "...") --- --- TODO: Change to require 'GithubAuth'? -userInfoCurrent' :: Maybe GithubAuth -> IO (Either Error GithubOwner) +userInfoCurrent' :: GithubAuth -> IO (Either Error GithubOwner) userInfoCurrent' auth = - executeRequestMaybe auth . unsafeDropAuthRequirements $ userInfoCurrentR + executeRequest auth $ userInfoCurrentR -- | Get the authenticated user. -- See diff --git a/spec/Github/UsersSpec.hs b/spec/Github/UsersSpec.hs index 8f970f4f..1593c3e6 100644 --- a/spec/Github/UsersSpec.hs +++ b/spec/Github/UsersSpec.hs @@ -39,7 +39,7 @@ spec = do describe "userInfoCurrent'" $ do it "returns information about the autenticated user" $ withAuth $ \auth -> do - userInfo <- userInfoCurrent' (Just auth) + userInfo <- userInfoCurrent' auth userInfo `shouldSatisfy` isRight describe "usersFollowing" $ do From 9501d384f2d9dd221e1015df74ec9d0319192803 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 18 Jan 2016 13:31:39 +0200 Subject: [PATCH 158/510] Status response handling --- Github/Data/Request.hs | 50 ++++++++++++++++++++++------- Github/Data/Search.hs | 3 +- Github/Gists.hs | 1 - Github/Gists/Comments.hs | 3 +- Github/GitData/Blobs.hs | 1 - Github/GitData/References.hs | 2 +- Github/GitData/Trees.hs | 1 - Github/Issues.hs | 1 - Github/Issues/Comments.hs | 2 +- Github/Issues/Events.hs | 4 +-- Github/Issues/Labels.hs | 2 +- Github/Issues/Milestones.hs | 4 +-- Github/Organizations.hs | 1 - Github/Organizations/Members.hs | 4 +-- Github/Organizations/Teams.hs | 2 +- Github/PullRequests.hs | 14 ++++---- Github/Repos.hs | 1 - Github/Repos/Collaborators.hs | 10 +++--- Github/Repos/Comments.hs | 1 - Github/Repos/Commits.hs | 1 - Github/Repos/Forks.hs | 1 - Github/Repos/Webhooks.hs | 18 +++++------ Github/Request.hs | 57 +++++++++++++++++++++------------ Github/Search.hs | 1 - run.sh | 1 + src/highlight.js | 27 ++++++++++++++++ src/style.css | 55 +++++++++++++++++++++++++++++++ 27 files changed, 189 insertions(+), 79 deletions(-) create mode 100644 run.sh create mode 100644 src/highlight.js create mode 100644 src/style.css diff --git a/Github/Data/Request.hs b/Github/Data/Request.hs index 6d52d5c4..02fe3943 100644 --- a/Github/Data/Request.hs +++ b/Github/Data/Request.hs @@ -11,18 +11,19 @@ module Github.Data.Request ( GithubRequest(..), PostMethod(..), toMethod, + StatusMap(..), + MergeResult(..), Paths, IsPathPart(..), QueryString, Count, ) where -import Data.Aeson.Compat (FromJSON) -import Data.Hashable (Hashable (..)) -import Data.Typeable (Typeable) -import Data.Vector (Vector) -import GHC.Generics (Generic) -import Network.HTTP.Types (Status) +import Data.Aeson.Compat (FromJSON) +import Data.Hashable (Hashable (..)) +import Data.Typeable (Typeable) +import Data.Vector (Vector) +import GHC.Generics (Generic) import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS @@ -60,6 +61,32 @@ toMethod Put = Method.methodPut instance Hashable PostMethod +-- | Result of merge operation +data MergeResult = MergeSuccessful + | MergeCannotPerform + | MergeConflict + deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable) + +instance Hashable MergeResult + +-- | Status code transform +data StatusMap a where + StatusOnlyOk :: StatusMap Bool + StatusMerge :: StatusMap MergeResult + deriving (Typeable) + +deriving instance Eq (StatusMap a) + +instance Show (StatusMap a) where + showsPrec _ r = + case r of + StatusOnlyOk -> showString "StatusOnlyOK" + StatusMerge -> showString "StatusMerge" + +instance Hashable (StatusMap a) where + hashWithSalt salt StatusOnlyOk = hashWithSalt salt (0 :: Int) + hashWithSalt salt StatusMerge = hashWithSalt salt (1 :: Int) + ------------------------------------------------------------------------------ -- Github request ------------------------------------------------------------------------------ @@ -70,14 +97,12 @@ instance Hashable PostMethod -- * @a@ is the result type -- -- /Note:/ 'GithubRequest' is not 'Functor' on purpose. --- --- TODO: Add constructor for collection fetches. data GithubRequest (k :: Bool) a where GithubGet :: FromJSON a => Paths -> QueryString -> GithubRequest k a GithubPagedGet :: FromJSON (Vector a) => Paths -> QueryString -> Maybe Count -> GithubRequest k (Vector a) GithubPost :: FromJSON a => PostMethod -> Paths -> LBS.ByteString -> GithubRequest 'True a GithubDelete :: Paths -> GithubRequest 'True () - GithubStatus :: GithubRequest k () -> GithubRequest k Status + GithubStatus :: StatusMap a -> GithubRequest k () -> GithubRequest k a deriving (Typeable) deriving instance Eq (GithubRequest k a) @@ -107,8 +132,10 @@ instance Show (GithubRequest k a) where GithubDelete ps -> showParen (d > appPrec) $ showString "GithubDelete " . showsPrec (appPrec + 1) ps - GithubStatus req -> showParen (d > appPrec) $ + GithubStatus m req -> showParen (d > appPrec) $ showString "GithubStatus " + . showsPrec (appPrec + 1) m + . showString " " . showsPrec (appPrec + 1) req where appPrec = 10 :: Int @@ -130,6 +157,7 @@ instance Hashable (GithubRequest k a) where hashWithSalt salt (GithubDelete ps) = salt `hashWithSalt` (3 :: Int) `hashWithSalt` ps - hashWithSalt salt (GithubStatus req) = + hashWithSalt salt (GithubStatus sm req) = salt `hashWithSalt` (4 :: Int) + `hashWithSalt` sm `hashWithSalt` req diff --git a/Github/Data/Search.hs b/Github/Data/Search.hs index 89bef5c9..84936295 100644 --- a/Github/Data/Search.hs +++ b/Github/Data/Search.hs @@ -2,8 +2,7 @@ {-# LANGUAGE DeriveGeneric #-} module Github.Data.Search where -import Github.Data.Issues (Issue) -import Github.Data.Repos (Repo) +import Github.Data.Repos (Repo) import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) diff --git a/Github/Gists.hs b/Github/Gists.hs index 12e083f0..88fa9828 100644 --- a/Github/Gists.hs +++ b/Github/Gists.hs @@ -10,7 +10,6 @@ module Github.Gists ( ) where import Data.Vector (Vector) -import Github.Auth import Github.Data import Github.Request diff --git a/Github/Gists/Comments.hs b/Github/Gists/Comments.hs index 1613933f..277c7f15 100644 --- a/Github/Gists/Comments.hs +++ b/Github/Gists/Comments.hs @@ -8,7 +8,8 @@ module Github.Gists.Comments ( module Github.Data, ) where -import Data.Vector (Vector) +import Data.Vector (Vector) + import Github.Data import Github.Request diff --git a/Github/GitData/Blobs.hs b/Github/GitData/Blobs.hs index a2c64a67..0e73d0cd 100644 --- a/Github/GitData/Blobs.hs +++ b/Github/GitData/Blobs.hs @@ -7,7 +7,6 @@ module Github.GitData.Blobs ( module Github.Data, ) where -import Github.Auth import Github.Data import Github.Request diff --git a/Github/GitData/References.hs b/Github/GitData/References.hs index 7006ebd2..d0748b05 100644 --- a/Github/GitData/References.hs +++ b/Github/GitData/References.hs @@ -17,7 +17,7 @@ module Github.GitData.References ( import Data.Aeson.Compat (encode) import Data.Vector (Vector) -import Github.Auth + import Github.Data import Github.Request diff --git a/Github/GitData/Trees.hs b/Github/GitData/Trees.hs index 1af6bbb5..360ec223 100644 --- a/Github/GitData/Trees.hs +++ b/Github/GitData/Trees.hs @@ -11,7 +11,6 @@ module Github.GitData.Trees ( module Github.Data, ) where -import Github.Auth import Github.Data import Github.Request diff --git a/Github/Issues.hs b/Github/Issues.hs index 0195fd12..3ec7622e 100644 --- a/Github/Issues.hs +++ b/Github/Issues.hs @@ -19,7 +19,6 @@ module Github.Issues ( module Github.Data, ) where -import Github.Auth import Github.Data import Github.Request diff --git a/Github/Issues/Comments.hs b/Github/Issues/Comments.hs index 3dd39ef2..4dfe0280 100644 --- a/Github/Issues/Comments.hs +++ b/Github/Issues/Comments.hs @@ -17,7 +17,7 @@ module Github.Issues.Comments ( import Data.Aeson.Compat (encode) import Data.Text (Text) import Data.Vector (Vector) -import Github.Auth + import Github.Data import Github.Request diff --git a/Github/Issues/Events.hs b/Github/Issues/Events.hs index 413178ce..b8738143 100644 --- a/Github/Issues/Events.hs +++ b/Github/Issues/Events.hs @@ -13,8 +13,8 @@ module Github.Issues.Events ( module Github.Data, ) where -import Data.Vector (Vector) -import Github.Auth +import Data.Vector (Vector) + import Github.Data import Github.Request diff --git a/Github/Issues/Labels.hs b/Github/Issues/Labels.hs index 25e6153a..996ebb70 100644 --- a/Github/Issues/Labels.hs +++ b/Github/Issues/Labels.hs @@ -38,7 +38,7 @@ import Prelude.Compat import Data.Aeson.Compat (encode, object, (.=)) import Data.Foldable (toList) import Data.Vector (Vector) -import Github.Auth + import Github.Data import Github.Request diff --git a/Github/Issues/Milestones.hs b/Github/Issues/Milestones.hs index 977b8499..a5ee4f7d 100644 --- a/Github/Issues/Milestones.hs +++ b/Github/Issues/Milestones.hs @@ -9,8 +9,8 @@ module Github.Issues.Milestones ( module Github.Data, ) where -import Data.Vector (Vector) -import Github.Auth +import Data.Vector (Vector) + import Github.Data import Github.Request diff --git a/Github/Organizations.hs b/Github/Organizations.hs index fed6a6a4..e5741fd0 100644 --- a/Github/Organizations.hs +++ b/Github/Organizations.hs @@ -10,7 +10,6 @@ module Github.Organizations ( ) where import Data.Vector (Vector) -import Github.Auth import Github.Data import Github.Request diff --git a/Github/Organizations/Members.hs b/Github/Organizations/Members.hs index a31bf9ef..dba2379b 100644 --- a/Github/Organizations/Members.hs +++ b/Github/Organizations/Members.hs @@ -7,8 +7,8 @@ module Github.Organizations.Members ( module Github.Data, ) where -import Data.Vector (Vector) -import Github.Auth +import Data.Vector (Vector) + import Github.Data import Github.Request diff --git a/Github/Organizations/Teams.hs b/Github/Organizations/Teams.hs index efe6118f..f4ca2bd2 100644 --- a/Github/Organizations/Teams.hs +++ b/Github/Organizations/Teams.hs @@ -28,7 +28,7 @@ module Github.Organizations.Teams ( import Data.Aeson.Compat (encode) import Data.Vector (Vector) -import Github.Auth + import Github.Data import Github.Request diff --git a/Github/PullRequests.hs b/Github/PullRequests.hs index be78956e..b1ceb7aa 100644 --- a/Github/PullRequests.hs +++ b/Github/PullRequests.hs @@ -27,13 +27,11 @@ module Github.PullRequests ( module Github.Data ) where -import Github.Auth import Github.Data import Github.Request import Data.Aeson.Compat (Value, encode, object, (.=)) import Data.Vector (Vector) -import Network.HTTP.Types import qualified Data.ByteString.Char8 as BS8 @@ -171,25 +169,25 @@ pullRequestFilesR user repo prid = GithubPagedGet ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "files"] [] -- | Check if pull request has been merged. -isPullRequestMerged :: GithubAuth -> Name GithubOwner -> Name Repo -> Id PullRequest -> IO (Either Error Status) +isPullRequestMerged :: GithubAuth -> Name GithubOwner -> Name Repo -> Id PullRequest -> IO (Either Error Bool) isPullRequestMerged auth user repo prid = executeRequest auth $ isPullRequestMergedR user repo prid -- | Get if a pull request has been merged. -- See -isPullRequestMergedR :: Name GithubOwner -> Name Repo -> Id PullRequest -> GithubRequest k Status -isPullRequestMergedR user repo prid = GithubStatus $ +isPullRequestMergedR :: Name GithubOwner -> Name Repo -> Id PullRequest -> GithubRequest k Bool +isPullRequestMergedR user repo prid = GithubStatus StatusOnlyOk $ GithubGet ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "merge"] [] -- | Merge a pull request. -mergePullRequest :: GithubAuth -> Name GithubOwner -> Name Repo -> Id PullRequest -> Maybe String -> IO (Either Error Status) +mergePullRequest :: GithubAuth -> Name GithubOwner -> Name Repo -> Id PullRequest -> Maybe String -> IO (Either Error MergeResult) 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 PullRequest -> Maybe String -> GithubRequest 'True Status -mergePullRequestR user repo prid commitMessage = GithubStatus $ +mergePullRequestR :: Name GithubOwner -> Name Repo -> Id PullRequest -> Maybe String -> GithubRequest 'True MergeResult +mergePullRequestR user repo prid commitMessage = GithubStatus StatusMerge $ GithubPost Put paths (encode $ buildCommitMessageMap commitMessage) where paths = ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "merge"] diff --git a/Github/Repos.hs b/Github/Repos.hs index 7ace309c..15682d41 100644 --- a/Github/Repos.hs +++ b/Github/Repos.hs @@ -58,7 +58,6 @@ import Control.Applicative ((<|>)) import Data.Aeson.Compat (encode) import Data.Vector (Vector) -import Github.Auth import Github.Data import Github.Request diff --git a/Github/Repos/Collaborators.hs b/Github/Repos/Collaborators.hs index 76c172eb..c59a4d63 100644 --- a/Github/Repos/Collaborators.hs +++ b/Github/Repos/Collaborators.hs @@ -9,11 +9,9 @@ module Github.Repos.Collaborators ( module Github.Data, ) where -import Data.Vector (Vector) -import Github.Auth +import Data.Vector (Vector) import Github.Data import Github.Request -import Network.HTTP.Types (Status) -- | All the users who have collaborated on a repo. -- @@ -44,7 +42,7 @@ isCollaboratorOn :: Maybe GithubAuth -> Name GithubOwner -- ^ Repository owner -> Name Repo -- ^ Repository name -> Name GithubOwner -- ^ Collaborator? - -> IO (Either Error Status) + -> IO (Either Error Bool) isCollaboratorOn auth user repo coll = executeRequestMaybe auth $ isCollaboratorOnR user repo coll @@ -53,6 +51,6 @@ isCollaboratorOn auth user repo coll = isCollaboratorOnR :: Name GithubOwner -- ^ Repository owner -> Name Repo -- ^ Repository name -> Name GithubOwner -- ^ Collaborator? - -> GithubRequest k Status -isCollaboratorOnR user repo coll = GithubStatus $ + -> GithubRequest k Bool +isCollaboratorOnR user repo coll = GithubStatus StatusOnlyOk $ GithubGet ["repos", toPathPart user, toPathPart repo, "collaborators", toPathPart coll] [] diff --git a/Github/Repos/Comments.hs b/Github/Repos/Comments.hs index 803f6a45..9a7f0244 100644 --- a/Github/Repos/Comments.hs +++ b/Github/Repos/Comments.hs @@ -16,7 +16,6 @@ module Github.Repos.Comments ( ) where import Data.Vector (Vector) -import Github.Auth import Github.Data import Github.Request diff --git a/Github/Repos/Commits.hs b/Github/Repos/Commits.hs index 18abbeb7..c6923d96 100644 --- a/Github/Repos/Commits.hs +++ b/Github/Repos/Commits.hs @@ -27,7 +27,6 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BS8 import qualified Data.Text.Encoding as TE -import Github.Auth import Github.Data import Github.Request diff --git a/Github/Repos/Forks.hs b/Github/Repos/Forks.hs index 5e0896e6..833f5ad0 100644 --- a/Github/Repos/Forks.hs +++ b/Github/Repos/Forks.hs @@ -8,7 +8,6 @@ module Github.Repos.Forks ( ) where import Data.Vector (Vector) -import Github.Auth import Github.Data import Github.Request diff --git a/Github/Repos/Webhooks.hs b/Github/Repos/Webhooks.hs index 042ae370..b9586e87 100644 --- a/Github/Repos/Webhooks.hs +++ b/Github/Repos/Webhooks.hs @@ -29,13 +29,11 @@ module Github.Repos.Webhooks ( deleteRepoWebhookR, ) where -import Github.Auth import Github.Data import Github.Request -import Data.Aeson.Compat (encode) -import Data.Vector (Vector) -import Network.HTTP.Types (Status) +import Data.Aeson.Compat (encode) +import Data.Vector (Vector) webhooksFor' :: GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error (Vector RepoWebhook)) webhooksFor' auth user repo = @@ -77,24 +75,24 @@ editRepoWebhookR :: Name GithubOwner -> Name Repo -> Id RepoWebhook -> EditRepoW editRepoWebhookR user repo hookId hookEdit = GithubPost Patch ["repos", toPathPart user, toPathPart repo, "hooks", toPathPart hookId] (encode hookEdit) -testPushRepoWebhook' :: GithubAuth -> Name GithubOwner -> Name Repo -> Id RepoWebhook -> IO (Either Error Status) +testPushRepoWebhook' :: GithubAuth -> Name GithubOwner -> Name Repo -> Id RepoWebhook -> IO (Either Error Bool) testPushRepoWebhook' auth user repo hookId = executeRequest auth $ testPushRepoWebhookR user repo hookId -- | Test a push hook. -- See -testPushRepoWebhookR :: Name GithubOwner -> Name Repo -> Id RepoWebhook -> GithubRequest 'True Status -testPushRepoWebhookR user repo hookId = GithubStatus $ +testPushRepoWebhookR :: Name GithubOwner -> Name Repo -> Id RepoWebhook -> GithubRequest 'True Bool +testPushRepoWebhookR user repo hookId = GithubStatus StatusOnlyOk $ GithubPost Post (createWebhookOpPath user repo hookId $ Just "tests") (encode ()) -pingRepoWebhook' :: GithubAuth -> Name GithubOwner -> Name Repo -> Id RepoWebhook -> IO (Either Error Status) +pingRepoWebhook' :: GithubAuth -> Name GithubOwner -> Name Repo -> Id RepoWebhook -> IO (Either Error Bool) pingRepoWebhook' auth user repo hookId = executeRequest auth $ pingRepoWebhookR user repo hookId -- | Ping a hook. -- See -pingRepoWebhookR :: Name GithubOwner -> Name Repo -> Id RepoWebhook -> GithubRequest 'True Status -pingRepoWebhookR user repo hookId = GithubStatus $ +pingRepoWebhookR :: Name GithubOwner -> Name Repo -> Id RepoWebhook -> GithubRequest 'True Bool +pingRepoWebhookR user repo hookId = GithubStatus StatusOnlyOk $ GithubPost Post (createWebhookOpPath user repo hookId $ Just "pings") (encode ()) deleteRepoWebhook' :: GithubAuth -> Name GithubOwner -> Name Repo -> Id RepoWebhook -> IO (Either Error ()) diff --git a/Github/Request.hs b/Github/Request.hs index 22e79576..29ca8eca 100644 --- a/Github/Request.hs +++ b/Github/Request.hs @@ -25,6 +25,7 @@ module Github.Request ( -- * Tools makeHttpRequest, parseResponse, + parseStatus, getNextUrl, ) where @@ -46,7 +47,7 @@ import Data.Monoid ((<>)) import Data.Text (Text) import Network.HTTP.Client (HttpException (..), Manager, Request (..), - RequestBody (..), Response (..), + RequestBody (..), Response (..), CookieJar, applyBasicAuth, httpLbs, newManager, parseUrl, setQueryString) import Network.HTTP.Client.Internal (setUri) @@ -54,7 +55,7 @@ import Network.HTTP.Client.TLS (tlsManagerSettings) import Network.HTTP.Link.Parser (parseLinkHeaderBS) import Network.HTTP.Link.Types (Link (..), LinkParam (..), href, linkParams) -import Network.HTTP.Types (Method, RequestHeaders, Status (..), +import Network.HTTP.Types (Method, RequestHeaders, ResponseHeaders, Status (..), methodDelete) import Network.URI (URI) @@ -68,8 +69,6 @@ import Github.Auth (GithubAuth (..)) import Github.Data (Error (..)) import Github.Data.Request -import Debug.Trace - -- | Execute 'GithubRequest' in 'IO' executeRequest :: Show a => GithubAuth -> GithubRequest k a -> IO (Either Error a) @@ -106,10 +105,10 @@ executeRequestWithMgr mgr auth req = httpReq <- makeHttpRequest (Just auth) req _ <- httpLbs httpReq mgr pure . Right $ () - GithubStatus {} -> do + GithubStatus sm _ -> do httpReq <- makeHttpRequest (Just auth) req res <- httpLbs httpReq mgr - pure . Right . responseStatus $ res + pure . parseStatus sm . responseStatus $ res -- | Like 'executeRequest' but without authentication. executeRequest' :: Show a @@ -137,14 +136,11 @@ executeRequestWithMgr' mgr req = httpReq <- makeHttpRequest Nothing req performPagedRequest (flip httpLbs mgr) predicate httpReq where - predicate = maybe (const True) (\l' -> (< l') . V.length . xxx) l - GithubStatus {} -> do + predicate = maybe (const True) (\l' -> (< l') . V.length) l + GithubStatus sm _ -> do httpReq <- makeHttpRequest Nothing req res <- httpLbs httpReq mgr - pure . Right . responseStatus $ res - -xxx :: V.Vector a -> V.Vector a -xxx v = traceShow (V.length v) v + pure . parseStatus sm . responseStatus $ res -- | Helper for picking between 'executeRequest' and 'executeRequest''. -- @@ -169,25 +165,27 @@ makeHttpRequest :: MonadThrow m -> GithubRequest k a -> m Request makeHttpRequest auth r = case r of - GithubStatus req -> makeHttpRequest auth req + GithubStatus sm req -> do + req' <- makeHttpRequest auth req + return $ setCheckStatus (Just sm) req' GithubGet paths qs -> do req <- parseUrl $ url paths return $ setReqHeaders - . setCheckStatus + . setCheckStatus Nothing . setAuthRequest auth . setQueryString qs $ req GithubPagedGet paths qs _ -> do req <- parseUrl $ url paths return $ setReqHeaders - . setCheckStatus + . setCheckStatus Nothing . setAuthRequest auth . setQueryString qs $ req GithubPost m paths body -> do req <- parseUrl $ url paths return $ setReqHeaders - . setCheckStatus + . setCheckStatus Nothing . setAuthRequest auth . setBody body . setMethod (toMethod m) @@ -195,7 +193,7 @@ makeHttpRequest auth r = case r of GithubDelete paths -> do req <- parseUrl $ url paths return $ setReqHeaders - . setCheckStatus + . setCheckStatus Nothing . setAuthRequest auth . setMethod methodDelete $ req @@ -211,8 +209,8 @@ makeHttpRequest auth r = case r of setReqHeaders :: Request -> Request setReqHeaders req = req { requestHeaders = reqHeaders <> requestHeaders req } - setCheckStatus :: Request -> Request - setCheckStatus req = req { checkStatus = successOrMissing } + setCheckStatus :: Maybe (StatusMap a) -> Request -> Request + setCheckStatus sm req = req { checkStatus = successOrMissing sm } setMethod :: Method -> Request -> Request setMethod m req = req { method = m } @@ -233,9 +231,15 @@ makeHttpRequest auth r = case r of getOAuthHeader (GithubOAuth token) = [("Authorization", BS8.pack ("token " ++ token))] getOAuthHeader _ = [] - successOrMissing s@(Status sci _) hs cookiejar - | (200 <= sci && sci < 300) || sci == 404 = Nothing + successOrMissing :: Maybe (StatusMap a) -> Status -> ResponseHeaders -> CookieJar -> Maybe E.SomeException + successOrMissing sm s@(Status sci _) hs cookiejar + | check = Nothing | otherwise = Just $ E.toException $ StatusCodeException s hs cookiejar + where + check = case sm of + Nothing -> 200 <= sci && sci < 300 + Just StatusOnlyOk -> sci == 204 || sci == 404 + Just StatusMerge -> sci `elem` [204, 405, 409] -- | Get Link rel=next from request headers. getNextUrl :: Response a -> Maybe URI @@ -256,6 +260,17 @@ parseResponse res = case eitherDecode (responseBody res) of Right x -> return x Left err -> throwError . ParseError . T.pack $ err +parseStatus :: StatusMap a -> Status -> Either Error a +parseStatus StatusOnlyOk (Status sci _) + | sci == 204 = Right True + | sci == 404 = Right False + | otherwise = Left $ JsonError $ "invalid status: " <> T.pack (show sci) +parseStatus StatusMerge (Status sci _) + | sci == 204 = Right MergeSuccessful + | sci == 405 = Right MergeCannotPerform + | sci == 409 = Right MergeConflict + | otherwise = Left $ JsonError $ "invalid status: " <> T.pack (show sci) + performPagedRequest :: forall a m. (FromJSON a, Monoid a, MonadThrow m) => (Request -> m (Response LBS.ByteString)) -- ^ `httpLbs` analogue -> (a -> Bool) -- ^ predicate to continue iteration diff --git a/Github/Search.hs b/Github/Search.hs index f5319d77..8e8cff5e 100644 --- a/Github/Search.hs +++ b/Github/Search.hs @@ -18,7 +18,6 @@ import Data.Text (Text) import qualified Data.Text.Encoding as TE -import Github.Auth import Github.Data import Github.Request diff --git a/run.sh b/run.sh new file mode 100644 index 00000000..f806f4a0 --- /dev/null +++ b/run.sh @@ -0,0 +1 @@ +STACK_YAML=stack-lts-4.yaml GITHUB_TOKEN=616a1561805125b8d673060e3d61dc1659ef7379 stack test --pedantic github diff --git a/src/highlight.js b/src/highlight.js new file mode 100644 index 00000000..1e903bd0 --- /dev/null +++ b/src/highlight.js @@ -0,0 +1,27 @@ + +var highlight = function (on) { + return function () { + var links = document.getElementsByTagName('a'); + for (var i = 0; i < links.length; i++) { + var that = links[i]; + + if (this.href != that.href) { + continue; + } + + if (on) { + that.classList.add("hover-highlight"); + } else { + that.classList.remove("hover-highlight"); + } + } + } +}; + +window.onload = function () { + var links = document.getElementsByTagName('a'); + for (var i = 0; i < links.length; i++) { + links[i].onmouseover = highlight(true); + links[i].onmouseout = highlight(false); + } +}; diff --git a/src/style.css b/src/style.css new file mode 100644 index 00000000..e83dc5ec --- /dev/null +++ b/src/style.css @@ -0,0 +1,55 @@ +body { + background-color: #fdf6e3; +} + +.hs-identifier { + color: #073642; +} + +.hs-identifier.hs-var { +} + +.hs-identifier.hs-type { + color: #5f5faf; +} + +.hs-keyword { + color: #af005f; +} + +.hs-string, .hs-char { + color: #cb4b16; +} + +.hs-number { + color: #268bd2; +} + +.hs-operator { + color: #d33682; +} + +.hs-glyph, .hs-special { + color: #dc322f; +} + +.hs-comment { + color: #8a8a8a; +} + +.hs-pragma { + color: #2aa198; +} + +.hs-cpp { + color: #859900; +} + +a:link, a:visited { + text-decoration: none; + border-bottom: 1px solid #eee8d5; +} + +a:hover, a.hover-highlight { + background-color: #eee8d5; +} From 8a6f4554e28f70ac778d68152388dd62d20b4646 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 18 Jan 2016 15:51:22 +0200 Subject: [PATCH 159/510] Update token --- .gitignore | 1 + .travis.yml | 2 +- run.sh | 1 - 3 files changed, 2 insertions(+), 2 deletions(-) delete mode 100644 run.sh diff --git a/.gitignore b/.gitignore index 83d72d13..d6b36ab8 100644 --- a/.gitignore +++ b/.gitignore @@ -8,3 +8,4 @@ cabal.sandbox.config *.hi *.o .stack-work +run.sh diff --git a/.travis.yml b/.travis.yml index 72d81f5d..f4bf421f 100644 --- a/.travis.yml +++ b/.travis.yml @@ -14,7 +14,7 @@ before_cache: env: global: - secure: "IRtE1XwgzQKlD/fzNrapx8l3dVIC8/0BeQoA3C2qQM7BW2BVs5Z12tX/I1nco3E7J5SwfMWStGJxgghcI1t4uTKg6Q1CQDhNNy+Sr3jX9kd3Evvd3HacE/FiBBtIoiE1tIqd0/duCpJ+EH5d9Gd/Zk+1BWnDTdEdAYZVbc6sEMM=" + secure: "C2YwYhIClWJKjKQ1AfsHn0Py5+6WkA79Ny6bfR9JxQ10aT3sq5FcZt0ZfwutK0+jQ5F6c3+L0yJaNm8dp1+0MGK0ALDE3vx9ftJkXLp/5LwSdfeHHiMLFoQsSs3mGw9DirxiHbWlDzBKNfRi397Vckh0sfEGx/rEBIs5PS86wIU=" matrix: include: diff --git a/run.sh b/run.sh deleted file mode 100644 index f806f4a0..00000000 --- a/run.sh +++ /dev/null @@ -1 +0,0 @@ -STACK_YAML=stack-lts-4.yaml GITHUB_TOKEN=616a1561805125b8d673060e3d61dc1659ef7379 stack test --pedantic github From ecc51e8df3f9fbe75ba7946adafceae488b5db2d Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 19 Jan 2016 06:47:17 +0200 Subject: [PATCH 160/510] Add mkRepoName --- Github/Data.hs | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/Github/Data.hs b/Github/Data.hs index 9ba85541..19c08a02 100644 --- a/Github/Data.hs +++ b/Github/Data.hs @@ -29,6 +29,7 @@ module Github.Data ( mkOwnerName, mkTeamName, mkOrganizationName, + mkRepoName, -- ** Id Id, mkId, @@ -36,6 +37,7 @@ module Github.Data ( mkOwnerId, mkTeamId, mkOrganizationId, + mkRepoId, ) where import Prelude () @@ -81,6 +83,12 @@ mkOrganizationId = Id mkOrganizationName :: T.Text -> Name Organization mkOrganizationName = N +mkRepoId :: Int -> Id Repo +mkRepoId = Id + +mkRepoName :: T.Text -> Name Repo +mkRepoName = N + instance FromJSON Commit where parseJSON (Object o) = Commit <$> o .: "sha" From 3eb33838e73059eab1c837f4967a312044d63052 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 19 Jan 2016 13:22:13 +0200 Subject: [PATCH 161/510] Catch HTTP exceptions --- Github/Data/Definitions.hs | 9 ++--- Github/Request.hs | 69 +++++++++++++++++++++----------------- spec/Github/UsersSpec.hs | 6 +++- 3 files changed, 49 insertions(+), 35 deletions(-) diff --git a/Github/Data/Definitions.hs b/Github/Data/Definitions.hs index 846fdac0..6b146315 100644 --- a/Github/Data/Definitions.hs +++ b/Github/Data/Definitions.hs @@ -11,6 +11,7 @@ import Data.Text (Text) import Data.Time (UTCTime) import Data.Vector (Vector) import GHC.Generics (Generic) +import Network.HTTP.Client (HttpException) import qualified Control.Exception as E @@ -28,10 +29,10 @@ data CommitQueryOption = CommitQuerySha !Text -- | Errors have been tagged according to their source, so you can more easily -- dispatch and handle them. data Error = - HTTPConnectionError E.SomeException -- ^ A HTTP error occurred. The actual caught error is included. - | ParseError Text -- ^ An error in the parser itself. - | JsonError Text -- ^ The JSON is malformed or unexpected. - | UserError Text -- ^ Incorrect input. + HTTPError !HttpException -- ^ A HTTP error occurred. The actual caught error is included. + | ParseError !Text -- ^ An error in the parser itself. + | JsonError !Text -- ^ The JSON is malformed or unexpected. + | UserError !Text -- ^ Incorrect input. deriving (Show, Typeable) instance E.Exception Error diff --git a/Github/Request.hs b/Github/Request.hs index 29ca8eca..3fa9150d 100644 --- a/Github/Request.hs +++ b/Github/Request.hs @@ -38,7 +38,7 @@ import Control.Monad.Except (MonadError (..)) import Control.Monad.Error (MonadError (..)) #endif -import Control.Monad.Catch (MonadThrow) +import Control.Monad.Catch (MonadThrow, MonadCatch(..)) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Except (ExceptT (..), runExceptT) import Data.Aeson.Compat (FromJSON, eitherDecode) @@ -86,29 +86,32 @@ executeRequestWithMgr :: Show a -> GithubAuth -> GithubRequest k a -> IO (Either Error a) -executeRequestWithMgr mgr auth req = +executeRequestWithMgr mgr auth req = runExceptT $ case req of GithubGet {} -> do httpReq <- makeHttpRequest (Just auth) req - res <- httpLbs httpReq mgr - pure $ parseResponse res + res <- httpLbs' httpReq + parseResponse res GithubPagedGet _ _ l -> do httpReq <- makeHttpRequest (Just auth) req - performPagedRequest (flip httpLbs mgr) predicate httpReq + performPagedRequest httpLbs' predicate httpReq where predicate = maybe (const True) (\l' -> (< l') . V.length ) l GithubPost {} -> do httpReq <- makeHttpRequest (Just auth) req - res <- httpLbs httpReq mgr - pure $ parseResponse res + res <- httpLbs' httpReq + parseResponse res GithubDelete {} -> do httpReq <- makeHttpRequest (Just auth) req - _ <- httpLbs httpReq mgr - pure . Right $ () + _ <- httpLbs' httpReq + pure () GithubStatus sm _ -> do httpReq <- makeHttpRequest (Just auth) req - res <- httpLbs httpReq mgr - pure . parseStatus sm . responseStatus $ res + res <- httpLbs' httpReq + parseStatus sm . responseStatus $ res + where + httpLbs' :: Request -> ExceptT Error IO (Response LBS.ByteString) + httpLbs' req = lift (httpLbs req mgr) `catch` onHttpException -- | Like 'executeRequest' but without authentication. executeRequest' :: Show a @@ -126,21 +129,24 @@ executeRequestWithMgr' :: Show a => Manager -> GithubRequest 'False a -> IO (Either Error a) -executeRequestWithMgr' mgr req = +executeRequestWithMgr' mgr req = runExceptT $ case req of GithubGet {} -> do httpReq <- makeHttpRequest Nothing req - res <- httpLbs httpReq mgr - pure $ parseResponse res + res <- httpLbs' httpReq + parseResponse res GithubPagedGet _ _ l -> do httpReq <- makeHttpRequest Nothing req - performPagedRequest (flip httpLbs mgr) predicate httpReq + performPagedRequest httpLbs' predicate httpReq where predicate = maybe (const True) (\l' -> (< l') . V.length) l GithubStatus sm _ -> do httpReq <- makeHttpRequest Nothing req - res <- httpLbs httpReq mgr - pure . parseStatus sm . responseStatus $ res + res <- httpLbs' httpReq + parseStatus sm . responseStatus $ res + where + httpLbs' :: Request -> ExceptT Error IO (Response LBS.ByteString) + httpLbs' req = lift (httpLbs req mgr) `catch` onHttpException -- | Helper for picking between 'executeRequest' and 'executeRequest''. -- @@ -260,27 +266,27 @@ parseResponse res = case eitherDecode (responseBody res) of Right x -> return x Left err -> throwError . ParseError . T.pack $ err -parseStatus :: StatusMap a -> Status -> Either Error a +parseStatus :: MonadError Error m => StatusMap a -> Status -> m a parseStatus StatusOnlyOk (Status sci _) - | sci == 204 = Right True - | sci == 404 = Right False - | otherwise = Left $ JsonError $ "invalid status: " <> T.pack (show sci) + | sci == 204 = return True + | sci == 404 = return False + | otherwise = throwError $ JsonError $ "invalid status: " <> T.pack (show sci) parseStatus StatusMerge (Status sci _) - | sci == 204 = Right MergeSuccessful - | sci == 405 = Right MergeCannotPerform - | sci == 409 = Right MergeConflict - | otherwise = Left $ JsonError $ "invalid status: " <> T.pack (show sci) + | sci == 204 = return MergeSuccessful + | sci == 405 = return MergeCannotPerform + | sci == 409 = return MergeConflict + | otherwise = throwError $ JsonError $ "invalid status: " <> T.pack (show sci) -performPagedRequest :: forall a m. (FromJSON a, Monoid a, MonadThrow m) +performPagedRequest :: forall a m. (FromJSON a, Monoid a, MonadCatch m, MonadError Error m) => (Request -> m (Response LBS.ByteString)) -- ^ `httpLbs` analogue -> (a -> Bool) -- ^ predicate to continue iteration -> Request -- ^ initial request - -> m (Either Error a) -performPagedRequest httpLbs' predicate = runExceptT . go mempty + -> m a +performPagedRequest httpLbs' predicate = go mempty where - go :: a -> Request -> ExceptT Error m a + go :: a -> Request -> m a go acc req = do - res <- lift $ httpLbs' req + res <- httpLbs' req m <- parseResponse res let m' = acc <> m case (predicate m', getNextUrl res) of @@ -288,3 +294,6 @@ performPagedRequest httpLbs' predicate = runExceptT . go mempty req' <- setUri req uri go m' req' (_, _) -> return m' + +onHttpException :: MonadError Error m => HttpException -> m a +onHttpException = throwError . HTTPError diff --git a/spec/Github/UsersSpec.hs b/spec/Github/UsersSpec.hs index 1593c3e6..fab499d4 100644 --- a/spec/Github/UsersSpec.hs +++ b/spec/Github/UsersSpec.hs @@ -3,7 +3,7 @@ module Github.UsersSpec where import Data.Aeson.Compat (eitherDecodeStrict) -import Data.Either.Compat (isRight) +import Data.Either.Compat (isRight, isLeft) import Data.FileEmbed (embedFile) import System.Environment (lookupEnv) import Test.Hspec (Spec, describe, it, pendingWith, shouldBe, @@ -37,6 +37,10 @@ spec = do userInfo <- userInfoFor' (Just auth) "mike-burns" githubOwnerLogin (fromRightS userInfo) `shouldBe` "mike-burns" + it "catches http exceptions" $ withAuth $ \auth -> do + userInfo <- userInfoFor' (Just auth) "i-hope-this-user-will-never-exist" + userInfo `shouldSatisfy` isLeft + describe "userInfoCurrent'" $ do it "returns information about the autenticated user" $ withAuth $ \auth -> do userInfo <- userInfoCurrent' auth From 4add4dc3820a1636f79ed9bef00b14eab9ea2278 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 19 Jan 2016 19:39:49 +0200 Subject: [PATCH 162/510] Add some haddocks --- Github/Activity/Starring.hs | 7 +++- Github/Activity/Watching.hs | 7 +++- Github/All.hs | 8 +++- Github/Auth.hs | 5 +++ Github/Data.hs | 9 ++-- Github/Data/Definitions.hs | 6 ++- Github/Data/Gists.hs | 5 +++ Github/Data/GitData.hs | 5 +++ Github/Data/Id.hs | 5 +++ Github/Data/Issues.hs | 5 +++ Github/Data/Name.hs | 5 +++ Github/Data/PullRequests.hs | 5 +++ Github/Data/Repos.hs | 5 +++ Github/Data/Request.hs | 7 ++++ Github/Data/Search.hs | 5 +++ Github/Data/Teams.hs | 5 +++ Github/Data/Webhooks.hs | 5 +++ Github/Gists.hs | 7 +++- Github/Gists/Comments.hs | 7 +++- Github/GitData/Blobs.hs | 7 +++- Github/GitData/Commits.hs | 7 +++- Github/GitData/References.hs | 7 +++- Github/GitData/Trees.hs | 7 +++- Github/Issues.hs | 7 +++- Github/Issues/Comments.hs | 7 +++- Github/Issues/Events.hs | 7 +++- Github/Issues/Labels.hs | 7 +++- Github/Issues/Milestones.hs | 7 +++- Github/Organizations.hs | 7 +++- Github/Organizations/Members.hs | 7 +++- Github/Organizations/Teams.hs | 7 +++- Github/PullRequests.hs | 11 +++-- Github/PullRequests/ReviewComments.hs | 7 +++- Github/Repos.hs | 7 +++- Github/Repos/Collaborators.hs | 7 +++- Github/Repos/Comments.hs | 8 +++- Github/Repos/Commits.hs | 8 +++- Github/Repos/Forks.hs | 7 +++- Github/Repos/Webhooks.hs | 7 +++- Github/Repos/Webhooks/Validate.hs | 9 ++-- Github/Request.hs | 59 +++++++++++++++++++++------ Github/Search.hs | 7 +++- Github/Users.hs | 7 +++- Github/Users/Followers.hs | 7 +++- 44 files changed, 297 insertions(+), 51 deletions(-) diff --git a/Github/Activity/Starring.hs b/Github/Activity/Starring.hs index 5f83068b..924a663d 100644 --- a/Github/Activity/Starring.hs +++ b/Github/Activity/Starring.hs @@ -1,5 +1,10 @@ {-# LANGUAGE DataKinds #-} --- | The repo starring API as described on +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +-- The repo starring API as described on -- . module Github.Activity.Starring ( stargazersFor, diff --git a/Github/Activity/Watching.hs b/Github/Activity/Watching.hs index e1753eaf..d4e077b1 100644 --- a/Github/Activity/Watching.hs +++ b/Github/Activity/Watching.hs @@ -1,4 +1,9 @@ --- | The repo watching API as described on +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +-- The repo watching API as described on -- . module Github.Activity.Watching ( watchersFor, diff --git a/Github/All.hs b/Github/All.hs index ce6ddcff..12ea4751 100644 --- a/Github/All.hs +++ b/Github/All.hs @@ -1,4 +1,7 @@ +----------------------------------------------------------------------------- -- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus -- -- This module re-exports all request constructrors and -- data definitions from this package. @@ -291,7 +294,9 @@ module Github.All ( usersFollowedByR, -- * Data definitions - module Github.Data + module Github.Data, + -- * Request handling + module Github.Request, ) where import Github.Activity.Starring @@ -319,6 +324,7 @@ import Github.Repos.Comments import Github.Repos.Commits import Github.Repos.Forks import Github.Repos.Webhooks +import Github.Request import Github.Search import Github.Users import Github.Users.Followers diff --git a/Github/Auth.hs b/Github/Auth.hs index 90b80343..62d3e77f 100644 --- a/Github/Auth.hs +++ b/Github/Auth.hs @@ -1,5 +1,10 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- module Github.Auth where import Control.DeepSeq (NFData (..)) diff --git a/Github/Data.hs b/Github/Data.hs index 19c08a02..750bda29 100644 --- a/Github/Data.hs +++ b/Github/Data.hs @@ -2,11 +2,14 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} - --- | This module re-exports the @Github.Data.Definitions@ module, adding +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +-- This module re-exports the @Github.Data.Definitions@ module, adding -- instances of @FromJSON@ to it. If you wish to use the data without the -- instances, use the @Github.Data.Definitions@ module instead. - module Github.Data ( -- * Module re-exports module Github.Auth, diff --git a/Github/Data/Definitions.hs b/Github/Data/Definitions.hs index 6b146315..23942569 100644 --- a/Github/Data/Definitions.hs +++ b/Github/Data/Definitions.hs @@ -1,6 +1,10 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} - +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- module Github.Data.Definitions where import Control.DeepSeq (NFData (..)) diff --git a/Github/Data/Gists.hs b/Github/Data/Gists.hs index 52ad8461..4d35130f 100644 --- a/Github/Data/Gists.hs +++ b/Github/Data/Gists.hs @@ -1,5 +1,10 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- module Github.Data.Gists where import Github.Data.Definitions diff --git a/Github/Data/GitData.hs b/Github/Data/GitData.hs index 0b16450c..92416ee9 100644 --- a/Github/Data/GitData.hs +++ b/Github/Data/GitData.hs @@ -1,5 +1,10 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- module Github.Data.GitData where import Github.Data.Definitions diff --git a/Github/Data/Id.hs b/Github/Data/Id.hs index b513de49..78c6d2ff 100644 --- a/Github/Data/Id.hs +++ b/Github/Data/Id.hs @@ -1,5 +1,10 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- module Github.Data.Id ( Id(..), mkId, diff --git a/Github/Data/Issues.hs b/Github/Data/Issues.hs index 848da553..e417df40 100644 --- a/Github/Data/Issues.hs +++ b/Github/Data/Issues.hs @@ -1,5 +1,10 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- module Github.Data.Issues where import Github.Data.Definitions diff --git a/Github/Data/Name.hs b/Github/Data/Name.hs index f61ecbd9..199c7794 100644 --- a/Github/Data/Name.hs +++ b/Github/Data/Name.hs @@ -1,5 +1,10 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- module Github.Data.Name ( Name(..), mkName, diff --git a/Github/Data/PullRequests.hs b/Github/Data/PullRequests.hs index 2226f60b..6ab1cc75 100644 --- a/Github/Data/PullRequests.hs +++ b/Github/Data/PullRequests.hs @@ -1,5 +1,10 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- module Github.Data.PullRequests where import Github.Data.Definitions diff --git a/Github/Data/Repos.hs b/Github/Data/Repos.hs index 75142ac7..3667900a 100644 --- a/Github/Data/Repos.hs +++ b/Github/Data/Repos.hs @@ -1,5 +1,10 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- module Github.Data.Repos where import Github.Data.Definitions diff --git a/Github/Data/Request.hs b/Github/Data/Request.hs index 02fe3943..457eb038 100644 --- a/Github/Data/Request.hs +++ b/Github/Data/Request.hs @@ -7,6 +7,11 @@ {-# LANGUAGE KindSignatures #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE StandaloneDeriving #-} +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- module Github.Data.Request ( GithubRequest(..), PostMethod(..), @@ -51,6 +56,8 @@ instance IsPathPart (Id a) where toPathPart = show . untagId -- | Http method of requests with body. +-- +-- /TODO/: Rename to CommandMethod data PostMethod = Post | Patch | Put deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable) diff --git a/Github/Data/Search.hs b/Github/Data/Search.hs index 84936295..8aa90822 100644 --- a/Github/Data/Search.hs +++ b/Github/Data/Search.hs @@ -1,5 +1,10 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- module Github.Data.Search where import Github.Data.Repos (Repo) diff --git a/Github/Data/Teams.hs b/Github/Data/Teams.hs index 36177742..e888e973 100644 --- a/Github/Data/Teams.hs +++ b/Github/Data/Teams.hs @@ -1,5 +1,10 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- module Github.Data.Teams where import Github.Data.Definitions diff --git a/Github/Data/Webhooks.hs b/Github/Data/Webhooks.hs index 7000a72e..ef7737aa 100644 --- a/Github/Data/Webhooks.hs +++ b/Github/Data/Webhooks.hs @@ -1,6 +1,11 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- module Github.Data.Webhooks where import Github.Data.Id (Id) diff --git a/Github/Gists.hs b/Github/Gists.hs index 88fa9828..65f419ea 100644 --- a/Github/Gists.hs +++ b/Github/Gists.hs @@ -1,4 +1,9 @@ --- | The gists API as described at . +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +-- The gists API as described at . module Github.Gists ( gists, gists', diff --git a/Github/Gists/Comments.hs b/Github/Gists/Comments.hs index 277c7f15..a607f40b 100644 --- a/Github/Gists/Comments.hs +++ b/Github/Gists/Comments.hs @@ -1,4 +1,9 @@ --- | The loving comments people have left on Gists, described on +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +-- The loving comments people have left on Gists, described on -- . module Github.Gists.Comments ( commentsOn, diff --git a/Github/GitData/Blobs.hs b/Github/GitData/Blobs.hs index 0e73d0cd..a6421ab9 100644 --- a/Github/GitData/Blobs.hs +++ b/Github/GitData/Blobs.hs @@ -1,4 +1,9 @@ --- | The API for dealing with git blobs from Github repos, as described in +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +-- The API for dealing with git blobs from Github repos, as described in -- . module Github.GitData.Blobs ( blob, diff --git a/Github/GitData/Commits.hs b/Github/GitData/Commits.hs index c3affc6d..4c1dbc71 100644 --- a/Github/GitData/Commits.hs +++ b/Github/GitData/Commits.hs @@ -1,4 +1,9 @@ --- | The API for underlying git commits of a Github repo, as described on +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +-- The API for underlying git commits of a Github repo, as described on -- . module Github.GitData.Commits ( commit, diff --git a/Github/GitData/References.hs b/Github/GitData/References.hs index d0748b05..21ad73af 100644 --- a/Github/GitData/References.hs +++ b/Github/GitData/References.hs @@ -1,5 +1,10 @@ {-# LANGUAGE DataKinds #-} --- | The underlying git references on a Github repo, exposed for the world to +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +-- The underlying git references on a Github repo, exposed for the world to -- see. The git internals documentation will also prove handy for understanding -- these. API documentation at . module Github.GitData.References ( diff --git a/Github/GitData/Trees.hs b/Github/GitData/Trees.hs index 360ec223..268fd603 100644 --- a/Github/GitData/Trees.hs +++ b/Github/GitData/Trees.hs @@ -1,5 +1,10 @@ {-# LANGUAGE OverloadedStrings #-} --- | The underlying tree of SHA1s and files that make up a git repo. The API is +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +-- The underlying tree of SHA1s and files that make up a git repo. The API is -- described on . module Github.GitData.Trees ( tree, diff --git a/Github/Issues.hs b/Github/Issues.hs index 3ec7622e..d0b9b06d 100644 --- a/Github/Issues.hs +++ b/Github/Issues.hs @@ -1,7 +1,12 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-} --- | The issues API as described on . +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +-- The issues API as described on . module Github.Issues ( issue, issue', diff --git a/Github/Issues/Comments.hs b/Github/Issues/Comments.hs index 4dfe0280..8367bf87 100644 --- a/Github/Issues/Comments.hs +++ b/Github/Issues/Comments.hs @@ -1,5 +1,10 @@ {-# LANGUAGE DataKinds #-} --- | The Github issue comments API from +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +-- The Github issue comments API from -- . module Github.Issues.Comments ( comment, diff --git a/Github/Issues/Events.hs b/Github/Issues/Events.hs index b8738143..44f93fb5 100644 --- a/Github/Issues/Events.hs +++ b/Github/Issues/Events.hs @@ -1,4 +1,9 @@ --- | The Github issue events API, which is described on +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +-- The Github issue events API, which is described on -- module Github.Issues.Events ( eventsForIssue, diff --git a/Github/Issues/Labels.hs b/Github/Issues/Labels.hs index 996ebb70..cc9bbc9b 100644 --- a/Github/Issues/Labels.hs +++ b/Github/Issues/Labels.hs @@ -1,6 +1,11 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-} --- | The API for dealing with labels on Github issues as described on +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +-- The API for dealing with labels on Github issues as described on -- . module Github.Issues.Labels ( labelsOnRepo, diff --git a/Github/Issues/Milestones.hs b/Github/Issues/Milestones.hs index a5ee4f7d..b2f8a40e 100644 --- a/Github/Issues/Milestones.hs +++ b/Github/Issues/Milestones.hs @@ -1,4 +1,9 @@ --- | The milestones API as described on +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +-- The milestones API as described on -- . module Github.Issues.Milestones ( milestones, diff --git a/Github/Organizations.hs b/Github/Organizations.hs index e5741fd0..262222f6 100644 --- a/Github/Organizations.hs +++ b/Github/Organizations.hs @@ -1,4 +1,9 @@ --- | The orgs API as described on . +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +-- The orgs API as described on . module Github.Organizations ( publicOrganizationsFor, publicOrganizationsFor', diff --git a/Github/Organizations/Members.hs b/Github/Organizations/Members.hs index dba2379b..1be8e719 100644 --- a/Github/Organizations/Members.hs +++ b/Github/Organizations/Members.hs @@ -1,4 +1,9 @@ --- | The organization members API as described on +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +-- The organization members API as described on -- . module Github.Organizations.Members ( membersOf, diff --git a/Github/Organizations/Teams.hs b/Github/Organizations/Teams.hs index f4ca2bd2..e2e61b0b 100644 --- a/Github/Organizations/Teams.hs +++ b/Github/Organizations/Teams.hs @@ -1,5 +1,10 @@ {-# LANGUAGE DataKinds #-} --- | The GithubOwner teams API as described on +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +-- The GithubOwner teams API as described on -- . module Github.Organizations.Teams ( teamsOf, diff --git a/Github/PullRequests.hs b/Github/PullRequests.hs index b1ceb7aa..683b7282 100644 --- a/Github/PullRequests.hs +++ b/Github/PullRequests.hs @@ -1,6 +1,11 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-} --- | The pull requests API as documented at +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +-- The pull requests API as documented at -- . module Github.PullRequests ( pullRequestsFor'', @@ -30,8 +35,8 @@ module Github.PullRequests ( import Github.Data import Github.Request -import Data.Aeson.Compat (Value, encode, object, (.=)) -import Data.Vector (Vector) +import Data.Aeson.Compat (Value, encode, object, (.=)) +import Data.Vector (Vector) import qualified Data.ByteString.Char8 as BS8 diff --git a/Github/PullRequests/ReviewComments.hs b/Github/PullRequests/ReviewComments.hs index 54e97112..e9016f6d 100644 --- a/Github/PullRequests/ReviewComments.hs +++ b/Github/PullRequests/ReviewComments.hs @@ -1,4 +1,9 @@ --- | The pull request review comments API as described at +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +-- The pull request review comments API as described at -- . module Github.PullRequests.ReviewComments ( pullRequestReviewCommentsIO, diff --git a/Github/Repos.hs b/Github/Repos.hs index 15682d41..381d0636 100644 --- a/Github/Repos.hs +++ b/Github/Repos.hs @@ -2,7 +2,12 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} --- | The Github Repos API, as documented at +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +-- The Github Repos API, as documented at -- module Github.Repos ( -- * Querying repositories diff --git a/Github/Repos/Collaborators.hs b/Github/Repos/Collaborators.hs index c59a4d63..5a84548e 100644 --- a/Github/Repos/Collaborators.hs +++ b/Github/Repos/Collaborators.hs @@ -1,4 +1,9 @@ --- | The repo collaborators API as described on +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +-- The repo collaborators API as described on -- . module Github.Repos.Collaborators ( collaboratorsOn, diff --git a/Github/Repos/Comments.hs b/Github/Repos/Comments.hs index 9a7f0244..37774424 100644 --- a/Github/Repos/Comments.hs +++ b/Github/Repos/Comments.hs @@ -1,6 +1,10 @@ {-# LANGUAGE CPP #-} - --- | The repo commits API as described on +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +-- The repo commits API as described on -- . module Github.Repos.Comments ( commentsFor, diff --git a/Github/Repos/Commits.hs b/Github/Repos/Commits.hs index c6923d96..5a6ce8cd 100644 --- a/Github/Repos/Commits.hs +++ b/Github/Repos/Commits.hs @@ -1,7 +1,11 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} - --- | The repo commits API as described on +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +-- The repo commits API as described on -- . module Github.Repos.Commits ( CommitQueryOption(..), diff --git a/Github/Repos/Forks.hs b/Github/Repos/Forks.hs index 833f5ad0..57abec42 100644 --- a/Github/Repos/Forks.hs +++ b/Github/Repos/Forks.hs @@ -1,4 +1,9 @@ --- | Hot forking action, as described at +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +-- Hot forking action, as described at -- . module Github.Repos.Forks ( forksFor, diff --git a/Github/Repos/Webhooks.hs b/Github/Repos/Webhooks.hs index b9586e87..2b26ba6b 100644 --- a/Github/Repos/Webhooks.hs +++ b/Github/Repos/Webhooks.hs @@ -1,5 +1,10 @@ {-# LANGUAGE DataKinds #-} --- | The webhooks API, as described at +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +-- The webhooks API, as described at -- -- diff --git a/Github/Repos/Webhooks/Validate.hs b/Github/Repos/Webhooks/Validate.hs index 12447f33..44cf7664 100644 --- a/Github/Repos/Webhooks/Validate.hs +++ b/Github/Repos/Webhooks/Validate.hs @@ -1,9 +1,12 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} - --- | Verification of incomming webhook payloads, as described at +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +-- Verification of incomming webhook payloads, as described at -- - module Github.Repos.Webhooks.Validate ( isValidPayload ) where diff --git a/Github/Request.hs b/Github/Request.hs index 3fa9150d..6b79fc6c 100644 --- a/Github/Request.hs +++ b/Github/Request.hs @@ -8,6 +8,10 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus module Github.Request ( -- * Types GithubRequest(..), @@ -22,11 +26,12 @@ module Github.Request ( executeRequestWithMgr', executeRequestMaybe, unsafeDropAuthRequirements, - -- * Tools + -- * Helpers makeHttpRequest, parseResponse, parseStatus, getNextUrl, + performPagedRequest, ) where import Prelude () @@ -38,7 +43,7 @@ import Control.Monad.Except (MonadError (..)) import Control.Monad.Error (MonadError (..)) #endif -import Control.Monad.Catch (MonadThrow, MonadCatch(..)) +import Control.Monad.Catch (MonadCatch (..), MonadThrow) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Except (ExceptT (..), runExceptT) import Data.Aeson.Compat (FromJSON, eitherDecode) @@ -46,17 +51,17 @@ import Data.List (find, intercalate) import Data.Monoid ((<>)) import Data.Text (Text) -import Network.HTTP.Client (HttpException (..), Manager, Request (..), - RequestBody (..), Response (..), CookieJar, - applyBasicAuth, httpLbs, newManager, - parseUrl, setQueryString) +import Network.HTTP.Client (CookieJar, HttpException (..), Manager, + Request (..), RequestBody (..), + Response (..), applyBasicAuth, httpLbs, + newManager, parseUrl, setQueryString) import Network.HTTP.Client.Internal (setUri) import Network.HTTP.Client.TLS (tlsManagerSettings) import Network.HTTP.Link.Parser (parseLinkHeaderBS) import Network.HTTP.Link.Types (Link (..), LinkParam (..), href, linkParams) -import Network.HTTP.Types (Method, RequestHeaders, ResponseHeaders, Status (..), - methodDelete) +import Network.HTTP.Types (Method, RequestHeaders, ResponseHeaders, + Status (..), methodDelete) import Network.URI (URI) import qualified Control.Exception as E @@ -111,7 +116,7 @@ executeRequestWithMgr mgr auth req = runExceptT $ parseStatus sm . responseStatus $ res where httpLbs' :: Request -> ExceptT Error IO (Response LBS.ByteString) - httpLbs' req = lift (httpLbs req mgr) `catch` onHttpException + httpLbs' req' = lift (httpLbs req' mgr) `catch` onHttpException -- | Like 'executeRequest' but without authentication. executeRequest' :: Show a @@ -146,7 +151,7 @@ executeRequestWithMgr' mgr req = runExceptT $ parseStatus sm . responseStatus $ res where httpLbs' :: Request -> ExceptT Error IO (Response LBS.ByteString) - httpLbs' req = lift (httpLbs req mgr) `catch` onHttpException + httpLbs' req' = lift (httpLbs req' mgr) `catch` onHttpException -- | Helper for picking between 'executeRequest' and 'executeRequest''. -- @@ -166,6 +171,15 @@ unsafeDropAuthRequirements r = -- Tools ------------------------------------------------------------------------------ +-- | Create @http-client@ 'Request'. +-- +-- * for 'GithubPagedGet', the initial request is created. +-- * for 'GithubStatus', the 'Request' for underlying 'GithubRequest' is created, +-- status checking is modifying accordingly. +-- +-- @ +-- parseResponse :: 'Maybe' 'GithubAuth' -> 'GithubRequest' k a -> 'Maybe' 'Request' +-- @ makeHttpRequest :: MonadThrow m => Maybe GithubAuth -> GithubRequest k a @@ -241,13 +255,13 @@ makeHttpRequest auth r = case r of successOrMissing sm s@(Status sci _) hs cookiejar | check = Nothing | otherwise = Just $ E.toException $ StatusCodeException s hs cookiejar - where + where check = case sm of Nothing -> 200 <= sci && sci < 300 Just StatusOnlyOk -> sci == 204 || sci == 404 Just StatusMerge -> sci `elem` [204, 405, 409] --- | Get Link rel=next from request headers. +-- | Get @Link@ header with @rel=next@ from the request headers. getNextUrl :: Response a -> Maybe URI getNextUrl req = do linkHeader <- lookup "Link" (responseHeaders req) @@ -261,11 +275,21 @@ getNextUrl req = do relNextLinkParam :: (LinkParam, Text) relNextLinkParam = (Rel, "next") +-- | Parse API response. +-- +-- @ +-- parseResponse :: 'FromJSON' a => 'Response' 'LBS.ByteString' -> 'Either' 'Error' a +-- @ parseResponse :: (FromJSON a, MonadError Error m) => Response LBS.ByteString -> m a parseResponse res = case eitherDecode (responseBody res) of Right x -> return x Left err -> throwError . ParseError . T.pack $ err +-- | Helper for handling of 'RequestStatus'. +-- +-- @ +-- parseStatus :: 'StatusMap' a -> 'Status' -> 'Either' 'Error' a +-- @ parseStatus :: MonadError Error m => StatusMap a -> Status -> m a parseStatus StatusOnlyOk (Status sci _) | sci == 204 = return True @@ -277,6 +301,17 @@ parseStatus StatusMerge (Status sci _) | sci == 409 = return MergeConflict | otherwise = throwError $ JsonError $ "invalid status: " <> T.pack (show sci) +-- | Helper for making paginated requests. Responses, @a@ are combined monoidally. +-- +-- @ +-- performPagedRequest :: ('FromJSON' a, 'Monoid' a) +-- => ('Request' -> 'ExceptT' 'Error' 'IO' ('Response' 'LBS.ByteString')) +-- -> (a -> 'Bool') +-- -> 'Request' +-- -> 'ExceptT' 'Error' 'IO' a +-- @ +-- +-- /TODO:/ require only 'Semigroup'. performPagedRequest :: forall a m. (FromJSON a, Monoid a, MonadCatch m, MonadError Error m) => (Request -> m (Response LBS.ByteString)) -- ^ `httpLbs` analogue -> (a -> Bool) -- ^ predicate to continue iteration diff --git a/Github/Search.hs b/Github/Search.hs index 8e8cff5e..fcc0f342 100644 --- a/Github/Search.hs +++ b/Github/Search.hs @@ -1,5 +1,10 @@ {-# LANGUAGE OverloadedStrings #-} --- | The Github Search API, as described at +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +-- The Github Search API, as described at -- . module Github.Search( searchRepos', diff --git a/Github/Users.hs b/Github/Users.hs index 157ef847..6967a7a7 100644 --- a/Github/Users.hs +++ b/Github/Users.hs @@ -1,5 +1,10 @@ {-# LANGUAGE DataKinds #-} --- | The Github Users API, as described at +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +-- The Github Users API, as described at -- . module Github.Users ( userInfoFor diff --git a/Github/Users/Followers.hs b/Github/Users/Followers.hs index 4fe475b7..fc768092 100644 --- a/Github/Users/Followers.hs +++ b/Github/Users/Followers.hs @@ -1,4 +1,9 @@ --- | The user followers API as described on +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +-- The user followers API as described on -- . module Github.Users.Followers ( usersFollowing, From f70feee20756064dec072f2ebbc8b1dcd019fac4 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 19 Jan 2016 20:02:54 +0200 Subject: [PATCH 163/510] Use CommandMethod --- Github/Data/Request.hs | 58 +++++++++++++++++++---------------- Github/GitData/References.hs | 2 +- Github/Issues.hs | 4 +-- Github/Issues/Comments.hs | 4 +-- Github/Issues/Labels.hs | 14 ++++----- Github/Organizations/Teams.hs | 13 +++++--- Github/PullRequests.hs | 6 ++-- Github/Repos.hs | 13 +++++--- Github/Repos/Collaborators.hs | 2 -- Github/Repos/Webhooks.hs | 17 +++++----- Github/Request.hs | 23 +++++--------- 11 files changed, 80 insertions(+), 76 deletions(-) diff --git a/Github/Data/Request.hs b/Github/Data/Request.hs index 457eb038..f25ec3a5 100644 --- a/Github/Data/Request.hs +++ b/Github/Data/Request.hs @@ -14,7 +14,7 @@ -- module Github.Data.Request ( GithubRequest(..), - PostMethod(..), + CommandMethod(..), toMethod, StatusMap(..), MergeResult(..), @@ -56,17 +56,32 @@ instance IsPathPart (Id a) where toPathPart = show . untagId -- | Http method of requests with body. --- --- /TODO/: Rename to CommandMethod -data PostMethod = Post | Patch | Put - deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable) +data CommandMethod a where + Post :: CommandMethod a + Patch :: CommandMethod a + Put :: CommandMethod a + Delete :: CommandMethod () + deriving (Typeable) + +deriving instance Eq (CommandMethod a) + +instance Show (CommandMethod a) where + showsPrec _ Post = showString "Post" + showsPrec _ Patch = showString "Patch" + showsPrec _ Put = showString "Put" + showsPrec _ Delete = showString "Delete" -toMethod :: PostMethod -> Method.Method -toMethod Post = Method.methodPost -toMethod Patch = Method.methodPatch -toMethod Put = Method.methodPut +instance Hashable (CommandMethod a) where + hashWithSalt salt Post = hashWithSalt salt (0 :: Int) + hashWithSalt salt Patch = hashWithSalt salt (1 :: Int) + hashWithSalt salt Put = hashWithSalt salt (2 :: Int) + hashWithSalt salt Delete = hashWithSalt salt (3 :: Int) -instance Hashable PostMethod +toMethod :: CommandMethod a -> Method.Method +toMethod Post = Method.methodPost +toMethod Patch = Method.methodPatch +toMethod Put = Method.methodPut +toMethod Delete = Method.methodDelete -- | Result of merge operation data MergeResult = MergeSuccessful @@ -85,10 +100,8 @@ data StatusMap a where deriving instance Eq (StatusMap a) instance Show (StatusMap a) where - showsPrec _ r = - case r of - StatusOnlyOk -> showString "StatusOnlyOK" - StatusMerge -> showString "StatusMerge" + showsPrec _ StatusOnlyOk = showString "StatusOnlyOK" + showsPrec _ StatusMerge = showString "StatusMerge" instance Hashable (StatusMap a) where hashWithSalt salt StatusOnlyOk = hashWithSalt salt (0 :: Int) @@ -107,8 +120,7 @@ instance Hashable (StatusMap a) where data GithubRequest (k :: Bool) a where GithubGet :: FromJSON a => Paths -> QueryString -> GithubRequest k a GithubPagedGet :: FromJSON (Vector a) => Paths -> QueryString -> Maybe Count -> GithubRequest k (Vector a) - GithubPost :: FromJSON a => PostMethod -> Paths -> LBS.ByteString -> GithubRequest 'True a - GithubDelete :: Paths -> GithubRequest 'True () + GithubCommand :: FromJSON a => CommandMethod a -> Paths -> LBS.ByteString -> GithubRequest 'True a GithubStatus :: StatusMap a -> GithubRequest k () -> GithubRequest k a deriving (Typeable) @@ -129,16 +141,13 @@ instance Show (GithubRequest k a) where . showsPrec (appPrec + 1) qs . showString " " . showsPrec (appPrec + 1) l - GithubPost m ps body -> showParen (d > appPrec) $ - showString "GithubPost " + GithubCommand m ps body -> showParen (d > appPrec) $ + showString "GithubCommand " . showsPrec (appPrec + 1) m . showString " " . showsPrec (appPrec + 1) ps . showString " " . showsPrec (appPrec + 1) body - GithubDelete ps -> showParen (d > appPrec) $ - showString "GithubDelete " - . showsPrec (appPrec + 1) ps GithubStatus m req -> showParen (d > appPrec) $ showString "GithubStatus " . showsPrec (appPrec + 1) m @@ -156,15 +165,12 @@ instance Hashable (GithubRequest k a) where `hashWithSalt` ps `hashWithSalt` qs `hashWithSalt` l - hashWithSalt salt (GithubPost m ps body) = + hashWithSalt salt (GithubCommand m ps body) = salt `hashWithSalt` (2 :: Int) `hashWithSalt` m `hashWithSalt` ps `hashWithSalt` body - hashWithSalt salt (GithubDelete ps) = - salt `hashWithSalt` (3 :: Int) - `hashWithSalt` ps hashWithSalt salt (GithubStatus sm req) = - salt `hashWithSalt` (4 :: Int) + salt `hashWithSalt` (3 :: Int) `hashWithSalt` sm `hashWithSalt` req diff --git a/Github/GitData/References.hs b/Github/GitData/References.hs index 21ad73af..81f24eac 100644 --- a/Github/GitData/References.hs +++ b/Github/GitData/References.hs @@ -73,7 +73,7 @@ createReference auth user repo newRef = -- See createReferenceR :: Name GithubOwner -> Name Repo -> NewGitReference -> GithubRequest 'True GitReference createReferenceR user repo newRef = - GithubPost Post ["repos", toPathPart user, toPathPart repo , "git", "refs"] (encode newRef) + GithubCommand Post ["repos", toPathPart user, toPathPart repo , "git", "refs"] (encode newRef) -- | Limited references by a namespace. -- diff --git a/Github/Issues.hs b/Github/Issues.hs index d0b9b06d..949accc4 100644 --- a/Github/Issues.hs +++ b/Github/Issues.hs @@ -113,7 +113,7 @@ createIssue auth user repo ni = -- See createIssueR :: Name GithubOwner -> Name Repo -> NewIssue -> GithubRequest 'True Issue createIssueR user repo = - GithubPost Post ["repos", toPathPart user, toPathPart repo, "issues"] . encode + GithubCommand Post ["repos", toPathPart user, toPathPart repo, "issues"] . encode -- Editing issues. @@ -133,4 +133,4 @@ editIssue auth user repo iss edit = -- See editIssueR :: Name GithubOwner -> Name Repo -> Id Issue -> EditIssue -> GithubRequest 'True Issue editIssueR user repo iss = - GithubPost Patch ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iss] . encode + GithubCommand Patch ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iss] . encode diff --git a/Github/Issues/Comments.hs b/Github/Issues/Comments.hs index 8367bf87..23a8a8d3 100644 --- a/Github/Issues/Comments.hs +++ b/Github/Issues/Comments.hs @@ -71,7 +71,7 @@ createComment auth user repo iss body = -- See createCommentR :: Name GithubOwner -> Name Repo -> Id Issue -> Text -> GithubRequest 'True Comment createCommentR user repo iss body = - GithubPost Post parts (encode $ NewComment body) + GithubCommand Post parts (encode $ NewComment body) where parts = ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iss, "comments"] @@ -88,6 +88,6 @@ editComment auth user repo commid body = -- See editCommentR :: Name GithubOwner -> Name Repo -> Id Comment -> Text -> GithubRequest 'True Comment editCommentR user repo commid body = - GithubPost Patch parts (encode $ EditComment body) + GithubCommand Patch parts (encode $ EditComment body) where parts = ["repos", toPathPart user, toPathPart repo, "issues", "comments", toPathPart commid] diff --git a/Github/Issues/Labels.hs b/Github/Issues/Labels.hs index cc9bbc9b..137c5886 100644 --- a/Github/Issues/Labels.hs +++ b/Github/Issues/Labels.hs @@ -96,7 +96,7 @@ createLabel auth user repo lbl color = -- See createLabelR :: Name GithubOwner -> Name Repo -> Name IssueLabel -> String -> GithubRequest 'True IssueLabel createLabelR user repo lbl color = - GithubPost Post paths $ encode body + GithubCommand Post paths $ encode body where paths = ["repos", toPathPart user, toPathPart repo, "labels"] body = object ["name" .= untagName lbl, "color" .= color] @@ -123,7 +123,7 @@ updateLabelR :: Name GithubOwner -> String -- ^ new color -> GithubRequest 'True IssueLabel updateLabelR user repo oldLbl newLbl color = - GithubPost Patch paths (encode body) + GithubCommand Patch paths (encode body) where paths = ["repos", toPathPart user, toPathPart repo, "labels", toPathPart oldLbl] body = object ["name" .= untagName newLbl, "color" .= color] @@ -139,7 +139,7 @@ deleteLabel auth user repo lbl = -- See deleteLabelR :: Name GithubOwner -> Name Repo -> Name IssueLabel -> GithubRequest 'True () deleteLabelR user repo lbl = - GithubDelete ["repos", toPathPart user, toPathPart repo, "labels", toPathPart lbl] + GithubCommand Delete ["repos", toPathPart user, toPathPart repo, "labels", toPathPart lbl] mempty -- | The labels on an issue in a repo. -- @@ -182,7 +182,7 @@ addLabelsToIssueR :: Foldable f -> f (Name IssueLabel) -> GithubRequest 'True (Vector IssueLabel) addLabelsToIssueR user repo iid lbls = - GithubPost Post paths (encode $ toList lbls) + GithubCommand Post paths (encode $ toList lbls) where paths = ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] @@ -197,7 +197,7 @@ removeLabelFromIssue auth user repo iid lbl = -- See removeLabelFromIssueR :: Name GithubOwner -> Name Repo -> Id Issue -> Name IssueLabel -> GithubRequest 'True () removeLabelFromIssueR user repo iid lbl = - GithubDelete ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels", toPathPart lbl] + GithubCommand Delete ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels", toPathPart lbl] mempty -- | Replace all labels on an issue. Sending an empty list will remove all labels from the issue. -- @@ -223,7 +223,7 @@ replaceAllLabelsForIssueR :: Foldable f -> f (Name IssueLabel) -> GithubRequest 'True (Vector IssueLabel) replaceAllLabelsForIssueR user repo iid lbls = - GithubPost Put paths (encode $ toList lbls) + GithubCommand Put paths (encode $ toList lbls) where paths = ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] @@ -238,7 +238,7 @@ removeAllLabelsFromIssue auth user repo iid = -- See removeAllLabelsFromIssueR :: Name GithubOwner -> Name Repo -> Id Issue -> GithubRequest 'True () removeAllLabelsFromIssueR user repo iid = - GithubDelete ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] + GithubCommand Delete ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] mempty -- | All the labels on a repo's milestone given the milestone ID. -- diff --git a/Github/Organizations/Teams.hs b/Github/Organizations/Teams.hs index e2e61b0b..080f3454 100644 --- a/Github/Organizations/Teams.hs +++ b/Github/Organizations/Teams.hs @@ -31,6 +31,9 @@ module Github.Organizations.Teams ( module Github.Data, ) where +import Prelude () +import Prelude.Compat + import Data.Aeson.Compat (encode) import Data.Vector (Vector) @@ -91,7 +94,7 @@ createTeamFor' auth org cteam = -- See createTeamForR :: Name Organization -> CreateTeam -> GithubRequest 'True Team createTeamForR org cteam = - GithubPost Post ["orgs", toPathPart org, "teams"] (encode cteam) + GithubCommand Post ["orgs", toPathPart org, "teams"] (encode cteam) -- | Edit a team, by id. -- @@ -107,7 +110,7 @@ editTeam' auth tid eteam = -- See editTeamR :: Id Team -> EditTeam -> GithubRequest 'True Team editTeamR tid eteam = - GithubPost Patch ["teams", toPathPart tid] (encode eteam) + GithubCommand Patch ["teams", toPathPart tid] (encode eteam) -- | Delete a team, by id. -- @@ -120,7 +123,7 @@ deleteTeam' auth tid = -- See deleteTeamR :: Id Team -> GithubRequest 'True () deleteTeamR tid = - GithubDelete ["teams", toPathPart tid] + GithubCommand Delete ["teams", toPathPart tid] mempty -- | Retrieve team mebership information for a user. -- | With authentication @@ -153,7 +156,7 @@ addTeamMembershipFor' auth tid user role = -- See addTeamMembershipForR :: Id Team -> Name GithubOwner -> Role -> GithubRequest 'True TeamMembership addTeamMembershipForR tid user role = - GithubPost Put ["teams", toPathPart tid, "memberships", toPathPart user] (encode $ CreateTeamMembership role) + GithubCommand Put ["teams", toPathPart tid, "memberships", toPathPart user] (encode $ CreateTeamMembership role) -- | Delete a member of a team. -- @@ -166,7 +169,7 @@ deleteTeamMembershipFor' auth tid user = -- See deleteTeamMembershipForR :: Id Team -> Name GithubOwner -> GithubRequest 'True () deleteTeamMembershipForR tid user = - GithubDelete ["teams", toPathPart tid, "memberships", toPathPart user] + GithubCommand Delete ["teams", toPathPart tid, "memberships", toPathPart user] mempty -- | List teams for current authenticated user -- diff --git a/Github/PullRequests.hs b/Github/PullRequests.hs index 683b7282..fc84e480 100644 --- a/Github/PullRequests.hs +++ b/Github/PullRequests.hs @@ -112,7 +112,7 @@ createPullRequestR :: Name GithubOwner -> CreatePullRequest -> GithubRequest 'True PullRequest createPullRequestR user repo cpr = - GithubPost Post ["repos", toPathPart user, toPathPart repo, "pulls"] (encode cpr) + GithubCommand Post ["repos", toPathPart user, toPathPart repo, "pulls"] (encode cpr) -- | Update a pull request updatePullRequest :: GithubAuth -> Name GithubOwner -> Name Repo -> Id PullRequest -> EditPullRequest -> IO (Either Error PullRequest) @@ -127,7 +127,7 @@ updatePullRequestR :: Name GithubOwner -> EditPullRequest -> GithubRequest 'True PullRequest updatePullRequestR user repo prid epr = - GithubPost Patch ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid] (encode epr) + GithubCommand Patch ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid] (encode epr) -- | All the commits on a pull request, given the repo owner, repo name, and -- the number of the pull request. @@ -193,7 +193,7 @@ mergePullRequest auth user repo prid commitMessage = -- https://developer.github.com/v3/pulls/#merge-a-pull-request-merge-button mergePullRequestR :: Name GithubOwner -> Name Repo -> Id PullRequest -> Maybe String -> GithubRequest 'True MergeResult mergePullRequestR user repo prid commitMessage = GithubStatus StatusMerge $ - GithubPost Put paths (encode $ buildCommitMessageMap commitMessage) + GithubCommand Put paths (encode $ buildCommitMessageMap commitMessage) where paths = ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "merge"] diff --git a/Github/Repos.hs b/Github/Repos.hs index 381d0636..dc4d6b1d 100644 --- a/Github/Repos.hs +++ b/Github/Repos.hs @@ -59,10 +59,13 @@ module Github.Repos ( module Github.Data, ) where +import Prelude () +import Prelude.Compat + import Control.Applicative ((<|>)) import Data.Aeson.Compat (encode) - import Data.Vector (Vector) + import Github.Data import Github.Request @@ -164,7 +167,7 @@ createRepo' auth nrepo = -- See createRepoR :: NewRepo -> GithubRequest 'True Repo createRepoR nrepo = - GithubPost Post ["user", "repos"] (encode nrepo) + GithubCommand Post ["user", "repos"] (encode nrepo) -- | Create a new repository for an organization. -- @@ -177,7 +180,7 @@ createOrganizationRepo' auth org nrepo = -- See createOrganizationRepoR :: Name Organization -> NewRepo -> GithubRequest 'True Repo createOrganizationRepoR org nrepo = - GithubPost Post ["orgs", toPathPart org, "repos"] (encode nrepo) + GithubCommand Post ["orgs", toPathPart org, "repos"] (encode nrepo) -- | Edit an existing repository. -- @@ -195,7 +198,7 @@ editRepo auth user repo body = -- See editRepoR :: Name GithubOwner -> Name Repo -> EditRepo -> GithubRequest 'True Repo editRepoR user repo body = - GithubPost Patch ["repos", toPathPart user, toPathPart repo] (encode b) + GithubCommand Patch ["repos", toPathPart user, toPathPart repo] (encode b) where -- if no name is given, use curent name b = body {editName = editName body <|> Just repo} @@ -358,4 +361,4 @@ deleteRepo auth user repo = deleteRepoR :: Name GithubOwner -> Name Repo -> GithubRequest 'True () deleteRepoR user repo = - GithubDelete ["repos", toPathPart user, toPathPart repo] + GithubCommand Delete ["repos", toPathPart user, toPathPart repo] mempty diff --git a/Github/Repos/Collaborators.hs b/Github/Repos/Collaborators.hs index 5a84548e..b79fd424 100644 --- a/Github/Repos/Collaborators.hs +++ b/Github/Repos/Collaborators.hs @@ -41,8 +41,6 @@ collaboratorsOnR user repo = -- -- > isCollaboratorOn Nothing "mike-burns" "thoughtbot" "paperclip" -- > isCollaboratorOn Nothing "johnson" "thoughtbot" "paperclip" --- --- TODO: GithubStatus isCollaboratorOn :: Maybe GithubAuth -> Name GithubOwner -- ^ Repository owner -> Name Repo -- ^ Repository name diff --git a/Github/Repos/Webhooks.hs b/Github/Repos/Webhooks.hs index 2b26ba6b..d6d4afa6 100644 --- a/Github/Repos/Webhooks.hs +++ b/Github/Repos/Webhooks.hs @@ -34,12 +34,15 @@ module Github.Repos.Webhooks ( deleteRepoWebhookR, ) where -import Github.Data -import Github.Request +import Prelude () +import Prelude.Compat import Data.Aeson.Compat (encode) import Data.Vector (Vector) +import Github.Data +import Github.Request + webhooksFor' :: GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error (Vector RepoWebhook)) webhooksFor' auth user repo = executeRequest auth $ webhooksForR user repo Nothing @@ -68,7 +71,7 @@ createRepoWebhook' auth user repo hook = -- See createRepoWebhookR :: Name GithubOwner -> Name Repo -> NewRepoWebhook -> GithubRequest 'True RepoWebhook createRepoWebhookR user repo hook = - GithubPost Post ["repos", toPathPart user, toPathPart repo, "hooks"] (encode hook) + GithubCommand Post ["repos", toPathPart user, toPathPart repo, "hooks"] (encode hook) editRepoWebhook' :: GithubAuth -> Name GithubOwner -> Name Repo -> Id RepoWebhook -> EditRepoWebhook -> IO (Either Error RepoWebhook) editRepoWebhook' auth user repo hookId hookEdit = @@ -78,7 +81,7 @@ editRepoWebhook' auth user repo hookId hookEdit = -- See editRepoWebhookR :: Name GithubOwner -> Name Repo -> Id RepoWebhook -> EditRepoWebhook -> GithubRequest 'True RepoWebhook editRepoWebhookR user repo hookId hookEdit = - GithubPost Patch ["repos", toPathPart user, toPathPart repo, "hooks", toPathPart hookId] (encode hookEdit) + GithubCommand Patch ["repos", toPathPart user, toPathPart repo, "hooks", toPathPart hookId] (encode hookEdit) testPushRepoWebhook' :: GithubAuth -> Name GithubOwner -> Name Repo -> Id RepoWebhook -> IO (Either Error Bool) testPushRepoWebhook' auth user repo hookId = @@ -88,7 +91,7 @@ testPushRepoWebhook' auth user repo hookId = -- See testPushRepoWebhookR :: Name GithubOwner -> Name Repo -> Id RepoWebhook -> GithubRequest 'True Bool testPushRepoWebhookR user repo hookId = GithubStatus StatusOnlyOk $ - GithubPost Post (createWebhookOpPath user repo hookId $ Just "tests") (encode ()) + GithubCommand Post (createWebhookOpPath user repo hookId $ Just "tests") (encode ()) pingRepoWebhook' :: GithubAuth -> Name GithubOwner -> Name Repo -> Id RepoWebhook -> IO (Either Error Bool) pingRepoWebhook' auth user repo hookId = @@ -98,7 +101,7 @@ pingRepoWebhook' auth user repo hookId = -- See pingRepoWebhookR :: Name GithubOwner -> Name Repo -> Id RepoWebhook -> GithubRequest 'True Bool pingRepoWebhookR user repo hookId = GithubStatus StatusOnlyOk $ - GithubPost Post (createWebhookOpPath user repo hookId $ Just "pings") (encode ()) + GithubCommand Post (createWebhookOpPath user repo hookId $ Just "pings") (encode ()) deleteRepoWebhook' :: GithubAuth -> Name GithubOwner -> Name Repo -> Id RepoWebhook -> IO (Either Error ()) deleteRepoWebhook' auth user repo hookId = @@ -108,7 +111,7 @@ deleteRepoWebhook' auth user repo hookId = -- See deleteRepoWebhookR :: Name GithubOwner -> Name Repo -> Id RepoWebhook -> GithubRequest 'True () deleteRepoWebhookR user repo hookId = - GithubDelete $ createWebhookOpPath user repo hookId Nothing + GithubCommand Delete (createWebhookOpPath user repo hookId Nothing) mempty createBaseWebhookPath :: Name GithubOwner -> Name Repo -> Id RepoWebhook -> [String] createBaseWebhookPath user repo hookId = diff --git a/Github/Request.hs b/Github/Request.hs index 6b79fc6c..4321404e 100644 --- a/Github/Request.hs +++ b/Github/Request.hs @@ -15,7 +15,7 @@ module Github.Request ( -- * Types GithubRequest(..), - PostMethod(..), + CommandMethod(..), toMethod, Paths, QueryString, @@ -61,7 +61,7 @@ import Network.HTTP.Link.Parser (parseLinkHeaderBS) import Network.HTTP.Link.Types (Link (..), LinkParam (..), href, linkParams) import Network.HTTP.Types (Method, RequestHeaders, ResponseHeaders, - Status (..), methodDelete) + Status (..)) import Network.URI (URI) import qualified Control.Exception as E @@ -102,14 +102,12 @@ executeRequestWithMgr mgr auth req = runExceptT $ performPagedRequest httpLbs' predicate httpReq where predicate = maybe (const True) (\l' -> (< l') . V.length ) l - GithubPost {} -> do + GithubCommand m _ _ -> do httpReq <- makeHttpRequest (Just auth) req res <- httpLbs' httpReq - parseResponse res - GithubDelete {} -> do - httpReq <- makeHttpRequest (Just auth) req - _ <- httpLbs' httpReq - pure () + case m of + Delete -> pure () + _ -> parseResponse res GithubStatus sm _ -> do httpReq <- makeHttpRequest (Just auth) req res <- httpLbs' httpReq @@ -202,7 +200,7 @@ makeHttpRequest auth r = case r of . setAuthRequest auth . setQueryString qs $ req - GithubPost m paths body -> do + GithubCommand m paths body -> do req <- parseUrl $ url paths return $ setReqHeaders . setCheckStatus Nothing @@ -210,13 +208,6 @@ makeHttpRequest auth r = case r of . setBody body . setMethod (toMethod m) $ req - GithubDelete paths -> do - req <- parseUrl $ url paths - return $ setReqHeaders - . setCheckStatus Nothing - . setAuthRequest auth - . setMethod methodDelete - $ req where url :: Paths -> String url paths = baseUrl ++ '/' : intercalate "/" paths From f4abd7c5c9dc1e436f29cec65dcff7c5ff88157d Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 19 Jan 2016 20:28:00 +0200 Subject: [PATCH 164/510] Require only semigroup in performPagedRequest --- Github/Request.hs | 29 +++++++++++++++-------------- github.cabal | 4 +++- 2 files changed, 18 insertions(+), 15 deletions(-) diff --git a/Github/Request.hs b/Github/Request.hs index 4321404e..a11a0cfa 100644 --- a/Github/Request.hs +++ b/Github/Request.hs @@ -48,8 +48,9 @@ import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Except (ExceptT (..), runExceptT) import Data.Aeson.Compat (FromJSON, eitherDecode) import Data.List (find, intercalate) -import Data.Monoid ((<>)) +import Data.Semigroup (Semigroup (..)) import Data.Text (Text) +import Data.Vector.Instances () import Network.HTTP.Client (CookieJar, HttpException (..), Manager, Request (..), RequestBody (..), @@ -295,31 +296,31 @@ parseStatus StatusMerge (Status sci _) -- | Helper for making paginated requests. Responses, @a@ are combined monoidally. -- -- @ --- performPagedRequest :: ('FromJSON' a, 'Monoid' a) +-- performPagedRequest :: ('FromJSON' a, 'Semigroup' a) -- => ('Request' -> 'ExceptT' 'Error' 'IO' ('Response' 'LBS.ByteString')) -- -> (a -> 'Bool') -- -> 'Request' -- -> 'ExceptT' 'Error' 'IO' a -- @ --- --- /TODO:/ require only 'Semigroup'. -performPagedRequest :: forall a m. (FromJSON a, Monoid a, MonadCatch m, MonadError Error m) +performPagedRequest :: forall a m. (FromJSON a, Semigroup a, MonadCatch m, MonadError Error m) => (Request -> m (Response LBS.ByteString)) -- ^ `httpLbs` analogue -> (a -> Bool) -- ^ predicate to continue iteration -> Request -- ^ initial request -> m a -performPagedRequest httpLbs' predicate = go mempty +performPagedRequest httpLbs' predicate initReq = do + res <- httpLbs' initReq + m <- parseResponse res + go m res initReq where - go :: a -> Request -> m a - go acc req = do - res <- httpLbs' req - m <- parseResponse res - let m' = acc <> m - case (predicate m', getNextUrl res) of + go :: a -> Response LBS.ByteString -> Request -> m a + go acc res req = + case (predicate acc, getNextUrl res) of (True, Just uri) -> do req' <- setUri req uri - go m' req' - (_, _) -> return m' + res' <- httpLbs' req + m <- parseResponse res + go (acc <> m) res' req' + (_, _) -> return acc onHttpException :: MonadError Error m => HttpException -> m a onHttpException = throwError . HTTPError diff --git a/github.cabal b/github.cabal index 99397485..e7ad5faf 100644 --- a/github.cabal +++ b/github.cabal @@ -101,12 +101,14 @@ Library iso8601-time >=0.1.4 && <0.2, mtl >=2.1.3.1 && <2.3, network-uri >=2.6.0.3 && <2.7, + semigroups >=0.16.2.2 && <0.19, text >=1.2.0.6 && <1.3, time >=1.4 && <1.7, transformers >=0.3.0.0 && <0.6, transformers-compat >=0.4.0.3 && <0.6, unordered-containers >=0.2 && <0.3, - vector >=0.10.12.3 && <0.12 + vector >=0.10.12.3 && <0.12, + vector-instances >=3.3.0.1 && <3.4 if flag(aeson-compat) Build-depends: aeson-compat >=0.3.0.0 && <0.4 From c6e8ed69669655441cee1ba656c384c3b1386324 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 19 Jan 2016 21:03:21 +0200 Subject: [PATCH 165/510] Operational example --- Github/Repos.hs | 2 +- Github/Request.hs | 35 ++++++++++++++++++++-------- samples/Operational/Operational.hs | 37 ++++++++++++++++++++++++++++++ samples/github-samples.cabal | 18 +++++++++++++++ samples/package.yaml | 10 ++++++++ 5 files changed, 91 insertions(+), 11 deletions(-) create mode 100644 samples/Operational/Operational.hs diff --git a/Github/Repos.hs b/Github/Repos.hs index dc4d6b1d..2c6ed7b8 100644 --- a/Github/Repos.hs +++ b/Github/Repos.hs @@ -64,7 +64,7 @@ import Prelude.Compat import Control.Applicative ((<|>)) import Data.Aeson.Compat (encode) -import Data.Vector (Vector) +import Data.Vector (Vector) import Github.Data import Github.Request diff --git a/Github/Request.hs b/Github/Request.hs index a11a0cfa..e68a8cb5 100644 --- a/Github/Request.hs +++ b/Github/Request.hs @@ -12,6 +12,26 @@ -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus +-- +-- This module provides data types and helper methods, which makes possible +-- to build alternative API request intepreters in addition to provided +-- 'IO' functions. +-- +-- Simple example using @operational@ package. See @samples\/Operational\/Operational.hs@ +-- +-- > type GithubMonad a = Program (GH.GithubRequest 'False) a +-- > +-- > -- | Intepret GithubMonad value into IO +-- > runGithubMonad :: Manager -> GH.GithubAuth -> GithubMonad a -> ExceptT GH.Error IO a +-- > runGithubMonad mgr auth m = case view m of +-- > Return a -> return a +-- > req :>>= k -> do +-- > b <- ExceptT $ GH.executeRequestWithMgr mgr auth req +-- > runGithubMonad mgr auth (k b) +-- > +-- > -- | Lift request into GithubMonad +-- > githubRequest :: GH.GithubRequest 'False a -> GithubMonad a +-- > githubRequest = singleton module Github.Request ( -- * Types GithubRequest(..), @@ -76,8 +96,7 @@ import Github.Data (Error (..)) import Github.Data.Request -- | Execute 'GithubRequest' in 'IO' -executeRequest :: Show a - => GithubAuth -> GithubRequest k a -> IO (Either Error a) +executeRequest :: GithubAuth -> GithubRequest k a -> IO (Either Error a) executeRequest auth req = do manager <- newManager tlsManagerSettings x <- executeRequestWithMgr manager auth req @@ -87,8 +106,7 @@ executeRequest auth req = do pure x -- | Like 'executeRequest' but with provided 'Manager'. -executeRequestWithMgr :: Show a - => Manager +executeRequestWithMgr :: Manager -> GithubAuth -> GithubRequest k a -> IO (Either Error a) @@ -118,8 +136,7 @@ executeRequestWithMgr mgr auth req = runExceptT $ httpLbs' req' = lift (httpLbs req' mgr) `catch` onHttpException -- | Like 'executeRequest' but without authentication. -executeRequest' :: Show a - => GithubRequest 'False a -> IO (Either Error a) +executeRequest' :: GithubRequest 'False a -> IO (Either Error a) executeRequest' req = do manager <- newManager tlsManagerSettings x <- executeRequestWithMgr' manager req @@ -129,8 +146,7 @@ executeRequest' req = do pure x -- | Like 'executeRequestWithMgr' but without authentication. -executeRequestWithMgr' :: Show a - => Manager +executeRequestWithMgr' :: Manager -> GithubRequest 'False a -> IO (Either Error a) executeRequestWithMgr' mgr req = runExceptT $ @@ -155,8 +171,7 @@ executeRequestWithMgr' mgr req = runExceptT $ -- | Helper for picking between 'executeRequest' and 'executeRequest''. -- -- The use is discouraged. -executeRequestMaybe :: Show a - => Maybe GithubAuth -> GithubRequest 'False a +executeRequestMaybe :: Maybe GithubAuth -> GithubRequest 'False a -> IO (Either Error a) executeRequestMaybe = maybe executeRequest' executeRequest diff --git a/samples/Operational/Operational.hs b/samples/Operational/Operational.hs new file mode 100644 index 00000000..7c4e39a9 --- /dev/null +++ b/samples/Operational/Operational.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +module Main (main) where + +import Common +import Prelude () + +import Control.Monad.Trans.Except (ExceptT (..), runExceptT) +import Control.Monad.Operational +import Network.HTTP.Client (Manager, newManager) +import Network.HTTP.Client.TLS (tlsManagerSettings) + +import qualified Github.All as GH + +type GithubMonad a = Program (GH.GithubRequest 'False) a + +runGithubMonad :: Manager -> GH.GithubAuth -> GithubMonad a -> ExceptT GH.Error IO a +runGithubMonad mgr auth m = case view m of + Return a -> return a + req :>>= k -> do + b <- ExceptT $ GH.executeRequestWithMgr mgr auth req + runGithubMonad mgr auth (k b) + +githubRequest :: GH.GithubRequest 'False a -> GithubMonad a +githubRequest = singleton + +main :: IO () +main = do + manager <- newManager tlsManagerSettings + auth' <- getAuth + case auth' of + Nothing -> return () + Just auth -> do + user <- runExceptT $ runGithubMonad manager auth $ do + repo <- githubRequest $ GH.repositoryR "phadej" "github" + githubRequest $ GH.userInfoForR (GH.simpleOwnerLogin . GH.repoOwner $ repo) + print user diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index 39e906de..26220e4d 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -103,6 +103,24 @@ executable github-list-following ListFollowers default-language: Haskell2010 +executable github-operational + main-is: Operational.hs + hs-source-dirs: + Operational + ghc-options: -Wall + build-depends: + base + , base-compat + , github + , text + , github-samples + , http-client + , http-client-tls + , operational + , transformers + , transformers-compat + default-language: Haskell2010 + executable github-add-team-membership-for main-is: AddTeamMembershipFor.hs hs-source-dirs: diff --git a/samples/package.yaml b/samples/package.yaml index b2615b94..68863e98 100644 --- a/samples/package.yaml +++ b/samples/package.yaml @@ -62,3 +62,13 @@ executables: source-dirs: Teams/Memberships dependencies: - github-samples + github-operational: + main: Operational.hs + source-dirs: Operational + dependencies: + - github-samples + - http-client + - http-client-tls + - operational + - transformers + - transformers-compat From 449ee122b7843736bbd012ddbee32af5683d938e Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Wed, 20 Jan 2016 08:09:45 +0200 Subject: [PATCH 166/510] show-users-2 --- Github/All.hs | 10 +++++++--- github.cabal | 25 +++++++++++++++++++------ samples/Users/ShowUser2.hs | 9 +++++++++ samples/github-samples.cabal | 18 ++++++++++++++++++ samples/package.yaml | 5 +++++ travis-script.sh | 2 +- 6 files changed, 59 insertions(+), 10 deletions(-) create mode 100644 samples/Users/ShowUser2.hs diff --git a/Github/All.hs b/Github/All.hs index 12ea4751..a1464ef2 100644 --- a/Github/All.hs +++ b/Github/All.hs @@ -3,10 +3,14 @@ -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- --- This module re-exports all request constructrors and --- data definitions from this package. +-- This module re-exports all request constructrors and data definitions from +-- this package. -- --- The missing endpoints lists are exhausive, they indicate endpoints we know are missing. +-- See 'Github.Request' module for executing 'GithubRequest', or other modules +-- of this package (e.g. 'Github.Users') for already composed versions. +-- +-- The missing endpoints lists show which endpoints we know are missing, there +-- might be more. module Github.All ( -- * Activity -- | See diff --git a/github.cabal b/github.cabal index e7ad5faf..6ed49efb 100644 --- a/github.cabal +++ b/github.cabal @@ -1,12 +1,25 @@ Name: github Version: 0.14.0 Synopsis: Access to the Github API, v3. -Description: The Github API provides programmatic access to the full - Github Web site, from Issues to Gists to repos down to the underlying git data - like references and trees. This library wraps all of that, exposing a basic but - Haskell-friendly set of functions and data structures. - . - For more of an overview please see the README: +Description: + The Github API provides programmatic access to the full + Github Web site, from Issues to Gists to repos down to the underlying git data + like references and trees. This library wraps all of that, exposing a basic but + Haskell-friendly set of functions and data structures. + . + For supported endpoints see "Github.All" module. + . + >{-# LANGUAGE OverloadedStrings #-} + >module Main (main) where + > + >import qualified Github.All as GH + > + >main :: IO () + >main = do + > possibleUser <- GH.executeRequest' $ GH.userInfoR "phadej" + > print possibleUser + . + For more of an overview please see the README: License: BSD3 License-file: LICENSE Author: Mike Burns, John Wiegley, Oleg Grenrus diff --git a/samples/Users/ShowUser2.hs b/samples/Users/ShowUser2.hs new file mode 100644 index 00000000..5c6360b7 --- /dev/null +++ b/samples/Users/ShowUser2.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main (main) where + +import qualified Github.All as GH + +main :: IO () +main = do + possibleUser <- GH.executeRequest' $ GH.userInfoForR "phadej" + print possibleUser diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index 26220e4d..8b667435 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -86,6 +86,7 @@ executable github-show-user other-modules: Followers.ListFollowers Followers.ListFollowing + ShowUser2 default-language: Haskell2010 executable github-list-following @@ -192,6 +193,23 @@ executable github-delete-team TeamInfoFor default-language: Haskell2010 +executable github-show-user-2 + main-is: ShowUser2.hs + hs-source-dirs: + Users + ghc-options: -Wall + build-depends: + base + , base-compat + , github + , text + , github-samples + other-modules: + Followers.ListFollowers + Followers.ListFollowing + ShowUser + default-language: Haskell2010 + executable github-teaminfo-for main-is: TeamInfoFor.hs hs-source-dirs: diff --git a/samples/package.yaml b/samples/package.yaml index 68863e98..82d68519 100644 --- a/samples/package.yaml +++ b/samples/package.yaml @@ -17,6 +17,11 @@ executables: source-dirs: Users dependencies: - github-samples + github-show-user-2: + main: ShowUser2.hs + source-dirs: Users + dependencies: + - github-samples github-list-followers: main: ListFollowers.hs source-dirs: Users/Followers diff --git a/travis-script.sh b/travis-script.sh index f9788d9c..abe20d8c 100644 --- a/travis-script.sh +++ b/travis-script.sh @@ -6,7 +6,7 @@ case $BUILD in stack --no-terminal build github-samples # TODO: get executables from info - for testbin in show-user list-followers list-following; do + for testbin in show-user list-followers list-following operational; do echo "Running " $testbin stack exec github-$testbin done From 9d708d248f14a4032b0a717f1757adf795e050d2 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Wed, 20 Jan 2016 09:56:25 +0200 Subject: [PATCH 167/510] Refactor Definitions --- Github/Activity/Starring.hs | 4 +- Github/Activity/Watching.hs | 6 +- Github/All.hs | 1 + Github/Data.hs | 179 +++----- Github/Data/Comments.hs | 50 +++ Github/Data/Content.hs | 62 +++ Github/Data/Definitions.hs | 384 +++++++++--------- Github/Data/Gists.hs | 4 +- Github/Data/GitData.hs | 21 +- Github/Data/Issues.hs | 12 +- Github/Data/PullRequests.hs | 10 +- Github/Data/Repos.hs | 18 +- Github/Data/Teams.hs | 2 +- Github/Organizations.hs | 8 +- Github/Organizations/Members.hs | 6 +- Github/Repos/Collaborators.hs | 10 +- Github/Users.hs | 32 +- Github/Users/Followers.hs | 15 +- NEWS.md | 4 +- .../{issueSearch.json => issue-search.json} | 0 github.cabal | 15 +- spec/Github/UsersSpec.hs | 26 +- travis-script.sh | 7 +- 23 files changed, 487 insertions(+), 389 deletions(-) create mode 100644 Github/Data/Comments.hs create mode 100644 Github/Data/Content.hs rename fixtures/{issueSearch.json => issue-search.json} (100%) diff --git a/Github/Activity/Starring.hs b/Github/Activity/Starring.hs index 924a663d..0b5d94a8 100644 --- a/Github/Activity/Starring.hs +++ b/Github/Activity/Starring.hs @@ -24,13 +24,13 @@ import Github.Request -- | The list of users that have starred the specified Github repo. -- -- > userInfoFor' Nothing "mike-burns" -stargazersFor :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error (Vector SimpleOwner)) +stargazersFor :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error (Vector SimpleUser)) stargazersFor auth user repo = executeRequestMaybe auth $ stargazersForR user repo Nothing -- | List Stargazers. -- See -stargazersForR :: Name GithubOwner -> Name Repo -> Maybe Count -> GithubRequest k (Vector SimpleOwner) +stargazersForR :: Name GithubOwner -> Name Repo -> Maybe Count -> GithubRequest k (Vector SimpleUser) stargazersForR user repo = GithubPagedGet ["repos", toPathPart user, toPathPart repo, "stargazers"] [] diff --git a/Github/Activity/Watching.hs b/Github/Activity/Watching.hs index d4e077b1..88cb0f71 100644 --- a/Github/Activity/Watching.hs +++ b/Github/Activity/Watching.hs @@ -23,20 +23,20 @@ import Github.Request -- | The list of users that are watching the specified Github repo. -- -- > watchersFor "thoughtbot" "paperclip" -watchersFor :: Name GithubOwner -> Name Repo -> IO (Either Error (Vector SimpleOwner)) +watchersFor :: Name GithubOwner -> Name Repo -> IO (Either Error (Vector SimpleUser)) watchersFor = watchersFor' Nothing -- | The list of users that are watching the specified Github repo. -- With authentication -- -- > watchersFor' (Just (GithubUser (user, password))) "thoughtbot" "paperclip" -watchersFor' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error (Vector SimpleOwner)) +watchersFor' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error (Vector SimpleUser)) watchersFor' auth user repo = executeRequestMaybe auth $ watchersForR user repo Nothing -- | List watchers. -- See -watchersForR :: Name GithubOwner -> Name Repo -> Maybe Count -> GithubRequest k (Vector SimpleOwner) +watchersForR :: Name GithubOwner -> Name Repo -> Maybe Count -> GithubRequest k (Vector SimpleUser) watchersForR user repo limit = GithubPagedGet ["repos", toPathPart user, toPathPart repo, "watchers"] [] limit diff --git a/Github/All.hs b/Github/All.hs index a1464ef2..551d5b10 100644 --- a/Github/All.hs +++ b/Github/All.hs @@ -283,6 +283,7 @@ module Github.All ( -- * Update the authenticated user -- * Get all users userInfoForR, + ownerInfoForR, userInfoCurrentR, -- ** Followers diff --git a/Github/Data.hs b/Github/Data.hs index 750bda29..72a6c79d 100644 --- a/Github/Data.hs +++ b/Github/Data.hs @@ -7,23 +7,8 @@ -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- --- This module re-exports the @Github.Data.Definitions@ module, adding --- instances of @FromJSON@ to it. If you wish to use the data without the --- instances, use the @Github.Data.Definitions@ module instead. +-- This module re-exports the @Github.Data.@ submodules. module Github.Data ( - -- * Module re-exports - module Github.Auth, - module Github.Data.Definitions, - module Github.Data.Gists, - module Github.Data.GitData, - module Github.Data.Issues, - module Github.Data.PullRequests, - module Github.Data.Repos, - module Github.Data.Request, - module Github.Data.Search, - module Github.Data.Teams, - module Github.Data.Webhooks, - -- * Tagged types -- ** Name Name, @@ -33,6 +18,8 @@ module Github.Data ( mkTeamName, mkOrganizationName, mkRepoName, + fromUserName, + fromOrganizationName, -- ** Id Id, mkId, @@ -41,6 +28,20 @@ module Github.Data ( mkTeamId, mkOrganizationId, mkRepoId, + -- * Module re-exports + module Github.Auth, + module Github.Data.Comments, + module Github.Data.Content, + module Github.Data.Definitions, + module Github.Data.Gists, + module Github.Data.GitData, + module Github.Data.Issues, + module Github.Data.PullRequests, + module Github.Data.Repos, + module Github.Data.Request, + module Github.Data.Search, + module Github.Data.Teams, + module Github.Data.Webhooks, ) where import Prelude () @@ -55,6 +56,8 @@ import qualified Data.Text as T import qualified Data.Vector as V import Github.Auth +import Github.Data.Comments +import Github.Data.Content import Github.Data.Definitions import Github.Data.Gists import Github.Data.GitData @@ -92,6 +95,12 @@ mkRepoId = Id mkRepoName :: T.Text -> Name Repo mkRepoName = N +fromOrganizationName :: Name Organization -> Name GithubOwner +fromOrganizationName = N . untagName + +fromUserName :: Name User -> Name GithubOwner +fromUserName = N . untagName + instance FromJSON Commit where parseJSON (Object o) = Commit <$> o .: "sha" @@ -100,7 +109,7 @@ instance FromJSON Commit where <*> o .: "commit" <*> o .:? "committer" <*> o .:? "author" - <*> o .:< "files" + <*> o .:? "files" .!= V.empty <*> o .:? "stats" parseJSON _ = fail "Could not build a Commit" @@ -108,7 +117,7 @@ instance FromJSON Tree where parseJSON (Object o) = Tree <$> o .: "sha" <*> o .: "url" - <*> o .:< "tree" + <*> o .:? "tree" .!= V.empty parseJSON _ = fail "Could not build a Tree" instance FromJSON GitTree where @@ -129,26 +138,9 @@ instance FromJSON GitCommit where <*> o .: "author" <*> o .: "tree" <*> o .:? "sha" - <*> o .:< "parents" + <*> o .:? "parents" .!= V.empty parseJSON _ = fail "Could not build a GitCommit" -instance FromJSON SimpleOwner where - parseJSON (Object o) - | o `at` "gravatar_id" == Nothing = - SimpleOrganizationOwner - <$> o .: "avatar_url" - <*> o .: "login" - <*> o .: "url" - <*> o .: "id" - | otherwise = - SimpleUserOwner - <$> o .: "avatar_url" - <*> o .: "login" - <*> o .: "url" - <*> o .: "id" - <*> o .: "gravatar_id" - parseJSON v = fail $ "Could not build a SimpleGithubOwner out of " ++ (show v) - instance FromJSON GitUser where parseJSON (Object o) = GitUser <$> o .: "name" @@ -204,10 +196,10 @@ instance FromJSON Diff where <*> o .: "patch_url" <*> o .: "url" <*> o .: "base_commit" - <*> o .:< "commits" + <*> o .:? "commits" .!= V.empty <*> o .: "total_commits" <*> o .: "html_url" - <*> o .:< "files" + <*> o .:? "files" .!= V.empty <*> o .: "ahead_by" <*> o .: "diff_url" <*> o .: "permalink_url" @@ -388,34 +380,6 @@ instance FromJSON EventType where parseJSON (String "head_ref_restored") = pure HeadRefRestored parseJSON _ = fail "Could not build an EventType" -instance FromJSON SimpleOrganization where - parseJSON (Object o) = - SimpleOrganization <$> o .: "url" - <*> o .: "avatar_url" - <*> o .: "id" - <*> o .: "login" - parseJSON _ = fail "Could not build a SimpleOrganization" - -instance FromJSON Organization where - parseJSON (Object o) = - Organization <$> o .: "type" - <*> o .:? "blog" - <*> o .:? "location" - <*> o .: "login" - <*> o .: "followers" - <*> o .:? "company" - <*> o .: "avatar_url" - <*> o .: "public_gists" - <*> o .: "html_url" - <*> o .:? "email" - <*> o .: "following" - <*> o .: "public_repos" - <*> o .: "url" - <*> o .: "created_at" - <*> o .:? "name" - <*> o .: "id" - parseJSON _ = fail "Could not build an Organization" - instance FromJSON SimplePullRequest where parseJSON (Object o) = SimplePullRequest @@ -575,9 +539,9 @@ instance FromJSON PingEvent where parseJSON _ = fail "Could not build a PingEvent" instance FromJSON entity => FromJSON (SearchResult entity) where - parseJSON = withObject "Searchresult" $ \o -> + parseJSON = withObject "SearchResult" $ \o -> SearchResult <$> o .: "total_count" - <*> o .:< "items" + <*> o .:? "items" .!= V.empty instance FromJSON Repo where parseJSON (Object o) = @@ -666,18 +630,21 @@ instance FromJSON RepoRef where parseJSON _ = fail "Could not build a RepoRef" instance FromJSON Contributor where - parseJSON (Object o) - | o `at` "type" == (Just "Anonymous") = - AnonymousContributor <$> o .: "contributions" - <*> o .: "name" - | otherwise = - KnownContributor <$> o .: "contributions" - <*> o .: "avatar_url" - <*> o .: "login" - <*> o .: "url" - <*> o .: "id" - <*> o .: "gravatar_id" - parseJSON _ = fail "Could not build a Contributor" + parseJSON = withObject "Contributor" $ \o -> do + t <- o .: "type" + case t of + _ | t == ("Anonymous" :: T.Text) -> + AnonymousContributor + <$> o .: "contributions" + <*> o .: "name" + _ | otherwise -> + KnownContributor + <$> o .: "contributions" + <*> o .: "avatar_url" + <*> o .: "login" + <*> o .: "url" + <*> o .: "id" + <*> o .: "gravatar_id" instance FromJSON Languages where parseJSON (Object o) = @@ -702,47 +669,6 @@ instance FromJSON BranchCommit where parseJSON (Object o) = BranchCommit <$> o .: "sha" <*> o .: "url" parseJSON _ = fail "Could not build a BranchCommit" -instance FromJSON GithubOwner where - parseJSON (Object o) - | o `at` "gravatar_id" == Nothing = - GithubOrganization <$> o .: "created_at" - <*> o .: "type" - <*> o .: "public_gists" - <*> o .: "avatar_url" - <*> o .: "followers" - <*> o .: "following" - <*> o .:? "blog" - <*> o .:? "bio" - <*> o .: "public_repos" - <*> o .:? "name" - <*> o .:? "location" - <*> o .:? "company" - <*> o .: "url" - <*> o .: "id" - <*> o .: "html_url" - <*> o .: "login" - | otherwise = - GithubUser <$> o .: "created_at" - <*> o .: "type" - <*> o .: "public_gists" - <*> o .: "avatar_url" - <*> o .: "followers" - <*> o .: "following" - <*> o .:? "hireable" - <*> o .: "gravatar_id" - <*> o .:? "blog" - <*> o .:? "bio" - <*> o .: "public_repos" - <*> o .:? "name" - <*> o .:? "location" - <*> o .:? "company" - <*> o .:? "email" - <*> o .: "url" - <*> o .: "id" - <*> o .: "html_url" - <*> o .: "login" - parseJSON _ = fail "Could not build a GithubOwner" - instance FromJSON Privacy where parseJSON (String attr) = case attr of @@ -941,13 +867,6 @@ instance FromJSON ContentInfo where <*> o .: "html_url" parseJSON _ = fail "Could not build a ContentInfo" --- | A slightly less generic version of Aeson's '.:?', using `V.empty' instead --- of 'Nothing'. -(.:<) :: (FromJSON a) => Object -> T.Text -> Parser (V.Vector a) -obj .:< key = case Map.lookup key obj of - Nothing -> pure V.empty - Just v -> parseJSON v - -- | Produce all values for the given key. values :: (Eq k, Hashable k, FromJSON v) => Map.HashMap k Value -> k -> Parser v obj `values` key = @@ -962,10 +881,6 @@ obj <.:> (key:keys) = nextObj <.:> keys _ <.:> [] = fail "must have a pair" --- | Produce the value for the given key, maybe. -at :: Object -> T.Text -> Maybe Value -obj `at` key = Map.lookup key obj - -- Taken from Data.Map: findWithDefault :: (Eq k, Hashable k) => v -> k -> Map.HashMap k v -> v findWithDefault def k m = diff --git a/Github/Data/Comments.hs b/Github/Data/Comments.hs new file mode 100644 index 00000000..b4bcebf8 --- /dev/null +++ b/Github/Data/Comments.hs @@ -0,0 +1,50 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +module Github.Data.Comments where + +import Control.DeepSeq (NFData (..)) +import Control.DeepSeq.Generics (genericRnf) +import Data.Binary.Orphans (Binary) +import Data.Data (Data, Typeable) +import Data.Text (Text) +import Data.Time (UTCTime) +import GHC.Generics (Generic) + +import Github.Data.Definitions +import Github.Data.Id + +data Comment = Comment { + commentPosition :: !(Maybe Int) + ,commentLine :: !(Maybe Int) + ,commentBody :: !Text + ,commentCommitId :: !(Maybe Text) + ,commentUpdatedAt :: !UTCTime + ,commentHtmlUrl :: !(Maybe Text) + ,commentUrl :: !Text + ,commentCreatedAt :: !(Maybe UTCTime) + ,commentPath :: !(Maybe Text) + ,commentUser :: !SimpleUser + ,commentId :: !(Id Comment) +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Comment where rnf = genericRnf +instance Binary Comment + +data NewComment = NewComment { + newCommentBody :: !Text +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData NewComment where rnf = genericRnf +instance Binary NewComment + +data EditComment = EditComment { + editCommentBody :: !Text +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData EditComment where rnf = genericRnf +instance Binary EditComment diff --git a/Github/Data/Content.hs b/Github/Data/Content.hs new file mode 100644 index 00000000..9eda0226 --- /dev/null +++ b/Github/Data/Content.hs @@ -0,0 +1,62 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +module Github.Data.Content where + +import Control.DeepSeq (NFData (..)) +import Control.DeepSeq.Generics (genericRnf) +import Data.Binary.Orphans (Binary) +import Data.Data (Data, Typeable) +import Data.Text (Text) +import Data.Vector (Vector) +import GHC.Generics (Generic) + +data Content + = ContentFile !ContentFileData + | ContentDirectory !(Vector ContentItem) + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Content where rnf = genericRnf +instance Binary Content + +data ContentFileData = ContentFileData { + contentFileInfo :: !ContentInfo + ,contentFileEncoding :: !Text + ,contentFileSize :: !Int + ,contentFileContent :: !Text +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData ContentFileData where rnf = genericRnf +instance Binary ContentFileData + +-- | An item in a directory listing. +data ContentItem = ContentItem { + contentItemType :: !ContentItemType + ,contentItemInfo :: !ContentInfo +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData ContentItem where rnf = genericRnf +instance Binary ContentItem + +data ContentItemType = ItemFile | ItemDir + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData ContentItemType where rnf = genericRnf +instance Binary ContentItemType + +-- | Information common to both kinds of Content: files and directories. +data ContentInfo = ContentInfo { + contentName :: !Text + ,contentPath :: !Text + ,contentSha :: !Text + ,contentUrl :: !Text + ,contentGitUrl :: !Text + ,contentHtmlUrl :: !Text +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData ContentInfo where rnf = genericRnf +instance Binary ContentInfo diff --git a/Github/Data/Definitions.hs b/Github/Data/Definitions.hs index 23942569..501d3bd3 100644 --- a/Github/Data/Definitions.hs +++ b/Github/Data/Definitions.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -7,225 +8,224 @@ -- module Github.Data.Definitions where +import Prelude () +import Prelude.Compat + import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) +import Control.Monad (mfilter) +import Data.Aeson.Compat (FromJSON (..), withObject, withText, (.:), + (.:?), Object) +import Data.Aeson.Types (Parser) import Data.Binary.Orphans (Binary) import Data.Data (Data, Typeable) import Data.Text (Text) import Data.Time (UTCTime) -import Data.Vector (Vector) import GHC.Generics (Generic) import Network.HTTP.Client (HttpException) import qualified Control.Exception as E +import qualified Data.Text as T import Github.Data.Id import Github.Data.Name --- | The options for querying commits. -data CommitQueryOption = CommitQuerySha !Text - | CommitQueryPath !Text - | CommitQueryAuthor !Text - | CommitQuerySince !UTCTime - | CommitQueryUntil !UTCTime - deriving (Show, Eq, Ord) - -- | Errors have been tagged according to their source, so you can more easily -- dispatch and handle them. -data Error = - HTTPError !HttpException -- ^ A HTTP error occurred. The actual caught error is included. - | ParseError !Text -- ^ An error in the parser itself. - | JsonError !Text -- ^ The JSON is malformed or unexpected. - | UserError !Text -- ^ Incorrect input. - deriving (Show, Typeable) +data Error + = HTTPError !HttpException -- ^ A HTTP error occurred. The actual caught error is included. + | ParseError !Text -- ^ An error in the parser itself. + | JsonError !Text -- ^ The JSON is malformed or unexpected. + | UserError !Text -- ^ Incorrect input. + deriving (Show, Typeable) instance E.Exception Error -data SimpleOwner = SimpleUserOwner { - simpleOwnerAvatarUrl :: !Text - ,simpleOwnerLogin :: !(Name GithubOwner) - ,simpleOwnerUrl :: !Text - ,simpleOwnerId :: !(Id GithubOwner) - ,simpleOwnerGravatarId :: !(Maybe Text) - } - | SimpleOrganizationOwner { - simpleOwnerAvatarUrl :: !Text - ,simpleOwnerLogin :: !(Name GithubOwner) - ,simpleOwnerUrl :: !Text - ,simpleOwnerId :: !(Id GithubOwner) -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData SimpleOwner where rnf = genericRnf -instance Binary SimpleOwner - -data Stats = Stats { - statsAdditions :: !Int - ,statsTotal :: !Int - ,statsDeletions :: !Int -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData Stats where rnf = genericRnf -instance Binary Stats - -data Comment = Comment { - commentPosition :: !(Maybe Int) - ,commentLine :: !(Maybe Int) - ,commentBody :: !Text - ,commentCommitId :: !(Maybe Text) - ,commentUpdatedAt :: !UTCTime - ,commentHtmlUrl :: !(Maybe Text) - ,commentUrl :: !Text - ,commentCreatedAt :: !(Maybe UTCTime) - ,commentPath :: !(Maybe Text) - ,commentUser :: !SimpleOwner - ,commentId :: !(Id Comment) -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData Comment where rnf = genericRnf -instance Binary Comment - -data NewComment = NewComment { - newCommentBody :: !Text -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData NewComment where rnf = genericRnf -instance Binary NewComment - -data EditComment = EditComment { - editCommentBody :: !Text -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData EditComment where rnf = genericRnf -instance Binary EditComment - -data SimpleOrganization = SimpleOrganization { - simpleOrganizationUrl :: !Text - ,simpleOrganizationAvatarUrl :: !Text - ,simpleOrganizationId :: !(Id Organization) - ,simpleOrganizationLogin :: !Text -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +-- | Type of the repository owners. +data OwnerType = OwnerUser | OwnerOrganization + deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic, Typeable, Data) + +instance NFData OwnerType +instance Binary OwnerType + +data SimpleUser = SimpleUser + { simpleUserId :: !(Id User) + , simpleUserLogin :: !(Name User) + , simpleUserAvatarUrl :: !Text + , simpleUserUrl :: !Text + , simpleUserType :: !OwnerType -- ^ Should always be 'OwnerUser' + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData SimpleUser where rnf = genericRnf +instance Binary SimpleUser + +data SimpleOrganization = SimpleOrganization + { simpleOrganizationId :: !(Id Organization) + , simpleOrganizationLogin :: !(Name Organization) + , simpleOrganizationUrl :: !Text + , simpleOrganizationAvatarUrl :: !Text + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData SimpleOrganization where rnf = genericRnf instance Binary SimpleOrganization -data Organization = Organization { - organizationType :: !Text - ,organizationBlog :: !(Maybe Text) - ,organizationLocation :: !(Maybe Text) - ,organizationLogin :: !(Name Organization) - ,organizationFollowers :: !Int - ,organizationCompany :: !(Maybe Text) - ,organizationAvatarUrl :: !Text - ,organizationPublicGists :: !Int - ,organizationHtmlUrl :: !Text - ,organizationEmail :: !(Maybe Text) - ,organizationFollowing :: !Int - ,organizationPublicRepos :: !Int - ,organizationUrl :: !Text - ,organizationCreatedAt :: !UTCTime - ,organizationName :: !(Maybe Text) - ,organizationId :: !(Id Organization) -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +-- | Sometimes we don't know the type of the owner, e.g. in 'Repo' +data SimpleOwner = SimpleOwner + { simpleOwnerId :: !(Id GithubOwner) + , simpleOwnerLogin :: !(Name GithubOwner) + , simpleOwnerUrl :: !Text + , simpleOwnerAvatarUrl :: !Text + , simpleOwnerType :: !OwnerType + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData SimpleOwner where rnf = genericRnf +instance Binary SimpleOwner + +data User = User + { userId :: !(Id User) + , userLogin :: !(Name User) + , userName :: !(Maybe Text) + , userType :: !OwnerType -- ^ Should always be 'OwnerUser' + , userCreatedAt :: !UTCTime + , userPublicGists :: !Int + , userAvatarUrl :: !Text + , userFollowers :: !Int + , userFollowing :: !Int + , userHireable :: !(Maybe Bool) + , userBlog :: !(Maybe Text) + , userBio :: !(Maybe Text) + , userPublicRepos :: !Int + , userLocation :: !(Maybe Text) + , userCompany :: !(Maybe Text) + , userEmail :: !(Maybe Text) + , userUrl :: !Text + , userHtmlUrl :: !Text + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData User where rnf = genericRnf +instance Binary User + +data Organization = Organization + { organizationId :: !(Id Organization) + , organizationLogin :: !(Name Organization) + , organizationName :: !(Maybe Text) + , organizationType :: !OwnerType -- ^ Should always be 'OwnerOrganization' + , organizationBlog :: !(Maybe Text) + , organizationLocation :: !(Maybe Text) + , organizationFollowers :: !Int + , organizationCompany :: !(Maybe Text) + , organizationAvatarUrl :: !Text + , organizationPublicGists :: !Int + , organizationHtmlUrl :: !Text + , organizationEmail :: !(Maybe Text) + , organizationFollowing :: !Int + , organizationPublicRepos :: !Int + , organizationUrl :: !Text + , organizationCreatedAt :: !UTCTime + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Organization where rnf = genericRnf instance Binary Organization -data Content - = ContentFile ContentFileData - | ContentDirectory (Vector ContentItem) - deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData Content where rnf = genericRnf -instance Binary Content - -data ContentFileData = ContentFileData { - contentFileInfo :: !ContentInfo - ,contentFileEncoding :: !Text - ,contentFileSize :: !Int - ,contentFileContent :: !Text -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData ContentFileData where rnf = genericRnf -instance Binary ContentFileData - --- | An item in a directory listing. -data ContentItem = ContentItem { - contentItemType :: !ContentItemType - ,contentItemInfo :: !ContentInfo -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData ContentItem where rnf = genericRnf -instance Binary ContentItem - -data ContentItemType = ItemFile | ItemDir - deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData ContentItemType where rnf = genericRnf -instance Binary ContentItemType - --- | Information common to both kinds of Content: files and directories. -data ContentInfo = ContentInfo { - contentName :: !Text - ,contentPath :: !Text - ,contentSha :: !Text - ,contentUrl :: !Text - ,contentGitUrl :: !Text - ,contentHtmlUrl :: !Text -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData ContentInfo where rnf = genericRnf -instance Binary ContentInfo - -data Contributor - -- | An existing Github user, with their number of contributions, avatar - -- URL, login, URL, ID, and Gravatar ID. - = KnownContributor Int Text (Name Contributor) Text (Id Contributor) Text - -- | An unknown Github user with their number of contributions and recorded name. - | AnonymousContributor Int Text - deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData Contributor where rnf = genericRnf -instance Binary Contributor - -data GithubOwner = GithubUser { - githubOwnerCreatedAt :: !UTCTime - ,githubOwnerType :: !Text - ,githubOwnerPublicGists :: !Int - ,githubOwnerAvatarUrl :: !Text - ,githubOwnerFollowers :: !Int - ,githubOwnerFollowing :: !Int - ,githubOwnerHireable :: !(Maybe Bool) - ,githubOwnerGravatarId :: !(Maybe Text) - ,githubOwnerBlog :: !(Maybe Text) - ,githubOwnerBio :: !(Maybe Text) - ,githubOwnerPublicRepos :: !Int - ,githubOwnerName :: !(Maybe Text) - ,githubOwnerLocation :: !(Maybe Text) - ,githubOwnerCompany :: !(Maybe Text) - ,githubOwnerEmail :: !(Maybe Text) - ,githubOwnerUrl :: !Text - ,githubOwnerId :: !(Id GithubOwner) - ,githubOwnerHtmlUrl :: !Text - ,githubOwnerLogin :: !(Name GithubOwner) - } - | GithubOrganization { - githubOwnerCreatedAt :: !UTCTime - ,githubOwnerType :: !Text - ,githubOwnerPublicGists :: !Int - ,githubOwnerAvatarUrl :: !Text - ,githubOwnerFollowers :: !Int - ,githubOwnerFollowing :: !Int - ,githubOwnerBlog :: !(Maybe Text) - ,githubOwnerBio :: !(Maybe Text) - ,githubOwnerPublicRepos :: !Int - ,githubOwnerName :: !(Maybe Text) - ,githubOwnerLocation :: !(Maybe Text) - ,githubOwnerCompany :: !(Maybe Text) - ,githubOwnerUrl :: !Text - ,githubOwnerId :: !(Id GithubOwner) - ,githubOwnerHtmlUrl :: !Text - ,githubOwnerLogin :: !(Name GithubOwner) -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +-- | In practic, you cam't have concrete values of 'GithubOwner'. +newtype GithubOwner = GithubOwner (Either User Organization) + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData GithubOwner where rnf = genericRnf instance Binary GithubOwner + +fromGithubOwner :: GithubOwner -> Either User Organization +fromGithubOwner (GithubOwner owner) = owner + +-- JSON instances + +instance FromJSON OwnerType where + parseJSON = withText "Owner type" $ \t -> + case t of + "User" -> pure $ OwnerUser + "Organization" -> pure $ OwnerOrganization + _ -> fail $ "Unknown owner type: " ++ T.unpack t + +instance FromJSON SimpleUser where + parseJSON = withObject "SimpleUser" $ \obj -> do + SimpleUser + <$> obj .: "id" + <*> obj .: "login" + <*> obj .: "avatar_url" + <*> obj .: "url" + <*> obj .: "type" + +instance FromJSON SimpleOrganization where + parseJSON = withObject "SimpleOrganization" $ \obj -> + SimpleOrganization + <$> obj .: "id" + <*> obj .: "login" + <*> obj .: "url" + <*> obj .: "avatar_url" + +instance FromJSON SimpleOwner where + parseJSON = withObject "SimpleOwner" $ \obj -> do + SimpleOwner + <$> obj .: "id" + <*> obj .: "login" + <*> obj .: "url" + <*> obj .: "avatar_url" + <*> obj .: "type" + +parseUser :: Object -> Parser User +parseUser obj = User + <$> obj .: "id" + <*> obj .: "login" + <*> obj .:? "name" + <*> obj .: "type" + <*> obj .: "created_at" + <*> obj .: "public_gists" + <*> obj .: "avatar_url" + <*> obj .: "followers" + <*> obj .: "following" + <*> obj .:? "hireable" + <*> obj .:? "blog" + <*> obj .:? "bio" + <*> obj .: "public_repos" + <*> obj .:? "location" + <*> obj .:? "company" + <*> obj .:? "email" + <*> obj .: "url" + <*> obj .: "html_url" + +parseOrganization :: Object -> Parser Organization +parseOrganization obj = Organization + <$> obj .: "id" + <*> obj .: "login" + <*> obj .:? "name" + <*> obj .: "type" + <*> obj .:? "blog" + <*> obj .:? "location" + <*> obj .: "followers" + <*> obj .:? "company" + <*> obj .: "avatar_url" + <*> obj .: "public_gists" + <*> obj .: "html_url" + <*> obj .:? "email" + <*> obj .: "following" + <*> obj .: "public_repos" + <*> obj .: "url" + <*> obj .: "created_at" + +instance FromJSON User where + parseJSON = mfilter ((== OwnerUser) . userType) . withObject "User" parseUser + +instance FromJSON Organization where + parseJSON = withObject "Organization" parseOrganization + +instance FromJSON GithubOwner where + parseJSON = withObject "GithubOwner" $ \obj -> do + t <- obj .: "type" + case t of + OwnerUser -> GithubOwner . Left <$> parseUser obj + OwnerOrganization -> GithubOwner . Right <$> parseOrganization obj diff --git a/Github/Data/Gists.hs b/Github/Data/Gists.hs index 4d35130f..5ce5a177 100644 --- a/Github/Data/Gists.hs +++ b/Github/Data/Gists.hs @@ -21,7 +21,7 @@ import Data.Vector (Vector) import GHC.Generics (Generic) data Gist = Gist { - gistUser :: !SimpleOwner + gistUser :: !SimpleUser ,gistGitPushUrl :: !Text ,gistUrl :: !Text ,gistDescription :: !(Maybe Text) @@ -51,7 +51,7 @@ instance NFData GistFile where rnf = genericRnf instance Binary GistFile data GistComment = GistComment { - gistCommentUser :: !SimpleOwner + gistCommentUser :: !SimpleUser ,gistCommentUrl :: !Text ,gistCommentCreatedAt :: !UTCTime ,gistCommentBody :: !Text diff --git a/Github/Data/GitData.hs b/Github/Data/GitData.hs index 92416ee9..59c73757 100644 --- a/Github/Data/GitData.hs +++ b/Github/Data/GitData.hs @@ -19,13 +19,30 @@ import Data.Time (UTCTime) import Data.Vector (Vector) import GHC.Generics (Generic) +-- | The options for querying commits. +data CommitQueryOption = CommitQuerySha !Text + | CommitQueryPath !Text + | CommitQueryAuthor !Text + | CommitQuerySince !UTCTime + | CommitQueryUntil !UTCTime + deriving (Show, Eq, Ord, Generic, Typeable, Data) + +data Stats = Stats { + statsAdditions :: !Int + ,statsTotal :: !Int + ,statsDeletions :: !Int +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Stats where rnf = genericRnf +instance Binary Stats + data Commit = Commit { commitSha :: !(Name Commit) ,commitParents :: !(Vector Tree) ,commitUrl :: !Text ,commitGitCommit :: !GitCommit - ,commitCommitter :: !(Maybe SimpleOwner) - ,commitAuthor :: !(Maybe SimpleOwner) + ,commitCommitter :: !(Maybe SimpleUser) + ,commitAuthor :: !(Maybe SimpleUser) ,commitFiles :: !(Vector File) ,commitStats :: !(Maybe Stats) } deriving (Show, Data, Typeable, Eq, Ord, Generic) diff --git a/Github/Data/Issues.hs b/Github/Data/Issues.hs index e417df40..96dcfeea 100644 --- a/Github/Data/Issues.hs +++ b/Github/Data/Issues.hs @@ -25,11 +25,11 @@ data Issue = Issue { ,issueUpdatedAt :: UTCTime ,issueEventsUrl :: Text ,issueHtmlUrl :: Maybe Text - ,issueClosedBy :: Maybe SimpleOwner + ,issueClosedBy :: Maybe SimpleUser ,issueLabels :: (Vector IssueLabel) ,issueNumber :: Int - ,issueAssignee :: Maybe SimpleOwner - ,issueUser :: SimpleOwner + ,issueAssignee :: Maybe SimpleUser + ,issueUser :: SimpleUser ,issueTitle :: Text ,issuePullRequest :: Maybe PullRequestReference ,issueUrl :: Text @@ -68,7 +68,7 @@ instance NFData EditIssue where rnf = genericRnf instance Binary EditIssue data Milestone = Milestone { - milestoneCreator :: SimpleOwner + milestoneCreator :: SimpleUser ,milestoneDueOn :: Maybe UTCTime ,milestoneOpenIssues :: Int ,milestoneNumber :: Int @@ -94,7 +94,7 @@ instance Binary IssueLabel data IssueComment = IssueComment { issueCommentUpdatedAt :: UTCTime - ,issueCommentUser :: SimpleOwner + ,issueCommentUser :: SimpleUser ,issueCommentUrl :: Text ,issueCommentHtmlUrl :: Text ,issueCommentCreatedAt :: UTCTime @@ -131,7 +131,7 @@ instance Binary EventType -- | Issue event data Event = Event { - eventActor :: !SimpleOwner + eventActor :: !SimpleUser ,eventType :: !EventType ,eventCommitId :: !(Maybe Text) ,eventUrl :: !Text diff --git a/Github/Data/PullRequests.hs b/Github/Data/PullRequests.hs index 6ab1cc75..0c23c4b2 100644 --- a/Github/Data/PullRequests.hs +++ b/Github/Data/PullRequests.hs @@ -21,7 +21,7 @@ import GHC.Generics (Generic) data SimplePullRequest = SimplePullRequest { simplePullRequestClosedAt :: !(Maybe UTCTime) ,simplePullRequestCreatedAt :: !UTCTime - ,simplePullRequestUser :: !SimpleOwner + ,simplePullRequestUser :: !SimpleUser ,simplePullRequestPatchUrl :: !Text ,simplePullRequestState :: !Text ,simplePullRequestNumber :: !Int @@ -44,7 +44,7 @@ data PullRequest = PullRequest { -- this is a duplication of a PullRequest pullRequestClosedAt :: !(Maybe UTCTime) ,pullRequestCreatedAt :: !UTCTime - ,pullRequestUser :: !SimpleOwner + ,pullRequestUser :: !SimpleUser ,pullRequestPatchUrl :: !Text ,pullRequestState :: !Text ,pullRequestNumber :: !Int @@ -58,7 +58,7 @@ data PullRequest = PullRequest { ,pullRequestMergedAt :: !(Maybe UTCTime) ,pullRequestTitle :: !Text ,pullRequestId :: !Int - ,pullRequestMergedBy :: !(Maybe SimpleOwner) + ,pullRequestMergedBy :: !(Maybe SimpleUser) ,pullRequestChangedFiles :: !Int ,pullRequestHead :: !PullRequestCommit ,pullRequestComments :: !Int @@ -114,7 +114,7 @@ data PullRequestCommit = PullRequestCommit { pullRequestCommitLabel :: !Text ,pullRequestCommitRef :: !Text ,pullRequestCommitSha :: !Text - ,pullRequestCommitUser :: !SimpleOwner + ,pullRequestCommitUser :: !SimpleUser ,pullRequestCommitRepo :: !Repo } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -126,7 +126,7 @@ data PullRequestEvent = PullRequestEvent { ,pullRequestEventNumber :: !Int ,pullRequestEventPullRequest :: !PullRequest ,pullRequestRepository :: !Repo - ,pullRequestSender :: !SimpleOwner + ,pullRequestSender :: !SimpleUser } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData PullRequestEvent where rnf = genericRnf diff --git a/Github/Data/Repos.hs b/Github/Data/Repos.hs index 3667900a..59e0f128 100644 --- a/Github/Data/Repos.hs +++ b/Github/Data/Repos.hs @@ -55,7 +55,7 @@ data Repo = Repo { instance NFData Repo where rnf = genericRnf instance Binary Repo -data RepoRef = RepoRef SimpleOwner (Name Repo) -- Repo owner and name +data RepoRef = RepoRef !SimpleOwner !(Name Repo) -- Repo owner and name deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData RepoRef where rnf = genericRnf @@ -113,3 +113,19 @@ data Language = Language !Text !Int instance NFData Language where rnf = genericRnf instance Binary Language + +data Contributor + -- | An existing Github user, with their number of contributions, avatar + -- URL, login, URL, ID, and Gravatar ID. + = KnownContributor !Int !Text !(Name User) !Text !(Id User) !Text + -- | An unknown Github user with their number of contributions and recorded name. + | AnonymousContributor !Int !Text + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Contributor where rnf = genericRnf +instance Binary Contributor + +contributorToSimpleUser :: Contributor -> Maybe SimpleUser +contributorToSimpleUser (AnonymousContributor _ _) = Nothing +contributorToSimpleUser (KnownContributor _contributions avatarUrl name url uid _gravatarid) = + Just $ SimpleUser uid name avatarUrl url OwnerUser diff --git a/Github/Data/Teams.hs b/Github/Data/Teams.hs index e888e973..85af3480 100644 --- a/Github/Data/Teams.hs +++ b/Github/Data/Teams.hs @@ -65,7 +65,7 @@ data Team = Team { ,teamRepositoriesUrl :: !Text ,teamMembersCount :: !Int ,teamReposCount :: !Int - ,teamOrganization :: !SimpleOwner + ,teamOrganization :: !SimpleOrganization } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Team where rnf = genericRnf diff --git a/Github/Organizations.hs b/Github/Organizations.hs index 262222f6..9ebe8e29 100644 --- a/Github/Organizations.hs +++ b/Github/Organizations.hs @@ -21,20 +21,20 @@ import Github.Request -- | The public organizations for a user, given the user's login, with authorization -- -- > publicOrganizationsFor' (Just ("github-username", "github-password")) "mike-burns" -publicOrganizationsFor' :: Maybe GithubAuth -> Name GithubOwner -> IO (Either Error (Vector SimpleOrganization)) +publicOrganizationsFor' :: Maybe GithubAuth -> Name User -> IO (Either Error (Vector SimpleOrganization)) publicOrganizationsFor' auth org = executeRequestMaybe auth $ publicOrganizationsForR org Nothing -- | List user organizations. The public organizations for a user, given the user's login. -- -- > publicOrganizationsFor "mike-burns" -publicOrganizationsFor :: Name GithubOwner -> IO (Either Error (Vector SimpleOrganization)) +publicOrganizationsFor :: Name User -> IO (Either Error (Vector SimpleOrganization)) publicOrganizationsFor = publicOrganizationsFor' Nothing -- | List user organizations. -- See -publicOrganizationsForR :: Name GithubOwner -> Maybe Count -> GithubRequest k (Vector SimpleOrganization) -publicOrganizationsForR userName = GithubPagedGet ["users", toPathPart userName, "orgs"] [] +publicOrganizationsForR :: Name User -> Maybe Count -> GithubRequest k (Vector SimpleOrganization) +publicOrganizationsForR user = GithubPagedGet ["users", toPathPart user, "orgs"] [] -- | Details on a public organization. Takes the organization's login. -- diff --git a/Github/Organizations/Members.hs b/Github/Organizations/Members.hs index 1be8e719..2bb1058d 100644 --- a/Github/Organizations/Members.hs +++ b/Github/Organizations/Members.hs @@ -21,7 +21,7 @@ import Github.Request -- | with or without authentication. -- -- > membersOf' (Just $ GithubOAuth "token") "thoughtbot" -membersOf' :: Maybe GithubAuth -> Name Organization -> IO (Either Error (Vector SimpleOwner)) +membersOf' :: Maybe GithubAuth -> Name Organization -> IO (Either Error (Vector SimpleUser)) membersOf' auth org = executeRequestMaybe auth $ membersOfR org Nothing @@ -29,11 +29,11 @@ membersOf' auth org = -- | without authentication. -- -- > membersOf "thoughtbot" -membersOf :: Name Organization -> IO (Either Error (Vector SimpleOwner)) +membersOf :: Name Organization -> IO (Either Error (Vector SimpleUser)) membersOf = membersOf' Nothing -- | All the users who are members of the specified organization. -- -- See -membersOfR :: Name Organization -> Maybe Count -> GithubRequest k (Vector SimpleOwner) +membersOfR :: Name Organization -> Maybe Count -> GithubRequest k (Vector SimpleUser) membersOfR organization = GithubPagedGet ["orgs", toPathPart organization, "members"] [] diff --git a/Github/Repos/Collaborators.hs b/Github/Repos/Collaborators.hs index b79fd424..a418d970 100644 --- a/Github/Repos/Collaborators.hs +++ b/Github/Repos/Collaborators.hs @@ -21,18 +21,18 @@ import Github.Request -- | All the users who have collaborated on a repo. -- -- > collaboratorsOn "thoughtbot" "paperclip" -collaboratorsOn :: Name GithubOwner -> Name Repo -> IO (Either Error (Vector SimpleOwner)) +collaboratorsOn :: Name GithubOwner -> Name Repo -> IO (Either Error (Vector SimpleUser)) collaboratorsOn = collaboratorsOn' Nothing -- | All the users who have collaborated on a repo. -- With authentication. -collaboratorsOn' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error (Vector SimpleOwner)) +collaboratorsOn' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error (Vector SimpleUser)) collaboratorsOn' auth user repo = executeRequestMaybe auth $ collaboratorsOnR user repo Nothing -- | List collaborators. -- See -collaboratorsOnR :: Name GithubOwner -> Name Repo -> Maybe Count -> GithubRequest k (Vector SimpleOwner) +collaboratorsOnR :: Name GithubOwner -> Name Repo -> Maybe Count -> GithubRequest k (Vector SimpleUser) collaboratorsOnR user repo = GithubPagedGet ["repos", toPathPart user, toPathPart repo, "collaborators"] [] @@ -44,7 +44,7 @@ collaboratorsOnR user repo = isCollaboratorOn :: Maybe GithubAuth -> Name GithubOwner -- ^ Repository owner -> Name Repo -- ^ Repository name - -> Name GithubOwner -- ^ Collaborator? + -> Name User -- ^ Collaborator? -> IO (Either Error Bool) isCollaboratorOn auth user repo coll = executeRequestMaybe auth $ isCollaboratorOnR user repo coll @@ -53,7 +53,7 @@ isCollaboratorOn auth user repo coll = -- See isCollaboratorOnR :: Name GithubOwner -- ^ Repository owner -> Name Repo -- ^ Repository name - -> Name GithubOwner -- ^ Collaborator? + -> Name User -- ^ Collaborator? -> GithubRequest k Bool isCollaboratorOnR user repo coll = GithubStatus StatusOnlyOk $ GithubGet ["repos", toPathPart user, toPathPart repo, "collaborators", toPathPart coll] [] diff --git a/Github/Users.hs b/Github/Users.hs index 6967a7a7..3841a126 100644 --- a/Github/Users.hs +++ b/Github/Users.hs @@ -7,13 +7,14 @@ -- The Github Users API, as described at -- . module Github.Users ( - userInfoFor -,userInfoFor' -,userInfoForR -,userInfoCurrent' -,userInfoCurrentR -,module Github.Data -) where + userInfoFor, + userInfoFor', + userInfoForR, + ownerInfoForR, + userInfoCurrent', + userInfoCurrentR, + module Github.Data, + ) where import Github.Data import Github.Request @@ -22,28 +23,33 @@ import Github.Request -- With authentification -- -- > userInfoFor' (Just ("github-username", "github-password")) "mike-burns" -userInfoFor' :: Maybe GithubAuth -> Name GithubOwner -> IO (Either Error GithubOwner) +userInfoFor' :: Maybe GithubAuth -> Name User -> IO (Either Error User) userInfoFor' auth = executeRequestMaybe auth . userInfoForR -- | The information for a single user, by login name. -- -- > userInfoFor "mike-burns" -userInfoFor :: Name GithubOwner -> IO (Either Error GithubOwner) +userInfoFor :: Name User -> IO (Either Error User) userInfoFor = executeRequest' . userInfoForR -- | Get a single user. -- See -userInfoForR :: Name GithubOwner -> GithubRequest k GithubOwner -userInfoForR userName = GithubGet ["users", toPathPart userName] [] +userInfoForR :: Name User -> GithubRequest k User +userInfoForR user = GithubGet ["users", toPathPart user] [] + +-- | Get a single user or an organization. +-- See +ownerInfoForR :: Name GithubOwner -> GithubRequest k GithubOwner +ownerInfoForR owner = GithubGet ["users", toPathPart owner] [] -- | Retrieve information about the user associated with the supplied authentication. -- -- > userInfoCurrent' (GithubOAuth "...") -userInfoCurrent' :: GithubAuth -> IO (Either Error GithubOwner) +userInfoCurrent' :: GithubAuth -> IO (Either Error User) userInfoCurrent' auth = executeRequest auth $ userInfoCurrentR -- | Get the authenticated user. -- See -userInfoCurrentR :: GithubRequest 'True GithubOwner +userInfoCurrentR :: GithubRequest 'True User userInfoCurrentR = GithubGet ["user"] [] diff --git a/Github/Users/Followers.hs b/Github/Users/Followers.hs index fc768092..886758c5 100644 --- a/Github/Users/Followers.hs +++ b/Github/Users/Followers.hs @@ -13,30 +13,31 @@ module Github.Users.Followers ( module Github.Data, ) where -import Data.Vector (Vector) +import Data.Vector (Vector) + import Github.Data import Github.Request -- | All the users following the given user. -- -- > usersFollowing "mike-burns" -usersFollowing :: Name GithubOwner -> IO (Either Error (Vector SimpleOwner)) +usersFollowing :: Name User -> IO (Either Error (Vector SimpleUser)) usersFollowing user = executeRequest' $ usersFollowingR user Nothing -- | List followers of a user. -- See -usersFollowingR :: Name GithubOwner -> Maybe Count -> GithubRequest k (Vector SimpleOwner) -usersFollowingR userName = GithubPagedGet ["users", toPathPart userName, "followers"] [] +usersFollowingR :: Name User -> Maybe Count -> GithubRequest k (Vector SimpleUser) +usersFollowingR user = GithubPagedGet ["users", toPathPart user, "followers"] [] -- | All the users that the given user follows. -- -- > usersFollowedBy "mike-burns" -usersFollowedBy :: Name GithubOwner -> IO (Either Error (Vector SimpleOwner)) +usersFollowedBy :: Name User -> IO (Either Error (Vector SimpleUser)) usersFollowedBy user = executeRequest' $ usersFollowedByR user Nothing -- | List users followed by another user. -- See -usersFollowedByR :: Name GithubOwner -> Maybe Count -> GithubRequest k (Vector SimpleOwner) -usersFollowedByR userName = GithubPagedGet ["users", toPathPart userName, "following"] [] +usersFollowedByR :: Name User -> Maybe Count -> GithubRequest k (Vector SimpleUser) +usersFollowedByR user = GithubPagedGet ["users", toPathPart user, "following"] [] diff --git a/NEWS.md b/NEWS.md index dacd168d..52f746b0 100644 --- a/NEWS.md +++ b/NEWS.md @@ -6,6 +6,8 @@ Large API changes: - Use `Name` and `Id` tagged types for names and identifiers. - Make detailed structures un-prefixed, simple ones prefixed with `Simple`. Example: `Team` and `SimpleTeam`. - Decouple request creation from execution (`*R` and `executeRequest*` functions). +- Add `Binary` instances for all data +- `GithubOwner` is a `newtype` of `Either User Organization`. There's still `SimpleOwner`. Changes for 0.5.0: @@ -30,7 +32,7 @@ Changes for 0.4.0: Changes for 0.3.0: * Re-instantiate the Blobs API. -* `repoDescription1 and `repoPushedAt` are a `Maybe GithubDate`. +* `repoDescription1` and `repoPushedAt` are a `Maybe GithubDate`. * Add `deleteRepo`, `editRepo`, and `createRepo`. * Private gists, issues, organizations, pull requests, and users. * Lock down `tls` and `tls-extra` instead of keeping up with the diff --git a/fixtures/issueSearch.json b/fixtures/issue-search.json similarity index 100% rename from fixtures/issueSearch.json rename to fixtures/issue-search.json diff --git a/github.cabal b/github.cabal index 6ed49efb..bf029fa0 100644 --- a/github.cabal +++ b/github.cabal @@ -30,7 +30,13 @@ Category: Network Build-type: Simple Tested-with: GHC==7.8.4, GHC==7.10.2 Cabal-version: >=1.10 -Extra-source-files: README.md +Extra-source-files: + README.md, + fixtures/issue-search.json, + fixtures/list-teams.json, + fixtures/members-list.json, + fixtures/user-organizations.json, + fixtures/user.json flag aeson-compat description: Whether to use aeson-compat or aeson-extra @@ -50,6 +56,8 @@ Library Github.Activity.Watching, Github.Auth, Github.Data, + Github.Data.Comments, + Github.Data.Content, Github.Data.Definitions, Github.Data.Gists, Github.Data.GitData, @@ -100,7 +108,6 @@ Library binary-orphans >=0.1.0.0 && <0.2, byteable >=0.1.1 && <0.2, bytestring >=0.10.4.0 && <0.11, - case-insensitive >=1.2.0.4 && <1.3, containers >=0.5.5.1 && <0.6, cryptohash >=0.11 && <0.12, deepseq >=1.3.0.2 && <1.5, @@ -121,7 +128,8 @@ Library transformers-compat >=0.4.0.3 && <0.6, unordered-containers >=0.2 && <0.3, vector >=0.10.12.3 && <0.12, - vector-instances >=3.3.0.1 && <3.4 + vector-instances >=3.3.0.1 && <3.4, + void >=0.7 && <0.8 if flag(aeson-compat) Build-depends: aeson-compat >=0.3.0.0 && <0.4 @@ -133,6 +141,7 @@ test-suite github-test type: exitcode-stdio-1.0 hs-source-dirs: spec other-modules: + Github.ActivitySpec Github.CommitsSpec Github.OrganizationsSpec Github.ReposSpec diff --git a/spec/Github/UsersSpec.hs b/spec/Github/UsersSpec.hs index fab499d4..00723d61 100644 --- a/spec/Github/UsersSpec.hs +++ b/spec/Github/UsersSpec.hs @@ -9,16 +9,19 @@ import System.Environment (lookupEnv) import Test.Hspec (Spec, describe, it, pendingWith, shouldBe, shouldSatisfy) -import Github.Auth (GithubAuth (..)) -import Github.Data.Definitions (GithubOwner (..)) +import Github.Data (GithubAuth (..), User (..), Organization (..), fromGithubOwner) import Github.Request (executeRequest) -import Github.Users (userInfoCurrent', userInfoFor') +import Github.Users (userInfoCurrent', userInfoFor', ownerInfoForR) import Github.Users.Followers (usersFollowedByR, usersFollowingR) fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a +fromLeftS :: Show b => Either a b -> a +fromLeftS (Left b) = b +fromLeftS (Right a) = error $ "Expected a Left and got a RIght" ++ show a + withAuth :: (GithubAuth -> IO ()) -> IO () withAuth action = do mtoken <- lookupEnv "GITHUB_TOKEN" @@ -31,16 +34,29 @@ spec = do describe "userInfoFor" $ do it "decodes user json" $ do let userInfo = eitherDecodeStrict $(embedFile "fixtures/user.json") - githubOwnerLogin (fromRightS userInfo) `shouldBe` "mike-burns" + userLogin (fromRightS userInfo) `shouldBe` "mike-burns" it "returns information about the user" $ withAuth $ \auth -> do userInfo <- userInfoFor' (Just auth) "mike-burns" - githubOwnerLogin (fromRightS userInfo) `shouldBe` "mike-burns" + userLogin (fromRightS userInfo) `shouldBe` "mike-burns" it "catches http exceptions" $ withAuth $ \auth -> do userInfo <- userInfoFor' (Just auth) "i-hope-this-user-will-never-exist" userInfo `shouldSatisfy` isLeft + it "should fail for organization" $ withAuth $ \auth -> do + userInfo <- userInfoFor' (Just auth) "haskell" + userInfo `shouldSatisfy` isLeft + + describe "ownerInfoFor" $ do + it "works for users and organizations" $ withAuth $ \auth -> do + a <- executeRequest auth $ ownerInfoForR "haskell" + b <- executeRequest auth $ ownerInfoForR "phadej" + a `shouldSatisfy` isRight + b `shouldSatisfy` isRight + (organizationLogin . fromRightS . fromGithubOwner . fromRightS $ a) `shouldBe` "haskell" + (userLogin . fromLeftS . fromGithubOwner . fromRightS $ b) `shouldBe` "phadej" + describe "userInfoCurrent'" $ do it "returns information about the autenticated user" $ withAuth $ \auth -> do userInfo <- userInfoCurrent' auth diff --git a/travis-script.sh b/travis-script.sh index abe20d8c..6303342b 100644 --- a/travis-script.sh +++ b/travis-script.sh @@ -25,7 +25,10 @@ case $BUILD in # Check that the resulting source distribution can be built & installed. # If there are no other `.tar.gz` files in `dist`, this can be even simpler: # `cabal install --force-reinstalls dist/*-*.tar.gz` - SRC_TGZ=$(cabal info . | awk '{print $2;exit}').tar.gz && - (cd dist && cabal install --force-reinstalls "$SRC_TGZ") + export SRCPKG=$(cabal info . | awk '{print $2;exit}') + cd dist + tar -xzvf $SRCPKG.tar.gz + cd $SRCPKG + cabal configure --enable-tests && cabal build && cabal install --force-reinstalls ;; esac From e806a94d1daf26b8657cec2d72ab78aeaaba4521 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Wed, 20 Jan 2016 14:05:20 +0200 Subject: [PATCH 168/510] Move orphan instances --- Github/All.hs | 4 +- Github/Data.hs | 806 +---------------------- Github/Data/Comments.hs | 26 + Github/Data/Content.hs | 41 ++ Github/Data/Definitions.hs | 8 +- Github/Data/Gists.hs | 46 +- Github/Data/GitData.hs | 123 ++++ Github/Data/Issues.hs | 109 +++ Github/Data/PullRequests.hs | 127 ++++ Github/Data/Repos.hs | 107 +++ Github/Data/Search.hs | 22 + Github/Data/Teams.hs | 120 ++++ Github/Data/Webhooks.hs | 104 +++ samples/Operational/Operational.hs | 6 +- samples/Users/Followers/ListFollowers.hs | 4 +- samples/Users/Followers/ListFollowing.hs | 4 +- samples/Users/ShowUser.hs | 45 +- spec/Github/SearchSpec.hs | 2 +- 18 files changed, 855 insertions(+), 849 deletions(-) diff --git a/Github/All.hs b/Github/All.hs index 551d5b10..1bfa2e60 100644 --- a/Github/All.hs +++ b/Github/All.hs @@ -6,8 +6,8 @@ -- This module re-exports all request constructrors and data definitions from -- this package. -- --- See 'Github.Request' module for executing 'GithubRequest', or other modules --- of this package (e.g. 'Github.Users') for already composed versions. +-- See "Github.Request" module for executing 'GithubRequest', or other modules +-- of this package (e.g. "Github.Users") for already composed versions. -- -- The missing endpoints lists show which endpoints we know are missing, there -- might be more. diff --git a/Github/Data.hs b/Github/Data.hs index 72a6c79d..897ec916 100644 --- a/Github/Data.hs +++ b/Github/Data.hs @@ -1,13 +1,12 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE OverloadedStrings #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- --- This module re-exports the @Github.Data.@ submodules. +-- This module re-exports the @Github.Data.@ and "Github.Auth" submodules. module Github.Data ( -- * Tagged types -- ** Name @@ -47,13 +46,7 @@ module Github.Data ( import Prelude () import Prelude.Compat -import Data.Aeson.Compat -import Data.Aeson.Types (Parser) -import Data.Hashable (Hashable) - -import qualified Data.HashMap.Lazy as Map -import qualified Data.Text as T -import qualified Data.Vector as V +import Data.Text (Text) import Github.Auth import Github.Data.Comments @@ -74,25 +67,25 @@ import Github.Data.Webhooks mkOwnerId :: Int -> Id GithubOwner mkOwnerId = Id -mkOwnerName :: T.Text -> Name GithubOwner +mkOwnerName :: Text -> Name GithubOwner mkOwnerName = N mkTeamId :: Int -> Id Team mkTeamId = Id -mkTeamName :: T.Text -> Name Team +mkTeamName :: Text -> Name Team mkTeamName = N mkOrganizationId :: Int -> Id Organization mkOrganizationId = Id -mkOrganizationName :: T.Text -> Name Organization +mkOrganizationName :: Text -> Name Organization mkOrganizationName = N mkRepoId :: Int -> Id Repo mkRepoId = Id -mkRepoName :: T.Text -> Name Repo +mkRepoName :: Text -> Name Repo mkRepoName = N fromOrganizationName :: Name Organization -> Name GithubOwner @@ -100,790 +93,3 @@ fromOrganizationName = N . untagName fromUserName :: Name User -> Name GithubOwner fromUserName = N . untagName - -instance FromJSON Commit where - parseJSON (Object o) = - Commit <$> o .: "sha" - <*> o .: "parents" - <*> o .: "url" - <*> o .: "commit" - <*> o .:? "committer" - <*> o .:? "author" - <*> o .:? "files" .!= V.empty - <*> o .:? "stats" - parseJSON _ = fail "Could not build a Commit" - -instance FromJSON Tree where - parseJSON (Object o) = - Tree <$> o .: "sha" - <*> o .: "url" - <*> o .:? "tree" .!= V.empty - parseJSON _ = fail "Could not build a Tree" - -instance FromJSON GitTree where - parseJSON (Object o) = - GitTree <$> o .: "type" - <*> o .: "sha" - <*> o .:? "url" - <*> o .:? "size" - <*> o .: "path" - <*> o .: "mode" - parseJSON _ = fail "Could not build a GitTree" - -instance FromJSON GitCommit where - parseJSON (Object o) = - GitCommit <$> o .: "message" - <*> o .: "url" - <*> o .: "committer" - <*> o .: "author" - <*> o .: "tree" - <*> o .:? "sha" - <*> o .:? "parents" .!= V.empty - parseJSON _ = fail "Could not build a GitCommit" - -instance FromJSON GitUser where - parseJSON (Object o) = - GitUser <$> o .: "name" - <*> o .: "email" - <*> o .: "date" - parseJSON _ = fail "Could not build a GitUser" - -instance FromJSON File where - parseJSON (Object o) = - File <$> o .: "blob_url" - <*> o .: "status" - <*> o .: "raw_url" - <*> o .: "additions" - <*> o .: "sha" - <*> o .: "changes" - <*> o .:? "patch" - <*> o .: "filename" - <*> o .: "deletions" - parseJSON _ = fail "Could not build a File" - -instance FromJSON Stats where - parseJSON (Object o) = - Stats <$> o .: "additions" - <*> o .: "total" - <*> o .: "deletions" - parseJSON _ = fail "Could not build a Stats" - -instance FromJSON Comment where - parseJSON (Object o) = - Comment <$> o .:? "position" - <*> o .:? "line" - <*> o .: "body" - <*> o .:? "commit_id" - <*> o .: "updated_at" - <*> o .:? "html_url" - <*> o .: "url" - <*> o .: "created_at" - <*> o .:? "path" - <*> o .: "user" - <*> o .: "id" - parseJSON _ = fail "Could not build a Comment" - -instance ToJSON NewComment where - toJSON (NewComment b) = object [ "body" .= b ] - -instance ToJSON EditComment where - toJSON (EditComment b) = object [ "body" .= b ] - -instance FromJSON Diff where - parseJSON (Object o) = - Diff <$> o .: "status" - <*> o .: "behind_by" - <*> o .: "patch_url" - <*> o .: "url" - <*> o .: "base_commit" - <*> o .:? "commits" .!= V.empty - <*> o .: "total_commits" - <*> o .: "html_url" - <*> o .:? "files" .!= V.empty - <*> o .: "ahead_by" - <*> o .: "diff_url" - <*> o .: "permalink_url" - parseJSON _ = fail "Could not build a Diff" - -instance FromJSON Gist where - parseJSON (Object o) = - Gist <$> o .: "owner" - <*> o .: "git_push_url" - <*> o .: "url" - <*> o .:? "description" - <*> o .: "created_at" - <*> o .: "public" - <*> o .: "comments" - <*> o .: "updated_at" - <*> o .: "html_url" - <*> o .: "id" - <*> o `values` "files" - <*> o .: "git_push_url" - parseJSON _ = fail "Could not build a Gist" - -instance FromJSON GistFile where - parseJSON (Object o) = - GistFile <$> o .: "type" - <*> o .: "raw_url" - <*> o .: "size" - <*> o .:? "language" - <*> o .: "filename" - <*> o .:? "content" - parseJSON _ = fail "Could not build a GistFile" - -instance FromJSON GistComment where - parseJSON (Object o) = - GistComment <$> o .: "user" - <*> o .: "url" - <*> o .: "created_at" - <*> o .: "body" - <*> o .: "updated_at" - <*> o .: "id" - parseJSON _ = fail "Could not build a GistComment" - -instance FromJSON Blob where - parseJSON (Object o) = - Blob <$> o .: "url" - <*> o .: "encoding" - <*> o .: "content" - <*> o .: "sha" - <*> o .: "size" - parseJSON _ = fail "Could not build a Blob" - -instance ToJSON NewGitReference where - toJSON (NewGitReference r s) = object [ "ref" .= r, "sha" .= s ] - -instance FromJSON GitReference where - parseJSON (Object o) = - GitReference <$> o .: "object" - <*> o .: "url" - <*> o .: "ref" - parseJSON _ = fail "Could not build a GitReference" - -instance FromJSON GitObject where - parseJSON (Object o) = - GitObject <$> o .: "type" - <*> o .: "sha" - <*> o .: "url" - parseJSON _ = fail "Could not build a GitObject" - -instance FromJSON Issue where - parseJSON (Object o) = - Issue <$> o .:? "closed_at" - <*> o .: "updated_at" - <*> o .: "events_url" - <*> o .: "html_url" - <*> o .:? "closed_by" - <*> o .: "labels" - <*> o .: "number" - <*> o .:? "assignee" - <*> o .: "user" - <*> o .: "title" - <*> o .:? "pull_request" - <*> o .: "url" - <*> o .: "created_at" - <*> o .: "body" - <*> o .: "state" - <*> o .: "id" - <*> o .: "comments" - <*> o .:? "milestone" - parseJSON _ = fail "Could not build an Issue" - -instance ToJSON NewIssue where - toJSON (NewIssue t b a m ls) = - object - [ "title" .= t - , "body" .= b - , "assignee" .= a - , "milestone" .= m - , "labels" .= ls ] - -instance ToJSON EditIssue where - toJSON (EditIssue t b a s m ls) = - object $ filter notNull $ [ "title" .= t - , "body" .= b - , "assignee" .= a - , "state" .= s - , "milestone" .= m - , "labels" .= ls ] - where notNull (_, Null) = False - notNull (_, _) = True - -instance FromJSON Milestone where - parseJSON (Object o) = - Milestone <$> o .: "creator" - <*> o .: "due_on" - <*> o .: "open_issues" - <*> o .: "number" - <*> o .: "closed_issues" - <*> o .: "description" - <*> o .: "title" - <*> o .: "url" - <*> o .: "created_at" - <*> o .: "state" - parseJSON _ = fail "Could not build a Milestone" - -instance FromJSON IssueLabel where - parseJSON (Object o) = - IssueLabel <$> o .: "color" - <*> o .: "url" - <*> o .: "name" - parseJSON _ = fail "Could not build a Milestone" - -instance FromJSON PullRequestReference where - parseJSON (Object o) = - PullRequestReference <$> o .:? "html_url" - <*> o .:? "patch_url" - <*> o .:? "diff_url" - parseJSON _ = fail "Could not build a PullRequest" - -instance FromJSON IssueComment where - parseJSON (Object o) = - IssueComment <$> o .: "updated_at" - <*> o .: "user" - <*> o .: "url" - <*> o .: "html_url" - <*> o .: "created_at" - <*> o .: "body" - <*> o .: "id" - parseJSON _ = fail "Could not build an IssueComment" - -instance FromJSON Event where - parseJSON (Object o) = - Event <$> o .: "actor" - <*> o .: "event" - <*> o .:? "commit_id" - <*> o .: "url" - <*> o .: "created_at" - <*> o .: "id" - <*> o .:? "issue" - parseJSON _ = fail "Could not build an Event" - -instance FromJSON EventType where - parseJSON (String "closed") = pure Closed - parseJSON (String "reopened") = pure Reopened - parseJSON (String "subscribed") = pure Subscribed - parseJSON (String "merged") = pure Merged - parseJSON (String "referenced") = pure Referenced - parseJSON (String "mentioned") = pure Mentioned - parseJSON (String "assigned") = pure Assigned - parseJSON (String "unsubscribed") = pure Unsubscribed - parseJSON (String "unassigned") = pure ActorUnassigned - parseJSON (String "labeled") = pure Labeled - parseJSON (String "unlabeled") = pure Unlabeled - parseJSON (String "milestoned") = pure Milestoned - parseJSON (String "demilestoned") = pure Demilestoned - parseJSON (String "renamed") = pure Renamed - parseJSON (String "locked") = pure Locked - parseJSON (String "unlocked") = pure Unlocked - parseJSON (String "head_ref_deleted") = pure HeadRefDeleted - parseJSON (String "head_ref_restored") = pure HeadRefRestored - parseJSON _ = fail "Could not build an EventType" - -instance FromJSON SimplePullRequest where - parseJSON (Object o) = - SimplePullRequest - <$> o .:? "closed_at" - <*> o .: "created_at" - <*> o .: "user" - <*> o .: "patch_url" - <*> o .: "state" - <*> o .: "number" - <*> o .: "html_url" - <*> o .: "updated_at" - <*> o .: "body" - <*> o .: "issue_url" - <*> o .: "diff_url" - <*> o .: "url" - <*> o .: "_links" - <*> o .:? "merged_at" - <*> o .: "title" - <*> o .: "id" - parseJSON _ = fail "Could not build a SimplePullRequest" - -instance ToJSON EditPullRequestState where - toJSON (EditPullRequestStateOpen) = String "open" - toJSON (EditPullRequestStateClosed) = String "closed" - -instance ToJSON EditPullRequest where - toJSON (EditPullRequest t b s) = - object $ filter notNull [ "title" .= t, "body" .= b, "state" .= s ] - where notNull (_, Null) = False - notNull (_, _) = True - -instance ToJSON CreatePullRequest where - toJSON (CreatePullRequest t b headPR basePR) = - object [ "title" .= t, "body" .= b, "head" .= headPR, "base" .= basePR ] - toJSON (CreatePullRequestIssue issueNum headPR basePR) = - object [ "issue" .= issueNum, "head" .= headPR, "base" .= basePR] - -instance FromJSON PullRequest where - parseJSON (Object o) = - PullRequest - <$> o .:? "closed_at" - <*> o .: "created_at" - <*> o .: "user" - <*> o .: "patch_url" - <*> o .: "state" - <*> o .: "number" - <*> o .: "html_url" - <*> o .: "updated_at" - <*> o .: "body" - <*> o .: "issue_url" - <*> o .: "diff_url" - <*> o .: "url" - <*> o .: "_links" - <*> o .:? "merged_at" - <*> o .: "title" - <*> o .: "id" - <*> o .:? "merged_by" - <*> o .: "changed_files" - <*> o .: "head" - <*> o .: "comments" - <*> o .: "deletions" - <*> o .: "additions" - <*> o .: "review_comments" - <*> o .: "base" - <*> o .: "commits" - <*> o .: "merged" - <*> o .:? "mergeable" - parseJSON _ = fail "Could not build a PullRequest" - -instance FromJSON PullRequestLinks where - parseJSON (Object o) = - PullRequestLinks <$> o <.:> ["review_comments", "href"] - <*> o <.:> ["comments", "href"] - <*> o <.:> ["html", "href"] - <*> o <.:> ["self", "href"] - parseJSON _ = fail "Could not build a PullRequestLinks" - -instance FromJSON PullRequestCommit where - parseJSON (Object o) = - PullRequestCommit <$> o .: "label" - <*> o .: "ref" - <*> o .: "sha" - <*> o .: "user" - <*> o .: "repo" - parseJSON _ = fail "Could not build a PullRequestCommit" - -instance FromJSON PullRequestEvent where - parseJSON (Object o) = - PullRequestEvent <$> o .: "action" - <*> o .: "number" - <*> o .: "pull_request" - <*> o .: "repository" - <*> o .: "sender" - parseJSON _ = fail "Could not build a PullRequestEvent" - -instance FromJSON PullRequestEventType where - parseJSON (String "opened") = pure PullRequestOpened - parseJSON (String "closed") = pure PullRequestClosed - parseJSON (String "synchronize") = pure PullRequestSynchronized - parseJSON (String "reopened") = pure PullRequestReopened - parseJSON (String "assigned") = pure PullRequestAssigned - parseJSON (String "unassigned") = pure PullRequestUnassigned - parseJSON (String "labeled") = pure PullRequestLabeled - parseJSON (String "unlabeled") = pure PullRequestUnlabeled - parseJSON _ = fail "Could not build a PullRequestEventType" - -instance FromJSON RepoWebhookEvent where - parseJSON (String "*") = pure WebhookWildcardEvent - parseJSON (String "commit_comment") = pure WebhookCommitCommentEvent - parseJSON (String "create") = pure WebhookCreateEvent - parseJSON (String "delete") = pure WebhookDeleteEvent - parseJSON (String "deployment") = pure WebhookDeploymentEvent - parseJSON (String "deployment_status") = pure WebhookDeploymentStatusEvent - parseJSON (String "fork") = pure WebhookForkEvent - parseJSON (String "gollum") = pure WebhookGollumEvent - parseJSON (String "issue_comment") = pure WebhookIssueCommentEvent - parseJSON (String "issues") = pure WebhookIssuesEvent - parseJSON (String "member") = pure WebhookMemberEvent - parseJSON (String "page_build") = pure WebhookPageBuildEvent - parseJSON (String "public") = pure WebhookPublicEvent - parseJSON (String "pull_request_review_comment") = pure WebhookPullRequestReviewCommentEvent - parseJSON (String "pull_request") = pure WebhookPullRequestEvent - parseJSON (String "push") = pure WebhookPushEvent - parseJSON (String "release") = pure WebhookReleaseEvent - parseJSON (String "status") = pure WebhookStatusEvent - parseJSON (String "team_add") = pure WebhookTeamAddEvent - parseJSON (String "watch") = pure WebhookWatchEvent - parseJSON _ = fail "Could not build a Webhook event" - -instance ToJSON RepoWebhookEvent where - toJSON (WebhookWildcardEvent) = String "*" - toJSON (WebhookCommitCommentEvent) = String "commit_comment" - toJSON (WebhookCreateEvent) = String "create" - toJSON (WebhookDeleteEvent) = String "delete" - toJSON (WebhookDeploymentEvent) = String "deployment" - toJSON (WebhookDeploymentStatusEvent) = String "deployment_status" - toJSON (WebhookForkEvent) = String "fork" - toJSON (WebhookGollumEvent) = String "gollum" - toJSON (WebhookIssueCommentEvent) = String "issue_comment" - toJSON (WebhookIssuesEvent) = String "issues" - toJSON (WebhookMemberEvent) = String "member" - toJSON (WebhookPageBuildEvent) = String "page_build" - toJSON (WebhookPublicEvent) = String "public" - toJSON (WebhookPullRequestReviewCommentEvent) = String "pull_request_review_comment" - toJSON (WebhookPullRequestEvent) = String "pull_request" - toJSON (WebhookPushEvent) = String "push" - toJSON (WebhookReleaseEvent) = String "release" - toJSON (WebhookStatusEvent) = String "status" - toJSON (WebhookTeamAddEvent) = String "team_add" - toJSON (WebhookWatchEvent) = String "watch" - -instance FromJSON PingEvent where - parseJSON (Object o) = - PingEvent <$> o .: "zen" - <*> o .: "hook" - <*> o .: "hook_id" - parseJSON _ = fail "Could not build a PingEvent" - -instance FromJSON entity => FromJSON (SearchResult entity) where - parseJSON = withObject "SearchResult" $ \o -> - SearchResult <$> o .: "total_count" - <*> o .:? "items" .!= V.empty - -instance FromJSON Repo where - parseJSON (Object o) = - Repo <$> o .:? "ssh_url" - <*> o .: "description" - <*> o .:? "created_at" - <*> o .: "html_url" - <*> o .:? "svn_url" - <*> o .:? "forks" - <*> o .:? "homepage" - <*> o .: "fork" - <*> o .:? "git_url" - <*> o .: "private" - <*> o .:? "clone_url" - <*> o .:? "size" - <*> o .:? "updated_at" - <*> o .:? "watchers" - <*> o .: "owner" - <*> o .: "name" - <*> o .:? "language" - <*> o .:? "master_branch" - <*> o .:? "pushed_at" - <*> o .: "id" - <*> o .: "url" - <*> o .:? "open_issues" - <*> o .:? "has_wiki" - <*> o .:? "has_issues" - <*> o .:? "has_downloads" - <*> o .:? "parent" - <*> o .:? "source" - <*> o .: "hooks_url" - <*> o .: "stargazers_count" - parseJSON _ = fail "Could not build a Repo" - -instance ToJSON NewRepo where - toJSON (NewRepo { newRepoName = name - , newRepoDescription = description - , newRepoHomepage = homepage - , newRepoPrivate = private - , newRepoHasIssues = hasIssues - , newRepoHasWiki = hasWiki - , newRepoAutoInit = autoInit - }) = object - [ "name" .= name - , "description" .= description - , "homepage" .= homepage - , "private" .= private - , "has_issues" .= hasIssues - , "has_wiki" .= hasWiki - , "auto_init" .= autoInit - ] - -instance ToJSON EditRepo where - toJSON (EditRepo { editName = name - , editDescription = description - , editHomepage = homepage - , editPublic = public - , editHasIssues = hasIssues - , editHasWiki = hasWiki - , editHasDownloads = hasDownloads - }) = object - [ "name" .= name - , "description" .= description - , "homepage" .= homepage - , "public" .= public - , "has_issues" .= hasIssues - , "has_wiki" .= hasWiki - , "has_downloads" .= hasDownloads - ] - -instance FromJSON Code where - parseJSON (Object o ) = - Code <$> o .: "name" - <*> o .: "path" - <*> o .: "sha" - <*> o .: "url" - <*> o .: "git_url" - <*> o .: "html_url" - <*> o .: "repository" - parseJSON _ = fail "Could not build a Code" - -instance FromJSON RepoRef where - parseJSON (Object o) = - RepoRef <$> o .: "owner" - <*> o .: "name" - parseJSON _ = fail "Could not build a RepoRef" - -instance FromJSON Contributor where - parseJSON = withObject "Contributor" $ \o -> do - t <- o .: "type" - case t of - _ | t == ("Anonymous" :: T.Text) -> - AnonymousContributor - <$> o .: "contributions" - <*> o .: "name" - _ | otherwise -> - KnownContributor - <$> o .: "contributions" - <*> o .: "avatar_url" - <*> o .: "login" - <*> o .: "url" - <*> o .: "id" - <*> o .: "gravatar_id" - -instance FromJSON Languages where - parseJSON (Object o) = - Languages . V.fromList <$> - mapM (\name -> Language name <$> o .: name) - (Map.keys o) - parseJSON _ = fail "Could not build Languages" - -instance FromJSON Tag where - parseJSON (Object o) = - Tag <$> o .: "name" - <*> o .: "zipball_url" - <*> o .: "tarball_url" - <*> o .: "commit" - parseJSON _ = fail "Could not build a Tag" - -instance FromJSON Branch where - parseJSON (Object o) = Branch <$> o .: "name" <*> o .: "commit" - parseJSON _ = fail "Could not build a Branch" - -instance FromJSON BranchCommit where - parseJSON (Object o) = BranchCommit <$> o .: "sha" <*> o .: "url" - parseJSON _ = fail "Could not build a BranchCommit" - -instance FromJSON Privacy where - parseJSON (String attr) = - case attr of - "secret" -> return PrivacySecret - "closed" -> return PrivacyClosed - _ -> fail "Unknown Privacy Attribute" - parseJSON _ = fail "Could not build Privacy" - -instance ToJSON Privacy where - toJSON attr = - String $ - case attr of - PrivacySecret -> "secret" - PrivacyClosed -> "closed" - -instance FromJSON Permission where - parseJSON (String attr) = - case attr of - "pull" -> return PermissionPull - "push" -> return PermissionPush - "admin" -> return PermissionAdmin - _ -> fail "Unknown Permission Attribute" - parseJSON _ = fail "Could not build Permission" - -instance ToJSON Permission where - toJSON attr = - String $ - case attr of - PermissionPull -> "pull" - PermissionPush -> "push" - PermissionAdmin -> "admin" - -instance FromJSON SimpleTeam where - parseJSON (Object o) = - SimpleTeam <$> o .: "id" - <*> o .: "url" - <*> o .: "name" - <*> o .: "slug" - <*> o .:?"description" .!= Nothing - <*> o .:?"privacy" .!= Nothing - <*> o .: "permission" - <*> o .: "members_url" - <*> o .: "repositories_url" - parseJSON _ = fail "Could not build SimpleTeam" - -instance FromJSON Team where - parseJSON (Object o) = - Team <$> o .: "id" - <*> o .: "url" - <*> o .: "name" - <*> o .: "slug" - <*> o .:?"description" .!= Nothing - <*> o .:?"privacy" .!= Nothing - <*> o .: "permission" - <*> o .: "members_url" - <*> o .: "repositories_url" - <*> o .: "members_count" - <*> o .: "repos_count" - <*> o .: "organization" - parseJSON _ = fail "Could not build a Team" - -instance ToJSON CreateTeam where - toJSON (CreateTeam name desc repo_names {-privacy-} permissions) = - object [ "name" .= name - , "description" .= desc - , "repo_names" .= repo_names - {-, "privacy" .= privacy-} - , "permissions" .= permissions ] - -instance ToJSON EditTeam where - toJSON (EditTeam name desc {-privacy-} permissions) = - object [ "name" .= name - , "description" .= desc - {-, "privacy" .= privacy-} - , "permissions" .= permissions ] - -instance FromJSON Role where - parseJSON (String attr) = - case attr of - "maintainer" -> return RoleMaintainer - "member" -> return RoleMember - _ -> fail "Unknown Role" - parseJSON _ = fail "Could not build Role" - -instance ToJSON Role where - toJSON RoleMaintainer = String "maintainer" - toJSON RoleMember = String "member" - -instance FromJSON ReqState where - parseJSON (String attr) = - case attr of - "active" -> return StateActive - "pending" -> return StatePending - _ -> fail "Unknown ReqState" - parseJSON _ = fail "Could not build ReqState" - -instance ToJSON ReqState where - toJSON StateActive = String "active" - toJSON StatePending = String "pending" - -instance FromJSON TeamMembership where - parseJSON (Object o) = - TeamMembership <$> o .: "url" - <*> o .: "role" - <*> o .: "state" - parseJSON _ = fail "Could not build TeamMembership" - -instance FromJSON CreateTeamMembership where - parseJSON (Object o) = - CreateTeamMembership <$> o .: "role" - parseJSON _ = fail "Could not build CreateTeamMembership" - -instance ToJSON CreateTeamMembership where - toJSON (CreateTeamMembership { createTeamMembershipRole = role }) = - object [ "role" .= role ] - -instance FromJSON RepoWebhook where - parseJSON (Object o) = - RepoWebhook <$> o .: "url" - <*> o .: "test_url" - <*> o .: "id" - <*> o .: "name" - <*> o .: "active" - <*> o .: "events" - <*> o .: "config" - <*> o .: "last_response" - <*> o .: "updated_at" - <*> o .: "created_at" - parseJSON _ = fail "Could not build a RepoWebhook" - -instance FromJSON RepoWebhookResponse where - parseJSON (Object o) = - RepoWebhookResponse <$> o .: "code" - <*> o .: "status" - <*> o .: "message" - parseJSON _ = fail "Could not build a RepoWebhookResponse" - -instance ToJSON NewRepoWebhook where - toJSON (NewRepoWebhook { newRepoWebhookName = name - , newRepoWebhookConfig = config - , newRepoWebhookEvents = events - , newRepoWebhookActive = active - - }) = object - [ "name" .= name - , "config" .= config - , "events" .= events - , "active" .= active - ] - -instance ToJSON EditRepoWebhook where - toJSON (EditRepoWebhook { editRepoWebhookConfig = config - , editRepoWebhookEvents = events - , editRepoWebhookAddEvents = addEvents - , editRepoWebhookRemoveEvents = removeEvents - , editRepoWebhookActive = active - }) = object - [ "config" .= config - , "events" .= events - , "add_events" .= addEvents - , "remove_events" .= removeEvents - , "active" .= active - ] - -instance FromJSON Content where - parseJSON o@(Object _) = ContentFile <$> parseJSON o - parseJSON (Array os) = ContentDirectory <$> (V.mapM parseJSON os) - parseJSON _ = fail "Could not build a Content" - -instance FromJSON ContentFileData where - parseJSON (Object o) = - ContentFileData <$> parseJSON (Object o) - <*> o .: "encoding" - <*> o .: "size" - <*> o .: "content" - parseJSON _ = fail "Could not build a ContentFileData" - -instance FromJSON ContentItem where - parseJSON (Object o) = - ContentItem <$> o .: "type" - <*> parseJSON (Object o) - parseJSON _ = fail "Could not build a ContentItem" - -instance FromJSON ContentItemType where - parseJSON (String "file") = return ItemFile - parseJSON (String "dir") = return ItemDir - parseJSON _ = fail "Could not build a ContentItemType" - -instance FromJSON ContentInfo where - parseJSON (Object o) = - ContentInfo <$> o .: "name" - <*> o .: "path" - <*> o .: "sha" - <*> o .: "url" - <*> o .: "git_url" - <*> o .: "html_url" - parseJSON _ = fail "Could not build a ContentInfo" - --- | Produce all values for the given key. -values :: (Eq k, Hashable k, FromJSON v) => Map.HashMap k Value -> k -> Parser v -obj `values` key = - let (Object children) = findWithDefault (Object Map.empty) key obj in - parseJSON $ Array $ V.fromList $ Map.elems children - --- | Produce the value for the last key by traversing. -(<.:>) :: (FromJSON v) => Object -> [T.Text] -> Parser v -obj <.:> [key] = obj .: key -obj <.:> (key:keys) = - let (Object nextObj) = findWithDefault (Object Map.empty) key obj in - nextObj <.:> keys -_ <.:> [] = fail "must have a pair" - --- Taken from Data.Map: -findWithDefault :: (Eq k, Hashable k) => v -> k -> Map.HashMap k v -> v -findWithDefault def k m = - case Map.lookup k m of - Nothing -> def - Just x -> x diff --git a/Github/Data/Comments.hs b/Github/Data/Comments.hs index b4bcebf8..2b7ac306 100644 --- a/Github/Data/Comments.hs +++ b/Github/Data/Comments.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -7,8 +8,13 @@ -- module Github.Data.Comments where +import Prelude () +import Prelude.Compat + import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) +import Data.Aeson.Compat (FromJSON (..), ToJSON (..), object, withObject, + (.:), (.:?), (.=)) import Data.Binary.Orphans (Binary) import Data.Data (Data, Typeable) import Data.Text (Text) @@ -35,6 +41,20 @@ data Comment = Comment { instance NFData Comment where rnf = genericRnf instance Binary Comment +instance FromJSON Comment where + parseJSON = withObject "Comment" $ \o -> Comment + <$> o .:? "position" + <*> o .:? "line" + <*> o .: "body" + <*> o .:? "commit_id" + <*> o .: "updated_at" + <*> o .:? "html_url" + <*> o .: "url" + <*> o .: "created_at" + <*> o .:? "path" + <*> o .: "user" + <*> o .: "id" + data NewComment = NewComment { newCommentBody :: !Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -42,9 +62,15 @@ data NewComment = NewComment { instance NFData NewComment where rnf = genericRnf instance Binary NewComment +instance ToJSON NewComment where + toJSON (NewComment b) = object [ "body" .= b ] + data EditComment = EditComment { editCommentBody :: !Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData EditComment where rnf = genericRnf instance Binary EditComment + +instance ToJSON EditComment where + toJSON (EditComment b) = object [ "body" .= b ] diff --git a/Github/Data/Content.hs b/Github/Data/Content.hs index 9eda0226..f2e5f334 100644 --- a/Github/Data/Content.hs +++ b/Github/Data/Content.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -7,14 +8,21 @@ -- module Github.Data.Content where +import Prelude () +import Prelude.Compat + import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) +import Data.Aeson.Compat (FromJSON (..), Value (..), withObject, + withText, (.:)) import Data.Binary.Orphans (Binary) import Data.Data (Data, Typeable) import Data.Text (Text) import Data.Vector (Vector) import GHC.Generics (Generic) +import qualified Data.Text as T + data Content = ContentFile !ContentFileData | ContentDirectory !(Vector ContentItem) @@ -60,3 +68,36 @@ data ContentInfo = ContentInfo { instance NFData ContentInfo where rnf = genericRnf instance Binary ContentInfo + +instance FromJSON Content where + parseJSON o@(Object _) = ContentFile <$> parseJSON o + parseJSON (Array os) = ContentDirectory <$> traverse parseJSON os + parseJSON _ = fail "Could not build a Content" + +instance FromJSON ContentFileData where + parseJSON = withObject "ContentFileData" $ \o -> + ContentFileData <$> parseJSON (Object o) + <*> o .: "encoding" + <*> o .: "size" + <*> o .: "content" + +instance FromJSON ContentItem where + parseJSON = withObject "ContentItem" $ \o -> + ContentItem <$> o .: "type" + <*> parseJSON (Object o) + +instance FromJSON ContentItemType where + parseJSON = withText "ContentItemType" $ \t -> + case t of + "file" -> return ItemFile + "dir" -> return ItemDir + _ -> fail $ "Invalid ContentItemType: " ++ T.unpack t + +instance FromJSON ContentInfo where + parseJSON = withObject "ContentInfo" $ \o -> + ContentInfo <$> o .: "name" + <*> o .: "path" + <*> o .: "sha" + <*> o .: "url" + <*> o .: "git_url" + <*> o .: "html_url" diff --git a/Github/Data/Definitions.hs b/Github/Data/Definitions.hs index 501d3bd3..a58a8f35 100644 --- a/Github/Data/Definitions.hs +++ b/Github/Data/Definitions.hs @@ -14,8 +14,8 @@ import Prelude.Compat import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) import Control.Monad (mfilter) -import Data.Aeson.Compat (FromJSON (..), withObject, withText, (.:), - (.:?), Object) +import Data.Aeson.Compat (FromJSON (..), Object, withObject, withText, + (.:), (.:?)) import Data.Aeson.Types (Parser) import Data.Binary.Orphans (Binary) import Data.Data (Data, Typeable) @@ -219,7 +219,7 @@ parseOrganization obj = Organization instance FromJSON User where parseJSON = mfilter ((== OwnerUser) . userType) . withObject "User" parseUser - + instance FromJSON Organization where parseJSON = withObject "Organization" parseOrganization @@ -228,4 +228,4 @@ instance FromJSON GithubOwner where t <- obj .: "type" case t of OwnerUser -> GithubOwner . Left <$> parseUser obj - OwnerOrganization -> GithubOwner . Right <$> parseOrganization obj + OwnerOrganization -> GithubOwner . Right <$> parseOrganization obj diff --git a/Github/Data/Gists.hs b/Github/Data/Gists.hs index 5ce5a177..c0934d43 100644 --- a/Github/Data/Gists.hs +++ b/Github/Data/Gists.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -7,17 +8,21 @@ -- module Github.Data.Gists where +import Prelude () +import Prelude.Compat + import Github.Data.Definitions import Github.Data.Id (Id) import Github.Data.Name (Name) import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) +import Data.Aeson.Compat (FromJSON (..), withObject, (.:), (.:?)) import Data.Binary (Binary) import Data.Data (Data, Typeable) +import Data.HashMap.Strict (HashMap) import Data.Text (Text) import Data.Time (UTCTime) -import Data.Vector (Vector) import GHC.Generics (Generic) data Gist = Gist { @@ -31,13 +36,28 @@ data Gist = Gist { ,gistUpdatedAt :: !UTCTime ,gistHtmlUrl :: !Text ,gistId :: !(Name Gist) - ,gistFiles :: !(Vector GistFile) + ,gistFiles :: !(HashMap Text GistFile) ,gistGitPullUrl :: !Text -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +} deriving (Show, Data, Typeable, Eq, Generic) instance NFData Gist where rnf = genericRnf instance Binary Gist +instance FromJSON Gist where + parseJSON = withObject "Gist" $ \o -> + Gist <$> o .: "owner" + <*> o .: "git_push_url" + <*> o .: "url" + <*> o .:? "description" + <*> o .: "created_at" + <*> o .: "public" + <*> o .: "comments" + <*> o .: "updated_at" + <*> o .: "html_url" + <*> o .: "id" + <*> o .: "files" + <*> o .: "git_push_url" + data GistFile = GistFile { gistFileType :: !Text ,gistFileRawUrl :: !Text @@ -45,11 +65,20 @@ data GistFile = GistFile { ,gistFileLanguage :: !(Maybe Text) ,gistFileFilename :: !Text ,gistFileContent :: !(Maybe Text) -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +} deriving (Show, Data, Typeable, Eq, Generic) instance NFData GistFile where rnf = genericRnf instance Binary GistFile +instance FromJSON GistFile where + parseJSON = withObject "GistFile" $ \o -> + GistFile <$> o .: "type" + <*> o .: "raw_url" + <*> o .: "size" + <*> o .:? "language" + <*> o .: "filename" + <*> o .:? "content" + data GistComment = GistComment { gistCommentUser :: !SimpleUser ,gistCommentUrl :: !Text @@ -61,3 +90,12 @@ data GistComment = GistComment { instance NFData GistComment where rnf = genericRnf instance Binary GistComment + +instance FromJSON GistComment where + parseJSON = withObject "GistComment" $ \o -> + GistComment <$> o .: "user" + <*> o .: "url" + <*> o .: "created_at" + <*> o .: "body" + <*> o .: "updated_at" + <*> o .: "id" diff --git a/Github/Data/GitData.hs b/Github/Data/GitData.hs index 59c73757..36d2a9a0 100644 --- a/Github/Data/GitData.hs +++ b/Github/Data/GitData.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -7,11 +8,16 @@ -- module Github.Data.GitData where +import Prelude () +import Prelude.Compat + import Github.Data.Definitions import Github.Data.Name (Name) import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) +import Data.Aeson.Compat (FromJSON (..), ToJSON (..), object, withObject, + (.!=), (.:), (.:?), (.=)) import Data.Binary (Binary) import Data.Data (Data, Typeable) import Data.Text (Text) @@ -19,6 +25,8 @@ import Data.Time (UTCTime) import Data.Vector (Vector) import GHC.Generics (Generic) +import qualified Data.Vector as V + -- | The options for querying commits. data CommitQueryOption = CommitQuerySha !Text | CommitQueryPath !Text @@ -188,3 +196,118 @@ data File = File { instance NFData File where rnf = genericRnf instance Binary File + +-- JSON instances + +instance FromJSON Stats where + parseJSON = withObject "Stats" $ \o -> + Stats <$> o .: "additions" + <*> o .: "total" + <*> o .: "deletions" + +instance FromJSON Commit where + parseJSON = withObject "Commit" $ \o -> + Commit <$> o .: "sha" + <*> o .: "parents" + <*> o .: "url" + <*> o .: "commit" + <*> o .:? "committer" + <*> o .:? "author" + <*> o .:? "files" .!= V.empty + <*> o .:? "stats" + +instance FromJSON Tree where + parseJSON = withObject "Tree" $ \o -> + Tree <$> o .: "sha" + <*> o .: "url" + <*> o .:? "tree" .!= V.empty + +instance FromJSON GitTree where + parseJSON = withObject "GitTree" $ \o -> + GitTree <$> o .: "type" + <*> o .: "sha" + <*> o .:? "url" + <*> o .:? "size" + <*> o .: "path" + <*> o .: "mode" + +instance FromJSON GitCommit where + parseJSON = withObject "GitCommit" $ \o -> + GitCommit <$> o .: "message" + <*> o .: "url" + <*> o .: "committer" + <*> o .: "author" + <*> o .: "tree" + <*> o .:? "sha" + <*> o .:? "parents" .!= V.empty + +instance FromJSON GitUser where + parseJSON = withObject "GitUser" $ \o -> + GitUser <$> o .: "name" + <*> o .: "email" + <*> o .: "date" + +instance FromJSON File where + parseJSON = withObject "File" $ \o -> + File <$> o .: "blob_url" + <*> o .: "status" + <*> o .: "raw_url" + <*> o .: "additions" + <*> o .: "sha" + <*> o .: "changes" + <*> o .:? "patch" + <*> o .: "filename" + <*> o .: "deletions" + +instance ToJSON NewGitReference where + toJSON (NewGitReference r s) = object [ "ref" .= r, "sha" .= s ] + +instance FromJSON GitReference where + parseJSON = withObject "GitReference" $ \o -> + GitReference <$> o .: "object" + <*> o .: "url" + <*> o .: "ref" + +instance FromJSON GitObject where + parseJSON = withObject "GitObject" $ \o -> + GitObject <$> o .: "type" + <*> o .: "sha" + <*> o .: "url" + +instance FromJSON Diff where + parseJSON = withObject "Diff" $ \o -> + Diff <$> o .: "status" + <*> o .: "behind_by" + <*> o .: "patch_url" + <*> o .: "url" + <*> o .: "base_commit" + <*> o .:? "commits" .!= V.empty + <*> o .: "total_commits" + <*> o .: "html_url" + <*> o .:? "files" .!= V.empty + <*> o .: "ahead_by" + <*> o .: "diff_url" + <*> o .: "permalink_url" + +instance FromJSON Blob where + parseJSON = withObject "Blob" $ \o -> + Blob <$> o .: "url" + <*> o .: "encoding" + <*> o .: "content" + <*> o .: "sha" + <*> o .: "size" + +instance FromJSON Tag where + parseJSON = withObject "Tag" $ \o -> + Tag <$> o .: "name" + <*> o .: "zipball_url" + <*> o .: "tarball_url" + <*> o .: "commit" + +instance FromJSON Branch where + parseJSON = withObject "Branch" $ \o -> + Branch <$> o .: "name" <*> o .: "commit" + +instance FromJSON BranchCommit where + parseJSON = withObject "BranchCommit" $ \o -> + BranchCommit <$> o .: "sha" <*> o .: "url" diff --git a/Github/Data/Issues.hs b/Github/Data/Issues.hs index 96dcfeea..708efbc7 100644 --- a/Github/Data/Issues.hs +++ b/Github/Data/Issues.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -7,12 +8,17 @@ -- module Github.Data.Issues where +import Prelude () +import Prelude.Compat + import Github.Data.Definitions import Github.Data.Id (Id) import Github.Data.PullRequests import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) +import Data.Aeson.Compat (FromJSON (..), ToJSON (..), Value (..), object, + withObject, (.:), (.:?), (.=)) import Data.Binary (Binary) import Data.Data (Data, Typeable) import Data.Text (Text) @@ -164,3 +170,106 @@ data IssueLimitation = instance NFData IssueLimitation where rnf = genericRnf instance Binary IssueLimitation + +-- JSON instances + +instance FromJSON Event where + parseJSON = withObject "Event" $ \o -> + Event <$> o .: "actor" + <*> o .: "event" + <*> o .:? "commit_id" + <*> o .: "url" + <*> o .: "created_at" + <*> o .: "id" + <*> o .:? "issue" + +instance FromJSON EventType where + parseJSON (String "closed") = pure Closed + parseJSON (String "reopened") = pure Reopened + parseJSON (String "subscribed") = pure Subscribed + parseJSON (String "merged") = pure Merged + parseJSON (String "referenced") = pure Referenced + parseJSON (String "mentioned") = pure Mentioned + parseJSON (String "assigned") = pure Assigned + parseJSON (String "unsubscribed") = pure Unsubscribed + parseJSON (String "unassigned") = pure ActorUnassigned + parseJSON (String "labeled") = pure Labeled + parseJSON (String "unlabeled") = pure Unlabeled + parseJSON (String "milestoned") = pure Milestoned + parseJSON (String "demilestoned") = pure Demilestoned + parseJSON (String "renamed") = pure Renamed + parseJSON (String "locked") = pure Locked + parseJSON (String "unlocked") = pure Unlocked + parseJSON (String "head_ref_deleted") = pure HeadRefDeleted + parseJSON (String "head_ref_restored") = pure HeadRefRestored + parseJSON _ = fail "Could not build an EventType" + +instance FromJSON IssueLabel where + parseJSON = withObject "IssueLabel" $ \o -> + IssueLabel <$> o .: "color" + <*> o .: "url" + <*> o .: "name" + +instance FromJSON IssueComment where + parseJSON = withObject "IssueComment" $ \o -> + IssueComment <$> o .: "updated_at" + <*> o .: "user" + <*> o .: "url" + <*> o .: "html_url" + <*> o .: "created_at" + <*> o .: "body" + <*> o .: "id" + +instance FromJSON Issue where + parseJSON = withObject "Issue" $ \o -> + Issue <$> o .:? "closed_at" + <*> o .: "updated_at" + <*> o .: "events_url" + <*> o .: "html_url" + <*> o .:? "closed_by" + <*> o .: "labels" + <*> o .: "number" + <*> o .:? "assignee" + <*> o .: "user" + <*> o .: "title" + <*> o .:? "pull_request" + <*> o .: "url" + <*> o .: "created_at" + <*> o .: "body" + <*> o .: "state" + <*> o .: "id" + <*> o .: "comments" + <*> o .:? "milestone" + +instance ToJSON NewIssue where + toJSON (NewIssue t b a m ls) = + object + [ "title" .= t + , "body" .= b + , "assignee" .= a + , "milestone" .= m + , "labels" .= ls ] + +instance ToJSON EditIssue where + toJSON (EditIssue t b a s m ls) = + object $ filter notNull $ [ "title" .= t + , "body" .= b + , "assignee" .= a + , "state" .= s + , "milestone" .= m + , "labels" .= ls ] + where notNull (_, Null) = False + notNull (_, _) = True + +instance FromJSON Milestone where + parseJSON = withObject "Milestone" $ \o -> + Milestone <$> o .: "creator" + <*> o .: "due_on" + <*> o .: "open_issues" + <*> o .: "number" + <*> o .: "closed_issues" + <*> o .: "description" + <*> o .: "title" + <*> o .: "url" + <*> o .: "created_at" + <*> o .: "state" diff --git a/Github/Data/PullRequests.hs b/Github/Data/PullRequests.hs index 0c23c4b2..4f074e22 100644 --- a/Github/Data/PullRequests.hs +++ b/Github/Data/PullRequests.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -7,11 +8,17 @@ -- module Github.Data.PullRequests where +import Prelude () +import Prelude.Compat + import Github.Data.Definitions import Github.Data.Repos (Repo) import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) +import Data.Aeson.Compat (FromJSON (..), ToJSON (..), Value (..), object, + withObject, (.:), (.:?), (.=)) +import Data.Aeson.Types (Object, Parser) import Data.Binary.Orphans (Binary) import Data.Data (Data, Typeable) import Data.Text (Text) @@ -162,3 +169,123 @@ data EditPullRequestState = instance NFData EditPullRequestState where rnf = genericRnf instance Binary EditPullRequestState + +-- JSON instances + + +instance FromJSON SimplePullRequest where + parseJSON = withObject "SimplePullRequest" $ \o -> + SimplePullRequest + <$> o .:? "closed_at" + <*> o .: "created_at" + <*> o .: "user" + <*> o .: "patch_url" + <*> o .: "state" + <*> o .: "number" + <*> o .: "html_url" + <*> o .: "updated_at" + <*> o .: "body" + <*> o .: "issue_url" + <*> o .: "diff_url" + <*> o .: "url" + <*> o .: "_links" + <*> o .:? "merged_at" + <*> o .: "title" + <*> o .: "id" + +instance ToJSON EditPullRequestState where + toJSON (EditPullRequestStateOpen) = String "open" + toJSON (EditPullRequestStateClosed) = String "closed" + +instance ToJSON EditPullRequest where + toJSON (EditPullRequest t b s) = + object $ filter notNull [ "title" .= t, "body" .= b, "state" .= s ] + where notNull (_, Null) = False + notNull (_, _) = True + +instance ToJSON CreatePullRequest where + toJSON (CreatePullRequest t b headPR basePR) = + object [ "title" .= t, "body" .= b, "head" .= headPR, "base" .= basePR ] + toJSON (CreatePullRequestIssue issueNum headPR basePR) = + object [ "issue" .= issueNum, "head" .= headPR, "base" .= basePR] + +instance FromJSON PullRequest where + parseJSON = withObject "PullRequest" $ \o -> + PullRequest + <$> o .:? "closed_at" + <*> o .: "created_at" + <*> o .: "user" + <*> o .: "patch_url" + <*> o .: "state" + <*> o .: "number" + <*> o .: "html_url" + <*> o .: "updated_at" + <*> o .: "body" + <*> o .: "issue_url" + <*> o .: "diff_url" + <*> o .: "url" + <*> o .: "_links" + <*> o .:? "merged_at" + <*> o .: "title" + <*> o .: "id" + <*> o .:? "merged_by" + <*> o .: "changed_files" + <*> o .: "head" + <*> o .: "comments" + <*> o .: "deletions" + <*> o .: "additions" + <*> o .: "review_comments" + <*> o .: "base" + <*> o .: "commits" + <*> o .: "merged" + <*> o .:? "mergeable" + +instance FromJSON PullRequestLinks where + parseJSON = withObject "PullRequestLinks" $ \o -> + PullRequestLinks <$> o <.:> ["review_comments", "href"] + <*> o <.:> ["comments", "href"] + <*> o <.:> ["html", "href"] + <*> o <.:> ["self", "href"] + +instance FromJSON PullRequestCommit where + parseJSON = withObject "PullRequestCommit" $ \o -> + PullRequestCommit <$> o .: "label" + <*> o .: "ref" + <*> o .: "sha" + <*> o .: "user" + <*> o .: "repo" + +instance FromJSON PullRequestEvent where + parseJSON = withObject "PullRequestEvent" $ \o -> + PullRequestEvent <$> o .: "action" + <*> o .: "number" + <*> o .: "pull_request" + <*> o .: "repository" + <*> o .: "sender" + +instance FromJSON PullRequestEventType where + parseJSON (String "opened") = pure PullRequestOpened + parseJSON (String "closed") = pure PullRequestClosed + parseJSON (String "synchronize") = pure PullRequestSynchronized + parseJSON (String "reopened") = pure PullRequestReopened + parseJSON (String "assigned") = pure PullRequestAssigned + parseJSON (String "unassigned") = pure PullRequestUnassigned + parseJSON (String "labeled") = pure PullRequestLabeled + parseJSON (String "unlabeled") = pure PullRequestUnlabeled + parseJSON _ = fail "Could not build a PullRequestEventType" + +instance FromJSON PullRequestReference where + parseJSON = withObject "PullRequestReference" $ \o -> + PullRequestReference <$> o .:? "html_url" + <*> o .:? "patch_url" + <*> o .:? "diff_url" + +-- Helpers + +-- | Produce the value for the last key by traversing. +(<.:>) :: FromJSON v => Object -> [Text] -> Parser v +obj <.:> [key] = obj .: key +obj <.:> (key:keys) = do + obj' <- obj .: key + obj' <.:> keys +_obj <.:> [] = fail "<.:> never happens - empty path" diff --git a/Github/Data/Repos.hs b/Github/Data/Repos.hs index 59e0f128..7154af0d 100644 --- a/Github/Data/Repos.hs +++ b/Github/Data/Repos.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -7,12 +8,17 @@ -- module Github.Data.Repos where +import Prelude () +import Prelude.Compat + import Github.Data.Definitions import Github.Data.Id (Id) import Github.Data.Name (Name) import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) +import Data.Aeson.Compat (FromJSON (..), ToJSON (..), object, withObject, + (.:), (.:?), (.=)) import Data.Binary (Binary) import Data.Data (Data, Typeable) import Data.Text (Text) @@ -20,6 +26,9 @@ import Data.Time (UTCTime) import Data.Vector (Vector) import GHC.Generics (Generic) +import qualified Data.HashMap.Strict as HM +import qualified Data.Vector as V + data Repo = Repo { repoSshUrl :: !(Maybe Text) ,repoDescription :: !(Maybe Text) @@ -129,3 +138,101 @@ contributorToSimpleUser :: Contributor -> Maybe SimpleUser contributorToSimpleUser (AnonymousContributor _ _) = Nothing contributorToSimpleUser (KnownContributor _contributions avatarUrl name url uid _gravatarid) = Just $ SimpleUser uid name avatarUrl url OwnerUser + +-- JSON instances + +instance FromJSON Repo where + parseJSON = withObject "Repo" $ \o -> + Repo <$> o .:? "ssh_url" + <*> o .: "description" + <*> o .:? "created_at" + <*> o .: "html_url" + <*> o .:? "svn_url" + <*> o .:? "forks" + <*> o .:? "homepage" + <*> o .: "fork" + <*> o .:? "git_url" + <*> o .: "private" + <*> o .:? "clone_url" + <*> o .:? "size" + <*> o .:? "updated_at" + <*> o .:? "watchers" + <*> o .: "owner" + <*> o .: "name" + <*> o .:? "language" + <*> o .:? "master_branch" + <*> o .:? "pushed_at" + <*> o .: "id" + <*> o .: "url" + <*> o .:? "open_issues" + <*> o .:? "has_wiki" + <*> o .:? "has_issues" + <*> o .:? "has_downloads" + <*> o .:? "parent" + <*> o .:? "source" + <*> o .: "hooks_url" + <*> o .: "stargazers_count" + +instance ToJSON NewRepo where + toJSON (NewRepo { newRepoName = name + , newRepoDescription = description + , newRepoHomepage = homepage + , newRepoPrivate = private + , newRepoHasIssues = hasIssues + , newRepoHasWiki = hasWiki + , newRepoAutoInit = autoInit + }) = object + [ "name" .= name + , "description" .= description + , "homepage" .= homepage + , "private" .= private + , "has_issues" .= hasIssues + , "has_wiki" .= hasWiki + , "auto_init" .= autoInit + ] + +instance ToJSON EditRepo where + toJSON (EditRepo { editName = name + , editDescription = description + , editHomepage = homepage + , editPublic = public + , editHasIssues = hasIssues + , editHasWiki = hasWiki + , editHasDownloads = hasDownloads + }) = object + [ "name" .= name + , "description" .= description + , "homepage" .= homepage + , "public" .= public + , "has_issues" .= hasIssues + , "has_wiki" .= hasWiki + , "has_downloads" .= hasDownloads + ] + +instance FromJSON RepoRef where + parseJSON = withObject "RepoRef" $ \o -> + RepoRef <$> o .: "owner" + <*> o .: "name" + +instance FromJSON Contributor where + parseJSON = withObject "Contributor" $ \o -> do + t <- o .: "type" + case t of + _ | t == ("Anonymous" :: Text) -> + AnonymousContributor + <$> o .: "contributions" + <*> o .: "name" + _ | otherwise -> + KnownContributor + <$> o .: "contributions" + <*> o .: "avatar_url" + <*> o .: "login" + <*> o .: "url" + <*> o .: "id" + <*> o .: "gravatar_id" + +instance FromJSON Languages where + parseJSON = withObject "Languages" $ \o -> + Languages . V.fromList <$> + traverse (\name -> Language name <$> o .: name) + (HM.keys o) diff --git a/Github/Data/Search.hs b/Github/Data/Search.hs index 8aa90822..8356a8b4 100644 --- a/Github/Data/Search.hs +++ b/Github/Data/Search.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -7,16 +8,22 @@ -- module Github.Data.Search where +import Prelude () +import Prelude.Compat + import Github.Data.Repos (Repo) import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) +import Data.Aeson.Compat (FromJSON (..), withObject, (.!=), (.:), (.:?)) import Data.Binary (Binary) import Data.Data (Data, Typeable) import Data.Text (Text) import Data.Vector (Vector) import GHC.Generics (Generic) +import qualified Data.Vector as V + data SearchResult entity = SearchResult { searchResultTotalCount :: !Int ,searchResultResults :: !(Vector entity) @@ -25,6 +32,11 @@ data SearchResult entity = SearchResult { instance NFData entity => NFData (SearchResult entity) where rnf = genericRnf instance Binary entity => Binary (SearchResult entity) +instance FromJSON entity => FromJSON (SearchResult entity) where + parseJSON = withObject "SearchResult" $ \o -> + SearchResult <$> o .: "total_count" + <*> o .:? "items" .!= V.empty + data Code = Code { codeName :: !Text ,codePath :: !Text @@ -37,3 +49,13 @@ data Code = Code { instance NFData Code where rnf = genericRnf instance Binary Code + +instance FromJSON Code where + parseJSON = withObject "Code" $ \o -> + Code <$> o .: "name" + <*> o .: "path" + <*> o .: "sha" + <*> o .: "url" + <*> o .: "git_url" + <*> o .: "html_url" + <*> o .: "repository" diff --git a/Github/Data/Teams.hs b/Github/Data/Teams.hs index 85af3480..969ab5d2 100644 --- a/Github/Data/Teams.hs +++ b/Github/Data/Teams.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -7,10 +8,15 @@ -- module Github.Data.Teams where +import Prelude () +import Prelude.Compat + import Github.Data.Definitions import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) +import Data.Aeson.Compat (FromJSON (..), ToJSON (..), Value (..), object, + withObject, (.!=), (.:), (.:?), (.=)) import Data.Binary (Binary) import Data.Data (Data, Typeable) import Data.Text (Text) @@ -123,3 +129,117 @@ data CreateTeamMembership = CreateTeamMembership { instance NFData CreateTeamMembership where rnf = genericRnf instance Binary CreateTeamMembership + +-- JSON Instances + +instance FromJSON SimpleTeam where + parseJSON = withObject "SimpleTeam" $ \o -> + SimpleTeam <$> o .: "id" + <*> o .: "url" + <*> o .: "name" + <*> o .: "slug" + <*> o .:?"description" .!= Nothing + <*> o .:?"privacy" .!= Nothing + <*> o .: "permission" + <*> o .: "members_url" + <*> o .: "repositories_url" + +instance FromJSON Team where + parseJSON = withObject "Team" $ \o -> + Team <$> o .: "id" + <*> o .: "url" + <*> o .: "name" + <*> o .: "slug" + <*> o .:?"description" .!= Nothing + <*> o .:?"privacy" .!= Nothing + <*> o .: "permission" + <*> o .: "members_url" + <*> o .: "repositories_url" + <*> o .: "members_count" + <*> o .: "repos_count" + <*> o .: "organization" + +instance ToJSON CreateTeam where + toJSON (CreateTeam name desc repo_names {-privacy-} permissions) = + object [ "name" .= name + , "description" .= desc + , "repo_names" .= repo_names + {-, "privacy" .= privacy-} + , "permissions" .= permissions ] + +instance ToJSON EditTeam where + toJSON (EditTeam name desc {-privacy-} permissions) = + object [ "name" .= name + , "description" .= desc + {-, "privacy" .= privacy-} + , "permissions" .= permissions ] + +instance FromJSON TeamMembership where + parseJSON = withObject "TeamMembership" $ \o -> + TeamMembership <$> o .: "url" + <*> o .: "role" + <*> o .: "state" + +instance FromJSON CreateTeamMembership where + parseJSON = withObject "CreateTeamMembership" $ \o -> + CreateTeamMembership <$> o .: "role" + +instance ToJSON CreateTeamMembership where + toJSON (CreateTeamMembership { createTeamMembershipRole = role }) = + object [ "role" .= role ] + +instance FromJSON Role where + parseJSON (String attr) = + case attr of + "maintainer" -> return RoleMaintainer + "member" -> return RoleMember + _ -> fail "Unknown Role" + parseJSON _ = fail "Could not build Role" + +instance ToJSON Role where + toJSON RoleMaintainer = String "maintainer" + toJSON RoleMember = String "member" + +instance ToJSON Permission where + toJSON attr = + String $ + case attr of + PermissionPull -> "pull" + PermissionPush -> "push" + PermissionAdmin -> "admin" + +instance FromJSON Permission where + parseJSON (String attr) = + case attr of + "pull" -> return PermissionPull + "push" -> return PermissionPush + "admin" -> return PermissionAdmin + _ -> fail "Unknown Permission Attribute" + parseJSON _ = fail "Could not build Permission" + +instance FromJSON Privacy where + parseJSON (String attr) = + case attr of + "secret" -> return PrivacySecret + "closed" -> return PrivacyClosed + _ -> fail "Unknown Privacy Attribute" + parseJSON _ = fail "Could not build Privacy" + +instance ToJSON Privacy where + toJSON attr = + String $ + case attr of + PrivacySecret -> "secret" + PrivacyClosed -> "closed" + +instance FromJSON ReqState where + parseJSON (String attr) = + case attr of + "active" -> return StateActive + "pending" -> return StatePending + _ -> fail "Unknown ReqState" + parseJSON _ = fail "Could not build ReqState" + +instance ToJSON ReqState where + toJSON StateActive = String "active" + toJSON StatePending = String "pending" diff --git a/Github/Data/Webhooks.hs b/Github/Data/Webhooks.hs index ef7737aa..9f781498 100644 --- a/Github/Data/Webhooks.hs +++ b/Github/Data/Webhooks.hs @@ -8,10 +8,15 @@ -- module Github.Data.Webhooks where +import Prelude () +import Prelude.Compat + import Github.Data.Id (Id) import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) +import Data.Aeson.Compat (FromJSON (..), ToJSON (..), Value (..), object, + withObject, (.:), (.=)) import Data.Binary.Orphans (Binary) import Data.Data (Data, Typeable) import Data.Text (Text) @@ -101,3 +106,102 @@ data EditRepoWebhook = EditRepoWebhook { instance NFData EditRepoWebhook where rnf = genericRnf instance Binary EditRepoWebhook + +-- JSON instances + +instance FromJSON RepoWebhookEvent where + parseJSON (String "*") = pure WebhookWildcardEvent + parseJSON (String "commit_comment") = pure WebhookCommitCommentEvent + parseJSON (String "create") = pure WebhookCreateEvent + parseJSON (String "delete") = pure WebhookDeleteEvent + parseJSON (String "deployment") = pure WebhookDeploymentEvent + parseJSON (String "deployment_status") = pure WebhookDeploymentStatusEvent + parseJSON (String "fork") = pure WebhookForkEvent + parseJSON (String "gollum") = pure WebhookGollumEvent + parseJSON (String "issue_comment") = pure WebhookIssueCommentEvent + parseJSON (String "issues") = pure WebhookIssuesEvent + parseJSON (String "member") = pure WebhookMemberEvent + parseJSON (String "page_build") = pure WebhookPageBuildEvent + parseJSON (String "public") = pure WebhookPublicEvent + parseJSON (String "pull_request_review_comment") = pure WebhookPullRequestReviewCommentEvent + parseJSON (String "pull_request") = pure WebhookPullRequestEvent + parseJSON (String "push") = pure WebhookPushEvent + parseJSON (String "release") = pure WebhookReleaseEvent + parseJSON (String "status") = pure WebhookStatusEvent + parseJSON (String "team_add") = pure WebhookTeamAddEvent + parseJSON (String "watch") = pure WebhookWatchEvent + parseJSON _ = fail "Could not build a Webhook event" + +instance ToJSON RepoWebhookEvent where + toJSON (WebhookWildcardEvent) = String "*" + toJSON (WebhookCommitCommentEvent) = String "commit_comment" + toJSON (WebhookCreateEvent) = String "create" + toJSON (WebhookDeleteEvent) = String "delete" + toJSON (WebhookDeploymentEvent) = String "deployment" + toJSON (WebhookDeploymentStatusEvent) = String "deployment_status" + toJSON (WebhookForkEvent) = String "fork" + toJSON (WebhookGollumEvent) = String "gollum" + toJSON (WebhookIssueCommentEvent) = String "issue_comment" + toJSON (WebhookIssuesEvent) = String "issues" + toJSON (WebhookMemberEvent) = String "member" + toJSON (WebhookPageBuildEvent) = String "page_build" + toJSON (WebhookPublicEvent) = String "public" + toJSON (WebhookPullRequestReviewCommentEvent) = String "pull_request_review_comment" + toJSON (WebhookPullRequestEvent) = String "pull_request" + toJSON (WebhookPushEvent) = String "push" + toJSON (WebhookReleaseEvent) = String "release" + toJSON (WebhookStatusEvent) = String "status" + toJSON (WebhookTeamAddEvent) = String "team_add" + toJSON (WebhookWatchEvent) = String "watch" + +instance FromJSON RepoWebhook where + parseJSON = withObject "RepoWebhook" $ \o -> + RepoWebhook <$> o .: "url" + <*> o .: "test_url" + <*> o .: "id" + <*> o .: "name" + <*> o .: "active" + <*> o .: "events" + <*> o .: "config" + <*> o .: "last_response" + <*> o .: "updated_at" + <*> o .: "created_at" + +instance FromJSON RepoWebhookResponse where + parseJSON = withObject "RepoWebhookResponse" $ \o -> + RepoWebhookResponse <$> o .: "code" + <*> o .: "status" + <*> o .: "message" + +instance ToJSON NewRepoWebhook where + toJSON (NewRepoWebhook { newRepoWebhookName = name + , newRepoWebhookConfig = config + , newRepoWebhookEvents = events + , newRepoWebhookActive = active + + }) = object + [ "name" .= name + , "config" .= config + , "events" .= events + , "active" .= active + ] + +instance ToJSON EditRepoWebhook where + toJSON (EditRepoWebhook { editRepoWebhookConfig = config + , editRepoWebhookEvents = events + , editRepoWebhookAddEvents = addEvents + , editRepoWebhookRemoveEvents = removeEvents + , editRepoWebhookActive = active + }) = object + [ "config" .= config + , "events" .= events + , "add_events" .= addEvents + , "remove_events" .= removeEvents + , "active" .= active + ] + +instance FromJSON PingEvent where + parseJSON = withObject "PingEvent" $ \o -> + PingEvent <$> o .: "zen" + <*> o .: "hook" + <*> o .: "hook_id" diff --git a/samples/Operational/Operational.hs b/samples/Operational/Operational.hs index 7c4e39a9..779704c2 100644 --- a/samples/Operational/Operational.hs +++ b/samples/Operational/Operational.hs @@ -31,7 +31,7 @@ main = do case auth' of Nothing -> return () Just auth -> do - user <- runExceptT $ runGithubMonad manager auth $ do + owner <- runExceptT $ runGithubMonad manager auth $ do repo <- githubRequest $ GH.repositoryR "phadej" "github" - githubRequest $ GH.userInfoForR (GH.simpleOwnerLogin . GH.repoOwner $ repo) - print user + githubRequest $ GH.ownerInfoForR (GH.simpleOwnerLogin . GH.repoOwner $ repo) + print owner diff --git a/samples/Users/Followers/ListFollowers.hs b/samples/Users/Followers/ListFollowers.hs index a83073a3..bb448677 100644 --- a/samples/Users/Followers/ListFollowers.hs +++ b/samples/Users/Followers/ListFollowers.hs @@ -15,5 +15,5 @@ main = do (foldMap ((<> "\n") . formatUser)) possibleUsers -formatUser :: Github.SimpleOwner -> Text -formatUser = Github.untagName . Github.simpleOwnerLogin +formatUser :: Github.SimpleUser -> Text +formatUser = Github.untagName . Github.simpleUserLogin diff --git a/samples/Users/Followers/ListFollowing.hs b/samples/Users/Followers/ListFollowing.hs index 7a509dd2..28361640 100644 --- a/samples/Users/Followers/ListFollowing.hs +++ b/samples/Users/Followers/ListFollowing.hs @@ -15,6 +15,6 @@ main = do (foldMap ((<> "\n") . formatUser)) possibleUsers -formatUser :: Github.SimpleOwner -> Text -formatUser = Github.untagName . Github.simpleOwnerLogin +formatUser :: Github.SimpleUser -> Text +formatUser = Github.untagName . Github.simpleUserLogin diff --git a/samples/Users/ShowUser.hs b/samples/Users/ShowUser.hs index 0ba94a10..bf645d9b 100644 --- a/samples/Users/ShowUser.hs +++ b/samples/Users/ShowUser.hs @@ -14,25 +14,8 @@ main = do possibleUser <- Github.userInfoFor' auth "mike-burns" putStrLn $ either (("Error: " <>) . tshow) formatUser possibleUser -formatUser :: Github.GithubOwner -> Text -formatUser user@(Github.GithubOrganization {}) = - "Organization: " <> (formatName userName login) <> "\t" <> - (fromMaybe "" company) <> "\t" <> - (fromMaybe "" location) <> "\n" <> - (fromMaybe "" blog) <> "\t" <> "\n" <> - htmlUrl <> "\t" <> tshow createdAt <> "\n\n" <> - (fromMaybe "" bio) - where - userName = Github.githubOwnerName user - login = Github.githubOwnerLogin user - company = Github.githubOwnerCompany user - location = Github.githubOwnerLocation user - blog = Github.githubOwnerBlog user - htmlUrl = Github.githubOwnerHtmlUrl user - createdAt = Github.githubOwnerCreatedAt user - bio = Github.githubOwnerBio user - -formatUser user@(Github.GithubUser {}) = +formatUser :: Github.User -> Text +formatUser user = (formatName userName login) <> "\t" <> (fromMaybe "" company) <> "\t" <> (fromMaybe "" location) <> "\n" <> (fromMaybe "" blog) <> "\t" <> "<" <> (fromMaybe "" email) <> ">" <> "\n" <> @@ -40,18 +23,18 @@ formatUser user@(Github.GithubUser {}) = "hireable: " <> formatHireable (fromMaybe False isHireable) <> "\n\n" <> (fromMaybe "" bio) where - userName = Github.githubOwnerName user - login = Github.githubOwnerLogin user - company = Github.githubOwnerCompany user - location = Github.githubOwnerLocation user - blog = Github.githubOwnerBlog user - email = Github.githubOwnerEmail user - htmlUrl = Github.githubOwnerHtmlUrl user - createdAt = Github.githubOwnerCreatedAt user - isHireable = Github.githubOwnerHireable user - bio = Github.githubOwnerBio user - -formatName :: Maybe Text -> Github.Name Github.GithubOwner -> Text + userName = Github.userName user + login = Github.userLogin user + company = Github.userCompany user + location = Github.userLocation user + blog = Github.userBlog user + email = Github.userEmail user + htmlUrl = Github.userHtmlUrl user + createdAt = Github.userCreatedAt user + isHireable = Github.userHireable user + bio = Github.userBio user + +formatName :: Maybe Text -> Github.Name Github.User -> Text formatName Nothing login = Github.untagName login formatName (Just name) login = name <> "(" <> Github.untagName login <> ")" diff --git a/spec/Github/SearchSpec.hs b/spec/Github/SearchSpec.hs index e8b63f0c..4b0345d7 100644 --- a/spec/Github/SearchSpec.hs +++ b/spec/Github/SearchSpec.hs @@ -23,7 +23,7 @@ spec :: Spec spec = do describe "searchIssues" $ do it "decodes issue search response JSON" $ do - let searchIssuesResult = fromRightS $ eitherDecodeStrict $(embedFile "fixtures/issueSearch.json") :: SearchResult Issue + let searchIssuesResult = fromRightS $ eitherDecodeStrict $(embedFile "fixtures/issue-search.json") :: SearchResult Issue searchResultTotalCount searchIssuesResult `shouldBe` 2 let issues = searchResultResults searchIssuesResult From c1f631e3c53a8f023375d1ed2b8a1633de7ae433 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Wed, 20 Jan 2016 14:31:25 +0200 Subject: [PATCH 169/510] Change example in github.cabal description --- github.cabal | 13 +++++-------- 1 file changed, 5 insertions(+), 8 deletions(-) diff --git a/github.cabal b/github.cabal index bf029fa0..b0d22200 100644 --- a/github.cabal +++ b/github.cabal @@ -9,15 +9,12 @@ Description: . For supported endpoints see "Github.All" module. . - >{-# LANGUAGE OverloadedStrings #-} - >module Main (main) where + > import qualified Github.All as GH > - >import qualified Github.All as GH - > - >main :: IO () - >main = do - > possibleUser <- GH.executeRequest' $ GH.userInfoR "phadej" - > print possibleUser + > main :: IO () + > main = do + > possibleUser <- GH.executeRequest' $ GH.userInfoR "phadej" + > print possibleUser . For more of an overview please see the README: License: BSD3 From 8245b3cb954934435bc7922fee73477113a01dcf Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Wed, 20 Jan 2016 19:29:53 +0200 Subject: [PATCH 170/510] Move everything around --- .gitignore | 2 + README.md | 9 +- github.cabal | 155 +++++++++--------- samples/Operational/Operational.hs | 2 +- samples/Teams/DeleteTeam.hs | 5 +- samples/Teams/EditTeam.hs | 11 +- samples/Teams/ListTeamsCurrent.hs | 5 +- .../Teams/Memberships/AddTeamMembershipFor.hs | 13 +- .../Memberships/DeleteTeamMembershipFor.hs | 11 +- .../Memberships/TeamMembershipInfoFor.hs | 7 +- samples/Teams/TeamInfoFor.hs | 7 +- samples/Users/Followers/ListFollowers.hs | 9 +- samples/Users/Followers/ListFollowing.hs | 9 +- samples/Users/ShowUser.hs | 33 ++-- samples/Users/ShowUser2.hs | 2 +- samples/src/Common.hs | 6 +- spec/{Github => GitHub}/ActivitySpec.hs | 8 +- spec/{Github => GitHub}/CommitsSpec.hs | 8 +- spec/{Github => GitHub}/OrganizationsSpec.hs | 10 +- spec/{Github => GitHub}/ReposSpec.hs | 6 +- spec/{Github => GitHub}/SearchSpec.hs | 8 +- spec/{Github => GitHub}/UsersSpec.hs | 10 +- Github/All.hs => src/GitHub.hs | 68 ++++---- {Github => src/GitHub}/Auth.hs | 2 +- {Github => src/GitHub}/Data.hs | 60 +++---- {Github => src/GitHub}/Data/Comments.hs | 6 +- {Github => src/GitHub}/Data/Content.hs | 2 +- {Github => src/GitHub}/Data/Definitions.hs | 6 +- {Github => src/GitHub}/Data/Gists.hs | 8 +- {Github => src/GitHub}/Data/GitData.hs | 6 +- {Github => src/GitHub}/Data/Id.hs | 2 +- {Github => src/GitHub}/Data/Issues.hs | 8 +- {Github => src/GitHub}/Data/Name.hs | 2 +- {Github => src/GitHub}/Data/PullRequests.hs | 6 +- {Github => src/GitHub}/Data/Repos.hs | 8 +- {Github => src/GitHub}/Data/Request.hs | 6 +- {Github => src/GitHub}/Data/Search.hs | 4 +- {Github => src/GitHub}/Data/Teams.hs | 10 +- {Github => src/GitHub}/Data/Webhooks.hs | 4 +- .../GitHub/Data}/Webhooks/Validate.hs | 2 +- .../GitHub/Endpoints}/Activity/Starring.hs | 10 +- .../GitHub/Endpoints}/Activity/Watching.hs | 10 +- {Github => src/GitHub/Endpoints}/Gists.hs | 8 +- .../GitHub/Endpoints}/Gists/Comments.hs | 8 +- .../GitHub/Endpoints}/GitData/Blobs.hs | 8 +- .../GitHub/Endpoints}/GitData/Commits.hs | 8 +- .../GitHub/Endpoints}/GitData/References.hs | 8 +- .../GitHub/Endpoints}/GitData/Trees.hs | 8 +- {Github => src/GitHub/Endpoints}/Issues.hs | 8 +- .../GitHub/Endpoints}/Issues/Comments.hs | 8 +- .../GitHub/Endpoints}/Issues/Events.hs | 8 +- .../GitHub/Endpoints}/Issues/Labels.hs | 8 +- .../GitHub/Endpoints}/Issues/Milestones.hs | 8 +- .../GitHub/Endpoints}/Organizations.hs | 8 +- .../Endpoints}/Organizations/Members.hs | 8 +- .../GitHub/Endpoints}/Organizations/Teams.hs | 8 +- .../GitHub/Endpoints}/PullRequests.hs | 8 +- .../Endpoints}/PullRequests/ReviewComments.hs | 8 +- {Github => src/GitHub/Endpoints}/Repos.hs | 8 +- .../GitHub/Endpoints}/Repos/Collaborators.hs | 8 +- .../GitHub/Endpoints}/Repos/Comments.hs | 8 +- .../GitHub/Endpoints}/Repos/Commits.hs | 8 +- .../GitHub/Endpoints}/Repos/Forks.hs | 8 +- .../GitHub/Endpoints}/Repos/Webhooks.hs | 7 +- {Github => src/GitHub/Endpoints}/Search.hs | 8 +- {Github => src/GitHub/Endpoints}/Users.hs | 8 +- .../GitHub/Endpoints}/Users/Followers.hs | 8 +- {Github => src/GitHub}/Request.hs | 8 +- 68 files changed, 391 insertions(+), 382 deletions(-) rename spec/{Github => GitHub}/ActivitySpec.hs (82%) rename spec/{Github => GitHub}/CommitsSpec.hs (89%) rename spec/{Github => GitHub}/OrganizationsSpec.hs (85%) rename spec/{Github => GitHub}/ReposSpec.hs (86%) rename spec/{Github => GitHub}/SearchSpec.hs (89%) rename spec/{Github => GitHub}/UsersSpec.hs (89%) rename Github/All.hs => src/GitHub.hs (84%) rename {Github => src/GitHub}/Auth.hs (97%) rename {Github => src/GitHub}/Data.hs (59%) rename {Github => src/GitHub}/Data/Comments.hs (96%) rename {Github => src/GitHub}/Data/Content.hs (99%) rename {Github => src/GitHub}/Data/Definitions.hs (98%) rename {Github => src/GitHub}/Data/Gists.hs (95%) rename {Github => src/GitHub}/Data/GitData.hs (98%) rename {Github => src/GitHub}/Data/Id.hs (97%) rename {Github => src/GitHub}/Data/Issues.hs (98%) rename {Github => src/GitHub}/Data/Name.hs (97%) rename {Github => src/GitHub}/Data/PullRequests.hs (98%) rename {Github => src/GitHub}/Data/Repos.hs (98%) rename {Github => src/GitHub}/Data/Request.hs (98%) rename {Github => src/GitHub}/Data/Search.hs (96%) rename {Github => src/GitHub}/Data/Teams.hs (97%) rename {Github => src/GitHub}/Data/Webhooks.hs (99%) rename {Github/Repos => src/GitHub/Data}/Webhooks/Validate.hs (97%) rename {Github => src/GitHub/Endpoints}/Activity/Starring.hs (93%) rename {Github => src/GitHub/Endpoints}/Activity/Watching.hs (94%) rename {Github => src/GitHub/Endpoints}/Gists.hs (94%) rename {Github => src/GitHub/Endpoints}/Gists/Comments.hs (92%) rename {Github => src/GitHub/Endpoints}/GitData/Blobs.hs (91%) rename {Github => src/GitHub/Endpoints}/GitData/Commits.hs (89%) rename {Github => src/GitHub/Endpoints}/GitData/References.hs (97%) rename {Github => src/GitHub/Endpoints}/GitData/Trees.hs (95%) rename {Github => src/GitHub/Endpoints}/Issues.hs (98%) rename {Github => src/GitHub/Endpoints}/Issues/Comments.hs (97%) rename {Github => src/GitHub/Endpoints}/Issues/Events.hs (96%) rename {Github => src/GitHub/Endpoints}/Issues/Labels.hs (99%) rename {Github => src/GitHub/Endpoints}/Issues/Milestones.hs (94%) rename {Github => src/GitHub/Endpoints}/Organizations.hs (95%) rename {Github => src/GitHub/Endpoints}/Organizations/Members.hs (91%) rename {Github => src/GitHub/Endpoints}/Organizations/Teams.hs (98%) rename {Github => src/GitHub/Endpoints}/PullRequests.hs (98%) rename {Github => src/GitHub/Endpoints}/PullRequests/ReviewComments.hs (94%) rename {Github => src/GitHub/Endpoints}/Repos.hs (99%) rename {Github => src/GitHub/Endpoints}/Repos/Collaborators.hs (95%) rename {Github => src/GitHub/Endpoints}/Repos/Comments.hs (96%) rename {Github => src/GitHub/Endpoints}/Repos/Commits.hs (97%) rename {Github => src/GitHub/Endpoints}/Repos/Forks.hs (91%) rename {Github => src/GitHub/Endpoints}/Repos/Webhooks.hs (98%) rename {Github => src/GitHub/Endpoints}/Search.hs (96%) rename {Github => src/GitHub/Endpoints}/Users.hs (94%) rename {Github => src/GitHub/Endpoints}/Users/Followers.hs (93%) rename {Github => src/GitHub}/Request.hs (98%) diff --git a/.gitignore b/.gitignore index d6b36ab8..e22e77ba 100644 --- a/.gitignore +++ b/.gitignore @@ -9,3 +9,5 @@ cabal.sandbox.config *.o .stack-work run.sh +src/hightlight.js +src/style.css diff --git a/README.md b/README.md index f052e8b0..740aead3 100644 --- a/README.md +++ b/README.md @@ -38,7 +38,8 @@ Each module lines up with the hierarchy of [documentation from the Github API](http://developer.github.com/v3/). Request functions (ending with `R`) construct a data type with can be executed -in `IO` by `executeRequest` functions. They are all listed in `Github.All` module. +in `IO` by `executeRequest` functions. They are all listed in the root `GitHub` +module. IO functions produce an `IO (Either Error a)`, where `a` is the actual thing you want. You must call the function using IO goodness, then dispatch on the @@ -48,15 +49,15 @@ Many function have samples under [`samples/`](https://github.com/phadej/github/tree/master/samples) directory. ```hs -import qualified Github.Users.Followers as Github +import qualified GitHub.Endpoints.Users.Followers as Github main = do - possibleUsers <- Github.usersFollowing "mike-burns" + possibleUsers <- GitHub.usersFollowing "mike-burns" T.putStrLn $ either (("Error: " <>) . T.pack . show) (foldMap (formatUser . (<> "\n"))) possibleUsers -formatUser = Github.untagName . Github.githubOwnerLogin +formatUser = GitHub.untagName . GitHub.githubOwnerLogin ``` Test setup diff --git a/github.cabal b/github.cabal index b0d22200..aad2bcc2 100644 --- a/github.cabal +++ b/github.cabal @@ -1,15 +1,15 @@ -Name: github -Version: 0.14.0 -Synopsis: Access to the Github API, v3. -Description: - The Github API provides programmatic access to the full - Github Web site, from Issues to Gists to repos down to the underlying git data +name: github +version: 0.14.0 +synopsis: Access to the GitHub API, v3. +description: + The GitHub API provides programmatic access to the full + GitHub Web site, from Issues to Gists to repos down to the underlying git data like references and trees. This library wraps all of that, exposing a basic but Haskell-friendly set of functions and data structures. . - For supported endpoints see "Github.All" module. + For supported endpoints see "GitHub" module. . - > import qualified Github.All as GH + > import qualified GitHub as GH > > main :: IO () > main = do @@ -17,17 +17,17 @@ Description: > print possibleUser . For more of an overview please see the README: -License: BSD3 -License-file: LICENSE -Author: Mike Burns, John Wiegley, Oleg Grenrus -Maintainer: Oleg Grenrus -Homepage: https://github.com/phadej/github -Copyright: Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016 Oleg Grenrus -Category: Network -Build-type: Simple -Tested-with: GHC==7.8.4, GHC==7.10.2 -Cabal-version: >=1.10 -Extra-source-files: +license: BSD3 +license-file: LICENSE +author: Mike Burns, John Wiegley, Oleg Grenrus +maintainer: Oleg Grenrus +homepage: https://github.com/phadej/github +copyright: Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016 Oleg Grenrus +category: Network +build-type: Simple +tested-with: GHC==7.8.4, GHC==7.10.2 +cabal-version: >=1.10 +extra-source-files: README.md, fixtures/issue-search.json, fixtures/list-teams.json, @@ -45,58 +45,59 @@ source-repository head location: git://github.com/phadej/github.git Library - -- Modules exported by the library. - Default-Language: Haskell2010 - GHC-Options: -Wall - Exposed-modules: Github.All, - Github.Activity.Starring, - Github.Activity.Watching, - Github.Auth, - Github.Data, - Github.Data.Comments, - Github.Data.Content, - Github.Data.Definitions, - Github.Data.Gists, - Github.Data.GitData, - Github.Data.Id, - Github.Data.Issues, - Github.Data.Name, - Github.Data.PullRequests, - Github.Data.Repos, - Github.Data.Request, - Github.Data.Search, - Github.Data.Teams, - Github.Data.Webhooks, - Github.Gists, - Github.Gists.Comments, - Github.GitData.Commits, - Github.GitData.References, - Github.GitData.Trees, - Github.GitData.Blobs, - Github.Issues, - Github.Issues.Comments, - Github.Issues.Events, - Github.Issues.Labels, - Github.Issues.Milestones, - Github.Organizations, - Github.Organizations.Members, - Github.Organizations.Teams, - Github.PullRequests, - Github.PullRequests.ReviewComments, - Github.Repos, - Github.Repos.Collaborators, - Github.Repos.Comments, - Github.Repos.Commits, - Github.Repos.Forks, - Github.Repos.Webhooks - Github.Repos.Webhooks.Validate, - Github.Users, - Github.Users.Followers - Github.Search - Github.Request + default-language: Haskell2010 + ghc-options: -Wall + hs-source-dirs: src + exposed-modules: + GitHub + GitHub.Auth + GitHub.Data + GitHub.Data.Comments + GitHub.Data.Content + GitHub.Data.Definitions + GitHub.Data.Gists + GitHub.Data.GitData + GitHub.Data.Id + GitHub.Data.Issues + GitHub.Data.Name + GitHub.Data.PullRequests + GitHub.Data.Repos + GitHub.Data.Request + GitHub.Data.Search + GitHub.Data.Teams + GitHub.Data.Webhooks + GitHub.Data.Webhooks.Validate + GitHub.Endpoints.Activity.Starring + GitHub.Endpoints.Activity.Watching + GitHub.Endpoints.Gists + GitHub.Endpoints.Gists.Comments + GitHub.Endpoints.GitData.Blobs + GitHub.Endpoints.GitData.Commits + GitHub.Endpoints.GitData.References + GitHub.Endpoints.GitData.Trees + GitHub.Endpoints.Issues + GitHub.Endpoints.Issues.Comments + GitHub.Endpoints.Issues.Events + GitHub.Endpoints.Issues.Labels + GitHub.Endpoints.Issues.Milestones + GitHub.Endpoints.Organizations + GitHub.Endpoints.Organizations.Members + GitHub.Endpoints.Organizations.Teams + GitHub.Endpoints.PullRequests + GitHub.Endpoints.PullRequests.ReviewComments + GitHub.Endpoints.Repos + GitHub.Endpoints.Repos.Collaborators + GitHub.Endpoints.Repos.Comments + GitHub.Endpoints.Repos.Commits + GitHub.Endpoints.Repos.Forks + GitHub.Endpoints.Repos.Webhooks + GitHub.Endpoints.Search + GitHub.Endpoints.Users + GitHub.Endpoints.Users.Followers + GitHub.Request -- Packages needed in order to build this package. - Build-depends: base >= 4.7 && <4.9, + build-depends: base >= 4.7 && <4.9, aeson >=0.7.0.6 && <0.11, attoparsec >=0.11.3.4 && <0.14, base-compat >=0.6.0 && <0.10, @@ -129,21 +130,21 @@ Library void >=0.7 && <0.8 if flag(aeson-compat) - Build-depends: aeson-compat >=0.3.0.0 && <0.4 + build-depends: aeson-compat >=0.3.0.0 && <0.4 else - Build-depends: aeson-extra >=0.2.0.0 && <0.3 + build-depends: aeson-extra >=0.2.0.0 && <0.3 test-suite github-test default-language: Haskell2010 type: exitcode-stdio-1.0 hs-source-dirs: spec other-modules: - Github.ActivitySpec - Github.CommitsSpec - Github.OrganizationsSpec - Github.ReposSpec - Github.SearchSpec - Github.UsersSpec + GitHub.ActivitySpec + GitHub.CommitsSpec + GitHub.OrganizationsSpec + GitHub.ReposSpec + GitHub.SearchSpec + GitHub.UsersSpec main-is: Spec.hs ghc-options: -Wall build-depends: base, diff --git a/samples/Operational/Operational.hs b/samples/Operational/Operational.hs index 779704c2..734f2416 100644 --- a/samples/Operational/Operational.hs +++ b/samples/Operational/Operational.hs @@ -10,7 +10,7 @@ import Control.Monad.Operational import Network.HTTP.Client (Manager, newManager) import Network.HTTP.Client.TLS (tlsManagerSettings) -import qualified Github.All as GH +import qualified GitHub as GH type GithubMonad a = Program (GH.GithubRequest 'False) a diff --git a/samples/Teams/DeleteTeam.hs b/samples/Teams/DeleteTeam.hs index 62b7f2ce..224df2ce 100644 --- a/samples/Teams/DeleteTeam.hs +++ b/samples/Teams/DeleteTeam.hs @@ -4,13 +4,14 @@ module Main (main) where import Common import Prelude () -import qualified Github.Organizations.Teams as Github +import qualified GitHub +import qualified GitHub.Endpoints.Organizations.Teams as GitHub main :: IO () main = do args <- getArgs result <- case args of - [token, team_id] -> Github.deleteTeam' (Github.GithubOAuth token) (Github.mkTeamId $ read team_id) + [token, team_id] -> GitHub.deleteTeam' (GitHub.GithubOAuth token) (GitHub.mkTeamId $ read team_id) _ -> error "usage: DeleteTeam " case result of Left err -> putStrLn $ "Error: " <> tshow err diff --git a/samples/Teams/EditTeam.hs b/samples/Teams/EditTeam.hs index 5cc007cb..434b07fd 100644 --- a/samples/Teams/EditTeam.hs +++ b/samples/Teams/EditTeam.hs @@ -4,17 +4,18 @@ module Main (main) where import Common import Prelude () -import qualified Github.Organizations.Teams as Github +import qualified GitHub +import qualified GitHub.Endpoints.Organizations.Teams as GitHub main :: IO () main = do args <- getArgs result <- case args of [token, team_id, team_name, desc] -> - Github.editTeam' - (Github.GithubOAuth token) - (Github.mkTeamId $ read team_id) - (Github.EditTeam (Github.mkTeamName $ fromString team_name) (Just $ fromString desc) Github.PermissionPull) + GitHub.editTeam' + (GitHub.GithubOAuth token) + (GitHub.mkTeamId $ read team_id) + (GitHub.EditTeam (GitHub.mkTeamName $ fromString team_name) (Just $ fromString desc) GitHub.PermissionPull) _ -> error "usage: EditTeam " case result of diff --git a/samples/Teams/ListTeamsCurrent.hs b/samples/Teams/ListTeamsCurrent.hs index 81e55ad9..495fd557 100644 --- a/samples/Teams/ListTeamsCurrent.hs +++ b/samples/Teams/ListTeamsCurrent.hs @@ -4,13 +4,14 @@ module Main (main) where import Common import Prelude () -import qualified Github.Organizations.Teams as Github +import qualified GitHub +import qualified GitHub.Endpoints.Organizations.Teams as GitHub main :: IO () main = do args <- getArgs result <- case args of - [token] -> Github.listTeamsCurrent' (Github.GithubOAuth token) + [token] -> GitHub.listTeamsCurrent' (GitHub.GithubOAuth token) _ -> error "usage: ListTeamsCurrent " case result of Left err -> putStrLn $ "Error: " <> tshow err diff --git a/samples/Teams/Memberships/AddTeamMembershipFor.hs b/samples/Teams/Memberships/AddTeamMembershipFor.hs index 4d0b1f24..5f91769e 100644 --- a/samples/Teams/Memberships/AddTeamMembershipFor.hs +++ b/samples/Teams/Memberships/AddTeamMembershipFor.hs @@ -4,18 +4,19 @@ module Main (main) where import Common import Prelude () -import qualified Github.Organizations.Teams as Github +import qualified GitHub +import qualified GitHub.Endpoints.Organizations.Teams as GitHub main :: IO () main = do args <- getArgs result <- case args of [token, team_id, username] -> - Github.addTeamMembershipFor' - (Github.GithubOAuth token) - (Github.mkTeamId $ read team_id) - (Github.mkOwnerName $ fromString username) - Github.RoleMember + GitHub.addTeamMembershipFor' + (GitHub.GithubOAuth token) + (GitHub.mkTeamId $ read team_id) + (GitHub.mkOwnerName $ fromString username) + GitHub.RoleMember _ -> error "usage: AddTeamMembershipFor " case result of diff --git a/samples/Teams/Memberships/DeleteTeamMembershipFor.hs b/samples/Teams/Memberships/DeleteTeamMembershipFor.hs index 4c9d3f16..6cf9ec67 100644 --- a/samples/Teams/Memberships/DeleteTeamMembershipFor.hs +++ b/samples/Teams/Memberships/DeleteTeamMembershipFor.hs @@ -4,17 +4,18 @@ module Main (main) where import Common import Prelude () -import qualified Github.Organizations.Teams as Github +import qualified GitHub +import qualified GitHub.Endpoints.Organizations.Teams as GitHub main :: IO () main = do args <- getArgs result <- case args of [token, team_id, username] -> - Github.deleteTeamMembershipFor' - (Github.GithubOAuth token) - (Github.mkTeamId $ read team_id) - (Github.mkOwnerName $ fromString username) + GitHub.deleteTeamMembershipFor' + (GitHub.GithubOAuth token) + (GitHub.mkTeamId $ read team_id) + (GitHub.mkOwnerName $ fromString username) _ -> error "usage: DeleteTeamMembershipFor " case result of diff --git a/samples/Teams/Memberships/TeamMembershipInfoFor.hs b/samples/Teams/Memberships/TeamMembershipInfoFor.hs index 967996b9..2cd1a625 100644 --- a/samples/Teams/Memberships/TeamMembershipInfoFor.hs +++ b/samples/Teams/Memberships/TeamMembershipInfoFor.hs @@ -4,16 +4,17 @@ module Main (main) where import Common import Prelude () -import qualified Github.Organizations.Teams as Github +import qualified GitHub +import qualified GitHub.Endpoints.Organizations.Teams as GitHub main :: IO () main = do args <- getArgs result <- case args of [team_id, username, token] -> - Github.teamMembershipInfoFor' (Just $ Github.GithubOAuth token) (Github.mkTeamId $ read team_id) (Github.mkOwnerName $ fromString username) + GitHub.teamMembershipInfoFor' (Just $ GitHub.GithubOAuth token) (GitHub.mkTeamId $ read team_id) (GitHub.mkOwnerName $ fromString username) [team_id, username] -> - Github.teamMembershipInfoFor (Github.mkTeamId $ read team_id) (Github.mkOwnerName $ fromString username) + GitHub.teamMembershipInfoFor (GitHub.mkTeamId $ read team_id) (GitHub.mkOwnerName $ fromString username) _ -> error "usage: TeamMembershipInfoFor [token]" case result of diff --git a/samples/Teams/TeamInfoFor.hs b/samples/Teams/TeamInfoFor.hs index f870cb60..3eb8b491 100644 --- a/samples/Teams/TeamInfoFor.hs +++ b/samples/Teams/TeamInfoFor.hs @@ -4,14 +4,15 @@ module Main (main) where import Common import Prelude () -import qualified Github.Organizations.Teams as Github +import qualified GitHub +import qualified GitHub.Endpoints.Organizations.Teams as GitHub main :: IO () main = do args <- getArgs result <- case args of - [team_id, token] -> Github.teamInfoFor' (Just $ Github.GithubOAuth token) (Github.mkTeamId $ read team_id) - [team_id] -> Github.teamInfoFor (Github.mkTeamId $ read team_id) + [team_id, token] -> GitHub.teamInfoFor' (Just $ GitHub.GithubOAuth token) (GitHub.mkTeamId $ read team_id) + [team_id] -> GitHub.teamInfoFor (GitHub.mkTeamId $ read team_id) _ -> error "usage: TeamInfoFor [auth token]" case result of Left err -> putStrLn $ "Error: " <> tshow err diff --git a/samples/Users/Followers/ListFollowers.hs b/samples/Users/Followers/ListFollowers.hs index bb448677..8f608f61 100644 --- a/samples/Users/Followers/ListFollowers.hs +++ b/samples/Users/Followers/ListFollowers.hs @@ -4,16 +4,15 @@ module Main (main) where import Common import Prelude () -import qualified Github.Request as Github -import qualified Github.Users.Followers as Github +import qualified GitHub main :: IO () main = do auth <- getAuth - possibleUsers <- Github.executeRequestMaybe auth $ Github.usersFollowingR "mike-burns" Nothing + possibleUsers <- GitHub.executeRequestMaybe auth $ GitHub.usersFollowingR "mike-burns" Nothing putStrLn $ either (("Error: " <>) . tshow) (foldMap ((<> "\n") . formatUser)) possibleUsers -formatUser :: Github.SimpleUser -> Text -formatUser = Github.untagName . Github.simpleUserLogin +formatUser :: GitHub.SimpleUser -> Text +formatUser = GitHub.untagName . GitHub.simpleUserLogin diff --git a/samples/Users/Followers/ListFollowing.hs b/samples/Users/Followers/ListFollowing.hs index 28361640..6e6e006c 100644 --- a/samples/Users/Followers/ListFollowing.hs +++ b/samples/Users/Followers/ListFollowing.hs @@ -4,17 +4,16 @@ module Main (main) where import Common import Prelude () -import qualified Github.Request as Github -import qualified Github.Users.Followers as Github +import qualified GitHub main :: IO () main = do auth <- getAuth - possibleUsers <- Github.executeRequestMaybe auth $ Github.usersFollowedByR "mike-burns" Nothing + possibleUsers <- GitHub.executeRequestMaybe auth $ GitHub.usersFollowedByR "mike-burns" Nothing putStrLn $ either (("Error: " <>) . tshow) (foldMap ((<> "\n") . formatUser)) possibleUsers -formatUser :: Github.SimpleUser -> Text -formatUser = Github.untagName . Github.simpleUserLogin +formatUser :: GitHub.SimpleUser -> Text +formatUser = GitHub.untagName . GitHub.simpleUserLogin diff --git a/samples/Users/ShowUser.hs b/samples/Users/ShowUser.hs index bf645d9b..b9c5d433 100644 --- a/samples/Users/ShowUser.hs +++ b/samples/Users/ShowUser.hs @@ -6,15 +6,16 @@ import Prelude () import Data.Maybe (fromMaybe) -import qualified Github.Users as Github +import qualified GitHub +import qualified GitHub.Endpoints.Users as GitHub main :: IO () main = do auth <- getAuth - possibleUser <- Github.userInfoFor' auth "mike-burns" + possibleUser <- GitHub.userInfoFor' auth "mike-burns" putStrLn $ either (("Error: " <>) . tshow) formatUser possibleUser -formatUser :: Github.User -> Text +formatUser :: GitHub.User -> Text formatUser user = (formatName userName login) <> "\t" <> (fromMaybe "" company) <> "\t" <> (fromMaybe "" location) <> "\n" <> @@ -23,20 +24,20 @@ formatUser user = "hireable: " <> formatHireable (fromMaybe False isHireable) <> "\n\n" <> (fromMaybe "" bio) where - userName = Github.userName user - login = Github.userLogin user - company = Github.userCompany user - location = Github.userLocation user - blog = Github.userBlog user - email = Github.userEmail user - htmlUrl = Github.userHtmlUrl user - createdAt = Github.userCreatedAt user - isHireable = Github.userHireable user - bio = Github.userBio user + userName = GitHub.userName user + login = GitHub.userLogin user + company = GitHub.userCompany user + location = GitHub.userLocation user + blog = GitHub.userBlog user + email = GitHub.userEmail user + htmlUrl = GitHub.userHtmlUrl user + createdAt = GitHub.userCreatedAt user + isHireable = GitHub.userHireable user + bio = GitHub.userBio user -formatName :: Maybe Text -> Github.Name Github.User -> Text -formatName Nothing login = Github.untagName login -formatName (Just name) login = name <> "(" <> Github.untagName login <> ")" +formatName :: Maybe Text -> GitHub.Name GitHub.User -> Text +formatName Nothing login = GitHub.untagName login +formatName (Just name) login = name <> "(" <> GitHub.untagName login <> ")" formatHireable :: Bool -> Text formatHireable True = "yes" diff --git a/samples/Users/ShowUser2.hs b/samples/Users/ShowUser2.hs index 5c6360b7..b0011c98 100644 --- a/samples/Users/ShowUser2.hs +++ b/samples/Users/ShowUser2.hs @@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} module Main (main) where -import qualified Github.All as GH +import qualified GitHub as GH main :: IO () main = do diff --git a/samples/src/Common.hs b/samples/src/Common.hs index 424cf590..bf0158c5 100644 --- a/samples/src/Common.hs +++ b/samples/src/Common.hs @@ -24,12 +24,12 @@ import System.Environment (lookupEnv) import System.Environment (getArgs) import qualified Data.Text as T -import qualified Github.Data as Github +import qualified GitHub -getAuth :: IO (Maybe (Github.GithubAuth)) +getAuth :: IO (Maybe (GitHub.GithubAuth)) getAuth = do token <- lookupEnv "GITHUB_TOKEN" - pure (Github.GithubOAuth <$> token) + pure (GitHub.GithubOAuth <$> token) tshow :: Show a => a -> Text tshow = T.pack . show diff --git a/spec/Github/ActivitySpec.hs b/spec/GitHub/ActivitySpec.hs similarity index 82% rename from spec/Github/ActivitySpec.hs rename to spec/GitHub/ActivitySpec.hs index 9b776a18..02d8458f 100644 --- a/spec/Github/ActivitySpec.hs +++ b/spec/GitHub/ActivitySpec.hs @@ -1,10 +1,10 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -module Github.ActivitySpec where +module GitHub.ActivitySpec where -import Github.Auth (GithubAuth (..)) -import Github.Activity.Watching (watchersForR) -import Github.Request (executeRequest) +import GitHub.Auth (GithubAuth (..)) +import GitHub.Endpoints.Activity.Watching (watchersForR) +import GitHub.Request (executeRequest) import Data.Either.Compat (isRight) import System.Environment (lookupEnv) diff --git a/spec/Github/CommitsSpec.hs b/spec/GitHub/CommitsSpec.hs similarity index 89% rename from spec/Github/CommitsSpec.hs rename to spec/GitHub/CommitsSpec.hs index a6a4e05f..46677b61 100644 --- a/spec/Github/CommitsSpec.hs +++ b/spec/GitHub/CommitsSpec.hs @@ -1,10 +1,10 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -module Github.CommitsSpec where +module GitHub.CommitsSpec where -import Github.Auth (GithubAuth (..)) -import Github.Repos.Commits (Commit, mkName, commitSha, commitsFor', commitsForR, diffR) -import Github.Request (executeRequest) +import GitHub.Auth (GithubAuth (..)) +import GitHub.Endpoints.Repos.Commits (Commit, mkName, commitSha, commitsFor', commitsForR, diffR) +import GitHub.Request (executeRequest) import Control.Monad (forM_) import Data.Either.Compat (isRight) diff --git a/spec/Github/OrganizationsSpec.hs b/spec/GitHub/OrganizationsSpec.hs similarity index 85% rename from spec/Github/OrganizationsSpec.hs rename to spec/GitHub/OrganizationsSpec.hs index 3e756391..d6120976 100644 --- a/spec/Github/OrganizationsSpec.hs +++ b/spec/GitHub/OrganizationsSpec.hs @@ -1,12 +1,12 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -module Github.OrganizationsSpec where +module GitHub.OrganizationsSpec where -import Github.Auth (GithubAuth (..)) -import Github.Data (SimpleOwner (..), SimpleOrganization (..), +import GitHub.Auth (GithubAuth (..)) +import GitHub.Data (SimpleOwner (..), SimpleOrganization (..), SimpleTeam (..)) -import Github.Organizations (publicOrganizationsFor') -import Github.Organizations.Members (membersOf') +import GitHub.Endpoints.Organizations (publicOrganizationsFor') +import GitHub.Endpoints.Organizations.Members (membersOf') import Data.Aeson.Compat (eitherDecodeStrict) import Data.Either.Compat (isRight) diff --git a/spec/Github/ReposSpec.hs b/spec/GitHub/ReposSpec.hs similarity index 86% rename from spec/Github/ReposSpec.hs rename to spec/GitHub/ReposSpec.hs index 6b633073..76e9205c 100644 --- a/spec/Github/ReposSpec.hs +++ b/spec/GitHub/ReposSpec.hs @@ -1,9 +1,9 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -module Github.ReposSpec where +module GitHub.ReposSpec where -import Github.Auth (GithubAuth (..)) -import Github.Repos (currentUserRepos, userRepos', RepoPublicity(..)) +import GitHub.Auth (GithubAuth (..)) +import GitHub.Endpoints.Repos (currentUserRepos, userRepos', RepoPublicity(..)) -- import Data.Aeson.Compat (eitherDecodeStrict) import Data.Either.Compat (isRight) diff --git a/spec/Github/SearchSpec.hs b/spec/GitHub/SearchSpec.hs similarity index 89% rename from spec/Github/SearchSpec.hs rename to spec/GitHub/SearchSpec.hs index 4b0345d7..ec3a33b7 100644 --- a/spec/Github/SearchSpec.hs +++ b/spec/GitHub/SearchSpec.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -module Github.SearchSpec where +module GitHub.SearchSpec where import Prelude () import Prelude.Compat @@ -11,9 +11,9 @@ import Test.Hspec (Spec, describe, it, shouldBe) import qualified Data.Vector as V -import Github.Data.Id (Id (..)) -import Github.Data.Issues (Issue (..)) -import Github.Search (SearchResult (..), searchIssues) +import GitHub.Data.Id (Id (..)) +import GitHub.Data.Issues (Issue (..)) +import GitHub.Endpoints.Search (SearchResult (..), searchIssues) fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b diff --git a/spec/Github/UsersSpec.hs b/spec/GitHub/UsersSpec.hs similarity index 89% rename from spec/Github/UsersSpec.hs rename to spec/GitHub/UsersSpec.hs index 00723d61..0a9c8603 100644 --- a/spec/Github/UsersSpec.hs +++ b/spec/GitHub/UsersSpec.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -module Github.UsersSpec where +module GitHub.UsersSpec where import Data.Aeson.Compat (eitherDecodeStrict) import Data.Either.Compat (isRight, isLeft) @@ -9,10 +9,10 @@ import System.Environment (lookupEnv) import Test.Hspec (Spec, describe, it, pendingWith, shouldBe, shouldSatisfy) -import Github.Data (GithubAuth (..), User (..), Organization (..), fromGithubOwner) -import Github.Request (executeRequest) -import Github.Users (userInfoCurrent', userInfoFor', ownerInfoForR) -import Github.Users.Followers (usersFollowedByR, usersFollowingR) +import GitHub.Data (GithubAuth (..), User (..), Organization (..), fromGithubOwner) +import GitHub.Request (executeRequest) +import GitHub.Endpoints.Users (userInfoCurrent', userInfoFor', ownerInfoForR) +import GitHub.Endpoints.Users.Followers (usersFollowedByR, usersFollowingR) fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b diff --git a/Github/All.hs b/src/GitHub.hs similarity index 84% rename from Github/All.hs rename to src/GitHub.hs index 1bfa2e60..b7608d55 100644 --- a/Github/All.hs +++ b/src/GitHub.hs @@ -6,12 +6,12 @@ -- This module re-exports all request constructrors and data definitions from -- this package. -- --- See "Github.Request" module for executing 'GithubRequest', or other modules --- of this package (e.g. "Github.Users") for already composed versions. +-- See "GitHub.Request" module for executing 'GithubRequest', or other modules +-- of this package (e.g. "GitHub.Users") for already composed versions. -- -- The missing endpoints lists show which endpoints we know are missing, there -- might be more. -module Github.All ( +module GitHub ( -- * Activity -- | See @@ -299,37 +299,37 @@ module Github.All ( usersFollowedByR, -- * Data definitions - module Github.Data, + module GitHub.Data, -- * Request handling - module Github.Request, + module GitHub.Request, ) where -import Github.Activity.Starring -import Github.Activity.Watching -import Github.Data -import Github.Gists -import Github.Gists.Comments -import Github.GitData.Blobs -import Github.GitData.Commits -import Github.GitData.References -import Github.GitData.Trees -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 -import Github.PullRequests -import Github.PullRequests.ReviewComments -import Github.Repos -import Github.Repos.Collaborators -import Github.Repos.Comments -import Github.Repos.Commits -import Github.Repos.Forks -import Github.Repos.Webhooks -import Github.Request -import Github.Search -import Github.Users -import Github.Users.Followers +import GitHub.Data +import GitHub.Endpoints.Activity.Starring +import GitHub.Endpoints.Activity.Watching +import GitHub.Endpoints.Gists +import GitHub.Endpoints.Gists.Comments +import GitHub.Endpoints.GitData.Blobs +import GitHub.Endpoints.GitData.Commits +import GitHub.Endpoints.GitData.References +import GitHub.Endpoints.GitData.Trees +import GitHub.Endpoints.Issues +import GitHub.Endpoints.Issues.Comments +import GitHub.Endpoints.Issues.Events +import GitHub.Endpoints.Issues.Labels +import GitHub.Endpoints.Issues.Milestones +import GitHub.Endpoints.Organizations +import GitHub.Endpoints.Organizations.Members +import GitHub.Endpoints.Organizations.Teams +import GitHub.Endpoints.PullRequests +import GitHub.Endpoints.PullRequests.ReviewComments +import GitHub.Endpoints.Repos +import GitHub.Endpoints.Repos.Collaborators +import GitHub.Endpoints.Repos.Comments +import GitHub.Endpoints.Repos.Commits +import GitHub.Endpoints.Repos.Forks +import GitHub.Endpoints.Repos.Webhooks +import GitHub.Endpoints.Search +import GitHub.Endpoints.Users +import GitHub.Endpoints.Users.Followers +import GitHub.Request diff --git a/Github/Auth.hs b/src/GitHub/Auth.hs similarity index 97% rename from Github/Auth.hs rename to src/GitHub/Auth.hs index 62d3e77f..33f6d687 100644 --- a/Github/Auth.hs +++ b/src/GitHub/Auth.hs @@ -5,7 +5,7 @@ -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -module Github.Auth where +module GitHub.Auth where import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) diff --git a/Github/Data.hs b/src/GitHub/Data.hs similarity index 59% rename from Github/Data.hs rename to src/GitHub/Data.hs index 897ec916..f5cdc7dd 100644 --- a/Github/Data.hs +++ b/src/GitHub/Data.hs @@ -6,8 +6,8 @@ -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- --- This module re-exports the @Github.Data.@ and "Github.Auth" submodules. -module Github.Data ( +-- This module re-exports the @GitHub.Data.@ and "Github.Auth" submodules. +module GitHub.Data ( -- * Tagged types -- ** Name Name, @@ -28,19 +28,19 @@ module Github.Data ( mkOrganizationId, mkRepoId, -- * Module re-exports - module Github.Auth, - module Github.Data.Comments, - module Github.Data.Content, - module Github.Data.Definitions, - module Github.Data.Gists, - module Github.Data.GitData, - module Github.Data.Issues, - module Github.Data.PullRequests, - module Github.Data.Repos, - module Github.Data.Request, - module Github.Data.Search, - module Github.Data.Teams, - module Github.Data.Webhooks, + module GitHub.Auth, + module GitHub.Data.Comments, + module GitHub.Data.Content, + module GitHub.Data.Definitions, + module GitHub.Data.Gists, + module GitHub.Data.GitData, + module GitHub.Data.Issues, + module GitHub.Data.PullRequests, + module GitHub.Data.Repos, + module GitHub.Data.Request, + module GitHub.Data.Search, + module GitHub.Data.Teams, + module GitHub.Data.Webhooks, ) where import Prelude () @@ -48,21 +48,21 @@ import Prelude.Compat import Data.Text (Text) -import Github.Auth -import Github.Data.Comments -import Github.Data.Content -import Github.Data.Definitions -import Github.Data.Gists -import Github.Data.GitData -import Github.Data.Id -import Github.Data.Issues -import Github.Data.Name -import Github.Data.PullRequests -import Github.Data.Repos -import Github.Data.Request -import Github.Data.Search -import Github.Data.Teams -import Github.Data.Webhooks +import GitHub.Auth +import GitHub.Data.Comments +import GitHub.Data.Content +import GitHub.Data.Definitions +import GitHub.Data.Gists +import GitHub.Data.GitData +import GitHub.Data.Id +import GitHub.Data.Issues +import GitHub.Data.Name +import GitHub.Data.PullRequests +import GitHub.Data.Repos +import GitHub.Data.Request +import GitHub.Data.Search +import GitHub.Data.Teams +import GitHub.Data.Webhooks mkOwnerId :: Int -> Id GithubOwner mkOwnerId = Id diff --git a/Github/Data/Comments.hs b/src/GitHub/Data/Comments.hs similarity index 96% rename from Github/Data/Comments.hs rename to src/GitHub/Data/Comments.hs index 2b7ac306..61cbfca6 100644 --- a/Github/Data/Comments.hs +++ b/src/GitHub/Data/Comments.hs @@ -6,7 +6,7 @@ -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -module Github.Data.Comments where +module GitHub.Data.Comments where import Prelude () import Prelude.Compat @@ -21,8 +21,8 @@ import Data.Text (Text) import Data.Time (UTCTime) import GHC.Generics (Generic) -import Github.Data.Definitions -import Github.Data.Id +import GitHub.Data.Definitions +import GitHub.Data.Id data Comment = Comment { commentPosition :: !(Maybe Int) diff --git a/Github/Data/Content.hs b/src/GitHub/Data/Content.hs similarity index 99% rename from Github/Data/Content.hs rename to src/GitHub/Data/Content.hs index f2e5f334..14519a5e 100644 --- a/Github/Data/Content.hs +++ b/src/GitHub/Data/Content.hs @@ -6,7 +6,7 @@ -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -module Github.Data.Content where +module GitHub.Data.Content where import Prelude () import Prelude.Compat diff --git a/Github/Data/Definitions.hs b/src/GitHub/Data/Definitions.hs similarity index 98% rename from Github/Data/Definitions.hs rename to src/GitHub/Data/Definitions.hs index a58a8f35..ac8059a1 100644 --- a/Github/Data/Definitions.hs +++ b/src/GitHub/Data/Definitions.hs @@ -6,7 +6,7 @@ -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -module Github.Data.Definitions where +module GitHub.Data.Definitions where import Prelude () import Prelude.Compat @@ -27,8 +27,8 @@ import Network.HTTP.Client (HttpException) import qualified Control.Exception as E import qualified Data.Text as T -import Github.Data.Id -import Github.Data.Name +import GitHub.Data.Id +import GitHub.Data.Name -- | Errors have been tagged according to their source, so you can more easily -- dispatch and handle them. diff --git a/Github/Data/Gists.hs b/src/GitHub/Data/Gists.hs similarity index 95% rename from Github/Data/Gists.hs rename to src/GitHub/Data/Gists.hs index c0934d43..74e34202 100644 --- a/Github/Data/Gists.hs +++ b/src/GitHub/Data/Gists.hs @@ -6,14 +6,14 @@ -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -module Github.Data.Gists where +module GitHub.Data.Gists where import Prelude () import Prelude.Compat -import Github.Data.Definitions -import Github.Data.Id (Id) -import Github.Data.Name (Name) +import GitHub.Data.Definitions +import GitHub.Data.Id (Id) +import GitHub.Data.Name (Name) import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) diff --git a/Github/Data/GitData.hs b/src/GitHub/Data/GitData.hs similarity index 98% rename from Github/Data/GitData.hs rename to src/GitHub/Data/GitData.hs index 36d2a9a0..5a9012a8 100644 --- a/Github/Data/GitData.hs +++ b/src/GitHub/Data/GitData.hs @@ -6,13 +6,13 @@ -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -module Github.Data.GitData where +module GitHub.Data.GitData where import Prelude () import Prelude.Compat -import Github.Data.Definitions -import Github.Data.Name (Name) +import GitHub.Data.Definitions +import GitHub.Data.Name (Name) import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) diff --git a/Github/Data/Id.hs b/src/GitHub/Data/Id.hs similarity index 97% rename from Github/Data/Id.hs rename to src/GitHub/Data/Id.hs index 78c6d2ff..bda2976c 100644 --- a/Github/Data/Id.hs +++ b/src/GitHub/Data/Id.hs @@ -5,7 +5,7 @@ -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -module Github.Data.Id ( +module GitHub.Data.Id ( Id(..), mkId, untagId, diff --git a/Github/Data/Issues.hs b/src/GitHub/Data/Issues.hs similarity index 98% rename from Github/Data/Issues.hs rename to src/GitHub/Data/Issues.hs index 708efbc7..15a931c4 100644 --- a/Github/Data/Issues.hs +++ b/src/GitHub/Data/Issues.hs @@ -6,14 +6,14 @@ -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -module Github.Data.Issues where +module GitHub.Data.Issues where import Prelude () import Prelude.Compat -import Github.Data.Definitions -import Github.Data.Id (Id) -import Github.Data.PullRequests +import GitHub.Data.Definitions +import GitHub.Data.Id (Id) +import GitHub.Data.PullRequests import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) diff --git a/Github/Data/Name.hs b/src/GitHub/Data/Name.hs similarity index 97% rename from Github/Data/Name.hs rename to src/GitHub/Data/Name.hs index 199c7794..024f7175 100644 --- a/Github/Data/Name.hs +++ b/src/GitHub/Data/Name.hs @@ -5,7 +5,7 @@ -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -module Github.Data.Name ( +module GitHub.Data.Name ( Name(..), mkName, untagName, diff --git a/Github/Data/PullRequests.hs b/src/GitHub/Data/PullRequests.hs similarity index 98% rename from Github/Data/PullRequests.hs rename to src/GitHub/Data/PullRequests.hs index 4f074e22..8c69a2e5 100644 --- a/Github/Data/PullRequests.hs +++ b/src/GitHub/Data/PullRequests.hs @@ -6,13 +6,13 @@ -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -module Github.Data.PullRequests where +module GitHub.Data.PullRequests where import Prelude () import Prelude.Compat -import Github.Data.Definitions -import Github.Data.Repos (Repo) +import GitHub.Data.Definitions +import GitHub.Data.Repos (Repo) import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) diff --git a/Github/Data/Repos.hs b/src/GitHub/Data/Repos.hs similarity index 98% rename from Github/Data/Repos.hs rename to src/GitHub/Data/Repos.hs index 7154af0d..95edc6c0 100644 --- a/Github/Data/Repos.hs +++ b/src/GitHub/Data/Repos.hs @@ -6,14 +6,14 @@ -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -module Github.Data.Repos where +module GitHub.Data.Repos where import Prelude () import Prelude.Compat -import Github.Data.Definitions -import Github.Data.Id (Id) -import Github.Data.Name (Name) +import GitHub.Data.Definitions +import GitHub.Data.Id (Id) +import GitHub.Data.Name (Name) import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) diff --git a/Github/Data/Request.hs b/src/GitHub/Data/Request.hs similarity index 98% rename from Github/Data/Request.hs rename to src/GitHub/Data/Request.hs index f25ec3a5..fcc7ec8f 100644 --- a/Github/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -12,7 +12,7 @@ -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -module Github.Data.Request ( +module GitHub.Data.Request ( GithubRequest(..), CommandMethod(..), toMethod, @@ -35,8 +35,8 @@ import qualified Data.ByteString.Lazy as LBS import qualified Data.Text as T import qualified Network.HTTP.Types.Method as Method -import Github.Data.Id (Id, untagId) -import Github.Data.Name (Name, untagName) +import GitHub.Data.Id (Id, untagId) +import GitHub.Data.Name (Name, untagName) ------------------------------------------------------------------------------ -- Auxillary types diff --git a/Github/Data/Search.hs b/src/GitHub/Data/Search.hs similarity index 96% rename from Github/Data/Search.hs rename to src/GitHub/Data/Search.hs index 8356a8b4..c2c46198 100644 --- a/Github/Data/Search.hs +++ b/src/GitHub/Data/Search.hs @@ -6,12 +6,12 @@ -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -module Github.Data.Search where +module GitHub.Data.Search where import Prelude () import Prelude.Compat -import Github.Data.Repos (Repo) +import GitHub.Data.Repos (Repo) import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) diff --git a/Github/Data/Teams.hs b/src/GitHub/Data/Teams.hs similarity index 97% rename from Github/Data/Teams.hs rename to src/GitHub/Data/Teams.hs index 969ab5d2..317f4263 100644 --- a/Github/Data/Teams.hs +++ b/src/GitHub/Data/Teams.hs @@ -6,12 +6,12 @@ -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -module Github.Data.Teams where +module GitHub.Data.Teams where import Prelude () import Prelude.Compat -import Github.Data.Definitions +import GitHub.Data.Definitions import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) @@ -23,9 +23,9 @@ import Data.Text (Text) import Data.Vector (Vector) import GHC.Generics (Generic) -import Github.Data.Id (Id) -import Github.Data.Name (Name) -import Github.Data.Repos (Repo) +import GitHub.Data.Id (Id) +import GitHub.Data.Name (Name) +import GitHub.Data.Repos (Repo) data Privacy = PrivacyClosed diff --git a/Github/Data/Webhooks.hs b/src/GitHub/Data/Webhooks.hs similarity index 99% rename from Github/Data/Webhooks.hs rename to src/GitHub/Data/Webhooks.hs index 9f781498..b52b867d 100644 --- a/Github/Data/Webhooks.hs +++ b/src/GitHub/Data/Webhooks.hs @@ -6,12 +6,12 @@ -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -module Github.Data.Webhooks where +module GitHub.Data.Webhooks where import Prelude () import Prelude.Compat -import Github.Data.Id (Id) +import GitHub.Data.Id (Id) import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) diff --git a/Github/Repos/Webhooks/Validate.hs b/src/GitHub/Data/Webhooks/Validate.hs similarity index 97% rename from Github/Repos/Webhooks/Validate.hs rename to src/GitHub/Data/Webhooks/Validate.hs index 44cf7664..2fcd6cd2 100644 --- a/Github/Repos/Webhooks/Validate.hs +++ b/src/GitHub/Data/Webhooks/Validate.hs @@ -7,7 +7,7 @@ -- -- Verification of incomming webhook payloads, as described at -- -module Github.Repos.Webhooks.Validate ( +module GitHub.Data.Webhooks.Validate ( isValidPayload ) where diff --git a/Github/Activity/Starring.hs b/src/GitHub/Endpoints/Activity/Starring.hs similarity index 93% rename from Github/Activity/Starring.hs rename to src/GitHub/Endpoints/Activity/Starring.hs index 0b5d94a8..876b8138 100644 --- a/Github/Activity/Starring.hs +++ b/src/GitHub/Endpoints/Activity/Starring.hs @@ -6,20 +6,20 @@ -- -- The repo starring API as described on -- . -module Github.Activity.Starring ( +module GitHub.Endpoints.Activity.Starring ( stargazersFor, stargazersForR, reposStarredBy, reposStarredByR, myStarred, myStarredR, - module Github.Data, + module GitHub.Data, ) where import Data.Vector (Vector) -import Github.Auth -import Github.Data -import Github.Request +import GitHub.Auth +import GitHub.Data +import GitHub.Request -- | The list of users that have starred the specified Github repo. -- diff --git a/Github/Activity/Watching.hs b/src/GitHub/Endpoints/Activity/Watching.hs similarity index 94% rename from Github/Activity/Watching.hs rename to src/GitHub/Endpoints/Activity/Watching.hs index 88cb0f71..19ba5727 100644 --- a/Github/Activity/Watching.hs +++ b/src/GitHub/Endpoints/Activity/Watching.hs @@ -5,20 +5,20 @@ -- -- The repo watching API as described on -- . -module Github.Activity.Watching ( +module GitHub.Endpoints.Activity.Watching ( watchersFor, watchersFor', watchersForR, reposWatchedBy, reposWatchedBy', reposWatchedByR, - module Github.Data, + module GitHub.Data, ) where import Data.Vector (Vector) -import Github.Auth -import Github.Data -import Github.Request +import GitHub.Auth +import GitHub.Data +import GitHub.Request -- | The list of users that are watching the specified Github repo. -- diff --git a/Github/Gists.hs b/src/GitHub/Endpoints/Gists.hs similarity index 94% rename from Github/Gists.hs rename to src/GitHub/Endpoints/Gists.hs index 65f419ea..b311965d 100644 --- a/Github/Gists.hs +++ b/src/GitHub/Endpoints/Gists.hs @@ -4,19 +4,19 @@ -- Maintainer : Oleg Grenrus -- -- The gists API as described at . -module Github.Gists ( +module GitHub.Endpoints.Gists ( gists, gists', gistsR, gist, gist', gistR, - module Github.Data, + module GitHub.Data, ) where import Data.Vector (Vector) -import Github.Data -import Github.Request +import GitHub.Data +import GitHub.Request -- | The list of all gists created by the user -- diff --git a/Github/Gists/Comments.hs b/src/GitHub/Endpoints/Gists/Comments.hs similarity index 92% rename from Github/Gists/Comments.hs rename to src/GitHub/Endpoints/Gists/Comments.hs index a607f40b..347f7ea1 100644 --- a/Github/Gists/Comments.hs +++ b/src/GitHub/Endpoints/Gists/Comments.hs @@ -5,18 +5,18 @@ -- -- The loving comments people have left on Gists, described on -- . -module Github.Gists.Comments ( +module GitHub.Endpoints.Gists.Comments ( commentsOn, commentsOnR, comment, gistCommentR, - module Github.Data, + module GitHub.Data, ) where import Data.Vector (Vector) -import Github.Data -import Github.Request +import GitHub.Data +import GitHub.Request -- | All the comments on a Gist, given the Gist ID. -- diff --git a/Github/GitData/Blobs.hs b/src/GitHub/Endpoints/GitData/Blobs.hs similarity index 91% rename from Github/GitData/Blobs.hs rename to src/GitHub/Endpoints/GitData/Blobs.hs index a6421ab9..af2db226 100644 --- a/Github/GitData/Blobs.hs +++ b/src/GitHub/Endpoints/GitData/Blobs.hs @@ -5,15 +5,15 @@ -- -- The API for dealing with git blobs from Github repos, as described in -- . -module Github.GitData.Blobs ( +module GitHub.Endpoints.GitData.Blobs ( blob, blob', blobR, - module Github.Data, + module GitHub.Data, ) where -import Github.Data -import Github.Request +import GitHub.Data +import GitHub.Request -- | Get a blob by SHA1. -- diff --git a/Github/GitData/Commits.hs b/src/GitHub/Endpoints/GitData/Commits.hs similarity index 89% rename from Github/GitData/Commits.hs rename to src/GitHub/Endpoints/GitData/Commits.hs index 4c1dbc71..4d918094 100644 --- a/Github/GitData/Commits.hs +++ b/src/GitHub/Endpoints/GitData/Commits.hs @@ -5,14 +5,14 @@ -- -- The API for underlying git commits of a Github repo, as described on -- . -module Github.GitData.Commits ( +module GitHub.Endpoints.GitData.Commits ( commit, gitCommitR, - module Github.Data, + module GitHub.Data, ) where -import Github.Data -import Github.Request +import GitHub.Data +import GitHub.Request -- | A single commit, by SHA1. -- diff --git a/Github/GitData/References.hs b/src/GitHub/Endpoints/GitData/References.hs similarity index 97% rename from Github/GitData/References.hs rename to src/GitHub/Endpoints/GitData/References.hs index 81f24eac..a57c7c6a 100644 --- a/Github/GitData/References.hs +++ b/src/GitHub/Endpoints/GitData/References.hs @@ -7,7 +7,7 @@ -- The underlying git references on a Github repo, exposed for the world to -- see. The git internals documentation will also prove handy for understanding -- these. API documentation at . -module Github.GitData.References ( +module GitHub.Endpoints.GitData.References ( reference, reference', referenceR, @@ -17,14 +17,14 @@ module Github.GitData.References ( createReference, createReferenceR, namespacedReferences, - module Github.Data, + module GitHub.Data, ) where import Data.Aeson.Compat (encode) import Data.Vector (Vector) -import Github.Data -import Github.Request +import GitHub.Data +import GitHub.Request -- | A single reference by the ref name. -- diff --git a/Github/GitData/Trees.hs b/src/GitHub/Endpoints/GitData/Trees.hs similarity index 95% rename from Github/GitData/Trees.hs rename to src/GitHub/Endpoints/GitData/Trees.hs index 268fd603..b9e3b78f 100644 --- a/Github/GitData/Trees.hs +++ b/src/GitHub/Endpoints/GitData/Trees.hs @@ -6,18 +6,18 @@ -- -- The underlying tree of SHA1s and files that make up a git repo. The API is -- described on . -module Github.GitData.Trees ( +module GitHub.Endpoints.GitData.Trees ( tree, tree', treeR, nestedTree, nestedTree', nestedTreeR, - module Github.Data, + module GitHub.Data, ) where -import Github.Data -import Github.Request +import GitHub.Data +import GitHub.Request -- | A tree for a SHA1. -- diff --git a/Github/Issues.hs b/src/GitHub/Endpoints/Issues.hs similarity index 98% rename from Github/Issues.hs rename to src/GitHub/Endpoints/Issues.hs index 949accc4..89c3543b 100644 --- a/Github/Issues.hs +++ b/src/GitHub/Endpoints/Issues.hs @@ -7,7 +7,7 @@ -- Maintainer : Oleg Grenrus -- -- The issues API as described on . -module Github.Issues ( +module GitHub.Endpoints.Issues ( issue, issue', issueR, @@ -21,11 +21,11 @@ module Github.Issues ( editIssue, editIssueR, editOfIssue, - module Github.Data, + module GitHub.Data, ) where -import Github.Data -import Github.Request +import GitHub.Data +import GitHub.Request import Data.Aeson.Compat (encode) import Data.List (intercalate) diff --git a/Github/Issues/Comments.hs b/src/GitHub/Endpoints/Issues/Comments.hs similarity index 97% rename from Github/Issues/Comments.hs rename to src/GitHub/Endpoints/Issues/Comments.hs index 23a8a8d3..d396187b 100644 --- a/Github/Issues/Comments.hs +++ b/src/GitHub/Endpoints/Issues/Comments.hs @@ -6,7 +6,7 @@ -- -- The Github issue comments API from -- . -module Github.Issues.Comments ( +module GitHub.Endpoints.Issues.Comments ( comment, commentR, comments, @@ -16,15 +16,15 @@ module Github.Issues.Comments ( createCommentR, editComment, editCommentR, - module Github.Data, + module GitHub.Data, ) where import Data.Aeson.Compat (encode) import Data.Text (Text) import Data.Vector (Vector) -import Github.Data -import Github.Request +import GitHub.Data +import GitHub.Request -- | A specific comment, by ID. -- diff --git a/Github/Issues/Events.hs b/src/GitHub/Endpoints/Issues/Events.hs similarity index 96% rename from Github/Issues/Events.hs rename to src/GitHub/Endpoints/Issues/Events.hs index 44f93fb5..9793cebb 100644 --- a/Github/Issues/Events.hs +++ b/src/GitHub/Endpoints/Issues/Events.hs @@ -5,7 +5,7 @@ -- -- The Github issue events API, which is described on -- -module Github.Issues.Events ( +module GitHub.Endpoints.Issues.Events ( eventsForIssue, eventsForIssue', eventsForIssueR, @@ -15,13 +15,13 @@ module Github.Issues.Events ( event, event', eventR, - module Github.Data, + module GitHub.Data, ) where import Data.Vector (Vector) -import Github.Data -import Github.Request +import GitHub.Data +import GitHub.Request -- | All events that have happened on an issue. -- diff --git a/Github/Issues/Labels.hs b/src/GitHub/Endpoints/Issues/Labels.hs similarity index 99% rename from Github/Issues/Labels.hs rename to src/GitHub/Endpoints/Issues/Labels.hs index 137c5886..6ff83d02 100644 --- a/Github/Issues/Labels.hs +++ b/src/GitHub/Endpoints/Issues/Labels.hs @@ -7,7 +7,7 @@ -- -- The API for dealing with labels on Github issues as described on -- . -module Github.Issues.Labels ( +module GitHub.Endpoints.Issues.Labels ( labelsOnRepo, labelsOnRepo', labelsOnRepoR, @@ -34,7 +34,7 @@ module Github.Issues.Labels ( labelsOnMilestone, labelsOnMilestone', labelsOnMilestoneR, - module Github.Data, + module GitHub.Data, ) where import Prelude () @@ -44,8 +44,8 @@ import Data.Aeson.Compat (encode, object, (.=)) import Data.Foldable (toList) import Data.Vector (Vector) -import Github.Data -import Github.Request +import GitHub.Data +import GitHub.Request -- | All the labels available to use on any issue in the repo. -- diff --git a/Github/Issues/Milestones.hs b/src/GitHub/Endpoints/Issues/Milestones.hs similarity index 94% rename from Github/Issues/Milestones.hs rename to src/GitHub/Endpoints/Issues/Milestones.hs index b2f8a40e..827c7b95 100644 --- a/Github/Issues/Milestones.hs +++ b/src/GitHub/Endpoints/Issues/Milestones.hs @@ -5,19 +5,19 @@ -- -- The milestones API as described on -- . -module Github.Issues.Milestones ( +module GitHub.Endpoints.Issues.Milestones ( milestones, milestones', milestonesR, milestone, milestoneR, - module Github.Data, + module GitHub.Data, ) where import Data.Vector (Vector) -import Github.Data -import Github.Request +import GitHub.Data +import GitHub.Request -- | All milestones in the repo. -- diff --git a/Github/Organizations.hs b/src/GitHub/Endpoints/Organizations.hs similarity index 95% rename from Github/Organizations.hs rename to src/GitHub/Endpoints/Organizations.hs index 9ebe8e29..ee9609d9 100644 --- a/Github/Organizations.hs +++ b/src/GitHub/Endpoints/Organizations.hs @@ -4,19 +4,19 @@ -- Maintainer : Oleg Grenrus -- -- The orgs API as described on . -module Github.Organizations ( +module GitHub.Endpoints.Organizations ( publicOrganizationsFor, publicOrganizationsFor', publicOrganizationsForR, publicOrganization, publicOrganization', publicOrganizationR, - module Github.Data, + module GitHub.Data, ) where import Data.Vector (Vector) -import Github.Data -import Github.Request +import GitHub.Data +import GitHub.Request -- | The public organizations for a user, given the user's login, with authorization -- diff --git a/Github/Organizations/Members.hs b/src/GitHub/Endpoints/Organizations/Members.hs similarity index 91% rename from Github/Organizations/Members.hs rename to src/GitHub/Endpoints/Organizations/Members.hs index 2bb1058d..721d139e 100644 --- a/Github/Organizations/Members.hs +++ b/src/GitHub/Endpoints/Organizations/Members.hs @@ -5,17 +5,17 @@ -- -- The organization members API as described on -- . -module Github.Organizations.Members ( +module GitHub.Endpoints.Organizations.Members ( membersOf, membersOf', membersOfR, - module Github.Data, + module GitHub.Data, ) where import Data.Vector (Vector) -import Github.Data -import Github.Request +import GitHub.Data +import GitHub.Request -- | All the users who are members of the specified organization, -- | with or without authentication. diff --git a/Github/Organizations/Teams.hs b/src/GitHub/Endpoints/Organizations/Teams.hs similarity index 98% rename from Github/Organizations/Teams.hs rename to src/GitHub/Endpoints/Organizations/Teams.hs index 080f3454..13b126ed 100644 --- a/Github/Organizations/Teams.hs +++ b/src/GitHub/Endpoints/Organizations/Teams.hs @@ -6,7 +6,7 @@ -- -- The GithubOwner teams API as described on -- . -module Github.Organizations.Teams ( +module GitHub.Endpoints.Organizations.Teams ( teamsOf, teamsOf', teamsOfR, @@ -28,7 +28,7 @@ module Github.Organizations.Teams ( deleteTeamMembershipForR, listTeamsCurrent', listTeamsCurrentR, - module Github.Data, + module GitHub.Data, ) where import Prelude () @@ -37,8 +37,8 @@ import Prelude.Compat import Data.Aeson.Compat (encode) import Data.Vector (Vector) -import Github.Data -import Github.Request +import GitHub.Data +import GitHub.Request -- | List teams. List the teams of an GithubOwner. -- When authenticated, lists private teams visible to the authenticated user. diff --git a/Github/PullRequests.hs b/src/GitHub/Endpoints/PullRequests.hs similarity index 98% rename from Github/PullRequests.hs rename to src/GitHub/Endpoints/PullRequests.hs index fc84e480..cd5a19aa 100644 --- a/Github/PullRequests.hs +++ b/src/GitHub/Endpoints/PullRequests.hs @@ -7,7 +7,7 @@ -- -- The pull requests API as documented at -- . -module Github.PullRequests ( +module GitHub.Endpoints.PullRequests ( pullRequestsFor'', pullRequestsFor', pullRequestsFor, @@ -29,11 +29,11 @@ module Github.PullRequests ( isPullRequestMergedR, mergePullRequest, mergePullRequestR, - module Github.Data + module GitHub.Data ) where -import Github.Data -import Github.Request +import GitHub.Data +import GitHub.Request import Data.Aeson.Compat (Value, encode, object, (.=)) import Data.Vector (Vector) diff --git a/Github/PullRequests/ReviewComments.hs b/src/GitHub/Endpoints/PullRequests/ReviewComments.hs similarity index 94% rename from Github/PullRequests/ReviewComments.hs rename to src/GitHub/Endpoints/PullRequests/ReviewComments.hs index e9016f6d..a112cc2a 100644 --- a/Github/PullRequests/ReviewComments.hs +++ b/src/GitHub/Endpoints/PullRequests/ReviewComments.hs @@ -5,17 +5,17 @@ -- -- The pull request review comments API as described at -- . -module Github.PullRequests.ReviewComments ( +module GitHub.Endpoints.PullRequests.ReviewComments ( pullRequestReviewCommentsIO, pullRequestReviewCommentsR, pullRequestReviewComment, pullRequestReviewCommentR, - module Github.Data, + module GitHub.Data, ) where import Data.Vector (Vector) -import Github.Data -import Github.Request +import GitHub.Data +import GitHub.Request -- | All the comments on a pull request with the given ID. -- diff --git a/Github/Repos.hs b/src/GitHub/Endpoints/Repos.hs similarity index 99% rename from Github/Repos.hs rename to src/GitHub/Endpoints/Repos.hs index 2c6ed7b8..254a1dee 100644 --- a/Github/Repos.hs +++ b/src/GitHub/Endpoints/Repos.hs @@ -9,7 +9,7 @@ -- -- The Github Repos API, as documented at -- -module Github.Repos ( +module GitHub.Endpoints.Repos ( -- * Querying repositories currentUserRepos, currentUserReposR, @@ -56,7 +56,7 @@ module Github.Repos ( deleteRepoR, -- * Data - module Github.Data, + module GitHub.Data, ) where import Prelude () @@ -66,8 +66,8 @@ import Control.Applicative ((<|>)) import Data.Aeson.Compat (encode) import Data.Vector (Vector) -import Github.Data -import Github.Request +import GitHub.Data +import GitHub.Request import qualified Data.ByteString.Char8 as BS8 diff --git a/Github/Repos/Collaborators.hs b/src/GitHub/Endpoints/Repos/Collaborators.hs similarity index 95% rename from Github/Repos/Collaborators.hs rename to src/GitHub/Endpoints/Repos/Collaborators.hs index a418d970..d6f3f62d 100644 --- a/Github/Repos/Collaborators.hs +++ b/src/GitHub/Endpoints/Repos/Collaborators.hs @@ -5,18 +5,18 @@ -- -- The repo collaborators API as described on -- . -module Github.Repos.Collaborators ( +module GitHub.Endpoints.Repos.Collaborators ( collaboratorsOn, collaboratorsOn', collaboratorsOnR, isCollaboratorOn, isCollaboratorOnR, - module Github.Data, + module GitHub.Data, ) where import Data.Vector (Vector) -import Github.Data -import Github.Request +import GitHub.Data +import GitHub.Request -- | All the users who have collaborated on a repo. -- diff --git a/Github/Repos/Comments.hs b/src/GitHub/Endpoints/Repos/Comments.hs similarity index 96% rename from Github/Repos/Comments.hs rename to src/GitHub/Endpoints/Repos/Comments.hs index 37774424..a0576b22 100644 --- a/Github/Repos/Comments.hs +++ b/src/GitHub/Endpoints/Repos/Comments.hs @@ -6,7 +6,7 @@ -- -- The repo commits API as described on -- . -module Github.Repos.Comments ( +module GitHub.Endpoints.Repos.Comments ( commentsFor, commentsFor', commentsForR, @@ -16,12 +16,12 @@ module Github.Repos.Comments ( commitCommentFor, commitCommentFor', commitCommentForR, - module Github.Data, + module GitHub.Data, ) where import Data.Vector (Vector) -import Github.Data -import Github.Request +import GitHub.Data +import GitHub.Request -- | All the comments on a Github repo. -- diff --git a/Github/Repos/Commits.hs b/src/GitHub/Endpoints/Repos/Commits.hs similarity index 97% rename from Github/Repos/Commits.hs rename to src/GitHub/Endpoints/Repos/Commits.hs index 5a6ce8cd..68dc42c2 100644 --- a/Github/Repos/Commits.hs +++ b/src/GitHub/Endpoints/Repos/Commits.hs @@ -7,7 +7,7 @@ -- -- The repo commits API as described on -- . -module Github.Repos.Commits ( +module GitHub.Endpoints.Repos.Commits ( CommitQueryOption(..), commitsFor, commitsFor', @@ -21,7 +21,7 @@ module Github.Repos.Commits ( diff, diff', diffR, - module Github.Data, + module GitHub.Data, ) where import Data.Time.ISO8601 (formatISO8601) @@ -31,8 +31,8 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BS8 import qualified Data.Text.Encoding as TE -import Github.Data -import Github.Request +import GitHub.Data +import GitHub.Request renderCommitQueryOption :: CommitQueryOption -> (BS.ByteString, Maybe BS.ByteString) renderCommitQueryOption (CommitQuerySha sha) = ("sha", Just $ TE.encodeUtf8 sha) diff --git a/Github/Repos/Forks.hs b/src/GitHub/Endpoints/Repos/Forks.hs similarity index 91% rename from Github/Repos/Forks.hs rename to src/GitHub/Endpoints/Repos/Forks.hs index 57abec42..1fd823ef 100644 --- a/Github/Repos/Forks.hs +++ b/src/GitHub/Endpoints/Repos/Forks.hs @@ -5,16 +5,16 @@ -- -- Hot forking action, as described at -- . -module Github.Repos.Forks ( +module GitHub.Endpoints.Repos.Forks ( forksFor, forksFor', forksForR, - module Github.Data, + module GitHub.Data, ) where import Data.Vector (Vector) -import Github.Data -import Github.Request +import GitHub.Data +import GitHub.Request -- | All the repos that are forked off the given repo. -- diff --git a/Github/Repos/Webhooks.hs b/src/GitHub/Endpoints/Repos/Webhooks.hs similarity index 98% rename from Github/Repos/Webhooks.hs rename to src/GitHub/Endpoints/Repos/Webhooks.hs index d6d4afa6..6f2908a7 100644 --- a/Github/Repos/Webhooks.hs +++ b/src/GitHub/Endpoints/Repos/Webhooks.hs @@ -7,8 +7,7 @@ -- The webhooks API, as described at -- -- - -module Github.Repos.Webhooks ( +module GitHub.Endpoints.Repos.Webhooks ( -- * Querying repositories webhooksFor', webhooksForR, @@ -40,8 +39,8 @@ import Prelude.Compat import Data.Aeson.Compat (encode) import Data.Vector (Vector) -import Github.Data -import Github.Request +import GitHub.Data +import GitHub.Request webhooksFor' :: GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error (Vector RepoWebhook)) webhooksFor' auth user repo = diff --git a/Github/Search.hs b/src/GitHub/Endpoints/Search.hs similarity index 96% rename from Github/Search.hs rename to src/GitHub/Endpoints/Search.hs index fcc0f342..47ef063f 100644 --- a/Github/Search.hs +++ b/src/GitHub/Endpoints/Search.hs @@ -6,7 +6,7 @@ -- -- The Github Search API, as described at -- . -module Github.Search( +module GitHub.Endpoints.Search( searchRepos', searchRepos, searchReposR, @@ -16,15 +16,15 @@ module Github.Search( searchIssues', searchIssues, searchIssuesR, - module Github.Data, + module GitHub.Data, ) where import Data.Text (Text) import qualified Data.Text.Encoding as TE -import Github.Data -import Github.Request +import GitHub.Data +import GitHub.Request -- | Perform a repository search. -- With authentication. diff --git a/Github/Users.hs b/src/GitHub/Endpoints/Users.hs similarity index 94% rename from Github/Users.hs rename to src/GitHub/Endpoints/Users.hs index 3841a126..8b91664f 100644 --- a/Github/Users.hs +++ b/src/GitHub/Endpoints/Users.hs @@ -6,18 +6,18 @@ -- -- The Github Users API, as described at -- . -module Github.Users ( +module GitHub.Endpoints.Users ( userInfoFor, userInfoFor', userInfoForR, ownerInfoForR, userInfoCurrent', userInfoCurrentR, - module Github.Data, + module GitHub.Data, ) where -import Github.Data -import Github.Request +import GitHub.Data +import GitHub.Request -- | The information for a single user, by login name. -- With authentification diff --git a/Github/Users/Followers.hs b/src/GitHub/Endpoints/Users/Followers.hs similarity index 93% rename from Github/Users/Followers.hs rename to src/GitHub/Endpoints/Users/Followers.hs index 886758c5..a6216067 100644 --- a/Github/Users/Followers.hs +++ b/src/GitHub/Endpoints/Users/Followers.hs @@ -5,18 +5,18 @@ -- -- The user followers API as described on -- . -module Github.Users.Followers ( +module GitHub.Endpoints.Users.Followers ( usersFollowing, usersFollowedBy, usersFollowingR, usersFollowedByR, - module Github.Data, + module GitHub.Data, ) where import Data.Vector (Vector) -import Github.Data -import Github.Request +import GitHub.Data +import GitHub.Request -- | All the users following the given user. -- diff --git a/Github/Request.hs b/src/GitHub/Request.hs similarity index 98% rename from Github/Request.hs rename to src/GitHub/Request.hs index e68a8cb5..db1182fe 100644 --- a/Github/Request.hs +++ b/src/GitHub/Request.hs @@ -32,7 +32,7 @@ -- > -- | Lift request into GithubMonad -- > githubRequest :: GH.GithubRequest 'False a -> GithubMonad a -- > githubRequest = singleton -module Github.Request ( +module GitHub.Request ( -- * Types GithubRequest(..), CommandMethod(..), @@ -91,9 +91,9 @@ import qualified Data.ByteString.Lazy as LBS import qualified Data.Text as T import qualified Data.Vector as V -import Github.Auth (GithubAuth (..)) -import Github.Data (Error (..)) -import Github.Data.Request +import GitHub.Auth (GithubAuth (..)) +import GitHub.Data (Error (..)) +import GitHub.Data.Request -- | Execute 'GithubRequest' in 'IO' executeRequest :: GithubAuth -> GithubRequest k a -> IO (Either Error a) From f1cf832f060c80b57a339c815c2ff4b0588bc099 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Wed, 20 Jan 2016 21:38:53 +0200 Subject: [PATCH 171/510] Drop Github prefix from data names and constructors --- samples/Gists/Comments/ShowComment.hs | 4 +- samples/Gists/Comments/ShowComments.hs | 4 +- samples/GitData/Commits/GitShow.hs | 2 +- .../GitData/References/GitCreateReference.hs | 2 +- samples/Issues/Comments/ShowComment.hs | 2 +- samples/Issues/Comments/ShowComments.hs | 2 +- samples/Issues/CreateIssue.hs | 4 +- samples/Issues/EditIssue.hs | 4 +- samples/Issues/Events/ShowEvent.hs | 2 +- samples/Issues/Events/ShowIssueEvents.hs | 2 +- samples/Issues/Events/ShowRepoEvents.hs | 2 +- samples/Issues/IssueReport/Issues.hs | 4 +- .../Issues/IssueReport/IssuesEnterprise.hs | 4 +- samples/Issues/Labels/CreateLabels.hs | 2 +- samples/Issues/Milestones/ShowMilestone.hs | 4 +- samples/Issues/Milestones/ShowMilestones.hs | 4 +- samples/Issues/ShowIssue.hs | 2 +- samples/Issues/ShowRepoIssues.hs | 2 +- samples/Operational/Operational.hs | 12 +- samples/Organizations/Teams/CreateTeamFor.hs | 2 +- .../Teams/ListTeamsForOrganization.hs | 2 +- samples/Pulls/IsMergedPull.hs | 2 +- samples/Pulls/ListPulls.hs | 6 +- samples/Pulls/MergePull.hs | 2 +- samples/Pulls/ReviewComments/ListComments.hs | 2 +- samples/Pulls/ReviewComments/ShowComment.hs | 2 +- samples/Pulls/ShowPull.hs | 4 +- samples/Pulls/UpdatePull.hs | 2 +- .../Repos/Collaborators/ListCollaborators.hs | 2 +- samples/Repos/Commits/CommitComment.hs | 2 +- samples/Repos/Commits/CommitComments.hs | 2 +- samples/Repos/Commits/GitLog.hs | 2 +- samples/Repos/Commits/GitShow.hs | 2 +- samples/Repos/Commits/RepoComments.hs | 2 +- samples/Repos/Forks/ListForks.hs | 2 +- samples/Repos/ListOrgRepos.hs | 2 +- samples/Repos/ListUserRepos.hs | 2 +- samples/Repos/ShowRepo.hs | 2 +- samples/Repos/Starring/ListStarred.hs | 2 +- samples/Repos/Watching/ListWatched.hs | 2 +- samples/Repos/Watching/ListWatchers.hs | 2 +- samples/Repos/Webhooks/CreateWebhook.hs | 2 +- samples/Repos/Webhooks/DeleteWebhook.hs | 2 +- samples/Repos/Webhooks/EditWebhook.hs | 2 +- samples/Repos/Webhooks/ListWebhook.hs | 2 +- samples/Repos/Webhooks/ListWebhooks.hs | 2 +- samples/Repos/Webhooks/PingWebhook.hs | 2 +- samples/Repos/Webhooks/TestPushWebhook.hs | 2 +- samples/Search/SearchIssues.hs | 2 +- samples/Search/SearchRepos.hs | 2 +- samples/Teams/DeleteTeam.hs | 2 +- samples/Teams/EditTeam.hs | 2 +- samples/Teams/ListTeamsCurrent.hs | 2 +- .../Teams/Memberships/AddTeamMembershipFor.hs | 2 +- .../Memberships/DeleteTeamMembershipFor.hs | 2 +- .../Memberships/TeamMembershipInfoFor.hs | 2 +- samples/Teams/TeamInfoFor.hs | 2 +- samples/src/Common.hs | 4 +- spec/GitHub/ActivitySpec.hs | 6 +- spec/GitHub/CommitsSpec.hs | 6 +- spec/GitHub/OrganizationsSpec.hs | 6 +- spec/GitHub/ReposSpec.hs | 12 +- spec/GitHub/UsersSpec.hs | 10 +- src/GitHub.hs | 12 +- src/GitHub/Auth.hs | 17 +- src/GitHub/Data.hs | 8 +- src/GitHub/Data/Definitions.hs | 24 +-- src/GitHub/Data/Repos.hs | 21 +-- src/GitHub/Data/Request.hs | 44 ++--- src/GitHub/Data/Webhooks/Validate.hs | 6 +- src/GitHub/Endpoints/Activity/Starring.hs | 18 +-- src/GitHub/Endpoints/Activity/Watching.hs | 20 +-- src/GitHub/Endpoints/Gists.hs | 16 +- src/GitHub/Endpoints/Gists/Comments.hs | 10 +- src/GitHub/Endpoints/GitData/Blobs.hs | 14 +- src/GitHub/Endpoints/GitData/Commits.hs | 8 +- src/GitHub/Endpoints/GitData/References.hs | 34 ++-- src/GitHub/Endpoints/GitData/Trees.hs | 20 +-- src/GitHub/Endpoints/Issues.hs | 34 ++-- src/GitHub/Endpoints/Issues/Comments.hs | 34 ++-- src/GitHub/Endpoints/Issues/Events.hs | 32 ++-- src/GitHub/Endpoints/Issues/Labels.hs | 112 ++++++------- src/GitHub/Endpoints/Issues/Milestones.hs | 18 +-- src/GitHub/Endpoints/Organizations.hs | 16 +- src/GitHub/Endpoints/Organizations/Members.hs | 8 +- src/GitHub/Endpoints/Organizations/Teams.hs | 88 +++++----- src/GitHub/Endpoints/PullRequests.hs | 74 ++++----- .../Endpoints/PullRequests/ReviewComments.hs | 14 +- src/GitHub/Endpoints/Repos.hs | 152 +++++++++--------- src/GitHub/Endpoints/Repos/Collaborators.hs | 20 +-- src/GitHub/Endpoints/Repos/Comments.hs | 26 +-- src/GitHub/Endpoints/Repos/Commits.hs | 38 ++--- src/GitHub/Endpoints/Repos/Forks.hs | 10 +- src/GitHub/Endpoints/Repos/Webhooks.hs | 52 +++--- src/GitHub/Endpoints/Search.hs | 24 +-- src/GitHub/Endpoints/Users.hs | 24 +-- src/GitHub/Endpoints/Users/Followers.hs | 8 +- src/GitHub/Request.hs | 107 ++++++------ 98 files changed, 678 insertions(+), 675 deletions(-) diff --git a/samples/Gists/Comments/ShowComment.hs b/samples/Gists/Comments/ShowComment.hs index 7338f119..093d21d5 100644 --- a/samples/Gists/Comments/ShowComment.hs +++ b/samples/Gists/Comments/ShowComment.hs @@ -10,7 +10,7 @@ main = do formatComment comment = (Github.githubOwnerLogin $ Github.gistCommentUser comment) ++ "\n" ++ - (formatGithubDate $ Github.gistCommentUpdatedAt comment) ++ "\n\n" ++ + (formatDate $ Github.gistCommentUpdatedAt comment) ++ "\n\n" ++ (Github.gistCommentBody comment) -formatGithubDate = show . Github.fromGithubDate +formatDate = show . Github.fromDate diff --git a/samples/Gists/Comments/ShowComments.hs b/samples/Gists/Comments/ShowComments.hs index 86011660..9473a71c 100644 --- a/samples/Gists/Comments/ShowComments.hs +++ b/samples/Gists/Comments/ShowComments.hs @@ -11,7 +11,7 @@ main = do formatComment comment = (Github.githubOwnerLogin $ Github.gistCommentUser comment) ++ "\n" ++ - (formatGithubDate $ Github.gistCommentUpdatedAt comment) ++ "\n\n" ++ + (formatDate $ Github.gistCommentUpdatedAt comment) ++ "\n\n" ++ (Github.gistCommentBody comment) -formatGithubDate = show . Github.fromGithubDate +formatDate = show . Github.fromDate diff --git a/samples/GitData/Commits/GitShow.hs b/samples/GitData/Commits/GitShow.hs index ea234b60..042dd812 100644 --- a/samples/GitData/Commits/GitShow.hs +++ b/samples/GitData/Commits/GitShow.hs @@ -13,7 +13,7 @@ formatCommit :: Github.GitCommit -> String formatCommit commit = "commit " ++ (fromJust $ Github.gitCommitSha commit) ++ "\nAuthor: " ++ (formatAuthor author) ++ - "\nDate: " ++ (show $ Github.fromGithubDate $ Github.gitUserDate author) ++ + "\nDate: " ++ (show $ Github.fromDate $ Github.gitUserDate author) ++ "\n\n\t" ++ (Github.gitCommitMessage commit) ++ "\n" where author = Github.gitCommitAuthor commit diff --git a/samples/GitData/References/GitCreateReference.hs b/samples/GitData/References/GitCreateReference.hs index b9f5007f..bf3d15b0 100644 --- a/samples/GitData/References/GitCreateReference.hs +++ b/samples/GitData/References/GitCreateReference.hs @@ -5,7 +5,7 @@ import Github.GitData.References main :: IO () main = do - let auth = Auth.GithubOAuth "oauthtoken" + let auth = Auth.OAuth "oauthtoken" newlyCreatedGitRef <- createReference auth "myrepo" "myowner" NewGitReference { newGitReferenceRef = "refs/heads/fav_tag" ,newGitReferenceSha = "aa218f56b14c9653891f9e74264a383fa43fefbd" diff --git a/samples/Issues/Comments/ShowComment.hs b/samples/Issues/Comments/ShowComment.hs index 94012d7e..ccfff2fe 100644 --- a/samples/Issues/Comments/ShowComment.hs +++ b/samples/Issues/Comments/ShowComment.hs @@ -11,5 +11,5 @@ main = do formatComment comment = (Github.githubOwnerLogin $ Github.issueCommentUser comment) ++ " commented " ++ - (show $ Github.fromGithubDate $ Github.issueCommentUpdatedAt comment) ++ + (show $ Github.fromDate $ Github.issueCommentUpdatedAt comment) ++ "\n" ++ (Github.issueCommentBody comment) diff --git a/samples/Issues/Comments/ShowComments.hs b/samples/Issues/Comments/ShowComments.hs index c8ee71bc..2b8466ed 100644 --- a/samples/Issues/Comments/ShowComments.hs +++ b/samples/Issues/Comments/ShowComments.hs @@ -13,5 +13,5 @@ main = do formatComment comment = (Github.githubOwnerLogin $ Github.issueCommentUser comment) ++ " commented " ++ - (show $ Github.fromGithubDate $ Github.issueCommentUpdatedAt comment) ++ + (show $ Github.fromDate $ Github.issueCommentUpdatedAt comment) ++ "\n" ++ (Github.issueCommentBody comment) diff --git a/samples/Issues/CreateIssue.hs b/samples/Issues/CreateIssue.hs index 510e874c..296013f5 100644 --- a/samples/Issues/CreateIssue.hs +++ b/samples/Issues/CreateIssue.hs @@ -4,7 +4,7 @@ module CreateIssue where import qualified Github.Auth as Github import qualified Github.Issues as Github main = do - let auth = Github.GithubBasicAuth "user" "password" + let auth = Github.BasicAuth "user" "password" newiss = (Github.newIssue "A new issue") { Github.newIssueBody = Just "Issue description text goes here" } @@ -16,7 +16,7 @@ main = do formatIssue issue = (Github.githubOwnerLogin $ Github.issueUser issue) ++ " opened this issue " ++ - (show $ Github.fromGithubDate $ Github.issueCreatedAt issue) ++ "\n" ++ + (show $ Github.fromDate $ Github.issueCreatedAt issue) ++ "\n" ++ (Github.issueState issue) ++ " with " ++ (show $ Github.issueComments issue) ++ " comments" ++ "\n\n" ++ (Github.issueTitle issue) diff --git a/samples/Issues/EditIssue.hs b/samples/Issues/EditIssue.hs index 5d5d8a6f..01948992 100644 --- a/samples/Issues/EditIssue.hs +++ b/samples/Issues/EditIssue.hs @@ -5,7 +5,7 @@ import qualified Github.Auth as Github import qualified Github.Issues as Github main = do - let auth = Github.GithubBasicAuth "user" "password" + let auth = Github.BasicAuth "user" "password" issueid = 3 edit = Github.editOfIssue { Github.editIssueState = Just "closed" } possibleIssue <- Github.editIssue auth "thoughtbot" "paperclip" issueid edit @@ -16,7 +16,7 @@ main = do formatIssue issue = (Github.githubOwnerLogin $ Github.issueUser issue) ++ " opened this issue " ++ - (show $ Github.fromGithubDate $ Github.issueCreatedAt issue) ++ "\n" ++ + (show $ Github.fromDate $ Github.issueCreatedAt issue) ++ "\n" ++ (Github.issueState issue) ++ " with " ++ (show $ Github.issueComments issue) ++ " comments" ++ "\n\n" ++ (Github.issueTitle issue) diff --git a/samples/Issues/Events/ShowEvent.hs b/samples/Issues/Events/ShowEvent.hs index 1c3d5a3c..bf7b1f1e 100644 --- a/samples/Issues/Events/ShowEvent.hs +++ b/samples/Issues/Events/ShowEvent.hs @@ -34,5 +34,5 @@ formatEvent event = formatEvent' event (Github.eventType event) "Issue assigned to " ++ loginName event ++ " on " ++ createdAt event loginName = Github.githubOwnerLogin . Github.eventActor -createdAt = show . Github.fromGithubDate . Github.eventCreatedAt +createdAt = show . Github.fromDate . Github.eventCreatedAt withCommitId event f = maybe "" f (Github.eventCommitId event) diff --git a/samples/Issues/Events/ShowIssueEvents.hs b/samples/Issues/Events/ShowIssueEvents.hs index dc8a56e9..f4553033 100644 --- a/samples/Issues/Events/ShowIssueEvents.hs +++ b/samples/Issues/Events/ShowIssueEvents.hs @@ -34,5 +34,5 @@ formatEvent event = formatEvent' event (Github.eventType event) "Issue assigned to " ++ loginName event ++ " on " ++ createdAt event loginName = Github.githubOwnerLogin . Github.eventActor -createdAt = show . Github.fromGithubDate . Github.eventCreatedAt +createdAt = show . Github.fromDate . Github.eventCreatedAt withCommitId event f = maybe "" f (Github.eventCommitId event) diff --git a/samples/Issues/Events/ShowRepoEvents.hs b/samples/Issues/Events/ShowRepoEvents.hs index df2a6ba0..fc2e66f8 100644 --- a/samples/Issues/Events/ShowRepoEvents.hs +++ b/samples/Issues/Events/ShowRepoEvents.hs @@ -36,6 +36,6 @@ formatEvent event = "assigned to " ++ loginName event ++ " on " ++ createdAt event loginName = Github.githubOwnerLogin . Github.eventActor -createdAt = show . Github.fromGithubDate . Github.eventCreatedAt +createdAt = show . Github.fromDate . Github.eventCreatedAt withCommitId event f = maybe "" f (Github.eventCommitId event) issueNumber = show . Github.issueNumber . fromJust . Github.eventIssue diff --git a/samples/Issues/IssueReport/Issues.hs b/samples/Issues/IssueReport/Issues.hs index f60f9808..14ce129c 100644 --- a/samples/Issues/IssueReport/Issues.hs +++ b/samples/Issues/IssueReport/Issues.hs @@ -8,8 +8,8 @@ import Report -- The example requires wl-pprint module "The Wadler/Leijen Pretty Printer" import Text.PrettyPrint.ANSI.Leijen -auth :: Maybe Github.GithubAuth -auth = Just $ Github.GithubBasicAuth "yourgithub id" "somepassword" +auth :: Maybe Github.Auth +auth = Just $ Github.BasicAuth "yourgithub id" "somepassword" mkIssue :: ReportedIssue -> Doc mkIssue (Issue n t h) = hsep [ diff --git a/samples/Issues/IssueReport/IssuesEnterprise.hs b/samples/Issues/IssueReport/IssuesEnterprise.hs index 3dc8719e..6b9f899c 100644 --- a/samples/Issues/IssueReport/IssuesEnterprise.hs +++ b/samples/Issues/IssueReport/IssuesEnterprise.hs @@ -8,8 +8,8 @@ import Report -- The example requires wl-pprint module "The Wadler/Leijen Pretty Printer" import Text.PrettyPrint.ANSI.Leijen -auth :: Maybe Github.GithubAuth -auth = Just $ Github.GithubEnterpriseOAuth +auth :: Maybe Github.Auth +auth = Just $ Github.EnterpriseOAuth "https://github.example.com/api" "1a79a4d60de6718e8e5b326e338ae533" diff --git a/samples/Issues/Labels/CreateLabels.hs b/samples/Issues/Labels/CreateLabels.hs index 2519fc83..d68f6f31 100644 --- a/samples/Issues/Labels/CreateLabels.hs +++ b/samples/Issues/Labels/CreateLabels.hs @@ -5,7 +5,7 @@ import Data.List (intercalate) import qualified Github.Auth as Github import qualified Github.Issues.Labels as Github main = do - let auth = Github.GithubBasicAuth "user" "password" + let auth = Github.BasicAuth "user" "password" possibleLabel <- Github.createLabel auth "thoughtbot" "papperclip" "sample label" "ff00ff" case possibleLabel of (Left error) -> putStrLn $ "Error: " ++ show error diff --git a/samples/Issues/Milestones/ShowMilestone.hs b/samples/Issues/Milestones/ShowMilestone.hs index d49a4279..b2a3cf0a 100644 --- a/samples/Issues/Milestones/ShowMilestone.hs +++ b/samples/Issues/Milestones/ShowMilestone.hs @@ -20,5 +20,5 @@ formatDueOn Nothing = "" formatDueOn (Just milestoneDate) = ", is due on " ++ dueOn milestoneDate loginName = Github.githubOwnerLogin . Github.milestoneCreator -createdAt = show . Github.fromGithubDate . Github.milestoneCreatedAt -dueOn = show . Github.fromGithubDate +createdAt = show . Github.fromDate . Github.milestoneCreatedAt +dueOn = show . Github.fromDate diff --git a/samples/Issues/Milestones/ShowMilestones.hs b/samples/Issues/Milestones/ShowMilestones.hs index 45163f04..5b109626 100644 --- a/samples/Issues/Milestones/ShowMilestones.hs +++ b/samples/Issues/Milestones/ShowMilestones.hs @@ -20,5 +20,5 @@ formatDueOn Nothing = "" formatDueOn (Just milestoneDate) = ", is due on " ++ dueOn milestoneDate loginName = Github.githubOwnerLogin . Github.milestoneCreator -createdAt = show . Github.fromGithubDate . Github.milestoneCreatedAt -dueOn = show . Github.fromGithubDate +createdAt = show . Github.fromDate . Github.milestoneCreatedAt +dueOn = show . Github.fromDate diff --git a/samples/Issues/ShowIssue.hs b/samples/Issues/ShowIssue.hs index 981e6dca..804742ef 100644 --- a/samples/Issues/ShowIssue.hs +++ b/samples/Issues/ShowIssue.hs @@ -11,7 +11,7 @@ main = do formatIssue issue = (Github.githubOwnerLogin $ Github.issueUser issue) ++ " opened this issue " ++ - (show $ Github.fromGithubDate $ Github.issueCreatedAt issue) ++ "\n" ++ + (show $ Github.fromDate $ Github.issueCreatedAt issue) ++ "\n" ++ (Github.issueState issue) ++ " with " ++ (show $ Github.issueComments issue) ++ " comments" ++ "\n\n" ++ (Github.issueTitle issue) diff --git a/samples/Issues/ShowRepoIssues.hs b/samples/Issues/ShowRepoIssues.hs index f55044fe..b6f26e68 100644 --- a/samples/Issues/ShowRepoIssues.hs +++ b/samples/Issues/ShowRepoIssues.hs @@ -14,7 +14,7 @@ main = do formatIssue issue = (Github.githubOwnerLogin $ Github.issueUser issue) ++ " opened this issue " ++ - (show $ Github.fromGithubDate $ Github.issueCreatedAt issue) ++ "\n" ++ + (show $ Github.fromDate $ Github.issueCreatedAt issue) ++ "\n" ++ (Github.issueState issue) ++ " with " ++ (show $ Github.issueComments issue) ++ " comments" ++ "\n\n" ++ (Github.issueTitle issue) diff --git a/samples/Operational/Operational.hs b/samples/Operational/Operational.hs index 734f2416..7819914e 100644 --- a/samples/Operational/Operational.hs +++ b/samples/Operational/Operational.hs @@ -12,16 +12,16 @@ import Network.HTTP.Client.TLS (tlsManagerSettings) import qualified GitHub as GH -type GithubMonad a = Program (GH.GithubRequest 'False) a +type GithubMonad a = Program (GH.Request 'False) a -runGithubMonad :: Manager -> GH.GithubAuth -> GithubMonad a -> ExceptT GH.Error IO a -runGithubMonad mgr auth m = case view m of +runMonad :: Manager -> GH.Auth -> GithubMonad a -> ExceptT GH.Error IO a +runMonad mgr auth m = case view m of Return a -> return a req :>>= k -> do b <- ExceptT $ GH.executeRequestWithMgr mgr auth req - runGithubMonad mgr auth (k b) + runMonad mgr auth (k b) -githubRequest :: GH.GithubRequest 'False a -> GithubMonad a +githubRequest :: GH.Request 'False a -> GithubMonad a githubRequest = singleton main :: IO () @@ -31,7 +31,7 @@ main = do case auth' of Nothing -> return () Just auth -> do - owner <- runExceptT $ runGithubMonad manager auth $ do + owner <- runExceptT $ runMonad manager auth $ do repo <- githubRequest $ GH.repositoryR "phadej" "github" githubRequest $ GH.ownerInfoForR (GH.simpleOwnerLogin . GH.repoOwner $ repo) print owner diff --git a/samples/Organizations/Teams/CreateTeamFor.hs b/samples/Organizations/Teams/CreateTeamFor.hs index 9cb29aea..6004b100 100644 --- a/samples/Organizations/Teams/CreateTeamFor.hs +++ b/samples/Organizations/Teams/CreateTeamFor.hs @@ -11,7 +11,7 @@ main = do result <- case args of [token, org, team, desc, repos] -> Github.createTeamFor' - (Github.GithubOAuth token) + (Github.OAuth token) org (Github.CreateTeam team (Just desc) (read repos :: [String]) Github.PermissionPull) _ -> diff --git a/samples/Organizations/Teams/ListTeamsForOrganization.hs b/samples/Organizations/Teams/ListTeamsForOrganization.hs index e29f147d..52331e82 100644 --- a/samples/Organizations/Teams/ListTeamsForOrganization.hs +++ b/samples/Organizations/Teams/ListTeamsForOrganization.hs @@ -9,7 +9,7 @@ import System.Environment (getArgs) main = do args <- getArgs result <- case args of - [team, token] -> Github.teamsOf' (Just $ Github.GithubOAuth token) team + [team, token] -> Github.teamsOf' (Just $ Github.OAuth token) team [team] -> Github.teamsOf team _ -> error "usage: ListTeamsForOrganization [auth token]" case result of diff --git a/samples/Pulls/IsMergedPull.hs b/samples/Pulls/IsMergedPull.hs index 8dce2bec..8e772f17 100644 --- a/samples/Pulls/IsMergedPull.hs +++ b/samples/Pulls/IsMergedPull.hs @@ -5,7 +5,7 @@ import Github.Auth main :: IO () main = do - mergeResult <- Github.isPullRequestMerged (GithubOAuth "authtoken") "thoughtbot" "paperclip" 575 + mergeResult <- Github.isPullRequestMerged (OAuth "authtoken") "thoughtbot" "paperclip" 575 case mergeResult of (Left err) -> putStrLn $ "Error: " ++ (show err) (Right stat) -> putStrLn $ (show stat) diff --git a/samples/Pulls/ListPulls.hs b/samples/Pulls/ListPulls.hs index 58b9adce..747afb00 100644 --- a/samples/Pulls/ListPulls.hs +++ b/samples/Pulls/ListPulls.hs @@ -15,9 +15,9 @@ formatPullRequest pullRequest = (take 80 $ Github.pullRequestBody pullRequest) ++ "\n" ++ (Github.githubOwnerLogin $ Github.pullRequestUser pullRequest) ++ " submitted to thoughtbot/paperclip " ++ - (formatGithubDate $ Github.pullRequestCreatedAt pullRequest) ++ + (formatDate $ Github.pullRequestCreatedAt pullRequest) ++ " updated " ++ - (formatGithubDate $ Github.pullRequestUpdatedAt pullRequest) ++ "\n" ++ + (formatDate $ Github.pullRequestUpdatedAt pullRequest) ++ "\n" ++ (Github.pullRequestHtmlUrl pullRequest) -formatGithubDate = show . Github.fromGithubDate +formatDate = show . Github.fromDate diff --git a/samples/Pulls/MergePull.hs b/samples/Pulls/MergePull.hs index 556512d8..c67902c2 100644 --- a/samples/Pulls/MergePull.hs +++ b/samples/Pulls/MergePull.hs @@ -5,7 +5,7 @@ import Github.Auth main :: IO () main = do - mergeResult <- Github.mergePullRequest (GithubOAuth "authtoken") "thoughtbot" "paperclip" 575 (Just "Merge message") + mergeResult <- Github.mergePullRequest (OAuth "authtoken") "thoughtbot" "paperclip" 575 (Just "Merge message") case mergeResult of (Left err) -> putStrLn $ "Error: " ++ (show err) (Right stat) -> putStrLn $ (show stat) diff --git a/samples/Pulls/ReviewComments/ListComments.hs b/samples/Pulls/ReviewComments/ListComments.hs index 11e9b1b9..f41234f2 100644 --- a/samples/Pulls/ReviewComments/ListComments.hs +++ b/samples/Pulls/ReviewComments/ListComments.hs @@ -16,6 +16,6 @@ formatComment comment = (maybe "" ("\nURL: "++) $ Github.commentHtmlUrl comment) ++ "\n\n" ++ (Github.commentBody comment) -formatAuthor :: Github.GithubOwner -> String +formatAuthor :: Github.Owner -> String formatAuthor user = (Github.githubOwnerLogin user) ++ " (" ++ (Github.githubOwnerUrl user) ++ ")" diff --git a/samples/Pulls/ReviewComments/ShowComment.hs b/samples/Pulls/ReviewComments/ShowComment.hs index 57c5fe21..254fa703 100644 --- a/samples/Pulls/ReviewComments/ShowComment.hs +++ b/samples/Pulls/ReviewComments/ShowComment.hs @@ -16,7 +16,7 @@ formatComment comment = (maybe "" ("\nURL: "++) $ Github.commentHtmlUrl comment) ++ "\n\n" ++ (Github.commentBody comment) -formatAuthor :: Github.GithubOwner -> String +formatAuthor :: Github.Owner -> String formatAuthor user = (Github.githubOwnerLogin user) ++ " (" ++ (Github.githubOwnerUrl user) ++ ")" diff --git a/samples/Pulls/ShowPull.hs b/samples/Pulls/ShowPull.hs index 2388717a..f95a661c 100644 --- a/samples/Pulls/ShowPull.hs +++ b/samples/Pulls/ShowPull.hs @@ -12,7 +12,7 @@ main = do formatPullRequest p = (Github.githubOwnerLogin $ Github.detailedPullRequestUser p) ++ " opened this pull request " ++ - (formatGithubDate $ Github.detailedPullRequestCreatedAt p) ++ "\n" ++ + (formatDate $ Github.detailedPullRequestCreatedAt p) ++ "\n" ++ (Github.detailedPullRequestTitle p) ++ "\n" ++ (Github.detailedPullRequestBody p) ++ "\n" ++ (Github.detailedPullRequestState p) ++ "\n" ++ @@ -21,4 +21,4 @@ formatPullRequest p = (show $ Github.detailedPullRequestComments p) ++ " comments\n" ++ (Github.detailedPullRequestHtmlUrl p) -formatGithubDate = show . Github.fromGithubDate +formatDate = show . Github.fromDate diff --git a/samples/Pulls/UpdatePull.hs b/samples/Pulls/UpdatePull.hs index 68e22fd6..5900b59a 100644 --- a/samples/Pulls/UpdatePull.hs +++ b/samples/Pulls/UpdatePull.hs @@ -6,7 +6,7 @@ import Github.Data main :: IO () main = do - mergeResult <- Github.updatePullRequest (GithubOAuth "authtoken") "repoOwner" "repoName" 22 (EditPullRequest { editPullRequestTitle = Just "Brand new title", editPullRequestBody = Nothing, editPullRequestState = Just EditPullRequestStateClosed }) + mergeResult <- Github.updatePullRequest (OAuth "authtoken") "repoOwner" "repoName" 22 (EditPullRequest { editPullRequestTitle = Just "Brand new title", editPullRequestBody = Nothing, editPullRequestState = Just EditPullRequestStateClosed }) case mergeResult of (Left err) -> putStrLn $ "Error: " ++ (show err) (Right dpr) -> putStrLn . show $ dpr diff --git a/samples/Repos/Collaborators/ListCollaborators.hs b/samples/Repos/Collaborators/ListCollaborators.hs index 6a579fbd..7bba7952 100644 --- a/samples/Repos/Collaborators/ListCollaborators.hs +++ b/samples/Repos/Collaborators/ListCollaborators.hs @@ -10,6 +10,6 @@ main = do (Right collaborators) -> putStrLn $ intercalate "\n" $ map formatAuthor collaborators -formatAuthor :: Github.GithubOwner -> String +formatAuthor :: Github.Owner -> String formatAuthor user = (Github.githubOwnerLogin user) ++ " (" ++ (Github.githubOwnerUrl user) ++ ")" diff --git a/samples/Repos/Commits/CommitComment.hs b/samples/Repos/Commits/CommitComment.hs index 890be574..8b542fe5 100644 --- a/samples/Repos/Commits/CommitComment.hs +++ b/samples/Repos/Commits/CommitComment.hs @@ -16,6 +16,6 @@ formatComment comment = (maybe "" ("\nURL: "++) $ Github.commentHtmlUrl comment) ++ "\n\n" ++ (Github.commentBody comment) -formatAuthor :: Github.GithubOwner -> String +formatAuthor :: Github.Owner -> String formatAuthor user = (Github.githubOwnerLogin user) ++ " (" ++ (Github.githubOwnerUrl user) ++ ")" diff --git a/samples/Repos/Commits/CommitComments.hs b/samples/Repos/Commits/CommitComments.hs index c0141a7f..fbf39607 100644 --- a/samples/Repos/Commits/CommitComments.hs +++ b/samples/Repos/Commits/CommitComments.hs @@ -17,6 +17,6 @@ formatComment comment = (maybe "" ("\nURL: "++) $ Github.commentHtmlUrl comment) ++ "\n\n" ++ (Github.commentBody comment) -formatAuthor :: Github.GithubOwner -> String +formatAuthor :: Github.Owner -> String formatAuthor user = (Github.githubOwnerLogin user) ++ " (" ++ (Github.githubOwnerUrl user) ++ ")" diff --git a/samples/Repos/Commits/GitLog.hs b/samples/Repos/Commits/GitLog.hs index ba4fd241..c244458f 100644 --- a/samples/Repos/Commits/GitLog.hs +++ b/samples/Repos/Commits/GitLog.hs @@ -13,7 +13,7 @@ formatCommit :: Github.Commit -> String formatCommit commit = "commit " ++ (Github.commitSha commit) ++ "\nAuthor: " ++ (formatAuthor author) ++ - "\nDate: " ++ (show $ Github.fromGithubDate $ Github.gitUserDate author) ++ + "\nDate: " ++ (show $ Github.fromDate $ Github.gitUserDate author) ++ "\n\n\t" ++ (Github.gitCommitMessage gitCommit) where author = Github.gitCommitAuthor gitCommit gitCommit = Github.commitGitCommit commit diff --git a/samples/Repos/Commits/GitShow.hs b/samples/Repos/Commits/GitShow.hs index 83bd1b14..b913cb47 100644 --- a/samples/Repos/Commits/GitShow.hs +++ b/samples/Repos/Commits/GitShow.hs @@ -13,7 +13,7 @@ formatCommit :: Github.Commit -> String formatCommit commit = "commit " ++ (Github.commitSha commit) ++ "\nAuthor: " ++ (formatAuthor author) ++ - "\nDate: " ++ (show $ Github.fromGithubDate $ Github.gitUserDate author) ++ + "\nDate: " ++ (show $ Github.fromDate $ Github.gitUserDate author) ++ "\n\n\t" ++ (Github.gitCommitMessage gitCommit) ++ "\n" ++ patches where author = Github.gitCommitAuthor gitCommit diff --git a/samples/Repos/Commits/RepoComments.hs b/samples/Repos/Commits/RepoComments.hs index 1698100c..c885942a 100644 --- a/samples/Repos/Commits/RepoComments.hs +++ b/samples/Repos/Commits/RepoComments.hs @@ -17,6 +17,6 @@ formatComment comment = (maybe "" ("\nURL: "++) $ Github.commentHtmlUrl comment) ++ "\n\n" ++ (Github.commentBody comment) -formatAuthor :: Github.GithubOwner -> String +formatAuthor :: Github.Owner -> String formatAuthor user = (Github.githubOwnerLogin user) ++ " (" ++ (Github.githubOwnerUrl user) ++ ")" diff --git a/samples/Repos/Forks/ListForks.hs b/samples/Repos/Forks/ListForks.hs index 13ea670e..9b2c5a7c 100644 --- a/samples/Repos/Forks/ListForks.hs +++ b/samples/Repos/Forks/ListForks.hs @@ -15,7 +15,7 @@ formatFork fork = (formatCloneUrl $ Github.repoCloneUrl fork) formatPushedAt Nothing = "" -formatPushedAt (Just pushedAt) = show $ Github.fromGithubDate pushedAt +formatPushedAt (Just pushedAt) = show $ Github.fromDate pushedAt formatCloneUrl Nothing = "" formatCloneUrl (Just cloneUrl) = cloneUrl diff --git a/samples/Repos/ListOrgRepos.hs b/samples/Repos/ListOrgRepos.hs index ce19985d..970ea464 100644 --- a/samples/Repos/ListOrgRepos.hs +++ b/samples/Repos/ListOrgRepos.hs @@ -20,7 +20,7 @@ formatRepo repo = "watchers: " ++ (show $ Github.repoWatchers repo) ++ "\t" ++ "forks: " ++ (show $ Github.repoForks repo) -formatDate (Just date) = show . Github.fromGithubDate $ date +formatDate (Just date) = show . Github.fromDate $ date formatDate Nothing = "????" formatLanguage (Just language) = "language: " ++ language ++ "\t" diff --git a/samples/Repos/ListUserRepos.hs b/samples/Repos/ListUserRepos.hs index 928e20e0..f80a4c9c 100644 --- a/samples/Repos/ListUserRepos.hs +++ b/samples/Repos/ListUserRepos.hs @@ -20,7 +20,7 @@ formatRepo repo = "watchers: " ++ (show $ Github.repoWatchers repo) ++ "\t" ++ "forks: " ++ (show $ Github.repoForks repo) -formatDate (Just date) = show . Github.fromGithubDate $ date +formatDate (Just date) = show . Github.fromDate $ date formatDate Nothing = "" formatLanguage (Just language) = "language: " ++ language ++ "\t" diff --git a/samples/Repos/ShowRepo.hs b/samples/Repos/ShowRepo.hs index 7ac0df4b..fb63c497 100644 --- a/samples/Repos/ShowRepo.hs +++ b/samples/Repos/ShowRepo.hs @@ -20,7 +20,7 @@ formatRepo repo = "watchers: " ++ (show $ Github.repoWatchers repo) ++ "\t" ++ "forks: " ++ (show $ Github.repoForks repo) -formatDate = show . Github.fromGithubDate +formatDate = show . Github.fromDate formatLanguage (Just language) = "language: " ++ language ++ "\t" formatLanguage Nothing = "" diff --git a/samples/Repos/Starring/ListStarred.hs b/samples/Repos/Starring/ListStarred.hs index 522b809b..d7516a81 100644 --- a/samples/Repos/Starring/ListStarred.hs +++ b/samples/Repos/Starring/ListStarred.hs @@ -18,7 +18,7 @@ formatRepo repo = (formatDate $ Github.repoUpdatedAt repo) ++ "\n" ++ formatLanguage (Github.repoLanguage repo) -formatDate (Just date) = show . Github.fromGithubDate $ date +formatDate (Just date) = show . Github.fromDate $ date formatDate Nothing = "" formatLanguage (Just language) = "language: " ++ language ++ "\t" diff --git a/samples/Repos/Watching/ListWatched.hs b/samples/Repos/Watching/ListWatched.hs index 1691906a..8d12ff70 100644 --- a/samples/Repos/Watching/ListWatched.hs +++ b/samples/Repos/Watching/ListWatched.hs @@ -20,7 +20,7 @@ formatRepo repo = "watchers: " ++ (show $ Github.repoWatchers repo) ++ "\t" ++ "forks: " ++ (show $ Github.repoForks repo) -formatDate (Just date) = show . Github.fromGithubDate $ date +formatDate (Just date) = show . Github.fromDate $ date formatDate Nothing = "" formatLanguage (Just language) = "language: " ++ language ++ "\t" diff --git a/samples/Repos/Watching/ListWatchers.hs b/samples/Repos/Watching/ListWatchers.hs index fa869b86..bbc0d078 100644 --- a/samples/Repos/Watching/ListWatchers.hs +++ b/samples/Repos/Watching/ListWatchers.hs @@ -9,6 +9,6 @@ main = do (intercalate "\n" . map formatWatcher) possibleWatchers -formatWatcher :: Github.GithubOwner -> String +formatWatcher :: Github.Owner -> String formatWatcher user = (Github.githubOwnerLogin user) ++ " (" ++ (Github.githubOwnerUrl user) ++ ")" diff --git a/samples/Repos/Webhooks/CreateWebhook.hs b/samples/Repos/Webhooks/CreateWebhook.hs index fc4e55ec..dbfe62f9 100644 --- a/samples/Repos/Webhooks/CreateWebhook.hs +++ b/samples/Repos/Webhooks/CreateWebhook.hs @@ -7,7 +7,7 @@ import qualified Data.Map as M main :: IO () main = do - let auth = Auth.GithubOAuth "oauthtoken" + let auth = Auth.OAuth "oauthtoken" let config = M.fromList [("url", "https://foo3.io"), ("content_type", "application/json"), ("insecure_ssl", "1")] let webhookDef = NewRepoWebhook { newRepoWebhookName = "web", diff --git a/samples/Repos/Webhooks/DeleteWebhook.hs b/samples/Repos/Webhooks/DeleteWebhook.hs index aa525828..67b9b8b7 100644 --- a/samples/Repos/Webhooks/DeleteWebhook.hs +++ b/samples/Repos/Webhooks/DeleteWebhook.hs @@ -5,7 +5,7 @@ import qualified Github.Auth as Auth main :: IO () main = do - let auth = Auth.GithubOAuth "oauthtoken" + let auth = Auth.OAuth "oauthtoken" resp <- deleteRepoWebhook' auth "repoOwner" "repoName" 123 case resp of (Left err) -> putStrLn $ "Error: " ++ (show err) diff --git a/samples/Repos/Webhooks/EditWebhook.hs b/samples/Repos/Webhooks/EditWebhook.hs index 4496e485..fceff2f2 100644 --- a/samples/Repos/Webhooks/EditWebhook.hs +++ b/samples/Repos/Webhooks/EditWebhook.hs @@ -6,7 +6,7 @@ import Github.Data.Definitions main :: IO () main = do - let auth = Auth.GithubOAuth "oauthtoken" + let auth = Auth.OAuth "oauthtoken" let editWebhookDef = EditRepoWebhook { editRepoWebhookRemoveEvents = Just [WebhookWildcardEvent], editRepoWebhookAddEvents = Just [WebhookCommitCommentEvent, WebhookGollumEvent], diff --git a/samples/Repos/Webhooks/ListWebhook.hs b/samples/Repos/Webhooks/ListWebhook.hs index 58ea3d9d..2c66d449 100644 --- a/samples/Repos/Webhooks/ListWebhook.hs +++ b/samples/Repos/Webhooks/ListWebhook.hs @@ -6,7 +6,7 @@ import qualified Github.Data.Definitions as Def main :: IO () main = do - let auth = Auth.GithubOAuth "oauthtoken" + let auth = Auth.OAuth "oauthtoken" possibleWebhook <- W.webhookFor' auth "repoOwner" "repoName" 123 case possibleWebhook of (Left err) -> putStrLn $ "Error: " ++ (show err) diff --git a/samples/Repos/Webhooks/ListWebhooks.hs b/samples/Repos/Webhooks/ListWebhooks.hs index 9d34ab89..0da564c4 100644 --- a/samples/Repos/Webhooks/ListWebhooks.hs +++ b/samples/Repos/Webhooks/ListWebhooks.hs @@ -7,7 +7,7 @@ import Data.List main :: IO () main = do - let auth = Auth.GithubOAuth "oauthtoken" + let auth = Auth.OAuth "oauthtoken" possibleWebhooks <- W.webhooksFor' auth "repoOwner" "repoName" case possibleWebhooks of (Left err) -> putStrLn $ "Error: " ++ (show err) diff --git a/samples/Repos/Webhooks/PingWebhook.hs b/samples/Repos/Webhooks/PingWebhook.hs index 3735f1d7..6cd959ad 100644 --- a/samples/Repos/Webhooks/PingWebhook.hs +++ b/samples/Repos/Webhooks/PingWebhook.hs @@ -5,7 +5,7 @@ import qualified Github.Auth as Auth main :: IO () main = do - let auth = Auth.GithubOAuth "oauthtoken" + let auth = Auth.OAuth "oauthtoken" resp <- pingRepoWebhook' auth "repoOwner" "repoName" 123 case resp of (Left err) -> putStrLn $ "Error: " ++ (show err) diff --git a/samples/Repos/Webhooks/TestPushWebhook.hs b/samples/Repos/Webhooks/TestPushWebhook.hs index 00d65cd0..ce1cf9c4 100644 --- a/samples/Repos/Webhooks/TestPushWebhook.hs +++ b/samples/Repos/Webhooks/TestPushWebhook.hs @@ -5,7 +5,7 @@ import qualified Github.Auth as Auth main :: IO () main = do - let auth = Auth.GithubOAuth "oauthtoken" + let auth = Auth.OAuth "oauthtoken" resp <- testPushRepoWebhook' auth "repoOwner" "repoName" 123 case resp of (Left err) -> putStrLn $ "Error: " ++ (show err) diff --git a/samples/Search/SearchIssues.hs b/samples/Search/SearchIssues.hs index 3910f556..9b86ac22 100644 --- a/samples/Search/SearchIssues.hs +++ b/samples/Search/SearchIssues.hs @@ -20,7 +20,7 @@ main = do formatIssue issue = (Github.githubOwnerLogin $ Github.issueUser issue) ++ " opened this issue " ++ - (show $ Github.fromGithubDate $ Github.issueCreatedAt issue) ++ "\n" ++ + (show $ Github.fromDate $ Github.issueCreatedAt issue) ++ "\n" ++ (Github.issueState issue) ++ " with " ++ (show $ Github.issueComments issue) ++ " comments" ++ "\n\n" ++ (Github.issueTitle issue) diff --git a/samples/Search/SearchRepos.hs b/samples/Search/SearchRepos.hs index 9961e690..ade7f784 100644 --- a/samples/Search/SearchRepos.hs +++ b/samples/Search/SearchRepos.hs @@ -53,4 +53,4 @@ formatRepo r = where n' = max 0 (n - length s) formatMaybeDate = maybe "???" formatDate -formatDate = show . Github.fromGithubDate +formatDate = show . Github.fromDate diff --git a/samples/Teams/DeleteTeam.hs b/samples/Teams/DeleteTeam.hs index 224df2ce..304fe0c5 100644 --- a/samples/Teams/DeleteTeam.hs +++ b/samples/Teams/DeleteTeam.hs @@ -11,7 +11,7 @@ main :: IO () main = do args <- getArgs result <- case args of - [token, team_id] -> GitHub.deleteTeam' (GitHub.GithubOAuth token) (GitHub.mkTeamId $ read team_id) + [token, team_id] -> GitHub.deleteTeam' (GitHub.OAuth token) (GitHub.mkTeamId $ read team_id) _ -> error "usage: DeleteTeam " case result of Left err -> putStrLn $ "Error: " <> tshow err diff --git a/samples/Teams/EditTeam.hs b/samples/Teams/EditTeam.hs index 434b07fd..99591758 100644 --- a/samples/Teams/EditTeam.hs +++ b/samples/Teams/EditTeam.hs @@ -13,7 +13,7 @@ main = do result <- case args of [token, team_id, team_name, desc] -> GitHub.editTeam' - (GitHub.GithubOAuth token) + (GitHub.OAuth token) (GitHub.mkTeamId $ read team_id) (GitHub.EditTeam (GitHub.mkTeamName $ fromString team_name) (Just $ fromString desc) GitHub.PermissionPull) _ -> diff --git a/samples/Teams/ListTeamsCurrent.hs b/samples/Teams/ListTeamsCurrent.hs index 495fd557..9a6f1850 100644 --- a/samples/Teams/ListTeamsCurrent.hs +++ b/samples/Teams/ListTeamsCurrent.hs @@ -11,7 +11,7 @@ main :: IO () main = do args <- getArgs result <- case args of - [token] -> GitHub.listTeamsCurrent' (GitHub.GithubOAuth token) + [token] -> GitHub.listTeamsCurrent' (GitHub.OAuth token) _ -> error "usage: ListTeamsCurrent " case result of Left err -> putStrLn $ "Error: " <> tshow err diff --git a/samples/Teams/Memberships/AddTeamMembershipFor.hs b/samples/Teams/Memberships/AddTeamMembershipFor.hs index 5f91769e..aa890d82 100644 --- a/samples/Teams/Memberships/AddTeamMembershipFor.hs +++ b/samples/Teams/Memberships/AddTeamMembershipFor.hs @@ -13,7 +13,7 @@ main = do result <- case args of [token, team_id, username] -> GitHub.addTeamMembershipFor' - (GitHub.GithubOAuth token) + (GitHub.OAuth token) (GitHub.mkTeamId $ read team_id) (GitHub.mkOwnerName $ fromString username) GitHub.RoleMember diff --git a/samples/Teams/Memberships/DeleteTeamMembershipFor.hs b/samples/Teams/Memberships/DeleteTeamMembershipFor.hs index 6cf9ec67..46b87aaa 100644 --- a/samples/Teams/Memberships/DeleteTeamMembershipFor.hs +++ b/samples/Teams/Memberships/DeleteTeamMembershipFor.hs @@ -13,7 +13,7 @@ main = do result <- case args of [token, team_id, username] -> GitHub.deleteTeamMembershipFor' - (GitHub.GithubOAuth token) + (GitHub.OAuth token) (GitHub.mkTeamId $ read team_id) (GitHub.mkOwnerName $ fromString username) _ -> diff --git a/samples/Teams/Memberships/TeamMembershipInfoFor.hs b/samples/Teams/Memberships/TeamMembershipInfoFor.hs index 2cd1a625..e66bce26 100644 --- a/samples/Teams/Memberships/TeamMembershipInfoFor.hs +++ b/samples/Teams/Memberships/TeamMembershipInfoFor.hs @@ -12,7 +12,7 @@ main = do args <- getArgs result <- case args of [team_id, username, token] -> - GitHub.teamMembershipInfoFor' (Just $ GitHub.GithubOAuth token) (GitHub.mkTeamId $ read team_id) (GitHub.mkOwnerName $ fromString username) + GitHub.teamMembershipInfoFor' (Just $ GitHub.OAuth token) (GitHub.mkTeamId $ read team_id) (GitHub.mkOwnerName $ fromString username) [team_id, username] -> GitHub.teamMembershipInfoFor (GitHub.mkTeamId $ read team_id) (GitHub.mkOwnerName $ fromString username) _ -> diff --git a/samples/Teams/TeamInfoFor.hs b/samples/Teams/TeamInfoFor.hs index 3eb8b491..a7717284 100644 --- a/samples/Teams/TeamInfoFor.hs +++ b/samples/Teams/TeamInfoFor.hs @@ -11,7 +11,7 @@ main :: IO () main = do args <- getArgs result <- case args of - [team_id, token] -> GitHub.teamInfoFor' (Just $ GitHub.GithubOAuth token) (GitHub.mkTeamId $ read team_id) + [team_id, token] -> GitHub.teamInfoFor' (Just $ GitHub.OAuth token) (GitHub.mkTeamId $ read team_id) [team_id] -> GitHub.teamInfoFor (GitHub.mkTeamId $ read team_id) _ -> error "usage: TeamInfoFor [auth token]" case result of diff --git a/samples/src/Common.hs b/samples/src/Common.hs index bf0158c5..11afba9b 100644 --- a/samples/src/Common.hs +++ b/samples/src/Common.hs @@ -26,10 +26,10 @@ import System.Environment (getArgs) import qualified Data.Text as T import qualified GitHub -getAuth :: IO (Maybe (GitHub.GithubAuth)) +getAuth :: IO (Maybe (GitHub.Auth)) getAuth = do token <- lookupEnv "GITHUB_TOKEN" - pure (GitHub.GithubOAuth <$> token) + pure (GitHub.OAuth <$> token) tshow :: Show a => a -> Text tshow = T.pack . show diff --git a/spec/GitHub/ActivitySpec.hs b/spec/GitHub/ActivitySpec.hs index 02d8458f..4fe9ae82 100644 --- a/spec/GitHub/ActivitySpec.hs +++ b/spec/GitHub/ActivitySpec.hs @@ -2,7 +2,7 @@ {-# LANGUAGE TemplateHaskell #-} module GitHub.ActivitySpec where -import GitHub.Auth (GithubAuth (..)) +import GitHub.Auth (Auth (..)) import GitHub.Endpoints.Activity.Watching (watchersForR) import GitHub.Request (executeRequest) @@ -16,12 +16,12 @@ fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a -withAuth :: (GithubAuth -> IO ()) -> IO () +withAuth :: (Auth -> IO ()) -> IO () withAuth action = do mtoken <- lookupEnv "GITHUB_TOKEN" case mtoken of Nothing -> pendingWith "no GITHUB_TOKEN" - Just token -> action (GithubOAuth token) + Just token -> action (OAuth token) spec :: Spec spec = do diff --git a/spec/GitHub/CommitsSpec.hs b/spec/GitHub/CommitsSpec.hs index 46677b61..87c01a50 100644 --- a/spec/GitHub/CommitsSpec.hs +++ b/spec/GitHub/CommitsSpec.hs @@ -2,7 +2,7 @@ {-# LANGUAGE TemplateHaskell #-} module GitHub.CommitsSpec where -import GitHub.Auth (GithubAuth (..)) +import GitHub.Auth (Auth (..)) import GitHub.Endpoints.Repos.Commits (Commit, mkName, commitSha, commitsFor', commitsForR, diffR) import GitHub.Request (executeRequest) @@ -18,12 +18,12 @@ fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a -withAuth :: (GithubAuth -> IO ()) -> IO () +withAuth :: (Auth -> IO ()) -> IO () withAuth action = do mtoken <- lookupEnv "GITHUB_TOKEN" case mtoken of Nothing -> pendingWith "no GITHUB_TOKEN" - Just token -> action (GithubOAuth token) + Just token -> action (OAuth token) spec :: Spec spec = do diff --git a/spec/GitHub/OrganizationsSpec.hs b/spec/GitHub/OrganizationsSpec.hs index d6120976..8d81204a 100644 --- a/spec/GitHub/OrganizationsSpec.hs +++ b/spec/GitHub/OrganizationsSpec.hs @@ -2,7 +2,7 @@ {-# LANGUAGE TemplateHaskell #-} module GitHub.OrganizationsSpec where -import GitHub.Auth (GithubAuth (..)) +import GitHub.Auth (Auth (..)) import GitHub.Data (SimpleOwner (..), SimpleOrganization (..), SimpleTeam (..)) import GitHub.Endpoints.Organizations (publicOrganizationsFor') @@ -19,12 +19,12 @@ fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a -withAuth :: (GithubAuth -> IO ()) -> IO () +withAuth :: (Auth -> IO ()) -> IO () withAuth action = do mtoken <- lookupEnv "GITHUB_TOKEN" case mtoken of Nothing -> pendingWith "no GITHUB_TOKEN" - Just token -> action (GithubOAuth token) + Just token -> action (OAuth token) spec :: Spec spec = do diff --git a/spec/GitHub/ReposSpec.hs b/spec/GitHub/ReposSpec.hs index 76e9205c..e972b19a 100644 --- a/spec/GitHub/ReposSpec.hs +++ b/spec/GitHub/ReposSpec.hs @@ -2,12 +2,10 @@ {-# LANGUAGE TemplateHaskell #-} module GitHub.ReposSpec where -import GitHub.Auth (GithubAuth (..)) +import GitHub.Auth (Auth (..)) import GitHub.Endpoints.Repos (currentUserRepos, userRepos', RepoPublicity(..)) --- import Data.Aeson.Compat (eitherDecodeStrict) import Data.Either.Compat (isRight) --- import Data.FileEmbed (embedFile) import System.Environment (lookupEnv) import Test.Hspec (Spec, describe, it, pendingWith, shouldSatisfy) @@ -15,21 +13,21 @@ fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a -withAuth :: (GithubAuth -> IO ()) -> IO () +withAuth :: (Auth -> IO ()) -> IO () withAuth action = do mtoken <- lookupEnv "GITHUB_TOKEN" case mtoken of Nothing -> pendingWith "no GITHUB_TOKEN" - Just token -> action (GithubOAuth token) + Just token -> action (OAuth token) spec :: Spec spec = do describe "currentUserRepos" $ do it "works" $ withAuth $ \auth -> do - cs <- currentUserRepos auth All + cs <- currentUserRepos auth RepoPublicityAll cs `shouldSatisfy` isRight describe "userRepos" $ do it "works" $ withAuth $ \auth -> do - cs <- userRepos' (Just auth) "phadej" All + cs <- userRepos' (Just auth) "phadej" RepoPublicityAll cs `shouldSatisfy` isRight diff --git a/spec/GitHub/UsersSpec.hs b/spec/GitHub/UsersSpec.hs index 0a9c8603..e1fe6c9b 100644 --- a/spec/GitHub/UsersSpec.hs +++ b/spec/GitHub/UsersSpec.hs @@ -9,7 +9,7 @@ import System.Environment (lookupEnv) import Test.Hspec (Spec, describe, it, pendingWith, shouldBe, shouldSatisfy) -import GitHub.Data (GithubAuth (..), User (..), Organization (..), fromGithubOwner) +import GitHub.Data (Auth (..), User (..), Organization (..), fromOwner) import GitHub.Request (executeRequest) import GitHub.Endpoints.Users (userInfoCurrent', userInfoFor', ownerInfoForR) import GitHub.Endpoints.Users.Followers (usersFollowedByR, usersFollowingR) @@ -22,12 +22,12 @@ fromLeftS :: Show b => Either a b -> a fromLeftS (Left b) = b fromLeftS (Right a) = error $ "Expected a Left and got a RIght" ++ show a -withAuth :: (GithubAuth -> IO ()) -> IO () +withAuth :: (Auth -> IO ()) -> IO () withAuth action = do mtoken <- lookupEnv "GITHUB_TOKEN" case mtoken of Nothing -> pendingWith "no GITHUB_TOKEN" - Just token -> action (GithubOAuth token) + Just token -> action (OAuth token) spec :: Spec spec = do @@ -54,8 +54,8 @@ spec = do b <- executeRequest auth $ ownerInfoForR "phadej" a `shouldSatisfy` isRight b `shouldSatisfy` isRight - (organizationLogin . fromRightS . fromGithubOwner . fromRightS $ a) `shouldBe` "haskell" - (userLogin . fromLeftS . fromGithubOwner . fromRightS $ b) `shouldBe` "phadej" + (organizationLogin . fromRightS . fromOwner . fromRightS $ a) `shouldBe` "haskell" + (userLogin . fromLeftS . fromOwner . fromRightS $ b) `shouldBe` "phadej" describe "userInfoCurrent'" $ do it "returns information about the autenticated user" $ withAuth $ \auth -> do diff --git a/src/GitHub.hs b/src/GitHub.hs index b7608d55..000df2c2 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -6,7 +6,7 @@ -- This module re-exports all request constructrors and data definitions from -- this package. -- --- See "GitHub.Request" module for executing 'GithubRequest', or other modules +-- See "GitHub.Request" module for executing 'Request', or other modules -- of this package (e.g. "GitHub.Users") for already composed versions. -- -- The missing endpoints lists show which endpoints we know are missing, there @@ -32,7 +32,7 @@ module GitHub ( -- -- Missing endpoints: -- - -- * Get a Repository Subscription + -- * Query a Repository Subscription -- * Set a Repository Subscription -- * Delete a Repository Subscription watchersForR, @@ -43,7 +43,7 @@ module GitHub ( -- -- Missing endpoints: -- - -- * Get a specific revision of a gist + -- * Query a specific revision of a gist -- * Create a gist -- * Edit a gist -- * List gist commits @@ -165,7 +165,7 @@ module GitHub ( -- Missing endpoints: -- -- * List team members - -- * Get team member (deprecated) + -- * Query team member (deprecated) -- * Add team member (deprecated) -- * Remove team member (deprecated) -- * List team repos @@ -212,7 +212,7 @@ module GitHub ( -- -- * List all public repositories -- * List Teams - -- * Get Branch + -- * Query Branch -- * Enabling and disabling branch protection currentUserReposR, userReposR, @@ -281,7 +281,7 @@ module GitHub ( -- Missing endpoints: -- -- * Update the authenticated user - -- * Get all users + -- * Query all users userInfoForR, ownerInfoForR, userInfoCurrentR, diff --git a/src/GitHub/Auth.hs b/src/GitHub/Auth.hs index 33f6d687..02cc8570 100644 --- a/src/GitHub/Auth.hs +++ b/src/GitHub/Auth.hs @@ -16,12 +16,13 @@ import GHC.Generics (Generic) import qualified Data.ByteString as BS -- | The Github auth data type -data GithubAuth = GithubBasicAuth BS.ByteString BS.ByteString - | GithubOAuth String -- ^ token - | GithubEnterpriseOAuth String -- custom API endpoint without - -- trailing slash - String -- token - deriving (Show, Data, Typeable, Eq, Ord, Generic) +data Auth + = BasicAuth BS.ByteString BS.ByteString + | OAuth String -- ^ token + | EnterpriseOAuth String -- custom API endpoint without + -- trailing slash + String -- token + deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData GithubAuth where rnf = genericRnf -instance Binary GithubAuth +instance NFData Auth where rnf = genericRnf +instance Binary Auth diff --git a/src/GitHub/Data.hs b/src/GitHub/Data.hs index f5cdc7dd..9cafbad8 100644 --- a/src/GitHub/Data.hs +++ b/src/GitHub/Data.hs @@ -64,10 +64,10 @@ import GitHub.Data.Search import GitHub.Data.Teams import GitHub.Data.Webhooks -mkOwnerId :: Int -> Id GithubOwner +mkOwnerId :: Int -> Id Owner mkOwnerId = Id -mkOwnerName :: Text -> Name GithubOwner +mkOwnerName :: Text -> Name Owner mkOwnerName = N mkTeamId :: Int -> Id Team @@ -88,8 +88,8 @@ mkRepoId = Id mkRepoName :: Text -> Name Repo mkRepoName = N -fromOrganizationName :: Name Organization -> Name GithubOwner +fromOrganizationName :: Name Organization -> Name Owner fromOrganizationName = N . untagName -fromUserName :: Name User -> Name GithubOwner +fromUserName :: Name User -> Name Owner fromUserName = N . untagName diff --git a/src/GitHub/Data/Definitions.hs b/src/GitHub/Data/Definitions.hs index ac8059a1..5c607e97 100644 --- a/src/GitHub/Data/Definitions.hs +++ b/src/GitHub/Data/Definitions.hs @@ -73,8 +73,8 @@ instance Binary SimpleOrganization -- | Sometimes we don't know the type of the owner, e.g. in 'Repo' data SimpleOwner = SimpleOwner - { simpleOwnerId :: !(Id GithubOwner) - , simpleOwnerLogin :: !(Name GithubOwner) + { simpleOwnerId :: !(Id Owner) + , simpleOwnerLogin :: !(Name Owner) , simpleOwnerUrl :: !Text , simpleOwnerAvatarUrl :: !Text , simpleOwnerType :: !OwnerType @@ -132,15 +132,15 @@ data Organization = Organization instance NFData Organization where rnf = genericRnf instance Binary Organization --- | In practic, you cam't have concrete values of 'GithubOwner'. -newtype GithubOwner = GithubOwner (Either User Organization) +-- | In practic, you cam't have concrete values of 'Owner'. +newtype Owner = Owner (Either User Organization) deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData GithubOwner where rnf = genericRnf -instance Binary GithubOwner +instance NFData Owner where rnf = genericRnf +instance Binary Owner -fromGithubOwner :: GithubOwner -> Either User Organization -fromGithubOwner (GithubOwner owner) = owner +fromOwner :: Owner -> Either User Organization +fromOwner (Owner owner) = owner -- JSON instances @@ -223,9 +223,9 @@ instance FromJSON User where instance FromJSON Organization where parseJSON = withObject "Organization" parseOrganization -instance FromJSON GithubOwner where - parseJSON = withObject "GithubOwner" $ \obj -> do +instance FromJSON Owner where + parseJSON = withObject "Owner" $ \obj -> do t <- obj .: "type" case t of - OwnerUser -> GithubOwner . Left <$> parseUser obj - OwnerOrganization -> GithubOwner . Right <$> parseOrganization obj + OwnerUser -> Owner . Left <$> parseUser obj + OwnerOrganization -> Owner . Right <$> parseOrganization obj diff --git a/src/GitHub/Data/Repos.hs b/src/GitHub/Data/Repos.hs index 95edc6c0..e9b31ef8 100644 --- a/src/GitHub/Data/Repos.hs +++ b/src/GitHub/Data/Repos.hs @@ -64,8 +64,11 @@ data Repo = Repo { instance NFData Repo where rnf = genericRnf instance Binary Repo -data RepoRef = RepoRef !SimpleOwner !(Name Repo) -- Repo owner and name - deriving (Show, Data, Typeable, Eq, Ord, Generic) +data RepoRef = RepoRef + { repoRefOwner :: !SimpleOwner + , repoRefRepo :: !(Name Repo) + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData RepoRef where rnf = genericRnf instance Binary RepoRef @@ -100,13 +103,13 @@ instance NFData EditRepo where rnf = genericRnf instance Binary EditRepo -- | Filter the list of the user's repos using any of these constructors. -data RepoPublicity = - All -- ^ All repos accessible to the user. - | Owner -- ^ Only repos owned by the user. - | Public -- ^ Only public repos. - | Private -- ^ Only private repos. - | Member -- ^ Only repos to which the user is a member but not an owner. - deriving (Show, Eq, Ord, Typeable, Data, Generic) +data RepoPublicity + = RepoPublicityAll -- ^ All repos accessible to the user. + | RepoPublicityOwner -- ^ Only repos owned by the user. + | RepoPublicityPublic -- ^ Only public repos. + | RepoPublicityPrivate -- ^ Only private repos. + | RepoPublicityMember -- ^ Only repos to which the user is a member but not an owner. + deriving (Show, Eq, Ord, Typeable, Data, Generic) -- | This is only used for the FromJSON instance. data Languages = Languages { getLanguages :: Vector Language } diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs index fcc7ec8f..5ad45e01 100644 --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -13,7 +13,7 @@ -- Maintainer : Oleg Grenrus -- module GitHub.Data.Request ( - GithubRequest(..), + Request(..), CommandMethod(..), toMethod, StatusMap(..), @@ -116,61 +116,61 @@ instance Hashable (StatusMap a) where -- * @k@ describes whether authentication is required. It's required for non-@GET@ requests. -- * @a@ is the result type -- --- /Note:/ 'GithubRequest' is not 'Functor' on purpose. -data GithubRequest (k :: Bool) a where - GithubGet :: FromJSON a => Paths -> QueryString -> GithubRequest k a - GithubPagedGet :: FromJSON (Vector a) => Paths -> QueryString -> Maybe Count -> GithubRequest k (Vector a) - GithubCommand :: FromJSON a => CommandMethod a -> Paths -> LBS.ByteString -> GithubRequest 'True a - GithubStatus :: StatusMap a -> GithubRequest k () -> GithubRequest k a +-- /Note:/ 'Request' is not 'Functor' on purpose. +data Request (k :: Bool) a where + Query :: FromJSON a => Paths -> QueryString -> Request k a + PagedQuery :: FromJSON (Vector a) => Paths -> QueryString -> Maybe Count -> Request k (Vector a) + Command :: FromJSON a => CommandMethod a -> Paths -> LBS.ByteString -> Request 'True a + StatusQuery :: StatusMap a -> Request k () -> Request k a deriving (Typeable) -deriving instance Eq (GithubRequest k a) +deriving instance Eq (Request k a) -instance Show (GithubRequest k a) where +instance Show (Request k a) where showsPrec d r = case r of - GithubGet ps qs -> showParen (d > appPrec) $ - showString "GithubGet " + Query ps qs -> showParen (d > appPrec) $ + showString "Query " . showsPrec (appPrec + 1) ps . showString " " . showsPrec (appPrec + 1) qs - GithubPagedGet ps qs l -> showParen (d > appPrec) $ - showString "GithubPagedGet " + PagedQuery ps qs l -> showParen (d > appPrec) $ + showString "PagedQuery " . showsPrec (appPrec + 1) ps . showString " " . showsPrec (appPrec + 1) qs . showString " " . showsPrec (appPrec + 1) l - GithubCommand m ps body -> showParen (d > appPrec) $ - showString "GithubCommand " + Command m ps body -> showParen (d > appPrec) $ + showString "Command " . showsPrec (appPrec + 1) m . showString " " . showsPrec (appPrec + 1) ps . showString " " . showsPrec (appPrec + 1) body - GithubStatus m req -> showParen (d > appPrec) $ - showString "GithubStatus " + StatusQuery m req -> showParen (d > appPrec) $ + showString "Status " . showsPrec (appPrec + 1) m . showString " " . showsPrec (appPrec + 1) req where appPrec = 10 :: Int -instance Hashable (GithubRequest k a) where - hashWithSalt salt (GithubGet ps qs) = +instance Hashable (Request k a) where + hashWithSalt salt (Query ps qs) = salt `hashWithSalt` (0 :: Int) `hashWithSalt` ps `hashWithSalt` qs - hashWithSalt salt (GithubPagedGet ps qs l) = + hashWithSalt salt (PagedQuery ps qs l) = salt `hashWithSalt` (1 :: Int) `hashWithSalt` ps `hashWithSalt` qs `hashWithSalt` l - hashWithSalt salt (GithubCommand m ps body) = + hashWithSalt salt (Command m ps body) = salt `hashWithSalt` (2 :: Int) `hashWithSalt` m `hashWithSalt` ps `hashWithSalt` body - hashWithSalt salt (GithubStatus sm req) = + hashWithSalt salt (StatusQuery sm req) = salt `hashWithSalt` (3 :: Int) `hashWithSalt` sm `hashWithSalt` req diff --git a/src/GitHub/Data/Webhooks/Validate.hs b/src/GitHub/Data/Webhooks/Validate.hs index 2fcd6cd2..0ca26283 100644 --- a/src/GitHub/Data/Webhooks/Validate.hs +++ b/src/GitHub/Data/Webhooks/Validate.hs @@ -11,9 +11,9 @@ module GitHub.Data.Webhooks.Validate ( isValidPayload ) where -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative -#endif +import Prelude () +import Prelude.Compat + import Crypto.Hash import Data.Byteable (constEqBytes, toBytes) import qualified Data.ByteString.Base16 as Hex diff --git a/src/GitHub/Endpoints/Activity/Starring.hs b/src/GitHub/Endpoints/Activity/Starring.hs index 876b8138..24259564 100644 --- a/src/GitHub/Endpoints/Activity/Starring.hs +++ b/src/GitHub/Endpoints/Activity/Starring.hs @@ -24,34 +24,34 @@ import GitHub.Request -- | The list of users that have starred the specified Github repo. -- -- > userInfoFor' Nothing "mike-burns" -stargazersFor :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error (Vector SimpleUser)) +stargazersFor :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector SimpleUser)) stargazersFor auth user repo = executeRequestMaybe auth $ stargazersForR user repo Nothing -- | List Stargazers. -- See -stargazersForR :: Name GithubOwner -> Name Repo -> Maybe Count -> GithubRequest k (Vector SimpleUser) +stargazersForR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector SimpleUser) stargazersForR user repo = - GithubPagedGet ["repos", toPathPart user, toPathPart repo, "stargazers"] [] + PagedQuery ["repos", toPathPart user, toPathPart repo, "stargazers"] [] -- | All the public repos starred by the specified user. -- -- > reposStarredBy Nothing "croaky" -reposStarredBy :: Maybe GithubAuth -> Name GithubOwner -> IO (Either Error (Vector Repo)) +reposStarredBy :: Maybe Auth -> Name Owner -> IO (Either Error (Vector Repo)) reposStarredBy auth user = executeRequestMaybe auth $ reposStarredByR user Nothing -- | List repositories being starred. -- See -reposStarredByR :: Name GithubOwner -> Maybe Count -> GithubRequest k (Vector Repo) +reposStarredByR :: Name Owner -> Maybe Count -> Request k (Vector Repo) reposStarredByR user = - GithubPagedGet ["users", toPathPart user, "starred"] [] + PagedQuery ["users", toPathPart user, "starred"] [] -- | All the repos starred by the authenticated user. -myStarred :: GithubAuth -> IO (Either Error (Vector Repo)) +myStarred :: Auth -> IO (Either Error (Vector Repo)) myStarred auth = executeRequest auth $ myStarredR Nothing -- | All the repos starred by the authenticated user. -myStarredR :: Maybe Count -> GithubRequest 'True (Vector Repo) -myStarredR = GithubPagedGet ["user", "starred"] [] +myStarredR :: Maybe Count -> Request 'True (Vector Repo) +myStarredR = PagedQuery ["user", "starred"] [] diff --git a/src/GitHub/Endpoints/Activity/Watching.hs b/src/GitHub/Endpoints/Activity/Watching.hs index 19ba5727..7dc93299 100644 --- a/src/GitHub/Endpoints/Activity/Watching.hs +++ b/src/GitHub/Endpoints/Activity/Watching.hs @@ -23,39 +23,39 @@ import GitHub.Request -- | The list of users that are watching the specified Github repo. -- -- > watchersFor "thoughtbot" "paperclip" -watchersFor :: Name GithubOwner -> Name Repo -> IO (Either Error (Vector SimpleUser)) +watchersFor :: Name Owner -> Name Repo -> IO (Either Error (Vector SimpleUser)) watchersFor = watchersFor' Nothing -- | The list of users that are watching the specified Github repo. -- With authentication -- --- > watchersFor' (Just (GithubUser (user, password))) "thoughtbot" "paperclip" -watchersFor' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error (Vector SimpleUser)) +-- > watchersFor' (Just (User (user, password))) "thoughtbot" "paperclip" +watchersFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector SimpleUser)) watchersFor' auth user repo = executeRequestMaybe auth $ watchersForR user repo Nothing -- | List watchers. -- See -watchersForR :: Name GithubOwner -> Name Repo -> Maybe Count -> GithubRequest k (Vector SimpleUser) +watchersForR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector SimpleUser) watchersForR user repo limit = - GithubPagedGet ["repos", toPathPart user, toPathPart repo, "watchers"] [] limit + PagedQuery ["repos", toPathPart user, toPathPart repo, "watchers"] [] limit -- | All the public repos watched by the specified user. -- -- > reposWatchedBy "croaky" -reposWatchedBy :: Name GithubOwner -> IO (Either Error (Vector Repo)) +reposWatchedBy :: Name Owner -> IO (Either Error (Vector Repo)) reposWatchedBy = reposWatchedBy' Nothing -- | All the public repos watched by the specified user. -- With authentication -- --- > reposWatchedBy' (Just (GithubUser (user, password))) "croaky" -reposWatchedBy' :: Maybe GithubAuth -> Name GithubOwner -> IO (Either Error (Vector Repo)) +-- > reposWatchedBy' (Just (User (user, password))) "croaky" +reposWatchedBy' :: Maybe Auth -> Name Owner -> IO (Either Error (Vector Repo)) reposWatchedBy' auth user = executeRequestMaybe auth $ reposWatchedByR user Nothing -- | List repositories being watched. -- See -reposWatchedByR :: Name GithubOwner -> Maybe Count -> GithubRequest k (Vector Repo) +reposWatchedByR :: Name Owner -> Maybe Count -> Request k (Vector Repo) reposWatchedByR user = - GithubPagedGet ["users", toPathPart user, "subscriptions"] [] + PagedQuery ["users", toPathPart user, "subscriptions"] [] diff --git a/src/GitHub/Endpoints/Gists.hs b/src/GitHub/Endpoints/Gists.hs index b311965d..537f3626 100644 --- a/src/GitHub/Endpoints/Gists.hs +++ b/src/GitHub/Endpoints/Gists.hs @@ -21,25 +21,25 @@ import GitHub.Request -- | The list of all gists created by the user -- -- > gists' (Just ("github-username", "github-password")) "mike-burns" -gists' :: Maybe GithubAuth -> Name GithubOwner -> IO (Either Error (Vector Gist)) +gists' :: Maybe Auth -> Name Owner -> IO (Either Error (Vector Gist)) gists' auth user = executeRequestMaybe auth $ gistsR user Nothing -- | The list of all public gists created by the user. -- -- > gists "mike-burns" -gists :: Name GithubOwner -> IO (Either Error (Vector Gist)) +gists :: Name Owner -> IO (Either Error (Vector Gist)) gists = gists' Nothing -- | List gists. -- See -gistsR :: Name GithubOwner -> Maybe Count -> GithubRequest k (Vector Gist) -gistsR user = GithubPagedGet ["users", toPathPart user, "gists"] [] +gistsR :: Name Owner -> Maybe Count -> Request k (Vector Gist) +gistsR user = PagedQuery ["users", toPathPart user, "gists"] [] -- | A specific gist, given its id, with authentication credentials -- -- > gist' (Just ("github-username", "github-password")) "225074" -gist' :: Maybe GithubAuth -> Name Gist -> IO (Either Error Gist) +gist' :: Maybe Auth -> Name Gist -> IO (Either Error Gist) gist' auth gid = executeRequestMaybe auth $ gistR gid @@ -49,8 +49,8 @@ gist' auth gid = gist :: Name Gist -> IO (Either Error Gist) gist = gist' Nothing --- | Get a single gist. +-- | Query a single gist. -- See -gistR :: Name Gist ->GithubRequest k Gist +gistR :: Name Gist ->Request k Gist gistR gid = - GithubGet ["gists", toPathPart gid] [] + Query ["gists", toPathPart gid] [] diff --git a/src/GitHub/Endpoints/Gists/Comments.hs b/src/GitHub/Endpoints/Gists/Comments.hs index 347f7ea1..0298e1a0 100644 --- a/src/GitHub/Endpoints/Gists/Comments.hs +++ b/src/GitHub/Endpoints/Gists/Comments.hs @@ -27,9 +27,9 @@ commentsOn gid = -- | List comments on a gist. -- See -commentsOnR :: Name Gist -> Maybe Count -> GithubRequest k (Vector GistComment) +commentsOnR :: Name Gist -> Maybe Count -> Request k (Vector GistComment) commentsOnR gid = - GithubPagedGet ["gists", toPathPart gid, "comments"] [] + PagedQuery ["gists", toPathPart gid, "comments"] [] -- | A specific comment, by the comment ID. -- @@ -38,8 +38,8 @@ comment :: Id GistComment -> IO (Either Error GistComment) comment cid = executeRequest' $ gistCommentR cid --- | Get a single comment. +-- | Query a single comment. -- See -gistCommentR :: Id GistComment -> GithubRequest k GistComment +gistCommentR :: Id GistComment -> Request k GistComment gistCommentR cid = - GithubGet ["gists", "comments", toPathPart cid] [] + Query ["gists", "comments", toPathPart cid] [] diff --git a/src/GitHub/Endpoints/GitData/Blobs.hs b/src/GitHub/Endpoints/GitData/Blobs.hs index af2db226..f473b09a 100644 --- a/src/GitHub/Endpoints/GitData/Blobs.hs +++ b/src/GitHub/Endpoints/GitData/Blobs.hs @@ -15,21 +15,21 @@ module GitHub.Endpoints.GitData.Blobs ( import GitHub.Data import GitHub.Request --- | Get a blob by SHA1. +-- | Query a blob by SHA1. -- -- > blob' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" "bc5c51d1ece1ee45f94b056a0f5a1674d7e8cba9" -blob' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> Name Blob -> IO (Either Error Blob) +blob' :: Maybe Auth -> Name Owner -> Name Repo -> Name Blob -> IO (Either Error Blob) blob' auth user repo sha = executeRequestMaybe auth $ blobR user repo sha --- | Get a blob by SHA1. +-- | Query a blob by SHA1. -- -- > blob "thoughtbot" "paperclip" "bc5c51d1ece1ee45f94b056a0f5a1674d7e8cba9" -blob :: Name GithubOwner -> Name Repo -> Name Blob -> IO (Either Error Blob) +blob :: Name Owner -> Name Repo -> Name Blob -> IO (Either Error Blob) blob = blob' Nothing --- | Get a blob. +-- | Query a blob. -- See -blobR :: Name GithubOwner -> Name Repo -> Name Blob -> GithubRequest k Blob +blobR :: Name Owner -> Name Repo -> Name Blob -> Request k Blob blobR user repo sha = - GithubGet ["repos", toPathPart user, toPathPart repo, "git", "blobs", toPathPart sha] [] + Query ["repos", toPathPart user, toPathPart repo, "git", "blobs", toPathPart sha] [] diff --git a/src/GitHub/Endpoints/GitData/Commits.hs b/src/GitHub/Endpoints/GitData/Commits.hs index 4d918094..c4c51ef5 100644 --- a/src/GitHub/Endpoints/GitData/Commits.hs +++ b/src/GitHub/Endpoints/GitData/Commits.hs @@ -17,12 +17,12 @@ import GitHub.Request -- | A single commit, by SHA1. -- -- > commit "thoughtbot" "paperclip" "bc5c51d1ece1ee45f94b056a0f5a1674d7e8cba9" -commit :: Name GithubOwner -> Name Repo -> Name GitCommit -> IO (Either Error GitCommit) +commit :: Name Owner -> Name Repo -> Name GitCommit -> IO (Either Error GitCommit) commit user repo sha = executeRequest' $ gitCommitR user repo sha --- | Get a commit. +-- | Query a commit. -- See -gitCommitR :: Name GithubOwner -> Name Repo -> Name GitCommit -> GithubRequest k GitCommit +gitCommitR :: Name Owner -> Name Repo -> Name GitCommit -> Request k GitCommit gitCommitR user repo sha = - GithubGet ["repos", toPathPart user, toPathPart repo, "git", "commits", toPathPart sha] [] + Query ["repos", toPathPart user, toPathPart repo, "git", "commits", toPathPart sha] [] diff --git a/src/GitHub/Endpoints/GitData/References.hs b/src/GitHub/Endpoints/GitData/References.hs index a57c7c6a..7a1a5137 100644 --- a/src/GitHub/Endpoints/GitData/References.hs +++ b/src/GitHub/Endpoints/GitData/References.hs @@ -29,61 +29,61 @@ import GitHub.Request -- | A single reference by the ref name. -- -- > reference' (Just ("github-username", "github-password")) "mike-burns" "github" "heads/master" -reference' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> Name GitReference -> IO (Either Error GitReference) +reference' :: Maybe Auth -> Name Owner -> Name Repo -> Name GitReference -> IO (Either Error GitReference) reference' auth user repo ref = executeRequestMaybe auth $ referenceR user repo ref -- | A single reference by the ref name. -- -- > reference "mike-burns" "github" "heads/master" -reference :: Name GithubOwner -> Name Repo -> Name GitReference -> IO (Either Error GitReference) +reference :: Name Owner -> Name Repo -> Name GitReference -> IO (Either Error GitReference) reference = reference' Nothing --- | Get a reference. +-- | Query a reference. -- See -referenceR :: Name GithubOwner -> Name Repo -> Name GitReference -> GithubRequest k GitReference +referenceR :: Name Owner -> Name Repo -> Name GitReference -> Request k GitReference referenceR user repo ref = - GithubGet ["repos", toPathPart user, toPathPart repo, "git", "refs", toPathPart ref] [] + Query ["repos", toPathPart user, toPathPart repo, "git", "refs", toPathPart ref] [] -- | The history of references for a repo. -- -- > references "mike-burns" "github" -references' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error (Vector GitReference)) +references' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector GitReference)) references' auth user repo = executeRequestMaybe auth $ referencesR user repo Nothing -- | The history of references for a repo. -- -- > references "mike-burns" "github" -references :: Name GithubOwner -> Name Repo -> IO (Either Error (Vector GitReference)) +references :: Name Owner -> Name Repo -> IO (Either Error (Vector GitReference)) references = references' Nothing --- | Get all References. +-- | Query all References. -- See -referencesR :: Name GithubOwner -> Name Repo -> Maybe Count -> GithubRequest k (Vector GitReference) +referencesR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector GitReference) referencesR user repo = - GithubPagedGet ["repos", toPathPart user, toPathPart repo, "git", "refs"] [] + PagedQuery ["repos", toPathPart user, toPathPart repo, "git", "refs"] [] -- | Create a reference. -createReference :: GithubAuth -> Name GithubOwner -> Name Repo -> NewGitReference -> IO (Either Error GitReference) +createReference :: Auth -> Name Owner -> Name Repo -> NewGitReference -> IO (Either Error GitReference) createReference auth user repo newRef = executeRequest auth $ createReferenceR user repo newRef -- | Create a reference. -- See -createReferenceR :: Name GithubOwner -> Name Repo -> NewGitReference -> GithubRequest 'True GitReference +createReferenceR :: Name Owner -> Name Repo -> NewGitReference -> Request 'True GitReference createReferenceR user repo newRef = - GithubCommand Post ["repos", toPathPart user, toPathPart repo , "git", "refs"] (encode newRef) + Command Post ["repos", toPathPart user, toPathPart repo , "git", "refs"] (encode newRef) -- | Limited references by a namespace. -- -- > namespacedReferences "thoughtbot" "paperclip" "tags" -namespacedReferences :: Name GithubOwner -> Name Repo -> String -> IO (Either Error [GitReference]) +namespacedReferences :: Name Owner -> Name Repo -> String -> IO (Either Error [GitReference]) namespacedReferences user repo namespace = executeRequest' $ namespacedReferencesR user repo namespace --- | Get namespaced references. +-- | Query namespaced references. -- See -namespacedReferencesR :: Name GithubOwner -> Name Repo -> String -> GithubRequest k [GitReference] +namespacedReferencesR :: Name Owner -> Name Repo -> String -> Request k [GitReference] namespacedReferencesR user repo namespace = - GithubGet ["repos", toPathPart user, toPathPart repo, "git", "refs", namespace] [] + Query ["repos", toPathPart user, toPathPart repo, "git", "refs", namespace] [] diff --git a/src/GitHub/Endpoints/GitData/Trees.hs b/src/GitHub/Endpoints/GitData/Trees.hs index b9e3b78f..661737a0 100644 --- a/src/GitHub/Endpoints/GitData/Trees.hs +++ b/src/GitHub/Endpoints/GitData/Trees.hs @@ -22,37 +22,37 @@ import GitHub.Request -- | A tree for a SHA1. -- -- > tree (Just ("github-username", "github-password")) "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844" -tree' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> Name Tree -> IO (Either Error Tree) +tree' :: Maybe Auth -> Name Owner -> Name Repo -> Name Tree -> IO (Either Error Tree) tree' auth user repo sha = executeRequestMaybe auth $ treeR user repo sha -- | A tree for a SHA1. -- -- > tree "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844" -tree :: Name GithubOwner -> Name Repo -> Name Tree -> IO (Either Error Tree) +tree :: Name Owner -> Name Repo -> Name Tree -> IO (Either Error Tree) tree = tree' Nothing --- | Get a Tree. +-- | Query a Tree. -- See -treeR :: Name GithubOwner -> Name Repo -> Name Tree -> GithubRequest k Tree +treeR :: Name Owner -> Name Repo -> Name Tree -> Request k Tree treeR user repo sha = - GithubGet ["repos", toPathPart user, toPathPart repo, "git", "trees", toPathPart sha] [] + Query ["repos", toPathPart user, toPathPart repo, "git", "trees", toPathPart sha] [] -- | A recursively-nested tree for a SHA1. -- -- > nestedTree' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844" -nestedTree' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> Name Tree -> IO (Either Error Tree) +nestedTree' :: Maybe Auth -> Name Owner -> Name Repo -> Name Tree -> IO (Either Error Tree) nestedTree' auth user repo sha = executeRequestMaybe auth $ nestedTreeR user repo sha -- | A recursively-nested tree for a SHA1. -- -- > nestedTree "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844" -nestedTree :: Name GithubOwner -> Name Repo -> Name Tree -> IO (Either Error Tree) +nestedTree :: Name Owner -> Name Repo -> Name Tree -> IO (Either Error Tree) nestedTree = nestedTree' Nothing --- | Get a Tree Recursively. +-- | Query a Tree Recursively. -- See -nestedTreeR :: Name GithubOwner -> Name Repo -> Name Tree -> GithubRequest k Tree +nestedTreeR :: Name Owner -> Name Repo -> Name Tree -> Request k Tree nestedTreeR user repo sha = - GithubGet ["repos", toPathPart user, toPathPart repo, "git", "trees", toPathPart sha] [("recursive", Just "1")] + Query ["repos", toPathPart user, toPathPart repo, "git", "trees", toPathPart sha] [("recursive", Just "1")] diff --git a/src/GitHub/Endpoints/Issues.hs b/src/GitHub/Endpoints/Issues.hs index 89c3543b..f3e7a6c0 100644 --- a/src/GitHub/Endpoints/Issues.hs +++ b/src/GitHub/Endpoints/Issues.hs @@ -39,7 +39,7 @@ import qualified Data.ByteString.Char8 as BS8 -- number.' -- -- > issue' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" "462" -issue' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> Id Issue -> IO (Either Error Issue) +issue' :: Maybe Auth -> Name Owner -> Name Repo -> Id Issue -> IO (Either Error Issue) issue' auth user reqRepoName reqIssueNumber = executeRequestMaybe auth $ issueR user reqRepoName reqIssueNumber @@ -47,20 +47,20 @@ issue' auth user reqRepoName reqIssueNumber = -- number. -- -- > issue "thoughtbot" "paperclip" (Id "462") -issue :: Name GithubOwner -> Name Repo -> Id Issue -> IO (Either Error Issue) +issue :: Name Owner -> Name Repo -> Id Issue -> IO (Either Error Issue) issue = issue' Nothing --- | Get a single issue. +-- | Query a single issue. -- See -issueR :: Name GithubOwner -> Name Repo -> Id Issue -> GithubRequest k Issue +issueR :: Name Owner -> Name Repo -> Id Issue -> Request k Issue issueR user reqRepoName reqIssueNumber = - GithubGet ["repos", toPathPart user, toPathPart reqRepoName, "issues", toPathPart reqIssueNumber] [] + Query ["repos", toPathPart user, toPathPart reqRepoName, "issues", toPathPart 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 -> Name GithubOwner -> Name Repo -> [IssueLimitation] -> IO (Either Error (Vector Issue)) +issuesForRepo' :: Maybe Auth -> Name Owner -> Name Repo -> [IssueLimitation] -> IO (Either Error (Vector Issue)) issuesForRepo' auth user reqRepoName issueLimitations = executeRequestMaybe auth $ issuesForRepoR user reqRepoName issueLimitations Nothing @@ -68,14 +68,14 @@ issuesForRepo' auth user reqRepoName issueLimitations = -- 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 (Vector Issue)) +issuesForRepo :: Name Owner -> Name Repo -> [IssueLimitation] -> IO (Either Error (Vector Issue)) issuesForRepo = issuesForRepo' Nothing -- | List issues for a repository. -- See -issuesForRepoR :: Name GithubOwner -> Name Repo -> [IssueLimitation] -> Maybe Count -> GithubRequest k (Vector Issue) +issuesForRepoR :: Name Owner -> Name Repo -> [IssueLimitation] -> Maybe Count -> Request k (Vector Issue) issuesForRepoR user reqRepoName issueLimitations = - GithubPagedGet ["repos", toPathPart user, toPathPart reqRepoName, "issues"] qs + PagedQuery ["repos", toPathPart user, toPathPart reqRepoName, "issues"] qs where qs = map convert issueLimitations @@ -102,18 +102,18 @@ newIssue title = NewIssue title Nothing Nothing Nothing Nothing -- | Create a new issue. -- --- > createIssue (GithubUser (user, password)) user repo +-- > createIssue (User (user, password)) user repo -- > (newIssue "some_repo") {...} -createIssue :: GithubAuth -> Name GithubOwner -> Name Repo -> NewIssue +createIssue :: Auth -> Name Owner -> Name Repo -> NewIssue -> IO (Either Error Issue) 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 :: Name Owner -> Name Repo -> NewIssue -> Request 'True Issue createIssueR user repo = - GithubCommand Post ["repos", toPathPart user, toPathPart repo, "issues"] . encode + Command Post ["repos", toPathPart user, toPathPart repo, "issues"] . encode -- Editing issues. @@ -122,15 +122,15 @@ editOfIssue = EditIssue Nothing Nothing Nothing Nothing Nothing Nothing -- | Edit an issue. -- --- > editIssue (GithubUser (user, password)) user repo issue +-- > editIssue (User (user, password)) user repo issue -- > editOfIssue {...} -editIssue :: GithubAuth -> Name GithubOwner -> Name Repo -> Id Issue -> EditIssue +editIssue :: Auth -> Name Owner -> Name Repo -> Id Issue -> EditIssue -> IO (Either Error Issue) 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 :: Name Owner -> Name Repo -> Id Issue -> EditIssue -> Request 'True Issue editIssueR user repo iss = - GithubCommand Patch ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iss] . encode + Command Patch ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iss] . encode diff --git a/src/GitHub/Endpoints/Issues/Comments.hs b/src/GitHub/Endpoints/Issues/Comments.hs index d396187b..a6f90234 100644 --- a/src/GitHub/Endpoints/Issues/Comments.hs +++ b/src/GitHub/Endpoints/Issues/Comments.hs @@ -29,65 +29,65 @@ import GitHub.Request -- | A specific comment, by ID. -- -- > comment "thoughtbot" "paperclip" 1468184 -comment :: Name GithubOwner -> Name Repo -> Id Comment -> IO (Either Error IssueComment) +comment :: Name Owner -> Name Repo -> Id Comment -> IO (Either Error IssueComment) comment user repo cid = executeRequest' $ commentR user repo cid --- | Get a single comment. +-- | Query a single comment. -- See -commentR :: Name GithubOwner -> Name Repo -> Id Comment -> GithubRequest k IssueComment +commentR :: Name Owner -> Name Repo -> Id Comment -> Request k IssueComment commentR user repo cid = - GithubGet ["repos", toPathPart user, toPathPart repo, "issues", "comments", toPathPart cid] [] + Query ["repos", toPathPart user, toPathPart repo, "issues", "comments", toPathPart cid] [] -- | All comments on an issue, by the issue's number. -- -- > comments "thoughtbot" "paperclip" 635 -comments :: Name GithubOwner -> Name Repo -> Id Issue -> IO (Either Error (Vector IssueComment)) +comments :: Name Owner -> Name Repo -> Id Issue -> IO (Either Error (Vector 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 -> Name GithubOwner -> Name Repo -> Id Issue -> IO (Either Error (Vector IssueComment)) +-- > comments' (User (user, password)) "thoughtbot" "paperclip" 635 +comments' :: Maybe Auth -> Name Owner -> Name Repo -> Id Issue -> IO (Either Error (Vector IssueComment)) comments' auth user repo iid = executeRequestMaybe auth $ commentsR user repo iid Nothing -- | List comments on an issue. -- See -commentsR :: Name GithubOwner -> Name Repo -> Id Issue -> Maybe Count -> GithubRequest k (Vector IssueComment) +commentsR :: Name Owner -> Name Repo -> Id Issue -> Maybe Count -> Request k (Vector IssueComment) commentsR user repo iid = - GithubPagedGet ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "comments"] [] + PagedQuery ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "comments"] [] -- | Create a new comment. -- --- > createComment (GithubUser (user, password)) user repo issue +-- > createComment (User (user, password)) user repo issue -- > "some words" -createComment :: GithubAuth -> Name GithubOwner -> Name Repo -> Id Issue -> Text +createComment :: Auth -> Name Owner -> Name Repo -> Id Issue -> Text -> IO (Either Error Comment) createComment auth user repo iss body = executeRequest auth $ createCommentR user repo iss body -- | Create a comment. -- See -createCommentR :: Name GithubOwner -> Name Repo -> Id Issue -> Text -> GithubRequest 'True Comment +createCommentR :: Name Owner -> Name Repo -> Id Issue -> Text -> Request 'True Comment createCommentR user repo iss body = - GithubCommand Post parts (encode $ NewComment body) + Command Post parts (encode $ NewComment body) where parts = ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iss, "comments"] -- | Edit a comment. -- --- > editComment (GithubUser (user, password)) user repo commentid +-- > editComment (User (user, password)) user repo commentid -- > "new words" -editComment :: GithubAuth -> Name GithubOwner -> Name Repo -> Id Comment -> Text +editComment :: Auth -> Name Owner -> Name Repo -> Id Comment -> Text -> IO (Either Error Comment) editComment auth user repo commid body = executeRequest auth $ editCommentR user repo commid body -- | Edit a comment. -- See -editCommentR :: Name GithubOwner -> Name Repo -> Id Comment -> Text -> GithubRequest 'True Comment +editCommentR :: Name Owner -> Name Repo -> Id Comment -> Text -> Request 'True Comment editCommentR user repo commid body = - GithubCommand Patch parts (encode $ EditComment body) + Command Patch parts (encode $ EditComment body) where parts = ["repos", toPathPart user, toPathPart repo, "issues", "comments", toPathPart commid] diff --git a/src/GitHub/Endpoints/Issues/Events.hs b/src/GitHub/Endpoints/Issues/Events.hs index 9793cebb..8e555c2d 100644 --- a/src/GitHub/Endpoints/Issues/Events.hs +++ b/src/GitHub/Endpoints/Issues/Events.hs @@ -26,56 +26,56 @@ import GitHub.Request -- | All events that have happened on an issue. -- -- > eventsForIssue "thoughtbot" "paperclip" 49 -eventsForIssue :: Name GithubOwner -> Name Repo -> Id Issue -> IO (Either Error (Vector Event)) +eventsForIssue :: Name Owner -> Name Repo -> Id Issue -> IO (Either Error (Vector Event)) eventsForIssue = eventsForIssue' Nothing -- | All events that have happened on an issue, using authentication. -- --- > eventsForIssue' (GithubUser (user, password)) "thoughtbot" "paperclip" 49 -eventsForIssue' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> Id Issue -> IO (Either Error (Vector Event)) +-- > eventsForIssue' (User (user, password)) "thoughtbot" "paperclip" 49 +eventsForIssue' :: Maybe Auth -> Name Owner -> Name Repo -> Id Issue -> IO (Either Error (Vector Event)) eventsForIssue' auth user repo iid = executeRequestMaybe auth $ eventsForIssueR user repo iid Nothing -- | List events for an issue. -- See -eventsForIssueR :: Name GithubOwner -> Name Repo -> Id Issue -> Maybe Count -> GithubRequest k (Vector Event) +eventsForIssueR :: Name Owner -> Name Repo -> Id Issue -> Maybe Count -> Request k (Vector Event) eventsForIssueR user repo iid = - GithubPagedGet ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "events"] [] + PagedQuery ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "events"] [] -- | All the events for all issues in a repo. -- -- > eventsForRepo "thoughtbot" "paperclip" -eventsForRepo :: Name GithubOwner -> Name Repo -> IO (Either Error (Vector Event)) +eventsForRepo :: Name Owner -> Name Repo -> IO (Either Error (Vector Event)) eventsForRepo = eventsForRepo' Nothing -- | All the events for all issues in a repo, using authentication. -- --- > eventsForRepo' (GithubUser (user, password)) "thoughtbot" "paperclip" -eventsForRepo' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error (Vector Event)) +-- > eventsForRepo' (User (user, password)) "thoughtbot" "paperclip" +eventsForRepo' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Event)) eventsForRepo' auth user repo = executeRequestMaybe auth $ eventsForRepoR user repo Nothing -- | List events for a repository. -- See -eventsForRepoR :: Name GithubOwner -> Name Repo -> Maybe Count -> GithubRequest k (Vector Event) +eventsForRepoR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector Event) eventsForRepoR user repo = - GithubPagedGet ["repos", toPathPart user, toPathPart repo, "issues", "events"] [] + PagedQuery ["repos", toPathPart user, toPathPart repo, "issues", "events"] [] -- | Details on a specific event, by the event's ID. -- -- > event "thoughtbot" "paperclip" 5335772 -event :: Name GithubOwner -> Name Repo -> Id Event -> IO (Either Error Event) +event :: Name Owner -> 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 -> Name GithubOwner -> Name Repo -> Id Event -> IO (Either Error Event) +-- > event' (User (user, password)) "thoughtbot" "paperclip" 5335772 +event' :: Maybe Auth -> Name Owner -> Name Repo -> Id Event -> IO (Either Error Event) event' auth user repo eid = executeRequestMaybe auth $ eventR user repo eid --- | Get a single event. +-- | Query a single event. -- See -eventR :: Name GithubOwner -> Name Repo -> Id Event -> GithubRequest k Event +eventR :: Name Owner -> Name Repo -> Id Event -> Request k Event eventR user repo eid = - GithubGet ["repos", toPathPart user, toPathPart repo, "issues", "events", show eid] [] + Query ["repos", toPathPart user, toPathPart repo, "issues", "events", show eid] [] diff --git a/src/GitHub/Endpoints/Issues/Labels.hs b/src/GitHub/Endpoints/Issues/Labels.hs index 6ff83d02..81ad0d50 100644 --- a/src/GitHub/Endpoints/Issues/Labels.hs +++ b/src/GitHub/Endpoints/Issues/Labels.hs @@ -50,62 +50,62 @@ import GitHub.Request -- | All the labels available to use on any issue in the repo. -- -- > labelsOnRepo "thoughtbot" "paperclip" -labelsOnRepo :: Name GithubOwner -> Name Repo -> IO (Either Error (Vector IssueLabel)) +labelsOnRepo :: Name Owner -> Name Repo -> IO (Either Error (Vector IssueLabel)) labelsOnRepo = labelsOnRepo' Nothing -- | All the labels available to use on any issue in the repo using authentication. -- --- > labelsOnRepo' (Just (GithubUser (user password))) "thoughtbot" "paperclip" -labelsOnRepo' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error (Vector IssueLabel)) +-- > labelsOnRepo' (Just (User (user password))) "thoughtbot" "paperclip" +labelsOnRepo' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector IssueLabel)) labelsOnRepo' auth user repo = executeRequestMaybe auth $ labelsOnRepoR user repo Nothing -- | List all labels for this repository. -- See -labelsOnRepoR :: Name GithubOwner -> Name Repo -> Maybe Count -> GithubRequest k (Vector IssueLabel) +labelsOnRepoR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector IssueLabel) labelsOnRepoR user repo = - GithubPagedGet ["repos", toPathPart user, toPathPart repo, "labels"] [] + PagedQuery ["repos", toPathPart user, toPathPart repo, "labels"] [] -- | A label by name. -- -- > label "thoughtbot" "paperclip" "bug" -label :: Name GithubOwner -> Name Repo -> Name IssueLabel -> IO (Either Error IssueLabel) +label :: Name Owner -> Name Repo -> Name IssueLabel -> IO (Either Error IssueLabel) label = label' Nothing -- | A label by name using authentication. -- --- > label' (Just (GithubUser (user password))) "thoughtbot" "paperclip" "bug" -label' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> Name IssueLabel -> IO (Either Error IssueLabel) +-- > label' (Just (User (user password))) "thoughtbot" "paperclip" "bug" +label' :: Maybe Auth -> Name Owner -> Name Repo -> Name IssueLabel -> IO (Either Error IssueLabel) label' auth user repo lbl = executeRequestMaybe auth $ labelR user repo lbl --- | Get a single label. +-- | Query a single label. -- See -labelR :: Name GithubOwner -> Name Repo -> Name IssueLabel -> GithubRequest k IssueLabel +labelR :: Name Owner -> Name Repo -> Name IssueLabel -> Request k IssueLabel labelR user repo lbl = - GithubGet ["repos", toPathPart user, toPathPart repo, "labels", toPathPart lbl] [] + Query ["repos", toPathPart user, toPathPart repo, "labels", toPathPart lbl] [] -- | Create a label -- --- > createLabel (GithubUser (user password)) "thoughtbot" "paperclip" "bug" "f29513" -createLabel :: GithubAuth -> Name GithubOwner -> Name Repo -> Name IssueLabel -> String -> IO (Either Error IssueLabel) +-- > createLabel (User (user password)) "thoughtbot" "paperclip" "bug" "f29513" +createLabel :: Auth -> Name Owner -> 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 :: Name Owner -> Name Repo -> Name IssueLabel -> String -> Request 'True IssueLabel createLabelR user repo lbl color = - GithubCommand Post paths $ encode body + Command Post paths $ encode body where paths = ["repos", toPathPart user, toPathPart repo, "labels"] body = object ["name" .= untagName lbl, "color" .= color] -- | Update a label -- --- > updateLabel (GithubUser (user password)) "thoughtbot" "paperclip" "bug" "new-bug" "ff1111" -updateLabel :: GithubAuth - -> Name GithubOwner +-- > updateLabel (User (user password)) "thoughtbot" "paperclip" "bug" "new-bug" "ff1111" +updateLabel :: Auth + -> Name Owner -> Name Repo -> Name IssueLabel -- ^ old label name -> Name IssueLabel -- ^ new label name @@ -116,56 +116,56 @@ updateLabel auth user repo oldLbl newLbl color = -- | Update a label. -- See -updateLabelR :: Name GithubOwner +updateLabelR :: Name Owner -> Name Repo -> Name IssueLabel -- ^ old label name -> Name IssueLabel -- ^ new label name -> String -- ^ new color - -> GithubRequest 'True IssueLabel + -> Request 'True IssueLabel updateLabelR user repo oldLbl newLbl color = - GithubCommand Patch paths (encode body) + Command Patch paths (encode body) where paths = ["repos", toPathPart user, toPathPart repo, "labels", toPathPart oldLbl] body = object ["name" .= untagName newLbl, "color" .= color] -- | Delete a label -- --- > deleteLabel (GithubUser (user password)) "thoughtbot" "paperclip" "bug" -deleteLabel :: GithubAuth -> Name GithubOwner -> Name Repo -> Name IssueLabel -> IO (Either Error ()) +-- > deleteLabel (User (user password)) "thoughtbot" "paperclip" "bug" +deleteLabel :: Auth -> Name Owner -> 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 :: Name Owner -> Name Repo -> Name IssueLabel -> Request 'True () deleteLabelR user repo lbl = - GithubCommand Delete ["repos", toPathPart user, toPathPart repo, "labels", toPathPart lbl] mempty + Command Delete ["repos", toPathPart user, toPathPart repo, "labels", toPathPart lbl] mempty -- | The labels on an issue in a repo. -- -- > labelsOnIssue "thoughtbot" "paperclip" 585 -labelsOnIssue :: Name GithubOwner -> Name Repo -> Id Issue -> IO (Either Error (Vector IssueLabel)) +labelsOnIssue :: Name Owner -> Name Repo -> Id Issue -> IO (Either Error (Vector IssueLabel)) labelsOnIssue = labelsOnIssue' Nothing -- | The labels on an issue in a repo using authentication. -- --- > labelsOnIssue' (Just (GithubUser (user password))) "thoughtbot" "paperclip" (Id 585) -labelsOnIssue' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> Id Issue -> IO (Either Error (Vector IssueLabel)) +-- > labelsOnIssue' (Just (User (user password))) "thoughtbot" "paperclip" (Id 585) +labelsOnIssue' :: Maybe Auth -> Name Owner -> Name Repo -> Id Issue -> IO (Either Error (Vector IssueLabel)) labelsOnIssue' auth user repo iid = executeRequestMaybe auth $ labelsOnIssueR user repo iid Nothing -- | List labels on an issue. -- See -labelsOnIssueR :: Name GithubOwner -> Name Repo -> Id Issue -> Maybe Count -> GithubRequest k (Vector IssueLabel) +labelsOnIssueR :: Name Owner -> Name Repo -> Id Issue -> Maybe Count -> Request k (Vector IssueLabel) labelsOnIssueR user repo iid = - GithubPagedGet ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] [] + PagedQuery ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] [] -- | Add labels to an issue. -- --- > addLabelsToIssue (GithubUser (user password)) "thoughtbot" "paperclip" (Id 585) ["Label1" "Label2"] +-- > addLabelsToIssue (User (user password)) "thoughtbot" "paperclip" (Id 585) ["Label1" "Label2"] addLabelsToIssue :: Foldable f - => GithubAuth - -> Name GithubOwner + => Auth + -> Name Owner -> Name Repo -> Id Issue -> f (Name IssueLabel) @@ -176,35 +176,35 @@ addLabelsToIssue auth user repo iid lbls = -- | Add lables to an issue. -- See addLabelsToIssueR :: Foldable f - => Name GithubOwner + => Name Owner -> Name Repo -> Id Issue -> f (Name IssueLabel) - -> GithubRequest 'True (Vector IssueLabel) + -> Request 'True (Vector IssueLabel) addLabelsToIssueR user repo iid lbls = - GithubCommand Post paths (encode $ toList lbls) + Command Post paths (encode $ toList lbls) where paths = ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] -- | Remove a label from an issue. -- --- > removeLabelFromIssue (GithubUser (user password)) "thoughtbot" "paperclip" (Id 585) "bug" -removeLabelFromIssue :: GithubAuth -> Name GithubOwner -> Name Repo -> Id Issue -> Name IssueLabel -> IO (Either Error ()) +-- > removeLabelFromIssue (User (user password)) "thoughtbot" "paperclip" (Id 585) "bug" +removeLabelFromIssue :: Auth -> Name Owner -> 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 :: Name Owner -> Name Repo -> Id Issue -> Name IssueLabel -> Request 'True () removeLabelFromIssueR user repo iid lbl = - GithubCommand Delete ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels", toPathPart lbl] mempty + Command Delete ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels", toPathPart lbl] mempty -- | Replace all labels on an issue. Sending an empty list will remove all labels from the issue. -- --- > replaceAllLabelsForIssue (GithubUser (user password)) "thoughtbot" "paperclip" (Id 585) ["Label1" "Label2"] +-- > replaceAllLabelsForIssue (User (user password)) "thoughtbot" "paperclip" (Id 585) ["Label1" "Label2"] replaceAllLabelsForIssue :: Foldable f - => GithubAuth - -> Name GithubOwner + => Auth + -> Name Owner -> Name Repo -> Id Issue -> f (Name IssueLabel) @@ -217,44 +217,44 @@ replaceAllLabelsForIssue auth user repo iid lbls = -- -- Sending an empty list will remove all labels from the issue. replaceAllLabelsForIssueR :: Foldable f - => Name GithubOwner + => Name Owner -> Name Repo -> Id Issue -> f (Name IssueLabel) - -> GithubRequest 'True (Vector IssueLabel) + -> Request 'True (Vector IssueLabel) replaceAllLabelsForIssueR user repo iid lbls = - GithubCommand Put paths (encode $ toList lbls) + Command Put paths (encode $ toList lbls) where paths = ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] -- | Remove all labels from an issue. -- --- > removeAllLabelsFromIssue (GithubUser (user password)) "thoughtbot" "paperclip" (Id 585) -removeAllLabelsFromIssue :: GithubAuth -> Name GithubOwner -> Name Repo -> Id Issue -> IO (Either Error ()) +-- > removeAllLabelsFromIssue (User (user password)) "thoughtbot" "paperclip" (Id 585) +removeAllLabelsFromIssue :: Auth -> Name Owner -> 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 :: Name Owner -> Name Repo -> Id Issue -> Request 'True () removeAllLabelsFromIssueR user repo iid = - GithubCommand Delete ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] mempty + Command Delete ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] mempty -- | All the labels on a repo's milestone given the milestone ID. -- -- > labelsOnMilestone "thoughtbot" "paperclip" (Id 2) -labelsOnMilestone :: Name GithubOwner -> Name Repo -> Id Milestone -> IO (Either Error (Vector IssueLabel)) +labelsOnMilestone :: Name Owner -> Name Repo -> Id Milestone -> IO (Either Error (Vector IssueLabel)) labelsOnMilestone = labelsOnMilestone' Nothing -- | All the labels on a repo's milestone given the milestone ID using authentication. -- --- > labelsOnMilestone' (Just (GithubUser (user password))) "thoughtbot" "paperclip" (Id 2) -labelsOnMilestone' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> Id Milestone -> IO (Either Error (Vector IssueLabel)) +-- > labelsOnMilestone' (Just (User (user password))) "thoughtbot" "paperclip" (Id 2) +labelsOnMilestone' :: Maybe Auth -> Name Owner -> Name Repo -> Id Milestone -> IO (Either Error (Vector IssueLabel)) labelsOnMilestone' auth user repo mid = executeRequestMaybe auth $ labelsOnMilestoneR user repo mid Nothing --- | Get labels for every issue in a milestone. +-- | Query labels for every issue in a milestone. -- See -labelsOnMilestoneR :: Name GithubOwner -> Name Repo -> Id Milestone -> Maybe Count -> GithubRequest k (Vector IssueLabel) +labelsOnMilestoneR :: Name Owner -> Name Repo -> Id Milestone -> Maybe Count -> Request k (Vector IssueLabel) labelsOnMilestoneR user repo mid = - GithubPagedGet ["repos", toPathPart user, toPathPart repo, "milestones", toPathPart mid, "labels"] [] + PagedQuery ["repos", toPathPart user, toPathPart repo, "milestones", toPathPart mid, "labels"] [] diff --git a/src/GitHub/Endpoints/Issues/Milestones.hs b/src/GitHub/Endpoints/Issues/Milestones.hs index 827c7b95..91447df2 100644 --- a/src/GitHub/Endpoints/Issues/Milestones.hs +++ b/src/GitHub/Endpoints/Issues/Milestones.hs @@ -22,30 +22,30 @@ import GitHub.Request -- | All milestones in the repo. -- -- > milestones "thoughtbot" "paperclip" -milestones :: Name GithubOwner -> Name Repo -> IO (Either Error (Vector Milestone)) +milestones :: Name Owner -> Name Repo -> IO (Either Error (Vector Milestone)) milestones = milestones' Nothing -- | All milestones in the repo, using authentication. -- --- > milestones' (GithubUser (user, passwordG) "thoughtbot" "paperclip" -milestones' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error (Vector Milestone)) +-- > milestones' (User (user, passwordG) "thoughtbot" "paperclip" +milestones' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Milestone)) milestones' auth user repo = executeRequestMaybe auth $ milestonesR user repo Nothing -- | List milestones for a repository. -- See -milestonesR :: Name GithubOwner -> Name Repo -> Maybe Count -> GithubRequest k (Vector Milestone) -milestonesR user repo = GithubPagedGet ["repos", toPathPart user, toPathPart repo, "milestones"] [] +milestonesR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector Milestone) +milestonesR user repo = PagedQuery ["repos", toPathPart user, toPathPart repo, "milestones"] [] -- | Details on a specific milestone, given it's milestone number. -- -- > milestone "thoughtbot" "paperclip" (Id 2) -milestone :: Name GithubOwner -> Name Repo -> Id Milestone -> IO (Either Error Milestone) +milestone :: Name Owner -> Name Repo -> Id Milestone -> IO (Either Error Milestone) milestone user repo mid = executeRequest' $ milestoneR user repo mid --- | Get a single milestone. +-- | Query a single milestone. -- See -milestoneR :: Name GithubOwner -> Name Repo -> Id Milestone -> GithubRequest k Milestone +milestoneR :: Name Owner -> Name Repo -> Id Milestone -> Request k Milestone milestoneR user repo mid = - GithubGet ["repos", toPathPart user, toPathPart repo, "milestones", toPathPart mid] [] + Query ["repos", toPathPart user, toPathPart repo, "milestones", toPathPart mid] [] diff --git a/src/GitHub/Endpoints/Organizations.hs b/src/GitHub/Endpoints/Organizations.hs index ee9609d9..d10d745a 100644 --- a/src/GitHub/Endpoints/Organizations.hs +++ b/src/GitHub/Endpoints/Organizations.hs @@ -21,7 +21,7 @@ import GitHub.Request -- | The public organizations for a user, given the user's login, with authorization -- -- > publicOrganizationsFor' (Just ("github-username", "github-password")) "mike-burns" -publicOrganizationsFor' :: Maybe GithubAuth -> Name User -> IO (Either Error (Vector SimpleOrganization)) +publicOrganizationsFor' :: Maybe Auth -> Name User -> IO (Either Error (Vector SimpleOrganization)) publicOrganizationsFor' auth org = executeRequestMaybe auth $ publicOrganizationsForR org Nothing @@ -33,22 +33,22 @@ publicOrganizationsFor = publicOrganizationsFor' Nothing -- | List user organizations. -- See -publicOrganizationsForR :: Name User -> Maybe Count -> GithubRequest k (Vector SimpleOrganization) -publicOrganizationsForR user = GithubPagedGet ["users", toPathPart user, "orgs"] [] +publicOrganizationsForR :: Name User -> Maybe Count -> Request k (Vector SimpleOrganization) +publicOrganizationsForR user = PagedQuery ["users", toPathPart user, "orgs"] [] -- | Details on a public organization. Takes the organization's login. -- -- > publicOrganization' (Just ("github-username", "github-password")) "thoughtbot" -publicOrganization' :: Maybe GithubAuth -> Name Organization -> IO (Either Error Organization) +publicOrganization' :: Maybe Auth -> Name Organization -> IO (Either Error Organization) publicOrganization' auth = executeRequestMaybe auth . publicOrganizationR --- | Get an organization. Details on a public organization. Takes the organization's login. +-- | Query an organization. Details on a public organization. Takes the organization's login. -- -- > publicOrganization "thoughtbot" publicOrganization :: Name Organization -> IO (Either Error Organization) publicOrganization = publicOrganization' Nothing --- | Get an organization. +-- | Query an organization. -- See -publicOrganizationR :: Name Organization -> GithubRequest k Organization -publicOrganizationR reqOrganizationName = GithubGet ["orgs", toPathPart reqOrganizationName] [] +publicOrganizationR :: Name Organization -> Request k Organization +publicOrganizationR reqOrganizationName = Query ["orgs", toPathPart reqOrganizationName] [] diff --git a/src/GitHub/Endpoints/Organizations/Members.hs b/src/GitHub/Endpoints/Organizations/Members.hs index 721d139e..7f733066 100644 --- a/src/GitHub/Endpoints/Organizations/Members.hs +++ b/src/GitHub/Endpoints/Organizations/Members.hs @@ -20,8 +20,8 @@ import GitHub.Request -- | All the users who are members of the specified organization, -- | with or without authentication. -- --- > membersOf' (Just $ GithubOAuth "token") "thoughtbot" -membersOf' :: Maybe GithubAuth -> Name Organization -> IO (Either Error (Vector SimpleUser)) +-- > membersOf' (Just $ OAuth "token") "thoughtbot" +membersOf' :: Maybe Auth -> Name Organization -> IO (Either Error (Vector SimpleUser)) membersOf' auth org = executeRequestMaybe auth $ membersOfR org Nothing @@ -35,5 +35,5 @@ membersOf = membersOf' Nothing -- | All the users who are members of the specified organization. -- -- See -membersOfR :: Name Organization -> Maybe Count -> GithubRequest k (Vector SimpleUser) -membersOfR organization = GithubPagedGet ["orgs", toPathPart organization, "members"] [] +membersOfR :: Name Organization -> Maybe Count -> Request k (Vector SimpleUser) +membersOfR organization = PagedQuery ["orgs", toPathPart organization, "members"] [] diff --git a/src/GitHub/Endpoints/Organizations/Teams.hs b/src/GitHub/Endpoints/Organizations/Teams.hs index 13b126ed..e9dde690 100644 --- a/src/GitHub/Endpoints/Organizations/Teams.hs +++ b/src/GitHub/Endpoints/Organizations/Teams.hs @@ -4,7 +4,7 @@ -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- --- The GithubOwner teams API as described on +-- The Owner teams API as described on -- . module GitHub.Endpoints.Organizations.Teams ( teamsOf, @@ -40,16 +40,16 @@ import Data.Vector (Vector) import GitHub.Data import GitHub.Request --- | List teams. List the teams of an GithubOwner. +-- | List teams. List the teams of an Owner. -- When authenticated, lists private teams visible to the authenticated user. --- When unauthenticated, lists only public teams for an GithubOwner. +-- When unauthenticated, lists only public teams for an Owner. -- --- > teamsOf' (Just $ GithubOAuth "token") "thoughtbot" -teamsOf' :: Maybe GithubAuth -> Name Organization -> IO (Either Error (Vector SimpleTeam)) +-- > teamsOf' (Just $ OAuth "token") "thoughtbot" +teamsOf' :: Maybe Auth -> Name Organization -> IO (Either Error (Vector SimpleTeam)) teamsOf' auth org = executeRequestMaybe auth $ teamsOfR org Nothing --- | List the public teams of an GithubOwner. +-- | List the public teams of an Owner. -- -- > teamsOf "thoughtbot" teamsOf :: Name Organization -> IO (Either Error (Vector SimpleTeam)) @@ -57,33 +57,33 @@ teamsOf = teamsOf' Nothing -- | List teams. -- See -teamsOfR :: Name Organization -> Maybe Count -> GithubRequest k (Vector SimpleTeam) -teamsOfR org = GithubPagedGet ["orgs", toPathPart org, "teams"] [] +teamsOfR :: Name Organization -> Maybe Count -> Request k (Vector SimpleTeam) +teamsOfR org = PagedQuery ["orgs", toPathPart org, "teams"] [] -- | The information for a single team, by team id. -- | With authentication -- --- > teamInfoFor' (Just $ GithubOAuth "token") 1010101 -teamInfoFor' :: Maybe GithubAuth -> Id Team -> IO (Either Error Team) +-- > teamInfoFor' (Just $ OAuth "token") 1010101 +teamInfoFor' :: Maybe Auth -> Id Team -> IO (Either Error Team) teamInfoFor' auth tid = executeRequestMaybe auth $ teamInfoForR tid -- | The information for a single team, by team id. -- --- > teamInfoFor' (Just $ GithubOAuth "token") 1010101 +-- > teamInfoFor' (Just $ OAuth "token") 1010101 teamInfoFor :: Id Team -> IO (Either Error Team) teamInfoFor = teamInfoFor' Nothing --- | Get team. +-- | Query team. -- See -teamInfoForR :: Id Team -> GithubRequest k Team +teamInfoForR :: Id Team -> Request k Team teamInfoForR tid = - GithubGet ["teams", toPathPart tid] [] + Query ["teams", toPathPart tid] [] --- | Create a team under an GithubOwner +-- | Create a team under an Owner -- --- > createTeamFor' (GithubOAuth "token") "GithubOwner" (CreateTeam "newteamname" "some description" [] PermssionPull) -createTeamFor' :: GithubAuth +-- > createTeamFor' (OAuth "token") "Owner" (CreateTeam "newteamname" "some description" [] PermssionPull) +createTeamFor' :: Auth -> Name Organization -> CreateTeam -> IO (Either Error Team) @@ -92,14 +92,14 @@ createTeamFor' auth org cteam = -- | Create team. -- See -createTeamForR :: Name Organization -> CreateTeam -> GithubRequest 'True Team +createTeamForR :: Name Organization -> CreateTeam -> Request 'True Team createTeamForR org cteam = - GithubCommand Post ["orgs", toPathPart org, "teams"] (encode cteam) + Command Post ["orgs", toPathPart org, "teams"] (encode cteam) -- | Edit a team, by id. -- -- > editTeamFor' -editTeam' :: GithubAuth +editTeam' :: Auth -> Id Team -> EditTeam -> IO (Either Error Team) @@ -108,76 +108,76 @@ editTeam' auth tid eteam = -- | Edit team. -- See -editTeamR :: Id Team -> EditTeam -> GithubRequest 'True Team +editTeamR :: Id Team -> EditTeam -> Request 'True Team editTeamR tid eteam = - GithubCommand Patch ["teams", toPathPart tid] (encode eteam) + Command Patch ["teams", toPathPart tid] (encode eteam) -- | Delete a team, by id. -- --- > deleteTeam' (GithubOAuth "token") 1010101 -deleteTeam' :: GithubAuth -> Id Team -> IO (Either Error ()) +-- > deleteTeam' (OAuth "token") 1010101 +deleteTeam' :: Auth -> Id Team -> IO (Either Error ()) deleteTeam' auth tid = executeRequest auth $ deleteTeamR tid -- | Delete team. -- See -deleteTeamR :: Id Team -> GithubRequest 'True () +deleteTeamR :: Id Team -> Request 'True () deleteTeamR tid = - GithubCommand Delete ["teams", toPathPart tid] mempty + Command Delete ["teams", toPathPart tid] mempty -- | Retrieve team mebership information for a user. -- | With authentication -- --- > teamMembershipInfoFor' (Just $ GithubOAuth "token") 1010101 "mburns" -teamMembershipInfoFor' :: Maybe GithubAuth -> Id Team -> Name GithubOwner -> IO (Either Error TeamMembership) +-- > teamMembershipInfoFor' (Just $ OAuth "token") 1010101 "mburns" +teamMembershipInfoFor' :: Maybe Auth -> Id Team -> Name Owner -> IO (Either Error TeamMembership) teamMembershipInfoFor' auth tid user = executeRequestMaybe auth $ teamMembershipInfoForR tid user --- | Get team membership. +-- | Query team membership. -- See Name GithubOwner -> GithubRequest k TeamMembership +teamMembershipInfoForR :: Id Team -> Name Owner -> Request k TeamMembership teamMembershipInfoForR tid user = - GithubGet ["teams", toPathPart tid, "memberships", toPathPart user] [] + Query ["teams", toPathPart tid, "memberships", toPathPart user] [] -- | Retrieve team mebership information for a user. -- -- > teamMembershipInfoFor 1010101 "mburns" -teamMembershipInfoFor :: Id Team -> Name GithubOwner -> IO (Either Error TeamMembership) +teamMembershipInfoFor :: Id Team -> Name Owner -> IO (Either Error TeamMembership) teamMembershipInfoFor = teamMembershipInfoFor' Nothing -- | Add (or invite) a member to a team. -- --- > addTeamMembershipFor' (GithubOAuth "token") 1010101 "mburns" RoleMember -addTeamMembershipFor' :: GithubAuth -> Id Team -> Name GithubOwner -> Role-> IO (Either Error TeamMembership) +-- > addTeamMembershipFor' (OAuth "token") 1010101 "mburns" RoleMember +addTeamMembershipFor' :: Auth -> Id Team -> Name Owner -> Role-> IO (Either Error TeamMembership) addTeamMembershipFor' auth tid user role = executeRequest auth $ addTeamMembershipForR tid user role -- | Add team membership. -- See -addTeamMembershipForR :: Id Team -> Name GithubOwner -> Role -> GithubRequest 'True TeamMembership +addTeamMembershipForR :: Id Team -> Name Owner -> Role -> Request 'True TeamMembership addTeamMembershipForR tid user role = - GithubCommand Put ["teams", toPathPart tid, "memberships", toPathPart user] (encode $ CreateTeamMembership role) + Command Put ["teams", toPathPart tid, "memberships", toPathPart user] (encode $ CreateTeamMembership role) -- | Delete a member of a team. -- --- > deleteTeamMembershipFor' (GithubOAuth "token") 1010101 "mburns" -deleteTeamMembershipFor' :: GithubAuth -> Id Team -> Name GithubOwner -> IO (Either Error ()) +-- > deleteTeamMembershipFor' (OAuth "token") 1010101 "mburns" +deleteTeamMembershipFor' :: Auth -> Id Team -> Name Owner -> IO (Either Error ()) deleteTeamMembershipFor' auth tid user = executeRequest auth $ deleteTeamMembershipForR tid user -- | Remove team membership. -- See -deleteTeamMembershipForR :: Id Team -> Name GithubOwner -> GithubRequest 'True () +deleteTeamMembershipForR :: Id Team -> Name Owner -> Request 'True () deleteTeamMembershipForR tid user = - GithubCommand Delete ["teams", toPathPart tid, "memberships", toPathPart user] mempty + Command Delete ["teams", toPathPart tid, "memberships", toPathPart user] mempty -- | List teams for current authenticated user -- --- > listTeamsCurrent' (GithubOAuth "token") -listTeamsCurrent' :: GithubAuth -> IO (Either Error (Vector Team)) +-- > listTeamsCurrent' (OAuth "token") +listTeamsCurrent' :: Auth -> IO (Either Error (Vector Team)) listTeamsCurrent' auth = executeRequest auth $ listTeamsCurrentR Nothing -- | List user teams. -- See -listTeamsCurrentR :: Maybe Count -> GithubRequest 'True (Vector Team) -listTeamsCurrentR = GithubPagedGet ["user", "teams"] [] +listTeamsCurrentR :: Maybe Count -> Request 'True (Vector Team) +listTeamsCurrentR = PagedQuery ["user", "teams"] [] diff --git a/src/GitHub/Endpoints/PullRequests.hs b/src/GitHub/Endpoints/PullRequests.hs index cd5a19aa..aede7adc 100644 --- a/src/GitHub/Endpoints/PullRequests.hs +++ b/src/GitHub/Endpoints/PullRequests.hs @@ -47,7 +47,7 @@ import qualified Data.ByteString.Char8 as BS8 -- -- State can be one of @all@, @open@, or @closed@. Default is @open@. -- -pullRequestsFor'' :: Maybe GithubAuth -> Maybe String -> Name GithubOwner -> Name Repo -> IO (Either Error (Vector SimplePullRequest)) +pullRequestsFor'' :: Maybe Auth -> Maybe String -> Name Owner -> Name Repo -> IO (Either Error (Vector SimplePullRequest)) pullRequestsFor'' auth state user repo = executeRequestMaybe auth $ pullRequestsForR user repo state Nothing @@ -55,23 +55,23 @@ pullRequestsFor'' auth state user repo = -- | With authentification -- -- > pullRequestsFor' (Just ("github-username", "github-password")) "rails" "rails" -pullRequestsFor' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error (Vector SimplePullRequest)) +pullRequestsFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector SimplePullRequest)) pullRequestsFor' auth = pullRequestsFor'' auth Nothing -- | All pull requests for the repo, by owner and repo name. -- -- > pullRequestsFor "rails" "rails" -pullRequestsFor :: Name GithubOwner -> Name Repo -> IO (Either Error (Vector SimplePullRequest)) +pullRequestsFor :: Name Owner -> Name Repo -> IO (Either Error (Vector SimplePullRequest)) pullRequestsFor = pullRequestsFor'' Nothing Nothing -- | List pull requests. -- See -pullRequestsForR :: Name GithubOwner -> Name Repo +pullRequestsForR :: Name Owner -> Name Repo -> Maybe String -- ^ State -> Maybe Count - -> GithubRequest k (Vector SimplePullRequest) + -> Request k (Vector SimplePullRequest) pullRequestsForR user repo state = - GithubPagedGet ["repos", toPathPart user, toPathPart repo, "pulls"] qs + PagedQuery ["repos", toPathPart user, toPathPart repo, "pulls"] qs where qs = maybe [] (\s -> [("state", Just . BS8.pack $ s)]) state @@ -80,7 +80,7 @@ pullRequestsForR user repo state = -- | With authentification -- -- > pullRequest' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" 562 -pullRequest' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> Id PullRequest -> IO (Either Error PullRequest) +pullRequest' :: Maybe Auth -> Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error PullRequest) pullRequest' auth user repo prid = executeRequestMaybe auth $ pullRequestR user repo prid @@ -88,17 +88,17 @@ pullRequest' auth user repo prid = -- repo owner and name along with the number assigned to the pull request. -- -- > pullRequest "thoughtbot" "paperclip" 562 -pullRequest :: Name GithubOwner -> Name Repo -> Id PullRequest -> IO (Either Error PullRequest) +pullRequest :: Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error PullRequest) pullRequest = pullRequest' Nothing --- | Get a single pull request. +-- | Query a single pull request. -- See -pullRequestR :: Name GithubOwner -> Name Repo -> Id PullRequest -> GithubRequest k PullRequest +pullRequestR :: Name Owner -> Name Repo -> Id PullRequest -> Request k PullRequest pullRequestR user repo prid = - GithubGet ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid] [] + Query ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid] [] -createPullRequest :: GithubAuth - -> Name GithubOwner +createPullRequest :: Auth + -> Name Owner -> Name Repo -> CreatePullRequest -> IO (Either Error PullRequest) @@ -107,34 +107,34 @@ createPullRequest auth user repo cpr = -- | Create a pull request. -- See -createPullRequestR :: Name GithubOwner +createPullRequestR :: Name Owner -> Name Repo -> CreatePullRequest - -> GithubRequest 'True PullRequest + -> Request 'True PullRequest createPullRequestR user repo cpr = - GithubCommand Post ["repos", toPathPart user, toPathPart repo, "pulls"] (encode cpr) + Command Post ["repos", toPathPart user, toPathPart repo, "pulls"] (encode cpr) -- | Update a pull request -updatePullRequest :: GithubAuth -> Name GithubOwner -> Name Repo -> Id PullRequest -> EditPullRequest -> IO (Either Error PullRequest) +updatePullRequest :: Auth -> Name Owner -> Name Repo -> Id PullRequest -> EditPullRequest -> IO (Either Error PullRequest) updatePullRequest auth user repo prid epr = executeRequest auth $ updatePullRequestR user repo prid epr -- | Update a pull request. -- See -updatePullRequestR :: Name GithubOwner +updatePullRequestR :: Name Owner -> Name Repo -> Id PullRequest -> EditPullRequest - -> GithubRequest 'True PullRequest + -> Request 'True PullRequest updatePullRequestR user repo prid epr = - GithubCommand Patch ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid] (encode epr) + Command Patch ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart 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 -> Name GithubOwner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector Commit)) +pullRequestCommits' :: Maybe Auth -> Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector Commit)) pullRequestCommits' auth user repo prid = executeRequestMaybe auth $ pullRequestCommitsR user repo prid Nothing @@ -142,21 +142,21 @@ pullRequestCommits' auth user repo prid = -- the number of the pull request. -- -- > pullRequestCommits "thoughtbot" "paperclip" 688 -pullRequestCommitsIO :: Name GithubOwner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector Commit)) +pullRequestCommitsIO :: Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector Commit)) pullRequestCommitsIO = pullRequestCommits' Nothing -- | List commits on a pull request. -- See -pullRequestCommitsR :: Name GithubOwner -> Name Repo -> Id PullRequest -> Maybe Count -> GithubRequest k (Vector Commit) +pullRequestCommitsR :: Name Owner -> Name Repo -> Id PullRequest -> Maybe Count -> Request k (Vector Commit) pullRequestCommitsR user repo prid = - GithubPagedGet ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "commits"] [] + PagedQuery ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart 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 -> Name GithubOwner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector File)) +pullRequestFiles' :: Maybe Auth -> Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector File)) pullRequestFiles' auth user repo prid = executeRequestMaybe auth $ pullRequestFilesR user repo prid Nothing @@ -164,36 +164,36 @@ pullRequestFiles' auth user repo prid = -- name, plus the number assigned to the pull request. -- -- > pullRequestFiles "thoughtbot" "paperclip" 688 -pullRequestFiles :: Name GithubOwner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector File)) +pullRequestFiles :: Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector File)) pullRequestFiles = pullRequestFiles' Nothing -- | List pull requests files. -- See -pullRequestFilesR :: Name GithubOwner -> Name Repo -> Id PullRequest -> Maybe Count -> GithubRequest k (Vector File) +pullRequestFilesR :: Name Owner -> Name Repo -> Id PullRequest -> Maybe Count -> Request k (Vector File) pullRequestFilesR user repo prid = - GithubPagedGet ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "files"] [] + PagedQuery ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "files"] [] -- | Check if pull request has been merged. -isPullRequestMerged :: GithubAuth -> Name GithubOwner -> Name Repo -> Id PullRequest -> IO (Either Error Bool) +isPullRequestMerged :: Auth -> Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error Bool) isPullRequestMerged auth user repo prid = executeRequest auth $ isPullRequestMergedR user repo prid --- | Get if a pull request has been merged. +-- | Query if a pull request has been merged. -- See -isPullRequestMergedR :: Name GithubOwner -> Name Repo -> Id PullRequest -> GithubRequest k Bool -isPullRequestMergedR user repo prid = GithubStatus StatusOnlyOk $ - GithubGet ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "merge"] [] +isPullRequestMergedR :: Name Owner -> Name Repo -> Id PullRequest -> Request k Bool +isPullRequestMergedR user repo prid = StatusQuery StatusOnlyOk $ + Query ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "merge"] [] -- | Merge a pull request. -mergePullRequest :: GithubAuth -> Name GithubOwner -> Name Repo -> Id PullRequest -> Maybe String -> IO (Either Error MergeResult) +mergePullRequest :: Auth -> Name Owner -> Name Repo -> Id PullRequest -> Maybe String -> IO (Either Error MergeResult) 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 PullRequest -> Maybe String -> GithubRequest 'True MergeResult -mergePullRequestR user repo prid commitMessage = GithubStatus StatusMerge $ - GithubCommand Put paths (encode $ buildCommitMessageMap commitMessage) +mergePullRequestR :: Name Owner -> Name Repo -> Id PullRequest -> Maybe String -> Request 'True MergeResult +mergePullRequestR user repo prid commitMessage = StatusQuery StatusMerge $ + Command Put paths (encode $ buildCommitMessageMap commitMessage) where paths = ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "merge"] diff --git a/src/GitHub/Endpoints/PullRequests/ReviewComments.hs b/src/GitHub/Endpoints/PullRequests/ReviewComments.hs index a112cc2a..24402266 100644 --- a/src/GitHub/Endpoints/PullRequests/ReviewComments.hs +++ b/src/GitHub/Endpoints/PullRequests/ReviewComments.hs @@ -20,25 +20,25 @@ import GitHub.Request -- | All the comments on a pull request with the given ID. -- -- > pullRequestReviewComments "thoughtbot" "factory_girl" (Id 256) -pullRequestReviewCommentsIO :: Name GithubOwner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector Comment)) +pullRequestReviewCommentsIO :: Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector Comment)) pullRequestReviewCommentsIO user repo prid = executeRequest' $ pullRequestReviewCommentsR user repo prid Nothing -- | List comments on a pull request. -- See -pullRequestReviewCommentsR :: Name GithubOwner -> Name Repo -> Id PullRequest -> Maybe Count -> GithubRequest k (Vector Comment) +pullRequestReviewCommentsR :: Name Owner -> Name Repo -> Id PullRequest -> Maybe Count -> Request k (Vector Comment) pullRequestReviewCommentsR user repo prid = - GithubPagedGet ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "comments"] [] + 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 GithubOwner -> Name Repo -> Id Comment -> IO (Either Error Comment) +pullRequestReviewComment :: Name Owner -> Name Repo -> Id Comment -> IO (Either Error Comment) pullRequestReviewComment user repo cid = executeRequest' $ pullRequestReviewCommentR user repo cid --- | Get a single comment. +-- | Query a single comment. -- See -pullRequestReviewCommentR :: Name GithubOwner -> Name Repo -> Id Comment -> GithubRequest k Comment +pullRequestReviewCommentR :: Name Owner -> Name Repo -> Id Comment -> Request k Comment pullRequestReviewCommentR user repo cid = - GithubGet ["repos", toPathPart user, toPathPart repo, "pulls", "comments", toPathPart cid] [] + Query ["repos", toPathPart user, toPathPart repo, "pulls", "comments", toPathPart cid] [] diff --git a/src/GitHub/Endpoints/Repos.hs b/src/GitHub/Endpoints/Repos.hs index 254a1dee..d053d461 100644 --- a/src/GitHub/Endpoints/Repos.hs +++ b/src/GitHub/Endpoints/Repos.hs @@ -72,22 +72,22 @@ import GitHub.Request import qualified Data.ByteString.Char8 as BS8 repoPublicityQueryString :: RepoPublicity -> QueryString -repoPublicityQueryString All = [("type", Just "all")] -repoPublicityQueryString Owner = [("type", Just "owner")] -repoPublicityQueryString Member = [("type", Just "member")] -repoPublicityQueryString Public = [("type", Just "public")] -repoPublicityQueryString Private = [("type", Just "private")] +repoPublicityQueryString RepoPublicityAll = [("type", Just "all")] +repoPublicityQueryString RepoPublicityOwner = [("type", Just "owner")] +repoPublicityQueryString RepoPublicityMember = [("type", Just "member")] +repoPublicityQueryString RepoPublicityPublic = [("type", Just "public")] +repoPublicityQueryString RepoPublicityPrivate = [("type", Just "private")] -- | List your repositories. -currentUserRepos :: GithubAuth -> RepoPublicity -> IO (Either Error (Vector Repo)) +currentUserRepos :: Auth -> RepoPublicity -> IO (Either Error (Vector Repo)) currentUserRepos auth publicity = executeRequest auth $ currentUserReposR publicity Nothing -- | List your repositories. -- See -currentUserReposR :: RepoPublicity -> Maybe Count -> GithubRequest k(Vector Repo) +currentUserReposR :: RepoPublicity -> Maybe Count -> Request k(Vector Repo) currentUserReposR publicity = - GithubPagedGet ["user", "repos"] qs + PagedQuery ["user", "repos"] qs where qs = repoPublicityQueryString publicity @@ -95,22 +95,22 @@ currentUserReposR publicity = -- own, are a member of, or publicize. Private repos will return empty list. -- -- > userRepos "mike-burns" All -userRepos :: Name GithubOwner -> RepoPublicity -> IO (Either Error (Vector Repo)) +userRepos :: Name Owner -> RepoPublicity -> IO (Either Error (Vector Repo)) userRepos = userRepos' Nothing -- | The repos for a user, by their login. -- With authentication. -- --- > userRepos' (Just (GithubBasicAuth (user, password))) "mike-burns" All -userRepos' :: Maybe GithubAuth -> Name GithubOwner -> RepoPublicity -> IO (Either Error (Vector Repo)) +-- > userRepos' (Just (BasicAuth (user, password))) "mike-burns" All +userRepos' :: Maybe Auth -> Name Owner -> RepoPublicity -> IO (Either Error (Vector Repo)) userRepos' auth user publicity = executeRequestMaybe auth $ userReposR user publicity Nothing -- | List user repositories. -- See -userReposR :: Name GithubOwner -> RepoPublicity -> Maybe Count -> GithubRequest k(Vector Repo) +userReposR :: Name Owner -> RepoPublicity -> Maybe Count -> Request k(Vector Repo) userReposR user publicity = - GithubPagedGet ["users", toPathPart user, "repos"] qs + PagedQuery ["users", toPathPart user, "repos"] qs where qs = repoPublicityQueryString publicity @@ -118,75 +118,75 @@ userReposR user publicity = -- -- > organizationRepos "thoughtbot" organizationRepos :: Name Organization -> IO (Either Error (Vector Repo)) -organizationRepos org = organizationRepos' Nothing org All +organizationRepos org = organizationRepos' Nothing org RepoPublicityAll -- | The repos for an organization, by the organization name. -- With authentication. -- --- > organizationRepos (Just (GithubBasicAuth (user, password))) "thoughtbot" All -organizationRepos' :: Maybe GithubAuth -> Name Organization -> RepoPublicity -> IO (Either Error (Vector Repo)) +-- > organizationRepos (Just (BasicAuth (user, password))) "thoughtbot" All +organizationRepos' :: Maybe Auth -> Name Organization -> RepoPublicity -> IO (Either Error (Vector Repo)) organizationRepos' auth org publicity = executeRequestMaybe auth $ organizationReposR org publicity Nothing -- | List organization repositories. -- See -organizationReposR :: Name Organization -> RepoPublicity -> Maybe Count -> GithubRequest k (Vector Repo) +organizationReposR :: Name Organization -> RepoPublicity -> Maybe Count -> Request k (Vector Repo) organizationReposR org publicity = - GithubPagedGet ["orgs", toPathPart org, "repos"] qs + PagedQuery ["orgs", toPathPart org, "repos"] qs where qs = repoPublicityQueryString publicity -- | Details on a specific repo, given the owner and repo name. -- -- > userRepo "mike-burns" "github" -repository :: Name GithubOwner -> Name Repo -> IO (Either Error Repo) +repository :: Name Owner -> Name Repo -> IO (Either Error Repo) repository = repository' Nothing -- | Details on a specific repo, given the owner and repo name. -- With authentication. -- --- > userRepo' (Just (GithubBasicAuth (user, password))) "mike-burns" "github" -repository' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error Repo) +-- > userRepo' (Just (BasicAuth (user, password))) "mike-burns" "github" +repository' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error Repo) repository' auth user repo = executeRequestMaybe auth $ repositoryR user repo --- | Get single repository. +-- | Query single repository. -- See -repositoryR :: Name GithubOwner -> Name Repo -> GithubRequest k Repo +repositoryR :: Name Owner -> Name Repo -> Request k Repo repositoryR user repo = - GithubGet ["repos", toPathPart user, toPathPart repo] [] + Query ["repos", toPathPart user, toPathPart repo] [] -- | Create a new repository. -- --- > createRepo' (GithubBasicAuth (user, password)) (newRepo "some_repo") {newRepoHasIssues = Just False} -createRepo' :: GithubAuth -> NewRepo -> IO (Either Error Repo) +-- > createRepo' (BasicAuth (user, password)) (newRepo "some_repo") {newRepoHasIssues = Just False} +createRepo' :: Auth -> NewRepo -> IO (Either Error Repo) createRepo' auth nrepo = executeRequest auth $ createRepoR nrepo -- | Create a new repository. -- See -createRepoR :: NewRepo -> GithubRequest 'True Repo +createRepoR :: NewRepo -> Request 'True Repo createRepoR nrepo = - GithubCommand Post ["user", "repos"] (encode nrepo) + Command Post ["user", "repos"] (encode nrepo) -- | Create a new repository for an organization. -- --- > createOrganizationRepo (GithubBasicAuth (user, password)) "thoughtbot" (newRepo "some_repo") {newRepoHasIssues = Just False} -createOrganizationRepo' :: GithubAuth -> Name Organization -> NewRepo -> IO (Either Error Repo) +-- > createOrganizationRepo (BasicAuth (user, password)) "thoughtbot" (newRepo "some_repo") {newRepoHasIssues = Just False} +createOrganizationRepo' :: Auth -> Name Organization -> NewRepo -> IO (Either Error Repo) createOrganizationRepo' auth org nrepo = executeRequest auth $ createOrganizationRepoR org nrepo -- | Create a new repository for an organization. -- See -createOrganizationRepoR :: Name Organization -> NewRepo -> GithubRequest 'True Repo +createOrganizationRepoR :: Name Organization -> NewRepo -> Request 'True Repo createOrganizationRepoR org nrepo = - GithubCommand Post ["orgs", toPathPart org, "repos"] (encode nrepo) + Command Post ["orgs", toPathPart org, "repos"] (encode nrepo) -- | Edit an existing repository. -- --- > editRepo (GithubBasicAuth (user, password)) "some_user" "some_repo" def {editDescription = Just "some description"} -editRepo :: GithubAuth - -> Name GithubOwner -- ^ owner +-- > editRepo (BasicAuth (user, password)) "some_user" "some_repo" def {editDescription = Just "some description"} +editRepo :: Auth + -> Name Owner -- ^ owner -> Name Repo -- ^ repository name -> EditRepo -> IO (Either Error Repo) @@ -196,9 +196,9 @@ editRepo auth user repo body = -- | Edit an existing repository. -- See -editRepoR :: Name GithubOwner -> Name Repo -> EditRepo -> GithubRequest 'True Repo +editRepoR :: Name Owner -> Name Repo -> EditRepo -> Request 'True Repo editRepoR user repo body = - GithubCommand Patch ["repos", toPathPart user, toPathPart repo] (encode b) + Command Patch ["repos", toPathPart user, toPathPart repo] (encode b) where -- if no name is given, use curent name b = body {editName = editName body <|> Just repo} @@ -206,26 +206,26 @@ editRepoR user repo body = -- | The contributors to a repo, given the owner and repo name. -- -- > contributors "thoughtbot" "paperclip" -contributors :: Name GithubOwner -> Name Repo -> IO (Either Error (Vector Contributor)) +contributors :: Name Owner -> Name Repo -> IO (Either Error (Vector Contributor)) contributors = contributors' Nothing -- | The contributors to a repo, given the owner and repo name. -- With authentication. -- --- > contributors' (Just (GithubBasicAuth (user, password))) "thoughtbot" "paperclip" -contributors' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error (Vector Contributor)) +-- > contributors' (Just (BasicAuth (user, password))) "thoughtbot" "paperclip" +contributors' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Contributor)) contributors' auth user repo = executeRequestMaybe auth $ contributorsR user repo False Nothing -- | List contributors. -- See -contributorsR :: Name GithubOwner +contributorsR :: Name Owner -> Name Repo -> Bool -- ^ Include anonymous -> Maybe Count - -> GithubRequest k (Vector Contributor) + -> Request k (Vector Contributor) contributorsR user repo anon = - GithubPagedGet ["repos", toPathPart user, toPathPart repo, "contributors"] qs + PagedQuery ["repos", toPathPart user, toPathPart repo, "contributors"] qs where qs | anon = [("anon", Just "true")] | otherwise = [] @@ -235,7 +235,7 @@ contributorsR user repo anon = -- and repo name. -- -- > contributorsWithAnonymous "thoughtbot" "paperclip" -contributorsWithAnonymous :: Name GithubOwner -> Name Repo -> IO (Either Error (Vector Contributor)) +contributorsWithAnonymous :: Name Owner -> Name Repo -> IO (Either Error (Vector Contributor)) contributorsWithAnonymous = contributorsWithAnonymous' Nothing -- | The contributors to a repo, including anonymous contributors (such as @@ -243,8 +243,8 @@ contributorsWithAnonymous = contributorsWithAnonymous' Nothing -- and repo name. -- With authentication. -- --- > contributorsWithAnonymous' (Just (GithubBasicAuth (user, password))) "thoughtbot" "paperclip" -contributorsWithAnonymous' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error (Vector Contributor)) +-- > contributorsWithAnonymous' (Just (BasicAuth (user, password))) "thoughtbot" "paperclip" +contributorsWithAnonymous' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Contributor)) contributorsWithAnonymous' auth user repo = executeRequestMaybe auth $ contributorsR user repo True Nothing @@ -252,113 +252,113 @@ contributorsWithAnonymous' auth user repo = -- characters written in that language. Takes the repo owner and name. -- -- > languagesFor "mike-burns" "ohlaunch" -languagesFor :: Name GithubOwner -> Name Repo -> IO (Either Error Languages) +languagesFor :: Name Owner -> Name Repo -> IO (Either Error Languages) languagesFor = languagesFor' Nothing -- | The programming languages used in a repo along with the number of -- characters written in that language. Takes the repo owner and name. -- With authentication. -- --- > languagesFor' (Just (GithubBasicAuth (user, password))) "mike-burns" "ohlaunch" -languagesFor' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error Languages) +-- > languagesFor' (Just (BasicAuth (user, password))) "mike-burns" "ohlaunch" +languagesFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error Languages) languagesFor' auth user repo = executeRequestMaybe auth $ languagesForR user repo -- | List languages. -- See -languagesForR :: Name GithubOwner -> Name Repo -> GithubRequest k Languages +languagesForR :: Name Owner -> Name Repo -> Request k Languages languagesForR user repo = - GithubGet ["repos", toPathPart user, toPathPart repo, "languages"] [] + Query ["repos", toPathPart user, toPathPart repo, "languages"] [] -- | The git tags on a repo, given the repo owner and name. -- -- > tagsFor "thoughtbot" "paperclip" -tagsFor :: Name GithubOwner -> Name Repo -> IO (Either Error (Vector Tag)) +tagsFor :: Name Owner -> Name Repo -> IO (Either Error (Vector Tag)) tagsFor = tagsFor' Nothing -- | The git tags on a repo, given the repo owner and name. -- With authentication. -- --- > tagsFor' (Just (GithubBasicAuth (user, password))) "thoughtbot" "paperclip" -tagsFor' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error (Vector Tag)) +-- > tagsFor' (Just (BasicAuth (user, password))) "thoughtbot" "paperclip" +tagsFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Tag)) tagsFor' auth user repo = executeRequestMaybe auth $ tagsForR user repo Nothing -- | List tags. -- See -tagsForR :: Name GithubOwner -> Name Repo -> Maybe Count -> GithubRequest k (Vector Tag) +tagsForR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector Tag) tagsForR user repo = - GithubPagedGet ["repos", toPathPart user, toPathPart repo, "tags"] [] + PagedQuery ["repos", toPathPart user, toPathPart repo, "tags"] [] -- | The git branches on a repo, given the repo owner and name. -- -- > branchesFor "thoughtbot" "paperclip" -branchesFor :: Name GithubOwner -> Name Repo -> IO (Either Error (Vector Branch)) +branchesFor :: Name Owner -> Name Repo -> IO (Either Error (Vector Branch)) branchesFor = branchesFor' Nothing -- | The git branches on a repo, given the repo owner and name. -- With authentication. -- --- > branchesFor' (Just (GithubBasicAuth (user, password))) "thoughtbot" "paperclip" -branchesFor' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error (Vector Branch)) +-- > branchesFor' (Just (BasicAuth (user, password))) "thoughtbot" "paperclip" +branchesFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Branch)) branchesFor' auth user repo = executeRequestMaybe auth $ branchesForR user repo Nothing -- | List branches. -- See -branchesForR :: Name GithubOwner -> Name Repo -> Maybe Count -> GithubRequest k (Vector Branch) +branchesForR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector Branch) branchesForR user repo = - GithubPagedGet ["repos", toPathPart user, toPathPart repo, "branches"] [] + 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 GithubOwner -> Name Repo -> String -> Maybe String -> IO (Either Error Content) +contentsFor :: Name Owner -> Name Repo -> String -> Maybe String -> 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 (GithubBasicAuth (user, password))) "thoughtbot" "paperclip" "README.md" Nothing -contentsFor' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> String -> Maybe String -> IO (Either Error Content) +-- > contentsFor' (Just (BasicAuth (user, password))) "thoughtbot" "paperclip" "README.md" Nothing +contentsFor' :: Maybe Auth -> Name Owner -> Name Repo -> String -> Maybe String -> IO (Either Error Content) contentsFor' auth user repo path ref = executeRequestMaybe auth $ contentsForR user repo path ref -contentsForR :: Name GithubOwner +contentsForR :: Name Owner -> Name Repo -> String -- ^ file or directory -> Maybe String -- ^ Git commit - -> GithubRequest k Content + -> Request k Content contentsForR user repo path ref = - GithubGet ["repos", toPathPart user, toPathPart repo, "contents", path] qs + Query ["repos", toPathPart user, toPathPart repo, "contents", path] qs where qs = maybe [] (\r -> [("ref", Just . BS8.pack $ r)]) ref -- | The contents of a README file in a repo, given the repo owner and name -- -- > readmeFor "thoughtbot" "paperclip" -readmeFor :: Name GithubOwner -> Name Repo -> IO (Either Error Content) +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 (GithubBasicAuth (user, password))) "thoughtbot" "paperclip" -readmeFor' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error Content) +-- > 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 GithubOwner -> Name Repo -> GithubRequest k Content +readmeForR :: Name Owner -> Name Repo -> Request k Content readmeForR user repo = - GithubGet ["repos", toPathPart user, toPathPart repo, "readme"] [] + Query ["repos", toPathPart user, toPathPart repo, "readme"] [] -- | Delete an existing repository. -- --- > deleteRepo (GithubBasicAuth (user, password)) "thoughtbot" "some_repo" -deleteRepo :: GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error ()) +-- > deleteRepo (BasicAuth (user, password)) "thoughtbot" "some_repo" +deleteRepo :: Auth -> Name Owner -> Name Repo -> IO (Either Error ()) deleteRepo auth user repo = executeRequest auth $ deleteRepoR user repo -deleteRepoR :: Name GithubOwner -> Name Repo -> GithubRequest 'True () +deleteRepoR :: Name Owner -> Name Repo -> Request 'True () deleteRepoR user repo = - GithubCommand Delete ["repos", toPathPart user, toPathPart repo] mempty + Command Delete ["repos", toPathPart user, toPathPart repo] mempty diff --git a/src/GitHub/Endpoints/Repos/Collaborators.hs b/src/GitHub/Endpoints/Repos/Collaborators.hs index d6f3f62d..34ffca78 100644 --- a/src/GitHub/Endpoints/Repos/Collaborators.hs +++ b/src/GitHub/Endpoints/Repos/Collaborators.hs @@ -21,28 +21,28 @@ import GitHub.Request -- | All the users who have collaborated on a repo. -- -- > collaboratorsOn "thoughtbot" "paperclip" -collaboratorsOn :: Name GithubOwner -> Name Repo -> IO (Either Error (Vector SimpleUser)) +collaboratorsOn :: Name Owner -> Name Repo -> IO (Either Error (Vector SimpleUser)) collaboratorsOn = collaboratorsOn' Nothing -- | All the users who have collaborated on a repo. -- With authentication. -collaboratorsOn' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error (Vector SimpleUser)) +collaboratorsOn' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector SimpleUser)) collaboratorsOn' auth user repo = executeRequestMaybe auth $ collaboratorsOnR user repo Nothing -- | List collaborators. -- See -collaboratorsOnR :: Name GithubOwner -> Name Repo -> Maybe Count -> GithubRequest k (Vector SimpleUser) +collaboratorsOnR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector SimpleUser) collaboratorsOnR user repo = - GithubPagedGet ["repos", toPathPart user, toPathPart repo, "collaborators"] [] + PagedQuery ["repos", toPathPart user, toPathPart repo, "collaborators"] [] -- | Whether the user is collaborating on a repo. Takes the user in question, -- the user who owns the repo, and the repo name. -- -- > isCollaboratorOn Nothing "mike-burns" "thoughtbot" "paperclip" -- > isCollaboratorOn Nothing "johnson" "thoughtbot" "paperclip" -isCollaboratorOn :: Maybe GithubAuth - -> Name GithubOwner -- ^ Repository owner +isCollaboratorOn :: Maybe Auth + -> Name Owner -- ^ Repository owner -> Name Repo -- ^ Repository name -> Name User -- ^ Collaborator? -> IO (Either Error Bool) @@ -51,9 +51,9 @@ isCollaboratorOn auth user repo coll = -- | Check if a user is a collaborator. -- See -isCollaboratorOnR :: Name GithubOwner -- ^ Repository owner +isCollaboratorOnR :: Name Owner -- ^ Repository owner -> Name Repo -- ^ Repository name -> Name User -- ^ Collaborator? - -> GithubRequest k Bool -isCollaboratorOnR user repo coll = GithubStatus StatusOnlyOk $ - GithubGet ["repos", toPathPart user, toPathPart repo, "collaborators", toPathPart coll] [] + -> Request k Bool +isCollaboratorOnR user repo coll = StatusQuery StatusOnlyOk $ + Query ["repos", toPathPart user, toPathPart repo, "collaborators", toPathPart coll] [] diff --git a/src/GitHub/Endpoints/Repos/Comments.hs b/src/GitHub/Endpoints/Repos/Comments.hs index a0576b22..95966ec6 100644 --- a/src/GitHub/Endpoints/Repos/Comments.hs +++ b/src/GitHub/Endpoints/Repos/Comments.hs @@ -26,58 +26,58 @@ import GitHub.Request -- | All the comments on a Github repo. -- -- > commentsFor "thoughtbot" "paperclip" -commentsFor :: Name GithubOwner -> Name Repo -> IO (Either Error (Vector Comment)) +commentsFor :: Name Owner -> Name Repo -> IO (Either Error (Vector Comment)) commentsFor = commentsFor' Nothing -- | All the comments on a Github repo. -- With authentication. -- -- > commentsFor "thoughtbot" "paperclip" -commentsFor' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error (Vector Comment)) +commentsFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Comment)) commentsFor' auth user repo = executeRequestMaybe auth $ commentsForR user repo Nothing -- | List commit comments for a repository. -- See -commentsForR :: Name GithubOwner -> Name Repo -> Maybe Count -> GithubRequest k (Vector Comment) +commentsForR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector Comment) commentsForR user repo = - GithubPagedGet ["repos", toPathPart user, toPathPart repo, "comments"] [] + PagedQuery ["repos", toPathPart user, toPathPart repo, "comments"] [] -- | Just the comments on a specific SHA for a given Github repo. -- -- > commitCommentsFor "thoughtbot" "paperclip" "41f685f6e01396936bb8cd98e7cca517e2c7d96b" -commitCommentsFor :: Name GithubOwner -> Name Repo -> Name Commit -> IO (Either Error (Vector Comment)) +commitCommentsFor :: Name Owner -> Name Repo -> Name Commit -> IO (Either Error (Vector Comment)) commitCommentsFor = commitCommentsFor' Nothing -- | Just the comments on a specific SHA for a given Github repo. -- With authentication. -- -- > commitCommentsFor "thoughtbot" "paperclip" "41f685f6e01396936bb8cd98e7cca517e2c7d96b" -commitCommentsFor' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> Name Commit -> IO (Either Error (Vector Comment)) +commitCommentsFor' :: Maybe Auth -> Name Owner -> Name Repo -> Name Commit -> IO (Either Error (Vector Comment)) commitCommentsFor' auth user repo sha = executeRequestMaybe auth $ commitCommentsForR user repo sha Nothing -- | List comments for a single commit. -- See -commitCommentsForR :: Name GithubOwner -> Name Repo -> Name Commit -> Maybe Count -> GithubRequest k (Vector Comment) +commitCommentsForR :: Name Owner -> Name Repo -> Name Commit -> Maybe Count -> Request k (Vector Comment) commitCommentsForR user repo sha = - GithubPagedGet ["repos", toPathPart user, toPathPart repo, "commits", toPathPart sha, "comments"] [] + PagedQuery ["repos", toPathPart user, toPathPart repo, "commits", toPathPart sha, "comments"] [] -- | A comment, by its ID, relative to the Github repo. -- -- > commitCommentFor "thoughtbot" "paperclip" "669575" -commitCommentFor :: Name GithubOwner -> Name Repo -> Id Comment -> IO (Either Error Comment) +commitCommentFor :: Name Owner -> Name Repo -> Id Comment -> IO (Either Error Comment) commitCommentFor = commitCommentFor' Nothing -- | A comment, by its ID, relative to the Github repo. -- -- > commitCommentFor "thoughtbot" "paperclip" "669575" -commitCommentFor' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> Id Comment -> IO (Either Error Comment) +commitCommentFor' :: Maybe Auth -> Name Owner -> Name Repo -> Id Comment -> IO (Either Error Comment) commitCommentFor' auth user repo cid = executeRequestMaybe auth $ commitCommentForR user repo cid --- | Get a single commit comment. +-- | Query a single commit comment. -- See -commitCommentForR :: Name GithubOwner -> Name Repo -> Id Comment -> GithubRequest k Comment +commitCommentForR :: Name Owner -> Name Repo -> Id Comment -> Request k Comment commitCommentForR user repo cid = - GithubGet ["repos", toPathPart user, toPathPart repo, "comments", toPathPart cid] [] + Query ["repos", toPathPart user, toPathPart repo, "comments", toPathPart cid] [] diff --git a/src/GitHub/Endpoints/Repos/Commits.hs b/src/GitHub/Endpoints/Repos/Commits.hs index 68dc42c2..16a68c0e 100644 --- a/src/GitHub/Endpoints/Repos/Commits.hs +++ b/src/GitHub/Endpoints/Repos/Commits.hs @@ -44,39 +44,39 @@ renderCommitQueryOption (CommitQueryUntil date) = ("until", Just $ BS8.pack $ -- | The commit history for a repo. -- -- > commitsFor "mike-burns" "github" -commitsFor :: Name GithubOwner -> Name Repo -> IO (Either Error (Vector Commit)) +commitsFor :: Name Owner -> Name Repo -> IO (Either Error (Vector Commit)) commitsFor = commitsFor' Nothing -- | The commit history for a repo. -- With authentication. -- --- > commitsFor' (Just (GithubBasicAuth (user, password))) "mike-burns" "github" -commitsFor' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error (Vector Commit)) +-- > commitsFor' (Just (BasicAuth (user, password))) "mike-burns" "github" +commitsFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Commit)) commitsFor' auth user repo = commitsWithOptionsFor' auth user repo [] -- | List commits on a repository. -- See -commitsForR :: Name GithubOwner -> Name Repo -> Maybe Count -> GithubRequest k (Vector Commit) +commitsForR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector Commit) commitsForR user repo limit = commitsWithOptionsForR user repo limit [] -commitsWithOptionsFor :: Name GithubOwner -> Name Repo -> [CommitQueryOption] -> IO (Either Error (Vector Commit)) +commitsWithOptionsFor :: Name Owner -> Name Repo -> [CommitQueryOption] -> IO (Either Error (Vector Commit)) commitsWithOptionsFor = commitsWithOptionsFor' Nothing -- | The commit history for a repo, with commits filtered to satisfy a list of -- query options. -- With authentication. -- --- > commitsWithOptionsFor' (Just (GithubBasicAuth (user, password))) "mike-burns" "github" [CommitQueryAuthor "djeik"] -commitsWithOptionsFor' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> [CommitQueryOption] -> IO (Either Error (Vector Commit)) +-- > commitsWithOptionsFor' (Just (BasicAuth (user, password))) "mike-burns" "github" [CommitQueryAuthor "djeik"] +commitsWithOptionsFor' :: Maybe Auth -> Name Owner -> Name Repo -> [CommitQueryOption] -> IO (Either Error (Vector Commit)) commitsWithOptionsFor' auth user repo opts = executeRequestMaybe auth $ commitsWithOptionsForR user repo Nothing opts -- | List commits on a repository. -- See -commitsWithOptionsForR :: Name GithubOwner -> Name Repo -> Maybe Count -> [CommitQueryOption] -> GithubRequest k (Vector Commit) +commitsWithOptionsForR :: Name Owner -> Name Repo -> Maybe Count -> [CommitQueryOption] -> Request k (Vector Commit) commitsWithOptionsForR user repo limit opts = - GithubPagedGet ["repos", toPathPart user, toPathPart repo, "commits"] qs limit + PagedQuery ["repos", toPathPart user, toPathPart repo, "commits"] qs limit where qs = map renderCommitQueryOption opts @@ -84,38 +84,38 @@ commitsWithOptionsForR user repo limit opts = -- | Details on a specific SHA1 for a repo. -- -- > commit "mike-burns" "github" "9d1a9a361266c3c890b1108ad2fdf52f824b1b81" -commit :: Name GithubOwner -> Name Repo -> Name Commit -> IO (Either Error Commit) +commit :: Name Owner -> Name Repo -> Name Commit -> IO (Either Error Commit) commit = commit' Nothing -- | Details on a specific SHA1 for a repo. -- With authentication. -- --- > commit (Just $ GithubBasicAuth (username, password)) "mike-burns" "github" "9d1a9a361266c3c890b1108ad2fdf52f824b1b81" -commit' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> Name Commit -> IO (Either Error Commit) +-- > commit (Just $ BasicAuth (username, password)) "mike-burns" "github" "9d1a9a361266c3c890b1108ad2fdf52f824b1b81" +commit' :: Maybe Auth -> Name Owner -> Name Repo -> Name Commit -> IO (Either Error Commit) commit' auth user repo sha = executeRequestMaybe auth $ commitR user repo sha --- | Get a single commit. +-- | Query a single commit. -- See -commitR :: Name GithubOwner -> Name Repo -> Name Commit -> GithubRequest k Commit +commitR :: Name Owner -> Name Repo -> Name Commit -> Request k Commit commitR user repo sha = - GithubGet ["repos", toPathPart user, toPathPart repo, "commits", toPathPart sha] [] + Query ["repos", toPathPart user, toPathPart repo, "commits", toPathPart sha] [] -- | The diff between two treeishes on a repo. -- -- > diff "thoughtbot" "paperclip" "41f685f6e01396936bb8cd98e7cca517e2c7d96b" "HEAD" -diff :: Name GithubOwner -> Name Repo -> Name Commit -> Name Commit -> IO (Either Error Diff) +diff :: Name Owner -> Name Repo -> Name Commit -> Name Commit -> IO (Either Error Diff) diff = diff' Nothing -- | The diff between two treeishes on a repo. -- -- > diff "thoughtbot" "paperclip" "41f685f6e01396936bb8cd98e7cca517e2c7d96b" "HEAD" -diff' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> Name Commit -> Name Commit -> IO (Either Error Diff) +diff' :: Maybe Auth -> Name Owner -> Name Repo -> Name Commit -> Name Commit -> IO (Either Error Diff) diff' auth user repo base headref = executeRequestMaybe auth $ diffR user repo base headref -- | Compare two commits. -- See -diffR :: Name GithubOwner -> Name Repo -> Name Commit -> Name Commit -> GithubRequest k Diff +diffR :: Name Owner -> Name Repo -> Name Commit -> Name Commit -> Request k Diff diffR user repo base headref = - GithubGet ["repos", toPathPart user, toPathPart repo, "compare", toPathPart base ++ "..." ++ toPathPart headref] [] + Query ["repos", toPathPart user, toPathPart repo, "compare", toPathPart base ++ "..." ++ toPathPart headref] [] diff --git a/src/GitHub/Endpoints/Repos/Forks.hs b/src/GitHub/Endpoints/Repos/Forks.hs index 1fd823ef..a8734a5c 100644 --- a/src/GitHub/Endpoints/Repos/Forks.hs +++ b/src/GitHub/Endpoints/Repos/Forks.hs @@ -19,19 +19,19 @@ import GitHub.Request -- | All the repos that are forked off the given repo. -- -- > forksFor "thoughtbot" "paperclip" -forksFor :: Name GithubOwner -> Name Repo -> IO (Either Error (Vector Repo)) +forksFor :: Name Owner -> Name Repo -> IO (Either Error (Vector Repo)) forksFor = forksFor' Nothing -- | All the repos that are forked off the given repo. -- | With authentication -- --- > forksFor' (Just (GithubUser (user, password))) "thoughtbot" "paperclip" -forksFor' :: Maybe GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error (Vector Repo)) +-- > forksFor' (Just (User (user, password))) "thoughtbot" "paperclip" +forksFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Repo)) forksFor' auth user repo = executeRequestMaybe auth $ forksForR user repo Nothing -- | List forks. -- See -forksForR :: Name GithubOwner -> Name Repo -> Maybe Count -> GithubRequest k (Vector Repo) +forksForR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector Repo) forksForR user repo = - GithubPagedGet ["repos", toPathPart user, toPathPart repo, "forks"] [] + PagedQuery ["repos", toPathPart user, toPathPart repo, "forks"] [] diff --git a/src/GitHub/Endpoints/Repos/Webhooks.hs b/src/GitHub/Endpoints/Repos/Webhooks.hs index 6f2908a7..fa225ac5 100644 --- a/src/GitHub/Endpoints/Repos/Webhooks.hs +++ b/src/GitHub/Endpoints/Repos/Webhooks.hs @@ -42,80 +42,80 @@ import Data.Vector (Vector) import GitHub.Data import GitHub.Request -webhooksFor' :: GithubAuth -> Name GithubOwner -> Name Repo -> IO (Either Error (Vector RepoWebhook)) +webhooksFor' :: Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector RepoWebhook)) webhooksFor' auth user repo = executeRequest auth $ webhooksForR user repo Nothing -- | List hooks. -- See -webhooksForR :: Name GithubOwner -> Name Repo -> Maybe Count -> GithubRequest k (Vector RepoWebhook) +webhooksForR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector RepoWebhook) webhooksForR user repo = - GithubPagedGet ["repos", toPathPart user, toPathPart repo, "hooks"] [] + PagedQuery ["repos", toPathPart user, toPathPart repo, "hooks"] [] -webhookFor' :: GithubAuth -> Name GithubOwner -> Name Repo -> Id RepoWebhook -> IO (Either Error RepoWebhook) +webhookFor' :: Auth -> Name Owner -> Name Repo -> Id RepoWebhook -> IO (Either Error RepoWebhook) webhookFor' auth user repo hookId = executeRequest auth $ webhookForR user repo hookId --- | Get single hook. +-- | Query single hook. -- See -webhookForR :: Name GithubOwner -> Name Repo -> Id RepoWebhook -> GithubRequest k RepoWebhook +webhookForR :: Name Owner -> Name Repo -> Id RepoWebhook -> Request k RepoWebhook webhookForR user repo hookId = - GithubGet ["repos", toPathPart user, toPathPart repo, "hooks", toPathPart hookId] [] + Query ["repos", toPathPart user, toPathPart repo, "hooks", toPathPart hookId] [] -createRepoWebhook' :: GithubAuth -> Name GithubOwner -> Name Repo -> NewRepoWebhook -> IO (Either Error RepoWebhook) +createRepoWebhook' :: Auth -> Name Owner -> Name Repo -> NewRepoWebhook -> IO (Either Error RepoWebhook) createRepoWebhook' auth user repo hook = executeRequest auth $ createRepoWebhookR user repo hook -- | Create a hook. -- See -createRepoWebhookR :: Name GithubOwner -> Name Repo -> NewRepoWebhook -> GithubRequest 'True RepoWebhook +createRepoWebhookR :: Name Owner -> Name Repo -> NewRepoWebhook -> Request 'True RepoWebhook createRepoWebhookR user repo hook = - GithubCommand Post ["repos", toPathPart user, toPathPart repo, "hooks"] (encode hook) + Command Post ["repos", toPathPart user, toPathPart repo, "hooks"] (encode hook) -editRepoWebhook' :: GithubAuth -> Name GithubOwner -> Name Repo -> Id RepoWebhook -> EditRepoWebhook -> IO (Either Error RepoWebhook) +editRepoWebhook' :: Auth -> Name Owner -> Name Repo -> Id RepoWebhook -> EditRepoWebhook -> IO (Either Error RepoWebhook) editRepoWebhook' auth user repo hookId hookEdit = executeRequest auth $ editRepoWebhookR user repo hookId hookEdit -- | Edit a hook. -- See -editRepoWebhookR :: Name GithubOwner -> Name Repo -> Id RepoWebhook -> EditRepoWebhook -> GithubRequest 'True RepoWebhook +editRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> EditRepoWebhook -> Request 'True RepoWebhook editRepoWebhookR user repo hookId hookEdit = - GithubCommand Patch ["repos", toPathPart user, toPathPart repo, "hooks", toPathPart hookId] (encode hookEdit) + Command Patch ["repos", toPathPart user, toPathPart repo, "hooks", toPathPart hookId] (encode hookEdit) -testPushRepoWebhook' :: GithubAuth -> Name GithubOwner -> Name Repo -> Id RepoWebhook -> IO (Either Error Bool) +testPushRepoWebhook' :: Auth -> Name Owner -> Name Repo -> Id RepoWebhook -> IO (Either Error Bool) testPushRepoWebhook' auth user repo hookId = executeRequest auth $ testPushRepoWebhookR user repo hookId -- | Test a push hook. -- See -testPushRepoWebhookR :: Name GithubOwner -> Name Repo -> Id RepoWebhook -> GithubRequest 'True Bool -testPushRepoWebhookR user repo hookId = GithubStatus StatusOnlyOk $ - GithubCommand Post (createWebhookOpPath user repo hookId $ Just "tests") (encode ()) +testPushRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> Request 'True Bool +testPushRepoWebhookR user repo hookId = StatusQuery StatusOnlyOk $ + Command Post (createWebhookOpPath user repo hookId $ Just "tests") (encode ()) -pingRepoWebhook' :: GithubAuth -> Name GithubOwner -> Name Repo -> Id RepoWebhook -> IO (Either Error Bool) +pingRepoWebhook' :: Auth -> Name Owner -> Name Repo -> Id RepoWebhook -> IO (Either Error Bool) pingRepoWebhook' auth user repo hookId = executeRequest auth $ pingRepoWebhookR user repo hookId -- | Ping a hook. -- See -pingRepoWebhookR :: Name GithubOwner -> Name Repo -> Id RepoWebhook -> GithubRequest 'True Bool -pingRepoWebhookR user repo hookId = GithubStatus StatusOnlyOk $ - GithubCommand Post (createWebhookOpPath user repo hookId $ Just "pings") (encode ()) +pingRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> Request 'True Bool +pingRepoWebhookR user repo hookId = StatusQuery StatusOnlyOk $ + Command Post (createWebhookOpPath user repo hookId $ Just "pings") (encode ()) -deleteRepoWebhook' :: GithubAuth -> Name GithubOwner -> Name Repo -> Id RepoWebhook -> IO (Either Error ()) +deleteRepoWebhook' :: Auth -> Name Owner -> Name Repo -> Id RepoWebhook -> IO (Either Error ()) deleteRepoWebhook' auth user repo hookId = executeRequest auth $ deleteRepoWebhookR user repo hookId -- | Delete a hook. -- See -deleteRepoWebhookR :: Name GithubOwner -> Name Repo -> Id RepoWebhook -> GithubRequest 'True () +deleteRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> Request 'True () deleteRepoWebhookR user repo hookId = - GithubCommand Delete (createWebhookOpPath user repo hookId Nothing) mempty + Command Delete (createWebhookOpPath user repo hookId Nothing) mempty -createBaseWebhookPath :: Name GithubOwner -> Name Repo -> Id RepoWebhook -> [String] +createBaseWebhookPath :: Name Owner -> Name Repo -> Id RepoWebhook -> [String] createBaseWebhookPath user repo hookId = ["repos", toPathPart user, toPathPart repo, "hooks", toPathPart hookId] -createWebhookOpPath :: Name GithubOwner -> Name Repo -> Id RepoWebhook -> Maybe String -> [String] +createWebhookOpPath :: Name Owner -> Name Repo -> Id RepoWebhook -> Maybe String -> [String] createWebhookOpPath owner reqName webhookId Nothing = createBaseWebhookPath owner reqName webhookId createWebhookOpPath owner reqName webhookId (Just operation) = createBaseWebhookPath owner reqName webhookId ++ [operation] diff --git a/src/GitHub/Endpoints/Search.hs b/src/GitHub/Endpoints/Search.hs index 47ef063f..e92230a9 100644 --- a/src/GitHub/Endpoints/Search.hs +++ b/src/GitHub/Endpoints/Search.hs @@ -29,8 +29,8 @@ import GitHub.Request -- | Perform a repository search. -- With authentication. -- --- > searchRepos' (Just $ GithubBasicAuth "github-username" "github-password') "a in%3Aname language%3Ahaskell created%3A>2013-10-01&per_page=100" -searchRepos' :: Maybe GithubAuth -> Text -> IO (Either Error (SearchResult Repo)) +-- > searchRepos' (Just $ BasicAuth "github-username" "github-password') "a in%3Aname language%3Ahaskell created%3A>2013-10-01&per_page=100" +searchRepos' :: Maybe Auth -> Text -> IO (Either Error (SearchResult Repo)) searchRepos' auth = executeRequestMaybe auth . searchReposR -- | Perform a repository search. @@ -42,14 +42,14 @@ searchRepos = searchRepos' Nothing -- | Search repositories. -- See -searchReposR :: Text -> GithubRequest k (SearchResult Repo) -searchReposR searchString = GithubGet ["search", "repositories"] [("q", Just $ TE.encodeUtf8 searchString)] +searchReposR :: Text -> Request k (SearchResult Repo) +searchReposR searchString = Query ["search", "repositories"] [("q", Just $ TE.encodeUtf8 searchString)] -- | Perform a code search. -- With authentication. -- --- > searchCode' (Just $ GithubBasicAuth "github-username" "github-password') "a in%3Aname language%3Ahaskell created%3A>2013-10-01&per_page=100" -searchCode' :: Maybe GithubAuth -> Text -> IO (Either Error (SearchResult Code)) +-- > searchCode' (Just $ BasicAuth "github-username" "github-password') "a in%3Aname language%3Ahaskell created%3A>2013-10-01&per_page=100" +searchCode' :: Maybe Auth -> Text -> IO (Either Error (SearchResult Code)) searchCode' auth = executeRequestMaybe auth . searchCodeR -- | Perform a code search. @@ -61,14 +61,14 @@ searchCode = searchCode' Nothing -- | Search code. -- See -searchCodeR :: Text -> GithubRequest k (SearchResult Code) -searchCodeR searchString = GithubGet ["search", "code"] [("q", Just $ TE.encodeUtf8 searchString)] +searchCodeR :: Text -> Request k (SearchResult Code) +searchCodeR searchString = Query ["search", "code"] [("q", Just $ TE.encodeUtf8 searchString)] -- | Perform an issue search. -- With authentication. -- --- > searchIssues' (Just $ GithubBasicAuth "github-username" "github-password') "a repo%3Aphadej%2Fgithub&per_page=100" -searchIssues' :: Maybe GithubAuth -> Text -> IO (Either Error (SearchResult Issue)) +-- > searchIssues' (Just $ BasicAuth "github-username" "github-password') "a repo%3Aphadej%2Fgithub&per_page=100" +searchIssues' :: Maybe Auth -> Text -> IO (Either Error (SearchResult Issue)) searchIssues' auth = executeRequestMaybe auth . searchIssuesR -- | Perform an issue search. @@ -80,5 +80,5 @@ searchIssues = searchIssues' Nothing -- | Search issues. -- See -searchIssuesR :: Text -> GithubRequest k (SearchResult Issue) -searchIssuesR searchString = GithubGet ["search", "issues"] [("q", Just $ TE.encodeUtf8 searchString)] +searchIssuesR :: Text -> Request k (SearchResult Issue) +searchIssuesR searchString = Query ["search", "issues"] [("q", Just $ TE.encodeUtf8 searchString)] diff --git a/src/GitHub/Endpoints/Users.hs b/src/GitHub/Endpoints/Users.hs index 8b91664f..19876dab 100644 --- a/src/GitHub/Endpoints/Users.hs +++ b/src/GitHub/Endpoints/Users.hs @@ -23,7 +23,7 @@ import GitHub.Request -- With authentification -- -- > userInfoFor' (Just ("github-username", "github-password")) "mike-burns" -userInfoFor' :: Maybe GithubAuth -> Name User -> IO (Either Error User) +userInfoFor' :: Maybe Auth -> Name User -> IO (Either Error User) userInfoFor' auth = executeRequestMaybe auth . userInfoForR -- | The information for a single user, by login name. @@ -32,24 +32,24 @@ userInfoFor' auth = executeRequestMaybe auth . userInfoForR userInfoFor :: Name User -> IO (Either Error User) userInfoFor = executeRequest' . userInfoForR --- | Get a single user. +-- | Query a single user. -- See -userInfoForR :: Name User -> GithubRequest k User -userInfoForR user = GithubGet ["users", toPathPart user] [] +userInfoForR :: Name User -> Request k User +userInfoForR user = Query ["users", toPathPart user] [] --- | Get a single user or an organization. +-- | Query a single user or an organization. -- See -ownerInfoForR :: Name GithubOwner -> GithubRequest k GithubOwner -ownerInfoForR owner = GithubGet ["users", toPathPart owner] [] +ownerInfoForR :: Name Owner -> Request k Owner +ownerInfoForR owner = Query ["users", toPathPart owner] [] -- | Retrieve information about the user associated with the supplied authentication. -- --- > userInfoCurrent' (GithubOAuth "...") -userInfoCurrent' :: GithubAuth -> IO (Either Error User) +-- > userInfoCurrent' (OAuth "...") +userInfoCurrent' :: Auth -> IO (Either Error User) userInfoCurrent' auth = executeRequest auth $ userInfoCurrentR --- | Get the authenticated user. +-- | Query the authenticated user. -- See -userInfoCurrentR :: GithubRequest 'True User -userInfoCurrentR = GithubGet ["user"] [] +userInfoCurrentR :: Request 'True User +userInfoCurrentR = Query ["user"] [] diff --git a/src/GitHub/Endpoints/Users/Followers.hs b/src/GitHub/Endpoints/Users/Followers.hs index a6216067..b1ee7690 100644 --- a/src/GitHub/Endpoints/Users/Followers.hs +++ b/src/GitHub/Endpoints/Users/Followers.hs @@ -27,8 +27,8 @@ usersFollowing user = -- | List followers of a user. -- See -usersFollowingR :: Name User -> Maybe Count -> GithubRequest k (Vector SimpleUser) -usersFollowingR user = GithubPagedGet ["users", toPathPart user, "followers"] [] +usersFollowingR :: Name User -> Maybe Count -> Request k (Vector SimpleUser) +usersFollowingR user = PagedQuery ["users", toPathPart user, "followers"] [] -- | All the users that the given user follows. -- @@ -39,5 +39,5 @@ usersFollowedBy user = -- | List users followed by another user. -- See -usersFollowedByR :: Name User -> Maybe Count -> GithubRequest k (Vector SimpleUser) -usersFollowedByR user = GithubPagedGet ["users", toPathPart user, "following"] [] +usersFollowedByR :: Name User -> Maybe Count -> Request k (Vector SimpleUser) +usersFollowedByR user = PagedQuery ["users", toPathPart user, "following"] [] diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index db1182fe..52bce8f2 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -19,22 +19,22 @@ -- -- Simple example using @operational@ package. See @samples\/Operational\/Operational.hs@ -- --- > type GithubMonad a = Program (GH.GithubRequest 'False) a +-- > type GithubMonad a = Program (GH.Request 'False) a -- > -- > -- | Intepret GithubMonad value into IO --- > runGithubMonad :: Manager -> GH.GithubAuth -> GithubMonad a -> ExceptT GH.Error IO a --- > runGithubMonad mgr auth m = case view m of +-- > runMonad :: Manager -> GH.Auth -> GithubMonad a -> ExceptT GH.Error IO a +-- > runMonad mgr auth m = case view m of -- > Return a -> return a -- > req :>>= k -> do -- > b <- ExceptT $ GH.executeRequestWithMgr mgr auth req --- > runGithubMonad mgr auth (k b) +-- > runMonad mgr auth (k b) -- > --- > -- | Lift request into GithubMonad --- > githubRequest :: GH.GithubRequest 'False a -> GithubMonad a +-- > -- | Lift request into Monad +-- > githubRequest :: GH.Request 'False a -> GithubMonad a -- > githubRequest = singleton module GitHub.Request ( -- * Types - GithubRequest(..), + Request(..), CommandMethod(..), toMethod, Paths, @@ -73,7 +73,7 @@ import Data.Text (Text) import Data.Vector.Instances () import Network.HTTP.Client (CookieJar, HttpException (..), Manager, - Request (..), RequestBody (..), + RequestBody (..), requestHeaders, checkStatus, method, requestBody, Response (..), applyBasicAuth, httpLbs, newManager, parseUrl, setQueryString) import Network.HTTP.Client.Internal (setUri) @@ -90,13 +90,14 @@ import qualified Data.ByteString.Char8 as BS8 import qualified Data.ByteString.Lazy as LBS import qualified Data.Text as T import qualified Data.Vector as V +import qualified Network.HTTP.Client as HTTP -import GitHub.Auth (GithubAuth (..)) +import GitHub.Auth (Auth (..)) import GitHub.Data (Error (..)) import GitHub.Data.Request --- | Execute 'GithubRequest' in 'IO' -executeRequest :: GithubAuth -> GithubRequest k a -> IO (Either Error a) +-- | Execute 'Request' in 'IO' +executeRequest :: Auth -> Request k a -> IO (Either Error a) executeRequest auth req = do manager <- newManager tlsManagerSettings x <- executeRequestWithMgr manager auth req @@ -107,36 +108,36 @@ executeRequest auth req = do -- | Like 'executeRequest' but with provided 'Manager'. executeRequestWithMgr :: Manager - -> GithubAuth - -> GithubRequest k a + -> Auth + -> Request k a -> IO (Either Error a) executeRequestWithMgr mgr auth req = runExceptT $ case req of - GithubGet {} -> do + Query {} -> do httpReq <- makeHttpRequest (Just auth) req res <- httpLbs' httpReq parseResponse res - GithubPagedGet _ _ l -> do + PagedQuery _ _ l -> do httpReq <- makeHttpRequest (Just auth) req performPagedRequest httpLbs' predicate httpReq where predicate = maybe (const True) (\l' -> (< l') . V.length ) l - GithubCommand m _ _ -> do + Command m _ _ -> do httpReq <- makeHttpRequest (Just auth) req res <- httpLbs' httpReq case m of Delete -> pure () _ -> parseResponse res - GithubStatus sm _ -> do + StatusQuery sm _ -> do httpReq <- makeHttpRequest (Just auth) req res <- httpLbs' httpReq parseStatus sm . responseStatus $ res where - httpLbs' :: Request -> ExceptT Error IO (Response LBS.ByteString) + httpLbs' :: HTTP.Request -> ExceptT Error IO (Response LBS.ByteString) httpLbs' req' = lift (httpLbs req' mgr) `catch` onHttpException -- | Like 'executeRequest' but without authentication. -executeRequest' :: GithubRequest 'False a -> IO (Either Error a) +executeRequest' :: Request 'False a -> IO (Either Error a) executeRequest' req = do manager <- newManager tlsManagerSettings x <- executeRequestWithMgr' manager req @@ -147,37 +148,37 @@ executeRequest' req = do -- | Like 'executeRequestWithMgr' but without authentication. executeRequestWithMgr' :: Manager - -> GithubRequest 'False a + -> Request 'False a -> IO (Either Error a) executeRequestWithMgr' mgr req = runExceptT $ case req of - GithubGet {} -> do + Query {} -> do httpReq <- makeHttpRequest Nothing req res <- httpLbs' httpReq parseResponse res - GithubPagedGet _ _ l -> do + PagedQuery _ _ l -> do httpReq <- makeHttpRequest Nothing req performPagedRequest httpLbs' predicate httpReq where predicate = maybe (const True) (\l' -> (< l') . V.length) l - GithubStatus sm _ -> do + StatusQuery sm _ -> do httpReq <- makeHttpRequest Nothing req res <- httpLbs' httpReq parseStatus sm . responseStatus $ res where - httpLbs' :: Request -> ExceptT Error IO (Response LBS.ByteString) + httpLbs' :: HTTP.Request -> ExceptT Error IO (Response LBS.ByteString) httpLbs' req' = lift (httpLbs req' mgr) `catch` onHttpException -- | Helper for picking between 'executeRequest' and 'executeRequest''. -- -- The use is discouraged. -executeRequestMaybe :: Maybe GithubAuth -> GithubRequest 'False a +executeRequestMaybe :: Maybe Auth -> Request 'False a -> IO (Either Error a) executeRequestMaybe = maybe executeRequest' executeRequest -- | Partial function to drop authentication need. -unsafeDropAuthRequirements :: GithubRequest 'True a -> GithubRequest k a -unsafeDropAuthRequirements (GithubGet ps qs) = GithubGet ps qs +unsafeDropAuthRequirements :: Request 'True a -> Request k a +unsafeDropAuthRequirements (Query ps qs) = Query ps qs unsafeDropAuthRequirements r = error $ "Trying to drop authenatication from" ++ show r @@ -187,36 +188,36 @@ unsafeDropAuthRequirements r = -- | Create @http-client@ 'Request'. -- --- * for 'GithubPagedGet', the initial request is created. --- * for 'GithubStatus', the 'Request' for underlying 'GithubRequest' is created, +-- * for 'PagedQuery', the initial request is created. +-- * for 'Status', the 'Request' for underlying 'Request' is created, -- status checking is modifying accordingly. -- -- @ --- parseResponse :: 'Maybe' 'GithubAuth' -> 'GithubRequest' k a -> 'Maybe' 'Request' +-- parseResponse :: 'Maybe' 'Auth' -> 'Request' k a -> 'Maybe' 'Request' -- @ makeHttpRequest :: MonadThrow m - => Maybe GithubAuth - -> GithubRequest k a - -> m Request + => Maybe Auth + -> Request k a + -> m HTTP.Request makeHttpRequest auth r = case r of - GithubStatus sm req -> do + StatusQuery sm req -> do req' <- makeHttpRequest auth req return $ setCheckStatus (Just sm) req' - GithubGet paths qs -> do + Query paths qs -> do req <- parseUrl $ url paths return $ setReqHeaders . setCheckStatus Nothing . setAuthRequest auth . setQueryString qs $ req - GithubPagedGet paths qs _ -> do + PagedQuery paths qs _ -> do req <- parseUrl $ url paths return $ setReqHeaders . setCheckStatus Nothing . setAuthRequest auth . setQueryString qs $ req - GithubCommand m paths body -> do + Command m paths body -> do req <- parseUrl $ url paths return $ setReqHeaders . setCheckStatus Nothing @@ -230,16 +231,16 @@ makeHttpRequest auth r = case r of baseUrl :: String baseUrl = case auth of - Just (GithubEnterpriseOAuth endpoint _) -> endpoint + Just (EnterpriseOAuth endpoint _) -> endpoint _ -> "https://api.github.com" - setReqHeaders :: Request -> Request + setReqHeaders :: HTTP.Request -> HTTP.Request setReqHeaders req = req { requestHeaders = reqHeaders <> requestHeaders req } - setCheckStatus :: Maybe (StatusMap a) -> Request -> Request + setCheckStatus :: Maybe (StatusMap a) -> HTTP.Request -> HTTP.Request setCheckStatus sm req = req { checkStatus = successOrMissing sm } - setMethod :: Method -> Request -> Request + setMethod :: Method -> HTTP.Request -> HTTP.Request setMethod m req = req { method = m } reqHeaders :: RequestHeaders @@ -247,15 +248,15 @@ makeHttpRequest auth r = case r of <> [("User-Agent", "github.hs/0.7.4")] <> [("Accept", "application/vnd.github.preview")] - setBody :: LBS.ByteString -> Request -> Request + setBody :: LBS.ByteString -> HTTP.Request -> HTTP.Request setBody body req = req { requestBody = RequestBodyLBS body } - setAuthRequest :: Maybe GithubAuth -> Request -> Request - setAuthRequest (Just (GithubBasicAuth user pass)) = applyBasicAuth user pass + setAuthRequest :: Maybe Auth -> HTTP.Request -> HTTP.Request + setAuthRequest (Just (BasicAuth user pass)) = applyBasicAuth user pass setAuthRequest _ = id - getOAuthHeader :: GithubAuth -> RequestHeaders - getOAuthHeader (GithubOAuth token) = [("Authorization", BS8.pack ("token " ++ token))] + getOAuthHeader :: Auth -> RequestHeaders + getOAuthHeader (OAuth token) = [("Authorization", BS8.pack ("token " ++ token))] getOAuthHeader _ = [] successOrMissing :: Maybe (StatusMap a) -> Status -> ResponseHeaders -> CookieJar -> Maybe E.SomeException @@ -268,7 +269,7 @@ makeHttpRequest auth r = case r of Just StatusOnlyOk -> sci == 204 || sci == 404 Just StatusMerge -> sci `elem` [204, 405, 409] --- | Get @Link@ header with @rel=next@ from the request headers. +-- | Query @Link@ header with @rel=next@ from the request headers. getNextUrl :: Response a -> Maybe URI getNextUrl req = do linkHeader <- lookup "Link" (responseHeaders req) @@ -312,22 +313,22 @@ parseStatus StatusMerge (Status sci _) -- -- @ -- performPagedRequest :: ('FromJSON' a, 'Semigroup' a) --- => ('Request' -> 'ExceptT' 'Error' 'IO' ('Response' 'LBS.ByteString')) +-- => ('HTTP.Request' -> 'ExceptT' 'Error' 'IO' ('Response' 'LBS.ByteString')) -- -> (a -> 'Bool') --- -> 'Request' +-- -> 'HTTP.Request' -- -> 'ExceptT' 'Error' 'IO' a -- @ performPagedRequest :: forall a m. (FromJSON a, Semigroup a, MonadCatch m, MonadError Error m) - => (Request -> m (Response LBS.ByteString)) -- ^ `httpLbs` analogue - -> (a -> Bool) -- ^ predicate to continue iteration - -> Request -- ^ initial request + => (HTTP.Request -> m (Response LBS.ByteString)) -- ^ `httpLbs` analogue + -> (a -> Bool) -- ^ predicate to continue iteration + -> HTTP.Request -- ^ initial request -> m a performPagedRequest httpLbs' predicate initReq = do res <- httpLbs' initReq m <- parseResponse res go m res initReq where - go :: a -> Response LBS.ByteString -> Request -> m a + go :: a -> Response LBS.ByteString -> HTTP.Request -> m a go acc res req = case (predicate acc, getNextUrl res) of (True, Just uri) -> do From 49249c88ca4d8fea8ad11d0d43865825b3867a0a Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Thu, 21 Jan 2016 09:46:08 +0200 Subject: [PATCH 172/510] Fix performPagedRequest --- spec/GitHub/CommitsSpec.hs | 8 ++++++-- src/GitHub/Request.hs | 4 ++-- 2 files changed, 8 insertions(+), 4 deletions(-) diff --git a/spec/GitHub/CommitsSpec.hs b/spec/GitHub/CommitsSpec.hs index 46677b61..b1c6bd45 100644 --- a/spec/GitHub/CommitsSpec.hs +++ b/spec/GitHub/CommitsSpec.hs @@ -8,9 +8,10 @@ import GitHub.Request (executeRequest) import Control.Monad (forM_) import Data.Either.Compat (isRight) +import Data.List (sort, nub) import Data.Proxy (Proxy (..)) import System.Environment (lookupEnv) -import Test.Hspec (Spec, describe, it, pendingWith, shouldSatisfy) +import Test.Hspec (Spec, describe, it, pendingWith, shouldBe, shouldSatisfy) import qualified Data.Vector as V @@ -37,7 +38,10 @@ spec = do it "limits the response" $ withAuth $ \auth -> do cs <- executeRequest auth $ commitsForR "phadej" "github" (Just 40) cs `shouldSatisfy` isRight - V.length (fromRightS cs) `shouldSatisfy` (< 70) + let cs' = fromRightS cs + V.length cs' `shouldSatisfy` (< 70) + let hashes = sort $ map commitSha $ V.toList cs' + hashes `shouldBe` nub hashes describe "diff" $ do it "works" $ withAuth $ \auth -> do diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index db1182fe..46491c9b 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -332,8 +332,8 @@ performPagedRequest httpLbs' predicate initReq = do case (predicate acc, getNextUrl res) of (True, Just uri) -> do req' <- setUri req uri - res' <- httpLbs' req - m <- parseResponse res + res' <- httpLbs' req' + m <- parseResponse res' go (acc <> m) res' req' (_, _) -> return acc From d25609b03370889104dbca2b1ca8e6144601b6e3 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Thu, 21 Jan 2016 16:24:01 +0200 Subject: [PATCH 173/510] Make token ByteString --- samples/Teams/DeleteTeam.hs | 4 ++- samples/Teams/EditTeam.hs | 4 ++- samples/Teams/ListTeamsCurrent.hs | 4 ++- .../Teams/Memberships/AddTeamMembershipFor.hs | 4 ++- .../Memberships/DeleteTeamMembershipFor.hs | 4 ++- .../Memberships/TeamMembershipInfoFor.hs | 4 ++- samples/Teams/TeamInfoFor.hs | 4 ++- samples/src/Common.hs | 5 ++-- spec/GitHub/ActivitySpec.hs | 7 +++--- spec/GitHub/CommitsSpec.hs | 15 ++++++----- spec/GitHub/OrganizationsSpec.hs | 10 +++++--- spec/GitHub/ReposSpec.hs | 7 +++--- spec/GitHub/UsersSpec.hs | 15 ++++++----- src/GitHub/Auth.hs | 6 +++-- src/GitHub/Request.hs | 25 ++++++++++--------- 15 files changed, 73 insertions(+), 45 deletions(-) diff --git a/samples/Teams/DeleteTeam.hs b/samples/Teams/DeleteTeam.hs index 304fe0c5..484102ff 100644 --- a/samples/Teams/DeleteTeam.hs +++ b/samples/Teams/DeleteTeam.hs @@ -4,6 +4,8 @@ module Main (main) where import Common import Prelude () +import Data.String (fromString) + import qualified GitHub import qualified GitHub.Endpoints.Organizations.Teams as GitHub @@ -11,7 +13,7 @@ main :: IO () main = do args <- getArgs result <- case args of - [token, team_id] -> GitHub.deleteTeam' (GitHub.OAuth token) (GitHub.mkTeamId $ read team_id) + [token, team_id] -> GitHub.deleteTeam' (GitHub.OAuth $ fromString token) (GitHub.mkTeamId $ read team_id) _ -> error "usage: DeleteTeam " case result of Left err -> putStrLn $ "Error: " <> tshow err diff --git a/samples/Teams/EditTeam.hs b/samples/Teams/EditTeam.hs index 99591758..e5485d46 100644 --- a/samples/Teams/EditTeam.hs +++ b/samples/Teams/EditTeam.hs @@ -4,6 +4,8 @@ module Main (main) where import Common import Prelude () +import Data.String (fromString) + import qualified GitHub import qualified GitHub.Endpoints.Organizations.Teams as GitHub @@ -13,7 +15,7 @@ main = do result <- case args of [token, team_id, team_name, desc] -> GitHub.editTeam' - (GitHub.OAuth token) + (GitHub.OAuth $ fromString token) (GitHub.mkTeamId $ read team_id) (GitHub.EditTeam (GitHub.mkTeamName $ fromString team_name) (Just $ fromString desc) GitHub.PermissionPull) _ -> diff --git a/samples/Teams/ListTeamsCurrent.hs b/samples/Teams/ListTeamsCurrent.hs index 9a6f1850..aa7718ec 100644 --- a/samples/Teams/ListTeamsCurrent.hs +++ b/samples/Teams/ListTeamsCurrent.hs @@ -4,6 +4,8 @@ module Main (main) where import Common import Prelude () +import Data.String (fromString) + import qualified GitHub import qualified GitHub.Endpoints.Organizations.Teams as GitHub @@ -11,7 +13,7 @@ main :: IO () main = do args <- getArgs result <- case args of - [token] -> GitHub.listTeamsCurrent' (GitHub.OAuth token) + [token] -> GitHub.listTeamsCurrent' (GitHub.OAuth $ fromString token) _ -> error "usage: ListTeamsCurrent " case result of Left err -> putStrLn $ "Error: " <> tshow err diff --git a/samples/Teams/Memberships/AddTeamMembershipFor.hs b/samples/Teams/Memberships/AddTeamMembershipFor.hs index aa890d82..faad9435 100644 --- a/samples/Teams/Memberships/AddTeamMembershipFor.hs +++ b/samples/Teams/Memberships/AddTeamMembershipFor.hs @@ -4,6 +4,8 @@ module Main (main) where import Common import Prelude () +import Data.String (fromString) + import qualified GitHub import qualified GitHub.Endpoints.Organizations.Teams as GitHub @@ -13,7 +15,7 @@ main = do result <- case args of [token, team_id, username] -> GitHub.addTeamMembershipFor' - (GitHub.OAuth token) + (GitHub.OAuth $ fromString token) (GitHub.mkTeamId $ read team_id) (GitHub.mkOwnerName $ fromString username) GitHub.RoleMember diff --git a/samples/Teams/Memberships/DeleteTeamMembershipFor.hs b/samples/Teams/Memberships/DeleteTeamMembershipFor.hs index 46b87aaa..9c7da148 100644 --- a/samples/Teams/Memberships/DeleteTeamMembershipFor.hs +++ b/samples/Teams/Memberships/DeleteTeamMembershipFor.hs @@ -4,6 +4,8 @@ module Main (main) where import Common import Prelude () +import Data.String (fromString) + import qualified GitHub import qualified GitHub.Endpoints.Organizations.Teams as GitHub @@ -13,7 +15,7 @@ main = do result <- case args of [token, team_id, username] -> GitHub.deleteTeamMembershipFor' - (GitHub.OAuth token) + (GitHub.OAuth $ fromString token) (GitHub.mkTeamId $ read team_id) (GitHub.mkOwnerName $ fromString username) _ -> diff --git a/samples/Teams/Memberships/TeamMembershipInfoFor.hs b/samples/Teams/Memberships/TeamMembershipInfoFor.hs index e66bce26..1596df5f 100644 --- a/samples/Teams/Memberships/TeamMembershipInfoFor.hs +++ b/samples/Teams/Memberships/TeamMembershipInfoFor.hs @@ -4,6 +4,8 @@ module Main (main) where import Common import Prelude () +import Data.String (fromString) + import qualified GitHub import qualified GitHub.Endpoints.Organizations.Teams as GitHub @@ -12,7 +14,7 @@ main = do args <- getArgs result <- case args of [team_id, username, token] -> - GitHub.teamMembershipInfoFor' (Just $ GitHub.OAuth token) (GitHub.mkTeamId $ read team_id) (GitHub.mkOwnerName $ fromString username) + GitHub.teamMembershipInfoFor' (Just $ GitHub.OAuth $ fromString token) (GitHub.mkTeamId $ read team_id) (GitHub.mkOwnerName $ fromString username) [team_id, username] -> GitHub.teamMembershipInfoFor (GitHub.mkTeamId $ read team_id) (GitHub.mkOwnerName $ fromString username) _ -> diff --git a/samples/Teams/TeamInfoFor.hs b/samples/Teams/TeamInfoFor.hs index a7717284..a2ca4c8e 100644 --- a/samples/Teams/TeamInfoFor.hs +++ b/samples/Teams/TeamInfoFor.hs @@ -4,6 +4,8 @@ module Main (main) where import Common import Prelude () +import Data.String (fromString) + import qualified GitHub import qualified GitHub.Endpoints.Organizations.Teams as GitHub @@ -11,7 +13,7 @@ main :: IO () main = do args <- getArgs result <- case args of - [team_id, token] -> GitHub.teamInfoFor' (Just $ GitHub.OAuth token) (GitHub.mkTeamId $ read team_id) + [team_id, token] -> GitHub.teamInfoFor' (Just $ GitHub.OAuth $ fromString token) (GitHub.mkTeamId $ read team_id) [team_id] -> GitHub.teamInfoFor (GitHub.mkTeamId $ read team_id) _ -> error "usage: TeamInfoFor [auth token]" case result of diff --git a/samples/src/Common.hs b/samples/src/Common.hs index 11afba9b..c48f8588 100644 --- a/samples/src/Common.hs +++ b/samples/src/Common.hs @@ -18,18 +18,19 @@ import Prelude.Compat hiding (putStrLn) import Data.Monoid ((<>)) import Data.Proxy (Proxy (..)) import Data.String (fromString) +import Data.String (fromString) import Data.Text (Text) import Data.Text.IO (putStrLn) import System.Environment (lookupEnv) import System.Environment (getArgs) -import qualified Data.Text as T +import qualified Data.Text as T import qualified GitHub getAuth :: IO (Maybe (GitHub.Auth)) getAuth = do token <- lookupEnv "GITHUB_TOKEN" - pure (GitHub.OAuth <$> token) + pure (GitHub.OAuth . fromString <$> token) tshow :: Show a => a -> Text tshow = T.pack . show diff --git a/spec/GitHub/ActivitySpec.hs b/spec/GitHub/ActivitySpec.hs index 4fe9ae82..463573bf 100644 --- a/spec/GitHub/ActivitySpec.hs +++ b/spec/GitHub/ActivitySpec.hs @@ -2,11 +2,12 @@ {-# LANGUAGE TemplateHaskell #-} module GitHub.ActivitySpec where -import GitHub.Auth (Auth (..)) +import GitHub.Auth (Auth (..)) import GitHub.Endpoints.Activity.Watching (watchersForR) -import GitHub.Request (executeRequest) +import GitHub.Request (executeRequest) import Data.Either.Compat (isRight) +import Data.String (fromString) import System.Environment (lookupEnv) import Test.Hspec (Spec, describe, it, pendingWith, shouldSatisfy) @@ -21,7 +22,7 @@ withAuth action = do mtoken <- lookupEnv "GITHUB_TOKEN" case mtoken of Nothing -> pendingWith "no GITHUB_TOKEN" - Just token -> action (OAuth token) + Just token -> action (OAuth $ fromString token) spec :: Spec spec = do diff --git a/spec/GitHub/CommitsSpec.hs b/spec/GitHub/CommitsSpec.hs index 8d71448d..b639d964 100644 --- a/spec/GitHub/CommitsSpec.hs +++ b/spec/GitHub/CommitsSpec.hs @@ -2,16 +2,19 @@ {-# LANGUAGE TemplateHaskell #-} module GitHub.CommitsSpec where -import GitHub.Auth (Auth (..)) -import GitHub.Endpoints.Repos.Commits (Commit, mkName, commitSha, commitsFor', commitsForR, diffR) -import GitHub.Request (executeRequest) +import GitHub.Auth (Auth (..)) +import GitHub.Endpoints.Repos.Commits (Commit, commitSha, commitsFor', + commitsForR, diffR, mkName) +import GitHub.Request (executeRequest) import Control.Monad (forM_) import Data.Either.Compat (isRight) -import Data.List (sort, nub) +import Data.List (nub, sort) import Data.Proxy (Proxy (..)) +import Data.String (fromString) import System.Environment (lookupEnv) -import Test.Hspec (Spec, describe, it, pendingWith, shouldBe, shouldSatisfy) +import Test.Hspec (Spec, describe, it, pendingWith, shouldBe, + shouldSatisfy) import qualified Data.Vector as V @@ -24,7 +27,7 @@ withAuth action = do mtoken <- lookupEnv "GITHUB_TOKEN" case mtoken of Nothing -> pendingWith "no GITHUB_TOKEN" - Just token -> action (OAuth token) + Just token -> action (OAuth $ fromString token) spec :: Spec spec = do diff --git a/spec/GitHub/OrganizationsSpec.hs b/spec/GitHub/OrganizationsSpec.hs index 8d81204a..e53ecb44 100644 --- a/spec/GitHub/OrganizationsSpec.hs +++ b/spec/GitHub/OrganizationsSpec.hs @@ -2,15 +2,17 @@ {-# LANGUAGE TemplateHaskell #-} module GitHub.OrganizationsSpec where -import GitHub.Auth (Auth (..)) -import GitHub.Data (SimpleOwner (..), SimpleOrganization (..), - SimpleTeam (..)) +import GitHub.Auth (Auth (..)) +import GitHub.Data (SimpleOrganization (..), + SimpleOwner (..), + SimpleTeam (..)) import GitHub.Endpoints.Organizations (publicOrganizationsFor') import GitHub.Endpoints.Organizations.Members (membersOf') import Data.Aeson.Compat (eitherDecodeStrict) import Data.Either.Compat (isRight) import Data.FileEmbed (embedFile) +import Data.String (fromString) import System.Environment (lookupEnv) import Test.Hspec (Spec, describe, it, pendingWith, shouldBe, shouldSatisfy) @@ -24,7 +26,7 @@ withAuth action = do mtoken <- lookupEnv "GITHUB_TOKEN" case mtoken of Nothing -> pendingWith "no GITHUB_TOKEN" - Just token -> action (OAuth token) + Just token -> action (OAuth $ fromString token) spec :: Spec spec = do diff --git a/spec/GitHub/ReposSpec.hs b/spec/GitHub/ReposSpec.hs index e972b19a..4cbfb607 100644 --- a/spec/GitHub/ReposSpec.hs +++ b/spec/GitHub/ReposSpec.hs @@ -2,10 +2,11 @@ {-# LANGUAGE TemplateHaskell #-} module GitHub.ReposSpec where -import GitHub.Auth (Auth (..)) -import GitHub.Endpoints.Repos (currentUserRepos, userRepos', RepoPublicity(..)) +import GitHub.Auth (Auth (..)) +import GitHub.Endpoints.Repos (RepoPublicity (..), currentUserRepos, userRepos') import Data.Either.Compat (isRight) +import Data.String (fromString) import System.Environment (lookupEnv) import Test.Hspec (Spec, describe, it, pendingWith, shouldSatisfy) @@ -18,7 +19,7 @@ withAuth action = do mtoken <- lookupEnv "GITHUB_TOKEN" case mtoken of Nothing -> pendingWith "no GITHUB_TOKEN" - Just token -> action (OAuth token) + Just token -> action (OAuth $ fromString token) spec :: Spec spec = do diff --git a/spec/GitHub/UsersSpec.hs b/spec/GitHub/UsersSpec.hs index e1fe6c9b..99842347 100644 --- a/spec/GitHub/UsersSpec.hs +++ b/spec/GitHub/UsersSpec.hs @@ -3,16 +3,19 @@ module GitHub.UsersSpec where import Data.Aeson.Compat (eitherDecodeStrict) -import Data.Either.Compat (isRight, isLeft) +import Data.Either.Compat (isLeft, isRight) import Data.FileEmbed (embedFile) +import Data.String (fromString) import System.Environment (lookupEnv) import Test.Hspec (Spec, describe, it, pendingWith, shouldBe, shouldSatisfy) -import GitHub.Data (Auth (..), User (..), Organization (..), fromOwner) -import GitHub.Request (executeRequest) -import GitHub.Endpoints.Users (userInfoCurrent', userInfoFor', ownerInfoForR) -import GitHub.Endpoints.Users.Followers (usersFollowedByR, usersFollowingR) +import GitHub.Data (Auth (..), Organization (..), + User (..), fromOwner) +import GitHub.Endpoints.Users (ownerInfoForR, userInfoCurrent', + userInfoFor') +import GitHub.Endpoints.Users.Followers (usersFollowedByR, usersFollowingR) +import GitHub.Request (executeRequest) fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b @@ -27,7 +30,7 @@ withAuth action = do mtoken <- lookupEnv "GITHUB_TOKEN" case mtoken of Nothing -> pendingWith "no GITHUB_TOKEN" - Just token -> action (OAuth token) + Just token -> action (OAuth $ fromString token) spec :: Spec spec = do diff --git a/src/GitHub/Auth.hs b/src/GitHub/Auth.hs index 02cc8570..ba04f821 100644 --- a/src/GitHub/Auth.hs +++ b/src/GitHub/Auth.hs @@ -15,13 +15,15 @@ import GHC.Generics (Generic) import qualified Data.ByteString as BS +type Token = BS.ByteString + -- | The Github auth data type data Auth = BasicAuth BS.ByteString BS.ByteString - | OAuth String -- ^ token + | OAuth Token -- ^ token | EnterpriseOAuth String -- custom API endpoint without -- trailing slash - String -- token + Token -- token deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Auth where rnf = genericRnf diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index 87c71e0b..32e49278 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -73,9 +73,10 @@ import Data.Text (Text) import Data.Vector.Instances () import Network.HTTP.Client (CookieJar, HttpException (..), Manager, - RequestBody (..), requestHeaders, checkStatus, method, requestBody, - Response (..), applyBasicAuth, httpLbs, - newManager, parseUrl, setQueryString) + RequestBody (..), Response (..), + applyBasicAuth, checkStatus, httpLbs, + method, newManager, parseUrl, requestBody, + requestHeaders, setQueryString) import Network.HTTP.Client.Internal (setUri) import Network.HTTP.Client.TLS (tlsManagerSettings) import Network.HTTP.Link.Parser (parseLinkHeaderBS) @@ -85,12 +86,11 @@ import Network.HTTP.Types (Method, RequestHeaders, ResponseHeaders, Status (..)) import Network.URI (URI) -import qualified Control.Exception as E -import qualified Data.ByteString.Char8 as BS8 -import qualified Data.ByteString.Lazy as LBS -import qualified Data.Text as T -import qualified Data.Vector as V -import qualified Network.HTTP.Client as HTTP +import qualified Control.Exception as E +import qualified Data.ByteString.Lazy as LBS +import qualified Data.Text as T +import qualified Data.Vector as V +import qualified Network.HTTP.Client as HTTP import GitHub.Auth (Auth (..)) import GitHub.Data (Error (..)) @@ -232,7 +232,7 @@ makeHttpRequest auth r = case r of baseUrl :: String baseUrl = case auth of Just (EnterpriseOAuth endpoint _) -> endpoint - _ -> "https://api.github.com" + _ -> "https://api.github.com" setReqHeaders :: HTTP.Request -> HTTP.Request setReqHeaders req = req { requestHeaders = reqHeaders <> requestHeaders req } @@ -256,8 +256,9 @@ makeHttpRequest auth r = case r of setAuthRequest _ = id getOAuthHeader :: Auth -> RequestHeaders - getOAuthHeader (OAuth token) = [("Authorization", BS8.pack ("token " ++ token))] - getOAuthHeader _ = [] + getOAuthHeader (OAuth token) = [("Authorization", "token " <> token)] + getOAuthHeader (EnterpriseOAuth _ token) = [("Authorization", "token " <> token)] + getOAuthHeader _ = [] successOrMissing :: Maybe (StatusMap a) -> Status -> ResponseHeaders -> CookieJar -> Maybe E.SomeException successOrMissing sm s@(Status sci _) hs cookiejar From 83ce51349f885afef652423263ded7fc0c804d5a Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sun, 24 Jan 2016 14:39:42 +0200 Subject: [PATCH 174/510] Refactor Language -stuff --- github.cabal | 4 +-- spec/GitHub/ReposSpec.hs | 11 +++++++- src/GitHub/Data/Gists.hs | 3 +- src/GitHub/Data/Repos.hs | 60 ++++++++++++++++++++++++++++------------ 4 files changed, 56 insertions(+), 22 deletions(-) diff --git a/github.cabal b/github.cabal index aad2bcc2..0b7d7f31 100644 --- a/github.cabal +++ b/github.cabal @@ -126,8 +126,7 @@ Library transformers-compat >=0.4.0.3 && <0.6, unordered-containers >=0.2 && <0.3, vector >=0.10.12.3 && <0.12, - vector-instances >=3.3.0.1 && <3.4, - void >=0.7 && <0.8 + vector-instances >=3.3.0.1 && <3.4 if flag(aeson-compat) build-depends: aeson-compat >=0.3.0.0 && <0.4 @@ -151,6 +150,7 @@ test-suite github-test base-compat, github, vector, + unordered-containers, file-embed, hspec if flag(aeson-compat) diff --git a/spec/GitHub/ReposSpec.hs b/spec/GitHub/ReposSpec.hs index 4cbfb607..bda2780b 100644 --- a/spec/GitHub/ReposSpec.hs +++ b/spec/GitHub/ReposSpec.hs @@ -3,13 +3,16 @@ module GitHub.ReposSpec where import GitHub.Auth (Auth (..)) -import GitHub.Endpoints.Repos (RepoPublicity (..), currentUserRepos, userRepos') +import GitHub.Endpoints.Repos (RepoPublicity (..), currentUserRepos, + languagesFor', userRepos') import Data.Either.Compat (isRight) import Data.String (fromString) import System.Environment (lookupEnv) import Test.Hspec (Spec, describe, it, pendingWith, shouldSatisfy) +import qualified Data.HashMap.Strict as HM + fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a @@ -32,3 +35,9 @@ spec = do it "works" $ withAuth $ \auth -> do cs <- userRepos' (Just auth) "phadej" RepoPublicityAll cs `shouldSatisfy` isRight + + describe "languagesFor'" $ do + it "works" $ withAuth $ \auth -> do + ls <- languagesFor' (Just auth) "phadej" "github" + ls `shouldSatisfy` isRight + fromRightS ls `shouldSatisfy` HM.member "Haskell" diff --git a/src/GitHub/Data/Gists.hs b/src/GitHub/Data/Gists.hs index 74e34202..53fc6cb4 100644 --- a/src/GitHub/Data/Gists.hs +++ b/src/GitHub/Data/Gists.hs @@ -14,6 +14,7 @@ import Prelude.Compat import GitHub.Data.Definitions import GitHub.Data.Id (Id) import GitHub.Data.Name (Name) +import GitHub.Data.Repos (Language) import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) @@ -62,7 +63,7 @@ data GistFile = GistFile { gistFileType :: !Text ,gistFileRawUrl :: !Text ,gistFileSize :: !Int - ,gistFileLanguage :: !(Maybe Text) + ,gistFileLanguage :: !(Maybe Language) ,gistFileFilename :: !Text ,gistFileContent :: !(Maybe Text) } deriving (Show, Data, Typeable, Eq, Generic) diff --git a/src/GitHub/Data/Repos.hs b/src/GitHub/Data/Repos.hs index e9b31ef8..45b58ad0 100644 --- a/src/GitHub/Data/Repos.hs +++ b/src/GitHub/Data/Repos.hs @@ -1,11 +1,16 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- +-- This module also exports +-- @'FromJSON' a => 'FromJSON' ('HM.HashMap' 'Language' a)@ +-- orphan-ish instance. module GitHub.Data.Repos where import Prelude () @@ -15,19 +20,26 @@ import GitHub.Data.Definitions import GitHub.Data.Id (Id) import GitHub.Data.Name (Name) +--import Control.Arrow (first) -- Data.Bifunctor would be better import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) import Data.Aeson.Compat (FromJSON (..), ToJSON (..), object, withObject, - (.:), (.:?), (.=)) + withText, (.:), (.:?), (.=)) import Data.Binary (Binary) import Data.Data (Data, Typeable) +import Data.Hashable (Hashable (..)) +import Data.String (IsString (..)) import Data.Text (Text) import Data.Time (UTCTime) -import Data.Vector (Vector) import GHC.Generics (Generic) import qualified Data.HashMap.Strict as HM -import qualified Data.Vector as V + +#if MIN_VERSION_base(4,8,0) +import Data.Type.Coercion (Coercion (..), coerceWith) +#else +import Unsafe.Coerce (unsafeCoerce) +#endif data Repo = Repo { repoSshUrl :: !(Maybe Text) @@ -46,7 +58,7 @@ data Repo = Repo { ,repoWatchers :: !(Maybe Int) ,repoOwner :: !SimpleOwner ,repoName :: !(Name Repo) - ,repoLanguage :: !(Maybe Text) + ,repoLanguage :: !(Maybe Language) ,repoMasterBranch :: !(Maybe Text) ,repoPushedAt :: !(Maybe UTCTime) -- ^ this is Nothing for new repositories ,repoId :: !(Id Repo) @@ -111,20 +123,22 @@ data RepoPublicity | RepoPublicityMember -- ^ Only repos to which the user is a member but not an owner. deriving (Show, Eq, Ord, Typeable, Data, Generic) --- | This is only used for the FromJSON instance. -data Languages = Languages { getLanguages :: Vector Language } - deriving (Show, Data, Typeable, Eq, Ord, Generic) +-- | The value is the number of bytes of code written in that language. +type Languages = HM.HashMap Language Int -instance NFData Languages where rnf = genericRnf -instance Binary Languages +-- | A programming language. +newtype Language = Language Text + deriving (Show, Data, Typeable, Eq, Ord, Generic) --- | A programming language with the name and number of characters written in --- it. -data Language = Language !Text !Int - deriving (Show, Data, Typeable, Eq, Ord, Generic) +getLanguage :: Language -> Text +getLanguage (Language l) = l instance NFData Language where rnf = genericRnf instance Binary Language +instance Hashable Language where + hashWithSalt salt (Language l) = hashWithSalt salt l +instance IsString Language where + fromString = Language . fromString data Contributor -- | An existing Github user, with their number of contributions, avatar @@ -234,8 +248,18 @@ instance FromJSON Contributor where <*> o .: "id" <*> o .: "gravatar_id" -instance FromJSON Languages where - parseJSON = withObject "Languages" $ \o -> - Languages . V.fromList <$> - traverse (\name -> Language name <$> o .: name) - (HM.keys o) +instance FromJSON Language where + parseJSON = withText "Language" (pure . Language) + +instance FromJSON a => FromJSON (HM.HashMap Language a) where + parseJSON = fmap mapKeyLanguage . parseJSON + where + mapKeyLanguage :: HM.HashMap Text a -> HM.HashMap Language a +#if MIN_VERSION_base(4,8,0) + mapKeyLanguage = coerceWith Coercion +#else + mapKeyLanguage = unsafeCoerce +#endif +-- mapKeyLanguage = mapKey Language +-- mapKey :: (Eq k2, Hashable k2) => (k1 -> k2) -> HM.HashMap k1 a -> HM.HashMap k2 a +-- mapKey f = HM.fromList . map (first f) . HM.toList From d99c17015dccdbdbc716ba15962aef7db262b68b Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sun, 24 Jan 2016 15:11:44 +0200 Subject: [PATCH 175/510] Just use unsafeCoerce --- src/GitHub/Data/Repos.hs | 18 ++++++++---------- 1 file changed, 8 insertions(+), 10 deletions(-) diff --git a/src/GitHub/Data/Repos.hs b/src/GitHub/Data/Repos.hs index 45b58ad0..793b1aa7 100644 --- a/src/GitHub/Data/Repos.hs +++ b/src/GitHub/Data/Repos.hs @@ -3,6 +3,7 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} +#define UNSAFE 1 ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -35,9 +36,7 @@ import GHC.Generics (Generic) import qualified Data.HashMap.Strict as HM -#if MIN_VERSION_base(4,8,0) -import Data.Type.Coercion (Coercion (..), coerceWith) -#else +#if UNSAFE import Unsafe.Coerce (unsafeCoerce) #endif @@ -255,11 +254,10 @@ instance FromJSON a => FromJSON (HM.HashMap Language a) where parseJSON = fmap mapKeyLanguage . parseJSON where mapKeyLanguage :: HM.HashMap Text a -> HM.HashMap Language a -#if MIN_VERSION_base(4,8,0) - mapKeyLanguage = coerceWith Coercion -#else +#ifdef UNSAFE mapKeyLanguage = unsafeCoerce -#endif --- mapKeyLanguage = mapKey Language --- mapKey :: (Eq k2, Hashable k2) => (k1 -> k2) -> HM.HashMap k1 a -> HM.HashMap k2 a --- mapKey f = HM.fromList . map (first f) . HM.toList +#else + mapKeyLanguage = mapKey Language + mapKey :: (Eq k2, Hashable k2) => (k1 -> k2) -> HM.HashMap k1 a -> HM.HashMap k2 a + mapKey f = HM.fromList . map (first f) . HM.toList +#endif \ No newline at end of file From 11e8fc367eb8540d3295c5ec7e58b7f95290fdda Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 25 Jan 2016 08:24:16 +0200 Subject: [PATCH 176/510] Add ToJSON Language --- src/GitHub/Data/Repos.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/GitHub/Data/Repos.hs b/src/GitHub/Data/Repos.hs index 793b1aa7..fcedd219 100644 --- a/src/GitHub/Data/Repos.hs +++ b/src/GitHub/Data/Repos.hs @@ -250,6 +250,9 @@ instance FromJSON Contributor where instance FromJSON Language where parseJSON = withText "Language" (pure . Language) +instance ToJSON Language where + toJSON = toJSON . getLanguage + instance FromJSON a => FromJSON (HM.HashMap Language a) where parseJSON = fmap mapKeyLanguage . parseJSON where From 5beb5732fa6b568a77c6ece840b146153a79eeef Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 1 Feb 2016 08:50:55 +0200 Subject: [PATCH 177/510] Missing stuff: - Add `membersOfWithR`, `listTeamMembersR` - Add related enums: `OrgMemberFilter`, `OrgMemberRole`, `TeamMemberRole` - Add `Enum` and `Bounded` instances to `Privacy`, `Permission`, `RepoPublicity` --- src/GitHub.hs | 2 ++ src/GitHub/Data/Definitions.hs | 13 +++++++++++++ src/GitHub/Data/Repos.hs | 4 ++-- src/GitHub/Data/Teams.hs | 13 ++++++++++--- src/GitHub/Endpoints/Organizations/Members.hs | 16 ++++++++++++++++ src/GitHub/Endpoints/Organizations/Teams.hs | 16 +++++++++++++++- 6 files changed, 58 insertions(+), 6 deletions(-) diff --git a/src/GitHub.hs b/src/GitHub.hs index 000df2c2..7cd29336 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -158,6 +158,7 @@ module GitHub ( -- -- Missing endpoints: All except /Members List/ membersOfR, + membersOfWithR, -- ** Teams -- | See @@ -177,6 +178,7 @@ module GitHub ( createTeamForR, editTeamR, deleteTeamR, + listTeamMembersR, teamMembershipInfoForR, addTeamMembershipForR, deleteTeamMembershipForR, diff --git a/src/GitHub/Data/Definitions.hs b/src/GitHub/Data/Definitions.hs index 5c607e97..5d84c44f 100644 --- a/src/GitHub/Data/Definitions.hs +++ b/src/GitHub/Data/Definitions.hs @@ -229,3 +229,16 @@ instance FromJSON Owner where case t of OwnerUser -> Owner . Left <$> parseUser obj OwnerOrganization -> Owner . Right <$> parseOrganization obj + +-- | Filter members returned in the list. +data OrgMemberFilter + = OrgMemberFilter2faDisabled -- ^ Members without two-factor authentication enabled. Available for organization owners. + | OrgMemberFilterAll -- ^ All members the authenticated user can see. + deriving (Show, Eq, Ord, Enum, Bounded, Typeable, Data, Generic) + +-- | Filter members returned by their role. +data OrgMemberRole + = OrgMemberRoleAll -- ^ All members of the organization, regardless of role. + | OrgMemberRoleAdmin -- ^ Organization owners. + | OrgMemberRoleMember -- ^ Non-owner organization members. + deriving (Show, Eq, Ord, Enum, Bounded, Typeable, Data, Generic) diff --git a/src/GitHub/Data/Repos.hs b/src/GitHub/Data/Repos.hs index fcedd219..91e9b4db 100644 --- a/src/GitHub/Data/Repos.hs +++ b/src/GitHub/Data/Repos.hs @@ -120,7 +120,7 @@ data RepoPublicity | RepoPublicityPublic -- ^ Only public repos. | RepoPublicityPrivate -- ^ Only private repos. | RepoPublicityMember -- ^ Only repos to which the user is a member but not an owner. - deriving (Show, Eq, Ord, Typeable, Data, Generic) + deriving (Show, Eq, Ord, Enum, Bounded, Typeable, Data, Generic) -- | The value is the number of bytes of code written in that language. type Languages = HM.HashMap Language Int @@ -263,4 +263,4 @@ instance FromJSON a => FromJSON (HM.HashMap Language a) where mapKeyLanguage = mapKey Language mapKey :: (Eq k2, Hashable k2) => (k1 -> k2) -> HM.HashMap k1 a -> HM.HashMap k2 a mapKey f = HM.fromList . map (first f) . HM.toList -#endif \ No newline at end of file +#endif diff --git a/src/GitHub/Data/Teams.hs b/src/GitHub/Data/Teams.hs index 317f4263..694288a9 100644 --- a/src/GitHub/Data/Teams.hs +++ b/src/GitHub/Data/Teams.hs @@ -30,7 +30,7 @@ import GitHub.Data.Repos (Repo) data Privacy = PrivacyClosed | PrivacySecret - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic) instance NFData Privacy where rnf = genericRnf instance Binary Privacy @@ -39,7 +39,7 @@ data Permission = PermissionPull | PermissionPush | PermissionAdmin - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic) instance NFData Permission where rnf = genericRnf instance Binary Permission @@ -47,7 +47,7 @@ instance Binary Permission data SimpleTeam = SimpleTeam { simpleTeamId :: !(Id Team) ,simpleTeamUrl :: !Text - ,simpleTeamName :: !Text + ,simpleTeamName :: !Text -- TODO (0.15.0): unify this and 'simpleTeamSlug' as in 'Team'. ,simpleTeamSlug :: !(Name Team) ,simpleTeamDescription :: !(Maybe Text) ,simpleTeamPrivacy :: !(Maybe Privacy) @@ -243,3 +243,10 @@ instance FromJSON ReqState where instance ToJSON ReqState where toJSON StateActive = String "active" toJSON StatePending = String "pending" + +-- | Filters members returned by their role in the team. +data TeamMemberRole + = TeamMemberRoleAll -- ^ all members of the team. + | TeamMemberRoleMaintainer -- ^ team maintainers + | TeamMemberRoleMember -- ^ normal members of the team. + deriving (Show, Eq, Ord, Enum, Bounded, Typeable, Data, Generic) diff --git a/src/GitHub/Endpoints/Organizations/Members.hs b/src/GitHub/Endpoints/Organizations/Members.hs index 7f733066..398184c1 100644 --- a/src/GitHub/Endpoints/Organizations/Members.hs +++ b/src/GitHub/Endpoints/Organizations/Members.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -9,6 +10,7 @@ module GitHub.Endpoints.Organizations.Members ( membersOf, membersOf', membersOfR, + membersOfWithR, module GitHub.Data, ) where @@ -37,3 +39,17 @@ membersOf = membersOf' Nothing -- See membersOfR :: Name Organization -> Maybe Count -> Request k (Vector SimpleUser) membersOfR organization = PagedQuery ["orgs", toPathPart organization, "members"] [] + +-- | 'membersOfR' with filters. +-- +-- See +membersOfWithR :: Name Organization -> OrgMemberFilter -> OrgMemberRole -> Maybe Count -> Request k (Vector SimpleUser) +membersOfWithR org f r = PagedQuery ["orgs", toPathPart org, "members"] [("filter", Just f'), ("role", Just r')] + where + f' = case f of + OrgMemberFilter2faDisabled -> "2fa_disabled" + OrgMemberFilterAll -> "all" + r' = case r of + OrgMemberRoleAll -> "all" + OrgMemberRoleAdmin -> "admin" + OrgMemberRoleMember -> "member" diff --git a/src/GitHub/Endpoints/Organizations/Teams.hs b/src/GitHub/Endpoints/Organizations/Teams.hs index e9dde690..c0bc9db0 100644 --- a/src/GitHub/Endpoints/Organizations/Teams.hs +++ b/src/GitHub/Endpoints/Organizations/Teams.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -19,6 +20,7 @@ module GitHub.Endpoints.Organizations.Teams ( editTeamR, deleteTeam', deleteTeamR, + listTeamMembersR, teamMembershipInfoFor, teamMembershipInfoFor', teamMembershipInfoForR, @@ -120,11 +122,23 @@ deleteTeam' auth tid = executeRequest auth $ deleteTeamR tid -- | Delete team. +-- -- See deleteTeamR :: Id Team -> Request 'True () deleteTeamR tid = Command Delete ["teams", toPathPart tid] mempty +-- List team members. +-- +-- See +listTeamMembersR :: Id Team -> TeamMemberRole -> Maybe Count -> Request 'True (Vector SimpleUser) +listTeamMembersR tid r = PagedQuery ["teams", toPathPart tid, "members"] [("role", Just r')] + where + r' = case r of + TeamMemberRoleAll -> "all" + TeamMemberRoleMaintainer -> "maintainer" + TeamMemberRoleMember -> "member" + -- | Retrieve team mebership information for a user. -- | With authentication -- From 38fe4a086481b1348cd3376fd02377c4ba6d7422 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 1 Feb 2016 08:54:52 +0200 Subject: [PATCH 178/510] Add stack-lts-5.yaml --- .travis.yml | 6 ++++++ stack-lts-4.yaml | 3 --- stack-lts-5.yaml | 5 +++++ 3 files changed, 11 insertions(+), 3 deletions(-) create mode 100644 stack-lts-5.yaml diff --git a/.travis.yml b/.travis.yml index f4bf421f..a8905397 100644 --- a/.travis.yml +++ b/.travis.yml @@ -33,6 +33,9 @@ matrix: - env: BUILD=cabal CABALVER=1.22 GHCVER=7.10.3 STACKAGESNAPSHOT=lts-4.2 compiler: ": #GHC 7.10.3 lts-4.2" addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3], sources: [hvr-ghc]}} + - env: BUILD=cabal CABALVER=1.22 GHCVER=7.10.3 STACKAGESNAPSHOT=lts-5.1 + compiler: ": #GHC 7.10.3 lts-5.1" + addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3], sources: [hvr-ghc]}} - env: BUILD=stack STACK_YAML=stack-lts-2.yaml GHCVER=7.8.4 compiler: ": #STACK LTS2" addons: {apt: {packages: [ghc-7.8.4], sources: [hvr-ghc]}} @@ -42,6 +45,9 @@ matrix: - env: BUILD=stack STACK_YAML=stack-lts-4.yaml GHCVER=7.10.3 compiler: ": #STACK LTS4" addons: {apt: {packages: [ghc-7.10.3], sources: [hvr-ghc]}} + - env: BUILD=stack STACK_YAML=stack-lts-5.yaml GHCVER=7.10.3 + compiler: ": #STACK LTS5" + addons: {apt: {packages: [ghc-7.10.3], sources: [hvr-ghc]}} - env: BUILD=stack STACK_YAML=stack-nightly.yaml GHCVER=7.10.3 compiler: ": #STACK nightly" addons: {apt: {packages: [ghc-7.10.3], sources: [hvr-ghc]}} diff --git a/stack-lts-4.yaml b/stack-lts-4.yaml index d66950a2..366e8409 100644 --- a/stack-lts-4.yaml +++ b/stack-lts-4.yaml @@ -3,6 +3,3 @@ packages: - 'samples/' extra-deps: [] resolver: lts-4.2 -flags: - github: - aeson-compat: true diff --git a/stack-lts-5.yaml b/stack-lts-5.yaml new file mode 100644 index 00000000..0d75a9dd --- /dev/null +++ b/stack-lts-5.yaml @@ -0,0 +1,5 @@ +packages: +- '.' +- 'samples/' +extra-deps: [] +resolver: lts-5.1 From 26c62a4e8984adcb4e80c865db8b31931f52c3f0 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 1 Feb 2016 08:57:24 +0200 Subject: [PATCH 179/510] Add badges --- README.md | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/README.md b/README.md index 740aead3..7ea7896a 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,11 @@ Github ------ +[![Build Status](https://travis-ci.org/phadej/github.svg?branch=master)](https://travis-ci.org/phadej/github) +[![Hackage](https://img.shields.io/hackage/v/github.svg)](http://hackage.haskell.org/package/github) +[![Stackage LTS 5](http://stackage.org/package/github/badge/lts-5)](http://stackage.org/lts-5/package/github) +[![Stackage Nightly](http://stackage.org/package/github/badge/nightly)](http://stackage.org/nightly/package/github) + The Github API v3 for Haskell. Some functions are missing; these are functions where the Github API did From a80895850b0bc786a474b6885e59feb9c6b3cacc Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 1 Feb 2016 09:11:54 +0200 Subject: [PATCH 180/510] Don't require network for search tests --- spec/GitHub/SearchSpec.hs | 31 ++++++++++++++++++++----------- 1 file changed, 20 insertions(+), 11 deletions(-) diff --git a/spec/GitHub/SearchSpec.hs b/spec/GitHub/SearchSpec.hs index ec3a33b7..11f12ee6 100644 --- a/spec/GitHub/SearchSpec.hs +++ b/spec/GitHub/SearchSpec.hs @@ -5,20 +5,29 @@ module GitHub.SearchSpec where import Prelude () import Prelude.Compat -import Data.Aeson.Compat (eitherDecodeStrict) -import Data.FileEmbed (embedFile) -import Test.Hspec (Spec, describe, it, shouldBe) +import Data.Aeson.Compat (eitherDecodeStrict) +import Data.FileEmbed (embedFile) +import Data.Proxy (Proxy (..)) +import Data.String (fromString) +import System.Environment (lookupEnv) +import Test.Hspec (Spec, describe, it, pendingWith, shouldBe) import qualified Data.Vector as V -import GitHub.Data.Id (Id (..)) -import GitHub.Data.Issues (Issue (..)) -import GitHub.Endpoints.Search (SearchResult (..), searchIssues) +import GitHub.Data (Auth (..), Issue (..), mkId) +import GitHub.Endpoints.Search (SearchResult (..), searchIssues') fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a +withAuth :: (Auth -> IO ()) -> IO () +withAuth action = do + mtoken <- lookupEnv "GITHUB_TOKEN" + case mtoken of + Nothing -> pendingWith "no GITHUB_TOKEN" + Just token -> action (OAuth $ fromString token) + spec :: Spec spec = do describe "searchIssues" $ do @@ -30,19 +39,19 @@ spec = do V.length issues `shouldBe` 2 let issue1 = issues V.! 0 - issueId issue1 `shouldBe` Id 123898390 + issueId issue1 `shouldBe` mkId (Proxy :: Proxy Issue) 123898390 issueNumber issue1 `shouldBe` 130 issueTitle issue1 `shouldBe` "Make test runner more robust" issueState issue1 `shouldBe` "closed" let issue2 = issues V.! 1 - issueId issue2 `shouldBe` Id 119694665 + issueId issue2 `shouldBe` mkId (Proxy :: Proxy Issue) 119694665 issueNumber issue2 `shouldBe` 127 issueTitle issue2 `shouldBe` "Decouple request creation from execution" issueState issue2 `shouldBe` "open" - it "performs an issue search via the API" $ do + it "performs an issue search via the API" $ withAuth $ \auth -> do let query = "Decouple in:title repo:phadej/github created:<=2015-12-01" - issues <- searchResultResults . fromRightS <$> searchIssues query + issues <- searchResultResults . fromRightS <$> searchIssues' (Just auth) query length issues `shouldBe` 1 - issueId (V.head issues) `shouldBe` Id 119694665 + issueId (V.head issues) `shouldBe` mkId (Proxy :: Proxy Issue) 119694665 From e48bc07d69c2518d5d5fbb576b8e9b3f60478bad Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 1 Feb 2016 10:38:07 +0200 Subject: [PATCH 181/510] Bump version to 0.14.1 --- NEWS.md => CHANGELOG.md | 8 ++++++++ github.cabal | 3 ++- 2 files changed, 10 insertions(+), 1 deletion(-) rename NEWS.md => CHANGELOG.md (90%) diff --git a/NEWS.md b/CHANGELOG.md similarity index 90% rename from NEWS.md rename to CHANGELOG.md index 52f746b0..a4492e93 100644 --- a/NEWS.md +++ b/CHANGELOG.md @@ -1,3 +1,11 @@ +Changes for 0.14.1 + +- Add `membersOfWithR`, `listTeamMembersR` +- Add related enums: `OrgMemberFilter`, `OrgMemberRole`, `TeamMemberRole` +- Add `Enum` and `Bounded` instances to `Privacy`, `Permission`, + `RepoPublicity` +- Don't require network access for search tests + Changes for 0.14.0 Large API changes: diff --git a/github.cabal b/github.cabal index 0b7d7f31..6111987d 100644 --- a/github.cabal +++ b/github.cabal @@ -1,5 +1,5 @@ name: github -version: 0.14.0 +version: 0.14.1 synopsis: Access to the GitHub API, v3. description: The GitHub API provides programmatic access to the full @@ -29,6 +29,7 @@ tested-with: GHC==7.8.4, GHC==7.10.2 cabal-version: >=1.10 extra-source-files: README.md, + CHANGELOG.md, fixtures/issue-search.json, fixtures/list-teams.json, fixtures/members-list.json, From eda2c8abede0bdf7e0bf9f2ee6dc75e6660bc424 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 1 Feb 2016 11:54:40 +0200 Subject: [PATCH 182/510] Remove github from downloaded cabal.config --- travis-install.sh | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/travis-install.sh b/travis-install.sh index d973e6c7..1d5ebf30 100644 --- a/travis-install.sh +++ b/travis-install.sh @@ -12,7 +12,9 @@ case $BUILD in stack --no-terminal test --only-dependencies ;; cabal) - if [ -n "$STACKAGESNAPSHOT" ]; then wget https://www.stackage.org/$STACKAGESNAPSHOT/cabal.config; fi + if [ -n "$STACKAGESNAPSHOT" ]; then + curl -s https://www.stackage.org/$STACKAGESNAPSHOT/cabal.config | grep -v 'github ==' > cabal.config + fi cabal --version echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]" if [ -f $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz ]; then From 489659a61fdb150ee1785c4954cde93a5078df2e Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 2 Feb 2016 13:58:15 +0200 Subject: [PATCH 183/510] Update haddock (list team members implemented) --- src/GitHub.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/src/GitHub.hs b/src/GitHub.hs index 7cd29336..4d1d0616 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -165,7 +165,6 @@ module GitHub ( -- -- Missing endpoints: -- - -- * List team members -- * Query team member (deprecated) -- * Add team member (deprecated) -- * Remove team member (deprecated) From e3e579c8be836909af11da7dc581524b8ea5eef7 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 9 Feb 2016 16:25:31 +0200 Subject: [PATCH 184/510] aeson-0.11 --- github.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/github.cabal b/github.cabal index 6111987d..87f4ad9b 100644 --- a/github.cabal +++ b/github.cabal @@ -99,7 +99,7 @@ Library -- Packages needed in order to build this package. build-depends: base >= 4.7 && <4.9, - aeson >=0.7.0.6 && <0.11, + aeson >=0.7.0.6 && <0.12, attoparsec >=0.11.3.4 && <0.14, base-compat >=0.6.0 && <0.10, base16-bytestring >=0.1.1.6 && <0.2, From a31703a4479366090584678b17966983c18bc759 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Wed, 17 Feb 2016 22:25:27 +0200 Subject: [PATCH 185/510] Add mkUserId, ... --- CHANGELOG.md | 4 ++++ github.cabal | 2 +- src/GitHub/Data.hs | 16 ++++++++++++++++ 3 files changed, 21 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index a4492e93..3f6ff36d 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,7 @@ +Changes for 0.14.2 + +- Add `mkUserId`, `mkUserName`, `fromUserId`, `fromOrganizationId` + Changes for 0.14.1 - Add `membersOfWithR`, `listTeamMembersR` diff --git a/github.cabal b/github.cabal index 87f4ad9b..8ecf5f1a 100644 --- a/github.cabal +++ b/github.cabal @@ -1,5 +1,5 @@ name: github -version: 0.14.1 +version: 0.14.2 synopsis: Access to the GitHub API, v3. description: The GitHub API provides programmatic access to the full diff --git a/src/GitHub/Data.hs b/src/GitHub/Data.hs index 9cafbad8..c025a898 100644 --- a/src/GitHub/Data.hs +++ b/src/GitHub/Data.hs @@ -14,6 +14,7 @@ module GitHub.Data ( mkName, untagName, mkOwnerName, + mkUserName, mkTeamName, mkOrganizationName, mkRepoName, @@ -24,9 +25,12 @@ module GitHub.Data ( mkId, untagId, mkOwnerId, + mkUserId, mkTeamId, mkOrganizationId, mkRepoId, + fromUserId, + fromOrganizationId, -- * Module re-exports module GitHub.Auth, module GitHub.Data.Comments, @@ -70,6 +74,12 @@ mkOwnerId = Id mkOwnerName :: Text -> Name Owner mkOwnerName = N +mkUserId :: Int -> Id User +mkUserId = Id + +mkUserName :: Text -> Name User +mkUserName = N + mkTeamId :: Int -> Id Team mkTeamId = Id @@ -93,3 +103,9 @@ fromOrganizationName = N . untagName fromUserName :: Name User -> Name Owner fromUserName = N . untagName + +fromOrganizationId :: Id Organization -> Id Owner +fromOrganizationId = Id . untagId + +fromUserId :: Id User -> Id Owner +fromUserId = Id . untagId From e53d065d32130c0d57b0b9c17393b059d740e999 Mon Sep 17 00:00:00 2001 From: Konstantin Zudov Date: Mon, 28 Mar 2016 15:45:48 +0300 Subject: [PATCH 186/510] instance Hashable Auth --- src/GitHub/Auth.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/GitHub/Auth.hs b/src/GitHub/Auth.hs index ba04f821..09475664 100644 --- a/src/GitHub/Auth.hs +++ b/src/GitHub/Auth.hs @@ -11,6 +11,7 @@ import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) import Data.Binary (Binary) import Data.Data (Data, Typeable) +import Data.Hashable (Hashable) import GHC.Generics (Generic) import qualified Data.ByteString as BS @@ -28,3 +29,4 @@ data Auth instance NFData Auth where rnf = genericRnf instance Binary Auth +instance Hashable Auth From 9cd79e31d0f9ed31cb9f59a3b67734bb5c19fe3d Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 28 Mar 2016 23:25:22 +0300 Subject: [PATCH 187/510] Bump version to 0.14.3 --- CHANGELOG.md | 4 ++++ github.cabal | 4 ++-- 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 3f6ff36d..103e2629 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,7 @@ +Changes for 0.14.3 + +- Add `Hashable Auth` instance + Changes for 0.14.2 - Add `mkUserId`, `mkUserName`, `fromUserId`, `fromOrganizationId` diff --git a/github.cabal b/github.cabal index 8ecf5f1a..a54f08a1 100644 --- a/github.cabal +++ b/github.cabal @@ -1,5 +1,5 @@ name: github -version: 0.14.2 +version: 0.14.3 synopsis: Access to the GitHub API, v3. description: The GitHub API provides programmatic access to the full @@ -25,7 +25,7 @@ homepage: https://github.com/phadej/github copyright: Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016 Oleg Grenrus category: Network build-type: Simple -tested-with: GHC==7.8.4, GHC==7.10.2 +tested-with: GHC==7.8.4, GHC==7.10.3 cabal-version: >=1.10 extra-source-files: README.md, From da344cddec804ee9720c0609d9e280dc381f3e55 Mon Sep 17 00:00:00 2001 From: nakaji-dayo Date: Mon, 25 Apr 2016 01:59:51 +0900 Subject: [PATCH 188/510] Add HeaderQuery and RepoStarred Data --- github.cabal | 1 + spec/GitHub/ActivitySpec.hs | 8 +++++ src/GitHub/Data.hs | 2 ++ src/GitHub/Data/Activities.hs | 37 +++++++++++++++++++++++ src/GitHub/Data/Request.hs | 12 ++++++++ src/GitHub/Endpoints/Activity/Starring.hs | 13 ++++++++ src/GitHub/Request.hs | 17 ++++++++--- 7 files changed, 86 insertions(+), 4 deletions(-) create mode 100644 src/GitHub/Data/Activities.hs diff --git a/github.cabal b/github.cabal index a54f08a1..877185c0 100644 --- a/github.cabal +++ b/github.cabal @@ -66,6 +66,7 @@ Library GitHub.Data.Request GitHub.Data.Search GitHub.Data.Teams + GitHub.Data.Activities GitHub.Data.Webhooks GitHub.Data.Webhooks.Validate GitHub.Endpoints.Activity.Starring diff --git a/spec/GitHub/ActivitySpec.hs b/spec/GitHub/ActivitySpec.hs index 463573bf..850469c0 100644 --- a/spec/GitHub/ActivitySpec.hs +++ b/spec/GitHub/ActivitySpec.hs @@ -4,6 +4,7 @@ module GitHub.ActivitySpec where import GitHub.Auth (Auth (..)) import GitHub.Endpoints.Activity.Watching (watchersForR) +import GitHub.Endpoints.Activity.Starring (myStarredAcceptStarR) import GitHub.Request (executeRequest) import Data.Either.Compat (isRight) @@ -13,6 +14,8 @@ import Test.Hspec (Spec, describe, it, pendingWith, shouldSatisfy) import qualified Data.Vector as V +import GitHub.Data.Activities + fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a @@ -31,3 +34,8 @@ spec = do cs <- executeRequest auth $ watchersForR "phadej" "github" Nothing cs `shouldSatisfy` isRight V.length (fromRightS cs) `shouldSatisfy` (> 10) + describe "myStarredR" $ do + it "works" $ withAuth $ \auth -> do + cs <- executeRequest auth $ myStarredAcceptStarR (Just 31) + cs `shouldSatisfy` isRight + fromRightS cs `shouldSatisfy` (\xs -> V.length xs > 30) diff --git a/src/GitHub/Data.hs b/src/GitHub/Data.hs index c025a898..a04a38a0 100644 --- a/src/GitHub/Data.hs +++ b/src/GitHub/Data.hs @@ -44,6 +44,7 @@ module GitHub.Data ( module GitHub.Data.Request, module GitHub.Data.Search, module GitHub.Data.Teams, + module GitHub.Data.Activities, module GitHub.Data.Webhooks, ) where @@ -66,6 +67,7 @@ import GitHub.Data.Repos import GitHub.Data.Request import GitHub.Data.Search import GitHub.Data.Teams +import GitHub.Data.Activities import GitHub.Data.Webhooks mkOwnerId :: Int -> Id Owner diff --git a/src/GitHub/Data/Activities.hs b/src/GitHub/Data/Activities.hs new file mode 100644 index 00000000..c42aaae6 --- /dev/null +++ b/src/GitHub/Data/Activities.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +module GitHub.Data.Activities where + +import Prelude () +import Prelude.Compat + +import Control.DeepSeq (NFData (..)) +import Control.DeepSeq.Generics (genericRnf) +import Data.Aeson.Compat (FromJSON (..), withObject, (.:)) +import Data.Binary (Binary) +import Data.Data (Data, Typeable) +import GHC.Generics (Generic) +import Data.Time (UTCTime) + +import GitHub.Data.Repos (Repo) + +data RepoStarred = RepoStarred { + repoStarredStarredAt :: !UTCTime + ,repoStarredRepo :: !Repo +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData RepoStarred where rnf = genericRnf +instance Binary RepoStarred + +-- JSON Instances +instance FromJSON RepoStarred where + parseJSON = withObject "RepoStarred" $ \o -> + RepoStarred <$> o .: "starred_at" + <*> o .: "repo" + diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs index 5ad45e01..15859bb4 100644 --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -34,6 +34,7 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS import qualified Data.Text as T import qualified Network.HTTP.Types.Method as Method +import qualified Network.HTTP.Types as Types import GitHub.Data.Id (Id, untagId) import GitHub.Data.Name (Name, untagName) @@ -122,6 +123,7 @@ data Request (k :: Bool) a where PagedQuery :: FromJSON (Vector a) => Paths -> QueryString -> Maybe Count -> Request k (Vector a) Command :: FromJSON a => CommandMethod a -> Paths -> LBS.ByteString -> Request 'True a StatusQuery :: StatusMap a -> Request k () -> Request k a + HeaderQuery :: FromJSON a => Types.RequestHeaders -> Request k a -> Request k a deriving (Typeable) deriving instance Eq (Request k a) @@ -153,6 +155,12 @@ instance Show (Request k a) where . showsPrec (appPrec + 1) m . showString " " . showsPrec (appPrec + 1) req + HeaderQuery m req -> showParen (d > appPrec) $ + showString "Header " + . showsPrec (appPrec + 1) m + . showString " " + . showsPrec (appPrec + 1) req + where appPrec = 10 :: Int instance Hashable (Request k a) where @@ -174,3 +182,7 @@ instance Hashable (Request k a) where salt `hashWithSalt` (3 :: Int) `hashWithSalt` sm `hashWithSalt` req + hashWithSalt salt (HeaderQuery h req) = + salt `hashWithSalt` (4 :: Int) + `hashWithSalt` h + `hashWithSalt` req diff --git a/src/GitHub/Endpoints/Activity/Starring.hs b/src/GitHub/Endpoints/Activity/Starring.hs index 24259564..8dcb36fd 100644 --- a/src/GitHub/Endpoints/Activity/Starring.hs +++ b/src/GitHub/Endpoints/Activity/Starring.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -13,6 +14,8 @@ module GitHub.Endpoints.Activity.Starring ( reposStarredByR, myStarred, myStarredR, + myStarredAcceptStar, + myStarredAcceptStarR, module GitHub.Data, ) where @@ -55,3 +58,13 @@ myStarred auth = -- | All the repos starred by the authenticated user. myStarredR :: Maybe Count -> Request 'True (Vector Repo) myStarredR = PagedQuery ["user", "starred"] [] + + +-- | All the repos starred by the authenticated user. +myStarredAcceptStar :: Auth -> IO (Either Error (Vector RepoStarred)) +myStarredAcceptStar auth = + executeRequest auth $ myStarredAcceptStarR Nothing + +-- | All the repos starred by the authenticated user. +myStarredAcceptStarR :: Maybe Count -> Request 'True (Vector RepoStarred) +myStarredAcceptStarR mc = HeaderQuery [("Accept", "application/vnd.github.v3.star+json")] $ PagedQuery ["user", "starred"] [] mc diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index 32e49278..0bf2c6f8 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -112,7 +112,9 @@ executeRequestWithMgr :: Manager -> Request k a -> IO (Either Error a) executeRequestWithMgr mgr auth req = runExceptT $ - case req of + execute req + where + execute req' = case req' of Query {} -> do httpReq <- makeHttpRequest (Just auth) req res <- httpLbs' httpReq @@ -132,7 +134,8 @@ executeRequestWithMgr mgr auth req = runExceptT $ httpReq <- makeHttpRequest (Just auth) req res <- httpLbs' httpReq parseStatus sm . responseStatus $ res - where + HeaderQuery _ r -> do + execute r httpLbs' :: HTTP.Request -> ExceptT Error IO (Response LBS.ByteString) httpLbs' req' = lift (httpLbs req' mgr) `catch` onHttpException @@ -151,7 +154,9 @@ executeRequestWithMgr' :: Manager -> Request 'False a -> IO (Either Error a) executeRequestWithMgr' mgr req = runExceptT $ - case req of + execute req + where + execute req' = case req' of Query {} -> do httpReq <- makeHttpRequest Nothing req res <- httpLbs' httpReq @@ -165,7 +170,8 @@ executeRequestWithMgr' mgr req = runExceptT $ httpReq <- makeHttpRequest Nothing req res <- httpLbs' httpReq parseStatus sm . responseStatus $ res - where + HeaderQuery _ r -> do + execute r httpLbs' :: HTTP.Request -> ExceptT Error IO (Response LBS.ByteString) httpLbs' req' = lift (httpLbs req' mgr) `catch` onHttpException @@ -225,6 +231,9 @@ makeHttpRequest auth r = case r of . setBody body . setMethod (toMethod m) $ req + HeaderQuery h req -> do + req' <- makeHttpRequest auth req + return $ req' { requestHeaders = h <> requestHeaders req'} where url :: Paths -> String url paths = baseUrl ++ '/' : intercalate "/" paths From 9bb7549a2dce1e7b4cb97667319e1b9ba2d88b46 Mon Sep 17 00:00:00 2001 From: nakaji-dayo Date: Tue, 26 Apr 2016 12:57:58 +0900 Subject: [PATCH 189/510] some fixes for #199 --- spec/GitHub/ActivitySpec.hs | 2 -- src/GitHub.hs | 1 + src/GitHub/Data/Request.hs | 2 +- src/GitHub/Endpoints/Activity/Starring.hs | 4 +++- src/GitHub/Request.hs | 6 ++++-- 5 files changed, 9 insertions(+), 6 deletions(-) diff --git a/spec/GitHub/ActivitySpec.hs b/spec/GitHub/ActivitySpec.hs index 850469c0..36f792a6 100644 --- a/spec/GitHub/ActivitySpec.hs +++ b/spec/GitHub/ActivitySpec.hs @@ -14,8 +14,6 @@ import Test.Hspec (Spec, describe, it, pendingWith, shouldSatisfy) import qualified Data.Vector as V -import GitHub.Data.Activities - fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a diff --git a/src/GitHub.hs b/src/GitHub.hs index 4d1d0616..21ed2e70 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -26,6 +26,7 @@ module GitHub ( stargazersForR, reposStarredByR, myStarredR, + myStarredAcceptStarR, -- ** Watching -- | See diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs index 15859bb4..d6a616a7 100644 --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -123,7 +123,7 @@ data Request (k :: Bool) a where PagedQuery :: FromJSON (Vector a) => Paths -> QueryString -> Maybe Count -> Request k (Vector a) Command :: FromJSON a => CommandMethod a -> Paths -> LBS.ByteString -> Request 'True a StatusQuery :: StatusMap a -> Request k () -> Request k a - HeaderQuery :: FromJSON a => Types.RequestHeaders -> Request k a -> Request k a + HeaderQuery :: Types.RequestHeaders -> Request k a -> Request k a deriving (Typeable) deriving instance Eq (Request k a) diff --git a/src/GitHub/Endpoints/Activity/Starring.hs b/src/GitHub/Endpoints/Activity/Starring.hs index 8dcb36fd..ec3c2198 100644 --- a/src/GitHub/Endpoints/Activity/Starring.hs +++ b/src/GitHub/Endpoints/Activity/Starring.hs @@ -56,6 +56,7 @@ myStarred auth = executeRequest auth $ myStarredR Nothing -- | All the repos starred by the authenticated user. +-- See myStarredR :: Maybe Count -> Request 'True (Vector Repo) myStarredR = PagedQuery ["user", "starred"] [] @@ -66,5 +67,6 @@ myStarredAcceptStar auth = executeRequest auth $ myStarredAcceptStarR Nothing -- | All the repos starred by the authenticated user. +-- See myStarredAcceptStarR :: Maybe Count -> Request 'True (Vector RepoStarred) -myStarredAcceptStarR mc = HeaderQuery [("Accept", "application/vnd.github.v3.star+json")] $ PagedQuery ["user", "starred"] [] mc +myStarredAcceptStarR = HeaderQuery [("Accept", "application/vnd.github.v3.star+json")] . PagedQuery ["user", "starred"] [] diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index 0bf2c6f8..e7ba1de1 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -114,6 +114,7 @@ executeRequestWithMgr :: Manager executeRequestWithMgr mgr auth req = runExceptT $ execute req where + execute :: Request k a -> ExceptT Error IO a execute req' = case req' of Query {} -> do httpReq <- makeHttpRequest (Just auth) req @@ -155,7 +156,8 @@ executeRequestWithMgr' :: Manager -> IO (Either Error a) executeRequestWithMgr' mgr req = runExceptT $ execute req - where + where + execute :: Request k a -> ExceptT Error IO a execute req' = case req' of Query {} -> do httpReq <- makeHttpRequest Nothing req @@ -233,7 +235,7 @@ makeHttpRequest auth r = case r of $ req HeaderQuery h req -> do req' <- makeHttpRequest auth req - return $ req' { requestHeaders = h <> requestHeaders req'} + return $ req' { requestHeaders = h <> requestHeaders req' } where url :: Paths -> String url paths = baseUrl ++ '/' : intercalate "/" paths From e0859362b7177db898f5246acd073801af9d1b11 Mon Sep 17 00:00:00 2001 From: nakaji-dayo Date: Tue, 26 Apr 2016 13:15:51 +0900 Subject: [PATCH 190/510] apply stylish-haskell, and reformat Activities.hs --- spec/GitHub/ActivitySpec.hs | 2 +- src/GitHub/Data.hs | 2 +- src/GitHub/Data/Activities.hs | 12 ++++++------ src/GitHub/Data/Request.hs | 2 +- src/GitHub/Endpoints/Activity/Starring.hs | 4 ++-- src/GitHub/Request.hs | 2 +- 6 files changed, 12 insertions(+), 12 deletions(-) diff --git a/spec/GitHub/ActivitySpec.hs b/spec/GitHub/ActivitySpec.hs index 36f792a6..71d62f1a 100644 --- a/spec/GitHub/ActivitySpec.hs +++ b/spec/GitHub/ActivitySpec.hs @@ -3,8 +3,8 @@ module GitHub.ActivitySpec where import GitHub.Auth (Auth (..)) -import GitHub.Endpoints.Activity.Watching (watchersForR) import GitHub.Endpoints.Activity.Starring (myStarredAcceptStarR) +import GitHub.Endpoints.Activity.Watching (watchersForR) import GitHub.Request (executeRequest) import Data.Either.Compat (isRight) diff --git a/src/GitHub/Data.hs b/src/GitHub/Data.hs index a04a38a0..9e9d455c 100644 --- a/src/GitHub/Data.hs +++ b/src/GitHub/Data.hs @@ -54,6 +54,7 @@ import Prelude.Compat import Data.Text (Text) import GitHub.Auth +import GitHub.Data.Activities import GitHub.Data.Comments import GitHub.Data.Content import GitHub.Data.Definitions @@ -67,7 +68,6 @@ import GitHub.Data.Repos import GitHub.Data.Request import GitHub.Data.Search import GitHub.Data.Teams -import GitHub.Data.Activities import GitHub.Data.Webhooks mkOwnerId :: Int -> Id Owner diff --git a/src/GitHub/Data/Activities.hs b/src/GitHub/Data/Activities.hs index c42aaae6..21e46ad5 100644 --- a/src/GitHub/Data/Activities.hs +++ b/src/GitHub/Data/Activities.hs @@ -16,14 +16,14 @@ import Control.DeepSeq.Generics (genericRnf) import Data.Aeson.Compat (FromJSON (..), withObject, (.:)) import Data.Binary (Binary) import Data.Data (Data, Typeable) -import GHC.Generics (Generic) import Data.Time (UTCTime) +import GHC.Generics (Generic) import GitHub.Data.Repos (Repo) data RepoStarred = RepoStarred { - repoStarredStarredAt :: !UTCTime - ,repoStarredRepo :: !Repo + repoStarredStarredAt :: !UTCTime + ,repoStarredRepo :: !Repo } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData RepoStarred where rnf = genericRnf @@ -31,7 +31,7 @@ instance Binary RepoStarred -- JSON Instances instance FromJSON RepoStarred where - parseJSON = withObject "RepoStarred" $ \o -> - RepoStarred <$> o .: "starred_at" - <*> o .: "repo" + parseJSON = withObject "RepoStarred" $ \o -> RepoStarred + <$> o .: "starred_at" + <*> o .: "repo" diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs index d6a616a7..b02b6385 100644 --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -33,8 +33,8 @@ import GHC.Generics (Generic) import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS import qualified Data.Text as T +import qualified Network.HTTP.Types as Types import qualified Network.HTTP.Types.Method as Method -import qualified Network.HTTP.Types as Types import GitHub.Data.Id (Id, untagId) import GitHub.Data.Name (Name, untagName) diff --git a/src/GitHub/Endpoints/Activity/Starring.hs b/src/GitHub/Endpoints/Activity/Starring.hs index ec3c2198..86828213 100644 --- a/src/GitHub/Endpoints/Activity/Starring.hs +++ b/src/GitHub/Endpoints/Activity/Starring.hs @@ -1,5 +1,5 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index e7ba1de1..ecd11302 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -155,7 +155,7 @@ executeRequestWithMgr' :: Manager -> Request 'False a -> IO (Either Error a) executeRequestWithMgr' mgr req = runExceptT $ - execute req + execute req where execute :: Request k a -> ExceptT Error IO a execute req' = case req' of From 3f58c4070648e9dfc41b31bc991167bf04bff6e6 Mon Sep 17 00:00:00 2001 From: Nils Blum-Oeste Date: Thu, 5 May 2016 10:20:06 +0200 Subject: [PATCH 191/510] Fix README example and add Hackage docs link --- README.md | 24 +++++++++++++++++------- 1 file changed, 17 insertions(+), 7 deletions(-) diff --git a/README.md b/README.md index 7ea7896a..2568f588 100644 --- a/README.md +++ b/README.md @@ -2,7 +2,7 @@ Github ------ [![Build Status](https://travis-ci.org/phadej/github.svg?branch=master)](https://travis-ci.org/phadej/github) -[![Hackage](https://img.shields.io/hackage/v/github.svg)](http://hackage.haskell.org/package/github) +[![Hackage](https://img.shields.io/hackage/v/github.svg)][hackage] [![Stackage LTS 5](http://stackage.org/package/github/badge/lts-5)](http://stackage.org/lts-5/package/github) [![Stackage Nightly](http://stackage.org/package/github/badge/nightly)](http://stackage.org/nightly/package/github) @@ -37,7 +37,7 @@ See the samples in the Documentation ============= -For details see the reference documentation on Hackage. +For details see the reference [documentation on Hackage][hackage]. Each module lines up with the hierarchy of [documentation from the Github API](http://developer.github.com/v3/). @@ -54,15 +54,23 @@ Many function have samples under [`samples/`](https://github.com/phadej/github/tree/master/samples) directory. ```hs -import qualified GitHub.Endpoints.Users.Followers as Github +{-# LANGUAGE OverloadedStrings #-} + +import qualified GitHub.Endpoints.Users.Followers as GitHub +import Data.Text as T +import Data.Text.IO as TIO +import Data.Monoid ((<>)) + +main :: IO () main = do - possibleUsers <- GitHub.usersFollowing "mike-burns" - T.putStrLn $ either (("Error: " <>) . T.pack . show) - (foldMap (formatUser . (<> "\n"))) + possibleUsers <- GitHub.usersFollowing "mike-burns" + TIO.putStrLn $ either (("Error: " <>) . T.pack . show) + (foldMap ((<> "\n") . formatUser)) possibleUsers -formatUser = GitHub.untagName . GitHub.githubOwnerLogin +formatUser :: GitHub.SimpleUser -> Text +formatUser = GitHub.untagName . GitHub.simpleUserLogin ``` Test setup @@ -90,3 +98,5 @@ Copyright 2013-2015 John Wiegley. Copyright 2016 Oleg Grenrus. Available under the BSD 3-clause license. + +[hackage]: http://hackage.haskell.org/package/github "Hackage" From 4a83e08d079ae78bf4d7caf9eb649172c4506a82 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Fri, 6 May 2016 20:45:36 +0300 Subject: [PATCH 192/510] Bump version to 0.15.0 --- github.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/github.cabal b/github.cabal index 877185c0..c9b1dad9 100644 --- a/github.cabal +++ b/github.cabal @@ -1,5 +1,5 @@ name: github -version: 0.14.3 +version: 0.15.0 synopsis: Access to the GitHub API, v3. description: The GitHub API provides programmatic access to the full From 248b8671ff68c60240da753f7ad763addd186024 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Fri, 6 May 2016 20:56:07 +0300 Subject: [PATCH 193/510] Add readme example as sample --- README.md | 12 +-- samples/github-samples.cabal | 139 ++++++++++++++++++++--------------- samples/package.yaml | 3 + 3 files changed, 88 insertions(+), 66 deletions(-) diff --git a/README.md b/README.md index 2568f588..32bf11bf 100644 --- a/README.md +++ b/README.md @@ -54,18 +54,18 @@ Many function have samples under [`samples/`](https://github.com/phadej/github/tree/master/samples) directory. ```hs - {-# LANGUAGE OverloadedStrings #-} +import Data.Text (Text, pack) +import Data.Text.IO as T (putStrLn) +import Data.Monoid ((<>)) + import qualified GitHub.Endpoints.Users.Followers as GitHub -import Data.Text as T -import Data.Text.IO as TIO -import Data.Monoid ((<>)) main :: IO () main = do - possibleUsers <- GitHub.usersFollowing "mike-burns" - TIO.putStrLn $ either (("Error: " <>) . T.pack . show) + possibleUsers <- GitHub.usersFollowing "mike-burns" + T.putStrLn $ either (("Error: " <>) . pack . show) (foldMap ((<> "\n") . formatUser)) possibleUsers diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index 8b667435..92aee861 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -1,4 +1,4 @@ --- This file has been generated from package.yaml by hpack version 0.8.0. +-- This file has been generated from package.yaml by hpack version 0.13.0. -- -- see: https://github.com/sol/hpack @@ -20,10 +20,10 @@ library Common default-language: Haskell2010 -executable github-edit-team - main-is: EditTeam.hs +executable github-add-team-membership-for + main-is: AddTeamMembershipFor.hs hs-source-dirs: - Teams + Teams/Memberships ghc-options: -Wall build-depends: base @@ -32,18 +32,14 @@ executable github-edit-team , text , github-samples other-modules: - DeleteTeam - ListTeamsCurrent - Memberships.AddTeamMembershipFor - Memberships.DeleteTeamMembershipFor - Memberships.TeamMembershipInfoFor - TeamInfoFor + DeleteTeamMembershipFor + TeamMembershipInfoFor default-language: Haskell2010 -executable github-team-membership-info-for - main-is: TeamMembershipInfoFor.hs +executable github-delete-team + main-is: DeleteTeam.hs hs-source-dirs: - Teams/Memberships + Teams ghc-options: -Wall build-depends: base @@ -52,8 +48,12 @@ executable github-team-membership-info-for , text , github-samples other-modules: - AddTeamMembershipFor - DeleteTeamMembershipFor + EditTeam + ListTeamsCurrent + Memberships.AddTeamMembershipFor + Memberships.DeleteTeamMembershipFor + Memberships.TeamMembershipInfoFor + TeamInfoFor default-language: Haskell2010 executable github-delete-team-membership-for @@ -72,10 +72,10 @@ executable github-delete-team-membership-for TeamMembershipInfoFor default-language: Haskell2010 -executable github-show-user - main-is: ShowUser.hs +executable github-edit-team + main-is: EditTeam.hs hs-source-dirs: - Users + Teams ghc-options: -Wall build-depends: base @@ -84,13 +84,16 @@ executable github-show-user , text , github-samples other-modules: - Followers.ListFollowers - Followers.ListFollowing - ShowUser2 + DeleteTeam + ListTeamsCurrent + Memberships.AddTeamMembershipFor + Memberships.DeleteTeamMembershipFor + Memberships.TeamMembershipInfoFor + TeamInfoFor default-language: Haskell2010 -executable github-list-following - main-is: ListFollowing.hs +executable github-list-followers + main-is: ListFollowers.hs hs-source-dirs: Users/Followers ghc-options: -Wall @@ -101,45 +104,27 @@ executable github-list-following , text , github-samples other-modules: - ListFollowers - default-language: Haskell2010 - -executable github-operational - main-is: Operational.hs - hs-source-dirs: - Operational - ghc-options: -Wall - build-depends: - base - , base-compat - , github - , text - , github-samples - , http-client - , http-client-tls - , operational - , transformers - , transformers-compat + Example + ListFollowing default-language: Haskell2010 -executable github-add-team-membership-for - main-is: AddTeamMembershipFor.hs +executable github-list-followers-example + main-is: Example.hs hs-source-dirs: - Teams/Memberships + Users/Followers ghc-options: -Wall build-depends: base , base-compat , github , text - , github-samples other-modules: - DeleteTeamMembershipFor - TeamMembershipInfoFor + ListFollowers + ListFollowing default-language: Haskell2010 -executable github-list-followers - main-is: ListFollowers.hs +executable github-list-following + main-is: ListFollowing.hs hs-source-dirs: Users/Followers ghc-options: -Wall @@ -150,7 +135,8 @@ executable github-list-followers , text , github-samples other-modules: - ListFollowing + Example + ListFollowers default-language: Haskell2010 executable github-list-team-current @@ -173,10 +159,28 @@ executable github-list-team-current TeamInfoFor default-language: Haskell2010 -executable github-delete-team - main-is: DeleteTeam.hs +executable github-operational + main-is: Operational.hs hs-source-dirs: - Teams + Operational + ghc-options: -Wall + build-depends: + base + , base-compat + , github + , text + , github-samples + , http-client + , http-client-tls + , operational + , transformers + , transformers-compat + default-language: Haskell2010 + +executable github-show-user + main-is: ShowUser.hs + hs-source-dirs: + Users ghc-options: -Wall build-depends: base @@ -185,12 +189,10 @@ executable github-delete-team , text , github-samples other-modules: - EditTeam - ListTeamsCurrent - Memberships.AddTeamMembershipFor - Memberships.DeleteTeamMembershipFor - Memberships.TeamMembershipInfoFor - TeamInfoFor + Followers.Example + Followers.ListFollowers + Followers.ListFollowing + ShowUser2 default-language: Haskell2010 executable github-show-user-2 @@ -205,11 +207,28 @@ executable github-show-user-2 , text , github-samples other-modules: + Followers.Example Followers.ListFollowers Followers.ListFollowing ShowUser default-language: Haskell2010 +executable github-team-membership-info-for + main-is: TeamMembershipInfoFor.hs + hs-source-dirs: + Teams/Memberships + ghc-options: -Wall + build-depends: + base + , base-compat + , github + , text + , github-samples + other-modules: + AddTeamMembershipFor + DeleteTeamMembershipFor + default-language: Haskell2010 + executable github-teaminfo-for main-is: TeamInfoFor.hs hs-source-dirs: diff --git a/samples/package.yaml b/samples/package.yaml index 82d68519..987e1e4b 100644 --- a/samples/package.yaml +++ b/samples/package.yaml @@ -22,6 +22,9 @@ executables: source-dirs: Users dependencies: - github-samples + github-list-followers-example: + main: Example.hs + source-dirs: Users/Followers github-list-followers: main: ListFollowers.hs source-dirs: Users/Followers From e074e305611d931e893ac487c785a8fe9c08fd30 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Fri, 6 May 2016 20:58:42 +0300 Subject: [PATCH 194/510] Reorder re-exports in Github.Data --- src/GitHub/Data.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/GitHub/Data.hs b/src/GitHub/Data.hs index 9e9d455c..beb85ba0 100644 --- a/src/GitHub/Data.hs +++ b/src/GitHub/Data.hs @@ -33,6 +33,7 @@ module GitHub.Data ( fromOrganizationId, -- * Module re-exports module GitHub.Auth, + module GitHub.Data.Activities, module GitHub.Data.Comments, module GitHub.Data.Content, module GitHub.Data.Definitions, @@ -44,7 +45,6 @@ module GitHub.Data ( module GitHub.Data.Request, module GitHub.Data.Search, module GitHub.Data.Teams, - module GitHub.Data.Activities, module GitHub.Data.Webhooks, ) where From 4a2d164033249f83df76692ed8723987f4990506 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sat, 7 May 2016 09:54:44 +0300 Subject: [PATCH 195/510] Add forgotten Example.hs --- README.md | 3 +++ samples/Users/Followers/Example.hs | 20 ++++++++++++++++++++ 2 files changed, 23 insertions(+) create mode 100644 samples/Users/Followers/Example.hs diff --git a/README.md b/README.md index 32bf11bf..9136e437 100644 --- a/README.md +++ b/README.md @@ -54,8 +54,11 @@ Many function have samples under [`samples/`](https://github.com/phadej/github/tree/master/samples) directory. ```hs +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} +import Prelude.Compat + import Data.Text (Text, pack) import Data.Text.IO as T (putStrLn) import Data.Monoid ((<>)) diff --git a/samples/Users/Followers/Example.hs b/samples/Users/Followers/Example.hs new file mode 100644 index 00000000..78243e9e --- /dev/null +++ b/samples/Users/Followers/Example.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} + +import Prelude.Compat + +import Data.Text (Text, pack) +import Data.Text.IO as T (putStrLn) +import Data.Monoid ((<>)) + +import qualified GitHub.Endpoints.Users.Followers as GitHub + +main :: IO () +main = do + possibleUsers <- GitHub.usersFollowing "mike-burns" + T.putStrLn $ either (("Error: " <>) . pack . show) + (foldMap ((<> "\n") . formatUser)) + possibleUsers + +formatUser :: GitHub.SimpleUser -> Text +formatUser = GitHub.untagName . GitHub.simpleUserLogin From bf18ce075d59c1c3f7ede22dba2062848cca6a14 Mon Sep 17 00:00:00 2001 From: Nils Blum-Oeste Date: Sat, 7 May 2016 12:38:38 +0200 Subject: [PATCH 196/510] Add support for team repositories endpoint --- samples/Teams/ListRepos.hs | 19 +++++++++++++++ samples/github-samples.cabal | 25 +++++++++++++++++++ samples/package.yaml | 5 ++++ src/GitHub.hs | 2 +- src/GitHub/Endpoints/Organizations/Teams.hs | 27 ++++++++++++++++++--- 5 files changed, 74 insertions(+), 4 deletions(-) create mode 100644 samples/Teams/ListRepos.hs diff --git a/samples/Teams/ListRepos.hs b/samples/Teams/ListRepos.hs new file mode 100644 index 00000000..505f4c7b --- /dev/null +++ b/samples/Teams/ListRepos.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main (main) where + +import Common +import Prelude () + +import qualified GitHub +import qualified GitHub.Endpoints.Organizations.Teams as GitHub + +main :: IO () +main = do + args <- getArgs + possibleRepos <- case args of + [team_id, token] -> GitHub.listTeamRepos' (Just $ GitHub.OAuth $ fromString token) (GitHub.mkTeamId $ read team_id) + [team_id] -> GitHub.listTeamRepos (GitHub.mkTeamId $ read team_id) + _ -> error "usage: TeamListRepos [auth token]" + case possibleRepos of + Left err -> putStrLn $ "Error: " <> tshow err + Right repos -> putStrLn $ tshow repos diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index 92aee861..eb607530 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -49,6 +49,7 @@ executable github-delete-team , github-samples other-modules: EditTeam + ListRepos ListTeamsCurrent Memberships.AddTeamMembershipFor Memberships.DeleteTeamMembershipFor @@ -85,6 +86,7 @@ executable github-edit-team , github-samples other-modules: DeleteTeam + ListRepos ListTeamsCurrent Memberships.AddTeamMembershipFor Memberships.DeleteTeamMembershipFor @@ -153,6 +155,28 @@ executable github-list-team-current other-modules: DeleteTeam EditTeam + ListRepos + Memberships.AddTeamMembershipFor + Memberships.DeleteTeamMembershipFor + Memberships.TeamMembershipInfoFor + TeamInfoFor + default-language: Haskell2010 + +executable github-list-team-repos + main-is: ListRepos.hs + hs-source-dirs: + Teams + ghc-options: -Wall + build-depends: + base + , base-compat + , github + , text + , github-samples + other-modules: + DeleteTeam + EditTeam + ListTeamsCurrent Memberships.AddTeamMembershipFor Memberships.DeleteTeamMembershipFor Memberships.TeamMembershipInfoFor @@ -243,6 +267,7 @@ executable github-teaminfo-for other-modules: DeleteTeam EditTeam + ListRepos ListTeamsCurrent Memberships.AddTeamMembershipFor Memberships.DeleteTeamMembershipFor diff --git a/samples/package.yaml b/samples/package.yaml index 987e1e4b..af03e708 100644 --- a/samples/package.yaml +++ b/samples/package.yaml @@ -50,6 +50,11 @@ executables: source-dirs: Teams dependencies: - github-samples + github-list-team-repos: + main: ListRepos.hs + source-dirs: Teams + dependencies: + - github-samples github-teaminfo-for: main: TeamInfoFor.hs source-dirs: Teams diff --git a/src/GitHub.hs b/src/GitHub.hs index 21ed2e70..3c53cfb5 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -169,7 +169,6 @@ module GitHub ( -- * Query team member (deprecated) -- * Add team member (deprecated) -- * Remove team member (deprecated) - -- * List team repos -- * Check if a team manages a repository -- * Add team repository -- * Remove team repository @@ -179,6 +178,7 @@ module GitHub ( editTeamR, deleteTeamR, listTeamMembersR, + listTeamReposR, teamMembershipInfoForR, addTeamMembershipForR, deleteTeamMembershipForR, diff --git a/src/GitHub/Endpoints/Organizations/Teams.hs b/src/GitHub/Endpoints/Organizations/Teams.hs index c0bc9db0..bd7a9784 100644 --- a/src/GitHub/Endpoints/Organizations/Teams.hs +++ b/src/GitHub/Endpoints/Organizations/Teams.hs @@ -21,6 +21,9 @@ module GitHub.Endpoints.Organizations.Teams ( deleteTeam', deleteTeamR, listTeamMembersR, + listTeamRepos, + listTeamRepos', + listTeamReposR, teamMembershipInfoFor, teamMembershipInfoFor', teamMembershipInfoForR, @@ -63,7 +66,7 @@ teamsOfR :: Name Organization -> Maybe Count -> Request k (Vector SimpleTeam) teamsOfR org = PagedQuery ["orgs", toPathPart org, "teams"] [] -- | The information for a single team, by team id. --- | With authentication +-- With authentication -- -- > teamInfoFor' (Just $ OAuth "token") 1010101 teamInfoFor' :: Maybe Auth -> Id Team -> IO (Either Error Team) @@ -128,7 +131,7 @@ deleteTeamR :: Id Team -> Request 'True () deleteTeamR tid = Command Delete ["teams", toPathPart tid] mempty --- List team members. +-- | List team members. -- -- See listTeamMembersR :: Id Team -> TeamMemberRole -> Maybe Count -> Request 'True (Vector SimpleUser) @@ -139,8 +142,26 @@ listTeamMembersR tid r = PagedQuery ["teams", toPathPart tid, "members"] [("role TeamMemberRoleMaintainer -> "maintainer" TeamMemberRoleMember -> "member" +-- | The repositories of a single team, by team id. +-- With authentication +-- +-- > listTeamRepos' (Just $ GitHub.OAuth token) (GitHub.mkTeamId team_id) +listTeamRepos' :: Maybe Auth -> Id Team -> IO (Either Error (Vector Repo)) +listTeamRepos' auth tid = executeRequestMaybe auth $ listTeamReposR tid Nothing + +-- | Query team repositories. +-- See +listTeamReposR :: Id Team -> Maybe Count -> Request k (Vector Repo) +listTeamReposR tid = PagedQuery ["teams", toPathPart tid, "repos"] [] + +-- | Retrieve repositories for a team. +-- +-- > listTeamRepos (GitHub.mkTeamId team_id) +listTeamRepos :: Id Team -> IO (Either Error (Vector Repo)) +listTeamRepos = listTeamRepos' Nothing + -- | Retrieve team mebership information for a user. --- | With authentication +-- With authentication -- -- > teamMembershipInfoFor' (Just $ OAuth "token") 1010101 "mburns" teamMembershipInfoFor' :: Maybe Auth -> Id Team -> Name Owner -> IO (Either Error TeamMembership) From 4206c647ffd8c0df8d26419cbe7602e4b8eed7fe Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Fri, 13 May 2016 19:58:34 +0300 Subject: [PATCH 197/510] Resolve #205 --- src/GitHub/Data/PullRequests.hs | 4 ++-- src/GitHub/Request.hs | 2 +- stack-nightly.yaml | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/GitHub/Data/PullRequests.hs b/src/GitHub/Data/PullRequests.hs index 8c69a2e5..3c9fc5d8 100644 --- a/src/GitHub/Data/PullRequests.hs +++ b/src/GitHub/Data/PullRequests.hs @@ -17,7 +17,7 @@ import GitHub.Data.Repos (Repo) import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) import Data.Aeson.Compat (FromJSON (..), ToJSON (..), Value (..), object, - withObject, (.:), (.:?), (.=)) + withObject, (.!=), (.:), (.:?), (.=)) import Data.Aeson.Types (Object, Parser) import Data.Binary.Orphans (Binary) import Data.Data (Data, Typeable) @@ -184,7 +184,7 @@ instance FromJSON SimplePullRequest where <*> o .: "number" <*> o .: "html_url" <*> o .: "updated_at" - <*> o .: "body" + <*> o .:? "body" .!= "" -- TODO: no body is treated as empty <*> o .: "issue_url" <*> o .: "diff_url" <*> o .: "url" diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index ecd11302..d1118153 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -157,7 +157,7 @@ executeRequestWithMgr' :: Manager executeRequestWithMgr' mgr req = runExceptT $ execute req where - execute :: Request k a -> ExceptT Error IO a + execute :: Request 'False a -> ExceptT Error IO a execute req' = case req' of Query {} -> do httpReq <- makeHttpRequest Nothing req diff --git a/stack-nightly.yaml b/stack-nightly.yaml index 04e05058..81e4d4ff 100644 --- a/stack-nightly.yaml +++ b/stack-nightly.yaml @@ -1,4 +1,4 @@ -resolver: nightly-2016-01-08 +resolver: nightly-2016-05-13 packages: - '.' - 'samples/' From fb8d90e203caa895fe469c80503f5d309b6eaf80 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sat, 14 May 2016 13:02:05 +0300 Subject: [PATCH 198/510] Add IssuesSpec and PullRequestsSpec --- github.cabal | 2 ++ spec/GitHub/IssuesSpec.hs | 35 +++++++++++++++++++++++++++++++++ spec/GitHub/PullRequestsSpec.hs | 35 +++++++++++++++++++++++++++++++++ 3 files changed, 72 insertions(+) create mode 100644 spec/GitHub/IssuesSpec.hs create mode 100644 spec/GitHub/PullRequestsSpec.hs diff --git a/github.cabal b/github.cabal index c9b1dad9..7a3f8006 100644 --- a/github.cabal +++ b/github.cabal @@ -143,6 +143,8 @@ test-suite github-test GitHub.ActivitySpec GitHub.CommitsSpec GitHub.OrganizationsSpec + GitHub.IssuesSpec + GitHub.PullRequestsSpec GitHub.ReposSpec GitHub.SearchSpec GitHub.UsersSpec diff --git a/spec/GitHub/IssuesSpec.hs b/spec/GitHub/IssuesSpec.hs new file mode 100644 index 00000000..354a84cb --- /dev/null +++ b/spec/GitHub/IssuesSpec.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE OverloadedStrings #-} +module GitHub.IssuesSpec where + +import qualified GitHub + +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) + +fromRightS :: Show a => Either a b -> b +fromRightS (Right b) = b +fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a + +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 "issuesForRepoR" $ do + it "works" $ withAuth $ \auth -> for_ repos $ \(owner, repo) -> do + cs <- GitHub.executeRequest auth $ + GitHub.issuesForRepoR owner repo [] Nothing + cs `shouldSatisfy` isRight + where + repos = + [ ("thoughtbot", "paperclip") + , ("phadej", "github") + , ("haskell", "cabal") + ] diff --git a/spec/GitHub/PullRequestsSpec.hs b/spec/GitHub/PullRequestsSpec.hs new file mode 100644 index 00000000..5099c14d --- /dev/null +++ b/spec/GitHub/PullRequestsSpec.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE OverloadedStrings #-} +module GitHub.PullRequestsSpec where + +import qualified GitHub + +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) + +fromRightS :: Show a => Either a b -> b +fromRightS (Right b) = b +fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a + +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 "pullRequestsForR" $ do + it "works" $ withAuth $ \auth -> for_ repos $ \(owner, repo) -> do + cs <- GitHub.executeRequest auth $ + GitHub.pullRequestsForR owner repo (Just "closed") Nothing + cs `shouldSatisfy` isRight + where + repos = + [ ("thoughtbot", "paperclip") + , ("phadej", "github") + , ("haskell", "cabal") + ] From 843b4b001b2550140a4c03d68e1f514ac8a90bb9 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sat, 14 May 2016 14:38:26 +0300 Subject: [PATCH 199/510] Require tls >=1.3.5 --- github.cabal | 4 +++- stack-lts-2.yaml | 10 ++++++++++ stack-lts-3.yaml | 3 +++ stack-lts-4.yaml | 4 +++- stack-lts-5.yaml | 2 +- stack.yaml | 2 +- travis-install.sh | 3 ++- 7 files changed, 23 insertions(+), 5 deletions(-) diff --git a/github.cabal b/github.cabal index 7a3f8006..c8b4e475 100644 --- a/github.cabal +++ b/github.cabal @@ -128,7 +128,9 @@ Library transformers-compat >=0.4.0.3 && <0.6, unordered-containers >=0.2 && <0.3, vector >=0.10.12.3 && <0.12, - vector-instances >=3.3.0.1 && <3.4 + vector-instances >=3.3.0.1 && <3.4, + + tls >=1.3.5 if flag(aeson-compat) build-depends: aeson-compat >=0.3.0.0 && <0.4 diff --git a/stack-lts-2.yaml b/stack-lts-2.yaml index 5ae8c4cd..6eccaf18 100644 --- a/stack-lts-2.yaml +++ b/stack-lts-2.yaml @@ -3,9 +3,19 @@ packages: - 'samples/' extra-deps: - aeson-extra-0.2.3.0 +- asn1-parse-0.9.4 +- asn1-types-0.3.2 - binary-orphans-0.1.3.0 +- connection-0.2.5 +- cryptonite-0.15 - http-link-header-1.0.1 - iso8601-time-0.1.4 +- memory-0.12 +- tls-1.3.8 +- x509-1.6.3 +- x509-store-1.6.1 +- x509-system-1.6.3 +- x509-validation-1.6.3 resolver: lts-2.22 flags: github: diff --git a/stack-lts-3.yaml b/stack-lts-3.yaml index 99e61ab2..065b2e15 100644 --- a/stack-lts-3.yaml +++ b/stack-lts-3.yaml @@ -2,8 +2,11 @@ packages: - '.' - 'samples/' extra-deps: +- cryptonite-0.15 - http-link-header-1.0.1 - iso8601-time-0.1.4 +- memory-0.12 +- tls-1.3.8 resolver: lts-3.22 flags: github: diff --git a/stack-lts-4.yaml b/stack-lts-4.yaml index 366e8409..a8afc37c 100644 --- a/stack-lts-4.yaml +++ b/stack-lts-4.yaml @@ -1,5 +1,7 @@ packages: - '.' - 'samples/' -extra-deps: [] +extra-deps: +- cryptonite-0.15 +- tls-1.3.8 resolver: lts-4.2 diff --git a/stack-lts-5.yaml b/stack-lts-5.yaml index 0d75a9dd..c0228d93 100644 --- a/stack-lts-5.yaml +++ b/stack-lts-5.yaml @@ -2,4 +2,4 @@ packages: - '.' - 'samples/' extra-deps: [] -resolver: lts-5.1 +resolver: lts-5.16 diff --git a/stack.yaml b/stack.yaml index 671f4734..0db6065a 120000 --- a/stack.yaml +++ b/stack.yaml @@ -1 +1 @@ -stack-lts-3.yaml \ No newline at end of file +stack-lts-5.yaml \ No newline at end of file diff --git a/travis-install.sh b/travis-install.sh index 1d5ebf30..911eddb1 100644 --- a/travis-install.sh +++ b/travis-install.sh @@ -13,7 +13,8 @@ case $BUILD in ;; cabal) if [ -n "$STACKAGESNAPSHOT" ]; then - curl -s https://www.stackage.org/$STACKAGESNAPSHOT/cabal.config | grep -v 'github ==' > cabal.config + curl -sL https://www.stackage.org/$STACKAGESNAPSHOT/cabal.config | sed 's/constraints:/preferences:/' | grep -v installed > cabal.config + head cabal.config fi cabal --version echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]" From 06f5112344fce5cba831cc71cdcf7fc5320112c8 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sun, 15 May 2016 17:11:40 +0300 Subject: [PATCH 200/510] Add PullRequestOptions --- github.cabal | 3 +- spec/GitHub/PullRequestsSpec.hs | 15 +- src/GitHub/Data.hs | 2 + src/GitHub/Data/Definitions.hs | 7 + src/GitHub/Data/PullRequests.hs | 413 +++++++++++++++++---------- src/GitHub/Data/Request.hs | 8 +- src/GitHub/Data/URL.hs | 40 +++ src/GitHub/Endpoints/PullRequests.hs | 42 +-- stack-lts-2.yaml | 1 + stack-lts-3.yaml | 1 + stack-lts-4.yaml | 1 + 11 files changed, 342 insertions(+), 191 deletions(-) create mode 100644 src/GitHub/Data/URL.hs diff --git a/github.cabal b/github.cabal index c8b4e475..98e1c84b 100644 --- a/github.cabal +++ b/github.cabal @@ -67,6 +67,7 @@ Library GitHub.Data.Search GitHub.Data.Teams GitHub.Data.Activities + GitHub.Data.URL GitHub.Data.Webhooks GitHub.Data.Webhooks.Validate GitHub.Endpoints.Activity.Starring @@ -102,7 +103,7 @@ Library build-depends: base >= 4.7 && <4.9, aeson >=0.7.0.6 && <0.12, attoparsec >=0.11.3.4 && <0.14, - base-compat >=0.6.0 && <0.10, + base-compat >=0.9.1 && <0.10, base16-bytestring >=0.1.1.6 && <0.2, binary >=0.7.1.0 && <0.9, binary-orphans >=0.1.0.0 && <0.2, diff --git a/spec/GitHub/PullRequestsSpec.hs b/spec/GitHub/PullRequestsSpec.hs index 5099c14d..9ff0f3e6 100644 --- a/spec/GitHub/PullRequestsSpec.hs +++ b/spec/GitHub/PullRequestsSpec.hs @@ -3,11 +3,12 @@ module GitHub.PullRequestsSpec where import qualified GitHub -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) +import Data.Either.Compat (isRight) +import Data.Foldable (for_) +import Data.Function.Compat ((&)) +import Data.String (fromString) +import System.Environment (lookupEnv) +import Test.Hspec (Spec, describe, it, pendingWith, shouldSatisfy) fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b @@ -25,7 +26,7 @@ spec = do describe "pullRequestsForR" $ do it "works" $ withAuth $ \auth -> for_ repos $ \(owner, repo) -> do cs <- GitHub.executeRequest auth $ - GitHub.pullRequestsForR owner repo (Just "closed") Nothing + GitHub.pullRequestsForR owner repo opts Nothing cs `shouldSatisfy` isRight where repos = @@ -33,3 +34,5 @@ spec = do , ("phadej", "github") , ("haskell", "cabal") ] + opts = GitHub.defaultPullRequestOptions + & GitHub.setPullRequestOptionsState GitHub.PullRequestStateClosed diff --git a/src/GitHub/Data.hs b/src/GitHub/Data.hs index beb85ba0..65c48289 100644 --- a/src/GitHub/Data.hs +++ b/src/GitHub/Data.hs @@ -45,6 +45,7 @@ module GitHub.Data ( module GitHub.Data.Request, module GitHub.Data.Search, module GitHub.Data.Teams, + module GitHub.Data.URL, module GitHub.Data.Webhooks, ) where @@ -68,6 +69,7 @@ import GitHub.Data.Repos import GitHub.Data.Request import GitHub.Data.Search import GitHub.Data.Teams +import GitHub.Data.URL import GitHub.Data.Webhooks mkOwnerId :: Int -> Id Owner diff --git a/src/GitHub/Data/Definitions.hs b/src/GitHub/Data/Definitions.hs index 5d84c44f..a652e670 100644 --- a/src/GitHub/Data/Definitions.hs +++ b/src/GitHub/Data/Definitions.hs @@ -26,6 +26,7 @@ import Network.HTTP.Client (HttpException) import qualified Control.Exception as E import qualified Data.Text as T +import qualified Data.ByteString as BS import GitHub.Data.Id import GitHub.Data.Name @@ -242,3 +243,9 @@ data OrgMemberRole | OrgMemberRoleAdmin -- ^ Organization owners. | OrgMemberRoleMember -- ^ Non-owner organization members. deriving (Show, Eq, Ord, Enum, Bounded, Typeable, Data, Generic) + +-- | Request query string +type QueryString = [(BS.ByteString, Maybe BS.ByteString)] + +-- | Count of elements +type Count = Int diff --git a/src/GitHub/Data/PullRequests.hs b/src/GitHub/Data/PullRequests.hs index 3c9fc5d8..f7915881 100644 --- a/src/GitHub/Data/PullRequests.hs +++ b/src/GitHub/Data/PullRequests.hs @@ -6,86 +6,113 @@ -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -module GitHub.Data.PullRequests where +module GitHub.Data.PullRequests ( + SimplePullRequest(..), + PullRequest(..), + EditPullRequest(..), + CreatePullRequest(..), + PullRequestLinks(..), + PullRequestCommit(..), + PullRequestEvent(..), + PullRequestEventType(..), + PullRequestReference(..), + PullRequestState(..), + PullRequestSort(..), + PullRequestSortDirection(..), + -- * Pull Request listing options + PullRequestOptions, + defaultPullRequestOptions, + pullRequestOptionsToQueryString, + setPullRequestOptionsState, + setPullRequestOptionsStateAll, + setPullRequestOptionsSort, + setPullRequestOptionsDirection, + setPullRequestOptionsHead, + setPullRequestOptionsBase, + ) where import Prelude () import Prelude.Compat import GitHub.Data.Definitions +import GitHub.Data.Id (Id) import GitHub.Data.Repos (Repo) +import GitHub.Data.URL (URL) import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) import Data.Aeson.Compat (FromJSON (..), ToJSON (..), Value (..), object, withObject, (.!=), (.:), (.:?), (.=)) -import Data.Aeson.Types (Object, Parser) +import Data.Aeson.Types (typeMismatch) import Data.Binary.Orphans (Binary) import Data.Data (Data, Typeable) +import Data.Maybe (catMaybes) import Data.Text (Text) import Data.Time (UTCTime) import GHC.Generics (Generic) -data SimplePullRequest = SimplePullRequest { - simplePullRequestClosedAt :: !(Maybe UTCTime) - ,simplePullRequestCreatedAt :: !UTCTime - ,simplePullRequestUser :: !SimpleUser - ,simplePullRequestPatchUrl :: !Text - ,simplePullRequestState :: !Text - ,simplePullRequestNumber :: !Int - ,simplePullRequestHtmlUrl :: !Text - ,simplePullRequestUpdatedAt :: !UTCTime - ,simplePullRequestBody :: !Text - ,simplePullRequestIssueUrl :: !Text - ,simplePullRequestDiffUrl :: !Text - ,simplePullRequestUrl :: !Text - ,simplePullRequestLinks :: !PullRequestLinks - ,simplePullRequestMergedAt :: !(Maybe UTCTime) - ,simplePullRequestTitle :: !Text - ,simplePullRequestId :: !Int -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +import qualified Data.Text.Encoding as TE + +data SimplePullRequest = SimplePullRequest + { simplePullRequestClosedAt :: !(Maybe UTCTime) + , simplePullRequestCreatedAt :: !UTCTime + , simplePullRequestUser :: !SimpleUser + , simplePullRequestPatchUrl :: !URL + , simplePullRequestState :: !PullRequestState + , simplePullRequestNumber :: !Int + , simplePullRequestHtmlUrl :: !URL + , simplePullRequestUpdatedAt :: !UTCTime + , simplePullRequestBody :: !Text + , simplePullRequestIssueUrl :: !Text + , simplePullRequestDiffUrl :: !URL + , simplePullRequestUrl :: !URL + , simplePullRequestLinks :: !PullRequestLinks + , simplePullRequestMergedAt :: !(Maybe UTCTime) + , simplePullRequestTitle :: !Text + , simplePullRequestId :: !(Id PullRequest) + } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData SimplePullRequest where rnf = genericRnf instance Binary SimplePullRequest -data PullRequest = PullRequest { - -- this is a duplication of a PullRequest - pullRequestClosedAt :: !(Maybe UTCTime) - ,pullRequestCreatedAt :: !UTCTime - ,pullRequestUser :: !SimpleUser - ,pullRequestPatchUrl :: !Text - ,pullRequestState :: !Text - ,pullRequestNumber :: !Int - ,pullRequestHtmlUrl :: !Text - ,pullRequestUpdatedAt :: !UTCTime - ,pullRequestBody :: !Text - ,pullRequestIssueUrl :: !Text - ,pullRequestDiffUrl :: !Text - ,pullRequestUrl :: !Text - ,pullRequestLinks :: !PullRequestLinks - ,pullRequestMergedAt :: !(Maybe UTCTime) - ,pullRequestTitle :: !Text - ,pullRequestId :: !Int - ,pullRequestMergedBy :: !(Maybe SimpleUser) - ,pullRequestChangedFiles :: !Int - ,pullRequestHead :: !PullRequestCommit - ,pullRequestComments :: !Int - ,pullRequestDeletions :: !Int - ,pullRequestAdditions :: !Int - ,pullRequestReviewComments :: !Int - ,pullRequestBase :: !PullRequestCommit - ,pullRequestCommits :: !Int - ,pullRequestMerged :: !Bool - ,pullRequestMergeable :: !(Maybe Bool) -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data PullRequest = PullRequest + { pullRequestClosedAt :: !(Maybe UTCTime) + , pullRequestCreatedAt :: !UTCTime + , pullRequestUser :: !SimpleUser + , pullRequestPatchUrl :: !URL + , pullRequestState :: !PullRequestState + , pullRequestNumber :: !Int + , pullRequestHtmlUrl :: !URL + , pullRequestUpdatedAt :: !UTCTime + , pullRequestBody :: !Text + , pullRequestIssueUrl :: !Text + , pullRequestDiffUrl :: !URL + , pullRequestUrl :: !URL + , pullRequestLinks :: !PullRequestLinks + , pullRequestMergedAt :: !(Maybe UTCTime) + , pullRequestTitle :: !Text + , pullRequestId :: !(Id PullRequest) + , pullRequestMergedBy :: !(Maybe SimpleUser) + , pullRequestChangedFiles :: !Int + , pullRequestHead :: !PullRequestCommit + , pullRequestComments :: !Count + , pullRequestDeletions :: !Count + , pullRequestAdditions :: !Count + , pullRequestReviewComments :: !Count + , pullRequestBase :: !PullRequestCommit + , pullRequestCommits :: !Count + , pullRequestMerged :: !Bool + , pullRequestMergeable :: !(Maybe Bool) + } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData PullRequest where rnf = genericRnf instance Binary PullRequest -data EditPullRequest = EditPullRequest { - editPullRequestTitle :: !(Maybe Text) - ,editPullRequestBody :: !(Maybe Text) - ,editPullRequestState :: !(Maybe EditPullRequestState) -} deriving (Show, Generic) +data EditPullRequest = EditPullRequest + { editPullRequestTitle :: !(Maybe Text) + , editPullRequestBody :: !(Maybe Text) + , editPullRequestState :: !(Maybe PullRequestState) + } deriving (Show, Generic) instance NFData EditPullRequest where rnf = genericRnf instance Binary EditPullRequest @@ -107,71 +134,159 @@ data CreatePullRequest = instance NFData CreatePullRequest where rnf = genericRnf instance Binary CreatePullRequest -data PullRequestLinks = PullRequestLinks { - pullRequestLinksReviewComments :: !Text - ,pullRequestLinksComments :: !Text - ,pullRequestLinksHtml :: !Text - ,pullRequestLinksSelf :: !Text -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data PullRequestLinks = PullRequestLinks + { pullRequestLinksReviewComments :: !URL + , pullRequestLinksComments :: !URL + , pullRequestLinksHtml :: !URL + , pullRequestLinksSelf :: !URL + } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData PullRequestLinks where rnf = genericRnf instance Binary PullRequestLinks -data PullRequestCommit = PullRequestCommit { - pullRequestCommitLabel :: !Text - ,pullRequestCommitRef :: !Text - ,pullRequestCommitSha :: !Text - ,pullRequestCommitUser :: !SimpleUser - ,pullRequestCommitRepo :: !Repo -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data PullRequestCommit = PullRequestCommit + { pullRequestCommitLabel :: !Text + , pullRequestCommitRef :: !Text + , pullRequestCommitSha :: !Text + , pullRequestCommitUser :: !SimpleUser + , pullRequestCommitRepo :: !Repo + } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData PullRequestCommit where rnf = genericRnf instance Binary PullRequestCommit -data PullRequestEvent = PullRequestEvent { - pullRequestEventAction :: !PullRequestEventType - ,pullRequestEventNumber :: !Int - ,pullRequestEventPullRequest :: !PullRequest - ,pullRequestRepository :: !Repo - ,pullRequestSender :: !SimpleUser -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data PullRequestEvent = PullRequestEvent + { pullRequestEventAction :: !PullRequestEventType + , pullRequestEventNumber :: !Int + , pullRequestEventPullRequest :: !PullRequest + , pullRequestRepository :: !Repo + , pullRequestSender :: !SimpleUser + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData PullRequestEvent where rnf = genericRnf instance Binary PullRequestEvent -data PullRequestEventType = - PullRequestOpened - | PullRequestClosed - | PullRequestSynchronized - | PullRequestReopened - | PullRequestAssigned - | PullRequestUnassigned - | PullRequestLabeled - | PullRequestUnlabeled - deriving (Show, Data, Typeable, Eq, Ord, Generic) +data PullRequestEventType + = PullRequestOpened + | PullRequestClosed + | PullRequestSynchronized + | PullRequestReopened + | PullRequestAssigned + | PullRequestUnassigned + | PullRequestLabeled + | PullRequestUnlabeled + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData PullRequestEventType where rnf = genericRnf instance Binary PullRequestEventType -data PullRequestReference = PullRequestReference { - pullRequestReferenceHtmlUrl :: !(Maybe Text) - ,pullRequestReferencePatchUrl :: !(Maybe Text) - ,pullRequestReferenceDiffUrl :: !(Maybe Text) -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data PullRequestReference = PullRequestReference + { pullRequestReferenceHtmlUrl :: !(Maybe Text) + , pullRequestReferencePatchUrl :: !(Maybe Text) + , pullRequestReferenceDiffUrl :: !(Maybe Text) + } + deriving (Eq, Ord, Show, Generic, Typeable, Data) instance NFData PullRequestReference where rnf = genericRnf instance Binary PullRequestReference -data EditPullRequestState = - EditPullRequestStateOpen - | EditPullRequestStateClosed - deriving (Show, Generic) - -instance NFData EditPullRequestState where rnf = genericRnf -instance Binary EditPullRequestState - +data PullRequestState + = PullRequestStateOpen + | PullRequestStateClosed + deriving (Eq, Ord, Show, Generic, Typeable, Data) + +instance NFData PullRequestState where rnf = genericRnf +instance Binary PullRequestState + +data PullRequestSort + = PullRequestSortCreated + | PulLRequestSortUpdated + | PullRequestSortPopularity + | PullRequestSortLongRunning + deriving (Eq, Ord, Show, Generic, Typeable, Data) + +instance NFData PullRequestSort where rnf = genericRnf +instance Binary PullRequestSort + +data PullRequestSortDirection + = PullRequestSortDesc + | PullRequestSortAsc + deriving (Eq, Ord, Show, Generic, Typeable, Data) + +instance NFData PullRequestSortDirection where rnf = genericRnf +instance Binary PullRequestSortDirection + +-- | See . +data PullRequestOptions = PullRequestOptions + { pullRequestOptionsState :: !(Maybe PullRequestState) + , pullRequestOptionsHead :: !(Maybe Text) + , pullRequestOptionsBase :: !(Maybe Text) + , pullRequestOptionsSort :: !PullRequestSort + , pullRequestOptionsDirection :: !PullRequestSortDirection + } + +defaultPullRequestOptions :: PullRequestOptions +defaultPullRequestOptions = PullRequestOptions + (Just PullRequestStateOpen) + Nothing + Nothing + PullRequestSortCreated + PullRequestSortDesc + +setPullRequestOptionsState :: PullRequestState -> PullRequestOptions -> PullRequestOptions +setPullRequestOptionsState x opts = opts + { pullRequestOptionsState = Just x } + +setPullRequestOptionsStateAll :: PullRequestOptions -> PullRequestOptions +setPullRequestOptionsStateAll opts = opts + { pullRequestOptionsState = Nothing } + +setPullRequestOptionsSort :: PullRequestSort -> PullRequestOptions -> PullRequestOptions +setPullRequestOptionsSort x opts = opts + { pullRequestOptionsSort = x } + +setPullRequestOptionsDirection :: PullRequestSortDirection -> PullRequestOptions -> PullRequestOptions +setPullRequestOptionsDirection x opts = opts + { pullRequestOptionsDirection = x } + +setPullRequestOptionsHead :: Text -> PullRequestOptions -> PullRequestOptions +setPullRequestOptionsHead x opts = opts + { pullRequestOptionsHead = Just x } + +setPullRequestOptionsBase :: Text -> PullRequestOptions -> PullRequestOptions +setPullRequestOptionsBase x opts = opts + { pullRequestOptionsBase = Just x } + +pullRequestOptionsToQueryString :: PullRequestOptions -> QueryString +pullRequestOptionsToQueryString (PullRequestOptions state head_ base sort dir) = + [ mk "state" state' + , mk "sort" sort' + , mk "direction" direction' + ] ++ catMaybes + [ mk "head" <$> head' + , mk "base" <$> base' + ] + where + mk k v = (k, Just v) + state' = case state of + Nothing -> "all" + Just PullRequestStateOpen -> "open" + Just PullRequestStateClosed -> "closed" + sort' = case sort of + PullRequestSortCreated -> "created" + PulLRequestSortUpdated -> "updated" + PullRequestSortPopularity -> "popularity" + PullRequestSortLongRunning -> "long-running" + direction' = case dir of + PullRequestSortDesc -> "desc" + PullRequestSortAsc -> "asc" + head' = fmap TE.encodeUtf8 head_ + base' = fmap TE.encodeUtf8 base + +------------------------------------------------------------------------------- -- JSON instances - +------------------------------------------------------------------------------- instance FromJSON SimplePullRequest where parseJSON = withObject "SimplePullRequest" $ \o -> @@ -193,21 +308,27 @@ instance FromJSON SimplePullRequest where <*> o .: "title" <*> o .: "id" -instance ToJSON EditPullRequestState where - toJSON (EditPullRequestStateOpen) = String "open" - toJSON (EditPullRequestStateClosed) = String "closed" +instance ToJSON PullRequestState where + toJSON PullRequestStateOpen = String "open" + toJSON PullRequestStateClosed = String "closed" + +instance FromJSON PullRequestState where + parseJSON (String "open") = pure PullRequestStateOpen + parseJSON (String "closed") = pure PullRequestStateClosed + parseJSON v = typeMismatch "PulLRequestState" v instance ToJSON EditPullRequest where - toJSON (EditPullRequest t b s) = - object $ filter notNull [ "title" .= t, "body" .= b, "state" .= s ] - where notNull (_, Null) = False - notNull (_, _) = True + toJSON (EditPullRequest t b s) = + object $ filter notNull [ "title" .= t, "body" .= b, "state" .= s ] + where + notNull (_, Null) = False + notNull (_, _) = True instance ToJSON CreatePullRequest where - toJSON (CreatePullRequest t b headPR basePR) = - object [ "title" .= t, "body" .= b, "head" .= headPR, "base" .= basePR ] - toJSON (CreatePullRequestIssue issueNum headPR basePR) = - object [ "issue" .= issueNum, "head" .= headPR, "base" .= basePR] + toJSON (CreatePullRequest t b headPR basePR) = + object [ "title" .= t, "body" .= b, "head" .= headPR, "base" .= basePR ] + toJSON (CreatePullRequestIssue issueNum headPR basePR) = + object [ "issue" .= issueNum, "head" .= headPR, "base" .= basePR] instance FromJSON PullRequest where parseJSON = withObject "PullRequest" $ \o -> @@ -241,51 +362,49 @@ instance FromJSON PullRequest where <*> o .:? "mergeable" instance FromJSON PullRequestLinks where - parseJSON = withObject "PullRequestLinks" $ \o -> - PullRequestLinks <$> o <.:> ["review_comments", "href"] - <*> o <.:> ["comments", "href"] - <*> o <.:> ["html", "href"] - <*> o <.:> ["self", "href"] + parseJSON = withObject "PullRequestLinks" $ \o -> PullRequestLinks + <$> fmap getHref (o .: "review_comments") + <*> fmap getHref (o .: "comments") + <*> fmap getHref (o .: "html") + <*> fmap getHref (o .: "self") instance FromJSON PullRequestCommit where - parseJSON = withObject "PullRequestCommit" $ \o -> - PullRequestCommit <$> o .: "label" - <*> o .: "ref" - <*> o .: "sha" - <*> o .: "user" - <*> o .: "repo" + parseJSON = withObject "PullRequestCommit" $ \o -> PullRequestCommit + <$> o .: "label" + <*> o .: "ref" + <*> o .: "sha" + <*> o .: "user" + <*> o .: "repo" instance FromJSON PullRequestEvent where - parseJSON = withObject "PullRequestEvent" $ \o -> - PullRequestEvent <$> o .: "action" - <*> o .: "number" - <*> o .: "pull_request" - <*> o .: "repository" - <*> o .: "sender" + parseJSON = withObject "PullRequestEvent" $ \o -> PullRequestEvent + <$> o .: "action" + <*> o .: "number" + <*> o .: "pull_request" + <*> o .: "repository" + <*> o .: "sender" instance FromJSON PullRequestEventType where - parseJSON (String "opened") = pure PullRequestOpened - parseJSON (String "closed") = pure PullRequestClosed - parseJSON (String "synchronize") = pure PullRequestSynchronized - parseJSON (String "reopened") = pure PullRequestReopened - parseJSON (String "assigned") = pure PullRequestAssigned - parseJSON (String "unassigned") = pure PullRequestUnassigned - parseJSON (String "labeled") = pure PullRequestLabeled - parseJSON (String "unlabeled") = pure PullRequestUnlabeled - parseJSON _ = fail "Could not build a PullRequestEventType" + parseJSON (String "opened") = pure PullRequestOpened + parseJSON (String "closed") = pure PullRequestClosed + parseJSON (String "synchronize") = pure PullRequestSynchronized + parseJSON (String "reopened") = pure PullRequestReopened + parseJSON (String "assigned") = pure PullRequestAssigned + parseJSON (String "unassigned") = pure PullRequestUnassigned + parseJSON (String "labeled") = pure PullRequestLabeled + parseJSON (String "unlabeled") = pure PullRequestUnlabeled + parseJSON v = typeMismatch "Could not build a PullRequestEventType" v instance FromJSON PullRequestReference where - parseJSON = withObject "PullRequestReference" $ \o -> - PullRequestReference <$> o .:? "html_url" - <*> o .:? "patch_url" - <*> o .:? "diff_url" + parseJSON = withObject "PullRequestReference" $ \o -> PullRequestReference + <$> o .:? "html_url" + <*> o .:? "patch_url" + <*> o .:? "diff_url" -- Helpers --- | Produce the value for the last key by traversing. -(<.:>) :: FromJSON v => Object -> [Text] -> Parser v -obj <.:> [key] = obj .: key -obj <.:> (key:keys) = do - obj' <- obj .: key - obj' <.:> keys -_obj <.:> [] = fail "<.:> never happens - empty path" +newtype Href a = Href { getHref :: a } + +instance FromJSON a => FromJSON (Href a) where + parseJSON = withObject "href object" $ + \obj -> Href <$> obj .: "href" diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs index b02b6385..5ee1c901 100644 --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -30,22 +30,20 @@ import Data.Typeable (Typeable) import Data.Vector (Vector) import GHC.Generics (Generic) -import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS import qualified Data.Text as T import qualified Network.HTTP.Types as Types import qualified Network.HTTP.Types.Method as Method -import GitHub.Data.Id (Id, untagId) -import GitHub.Data.Name (Name, untagName) +import GitHub.Data.Definitions (Count, QueryString) +import GitHub.Data.Id (Id, untagId) +import GitHub.Data.Name (Name, untagName) ------------------------------------------------------------------------------ -- Auxillary types ------------------------------------------------------------------------------ type Paths = [String] -type QueryString = [(BS.ByteString, Maybe BS.ByteString)] -type Count = Int class IsPathPart a where toPathPart :: a -> String diff --git a/src/GitHub/Data/URL.hs b/src/GitHub/Data/URL.hs new file mode 100644 index 00000000..9ab236df --- /dev/null +++ b/src/GitHub/Data/URL.hs @@ -0,0 +1,40 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +module GitHub.Data.URL ( + URL(..), + getUrl, + ) where + +import Prelude () +import Prelude.Compat + +import Control.DeepSeq (NFData (..)) +import Control.DeepSeq.Generics (genericRnf) +import Data.Aeson.Compat (FromJSON (..), ToJSON (..), withText) +import Data.Binary.Orphans (Binary) +import Data.Data (Data, Typeable) +import Data.Text (Text) +import GHC.Generics (Generic) + +-- | Data representing URLs in responses. +-- +-- /N.B./ syntactical validity is not verified. +newtype URL = URL Text + deriving (Eq, Ord, Show, Generic, Typeable, Data) + +getUrl :: URL -> Text +getUrl (URL url) = url + +instance NFData URL where rnf = genericRnf +instance Binary URL + +instance ToJSON URL where + toJSON (URL url) = toJSON url + +instance FromJSON URL where + parseJSON = withText "URL" (pure . URL) diff --git a/src/GitHub/Endpoints/PullRequests.hs b/src/GitHub/Endpoints/PullRequests.hs index aede7adc..5cdc15fa 100644 --- a/src/GitHub/Endpoints/PullRequests.hs +++ b/src/GitHub/Endpoints/PullRequests.hs @@ -8,8 +8,6 @@ -- The pull requests API as documented at -- . module GitHub.Endpoints.PullRequests ( - pullRequestsFor'', - pullRequestsFor', pullRequestsFor, pullRequestsForR, pullRequest', @@ -38,46 +36,26 @@ import GitHub.Request import Data.Aeson.Compat (Value, encode, object, (.=)) import Data.Vector (Vector) -import qualified Data.ByteString.Char8 as BS8 - --- | All pull requests for the repo, by owner, repo name, and pull request state. --- | With authentification --- --- > pullRequestsFor' (Just ("github-username", "github-password")) (Just "open") "rails" "rails" --- --- State can be one of @all@, @open@, or @closed@. Default is @open@. --- -pullRequestsFor'' :: Maybe Auth -> Maybe String -> Name Owner -> Name Repo -> IO (Either Error (Vector SimplePullRequest)) -pullRequestsFor'' auth state user repo = - executeRequestMaybe auth $ pullRequestsForR user repo state Nothing - --- | All pull requests for the repo, by owner and repo name. --- | With authentification --- --- > pullRequestsFor' (Just ("github-username", "github-password")) "rails" "rails" -pullRequestsFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector SimplePullRequest)) -pullRequestsFor' auth = pullRequestsFor'' auth Nothing - --- | All pull requests for the repo, by owner and repo name. +-- | All open pull requests for the repo, by owner and repo name. -- -- > pullRequestsFor "rails" "rails" pullRequestsFor :: Name Owner -> Name Repo -> IO (Either Error (Vector SimplePullRequest)) -pullRequestsFor = pullRequestsFor'' Nothing Nothing +pullRequestsFor user repo = + executeRequest' $ pullRequestsForR user repo defaultPullRequestOptions Nothing -- | List pull requests. -- See pullRequestsForR :: Name Owner -> Name Repo - -> Maybe String -- ^ State + -> PullRequestOptions -- ^ State -> Maybe Count -> Request k (Vector SimplePullRequest) -pullRequestsForR user repo state = - PagedQuery ["repos", toPathPart user, toPathPart repo, "pulls"] qs - where - qs = maybe [] (\s -> [("state", Just . BS8.pack $ s)]) state +pullRequestsForR user repo opts = PagedQuery + ["repos", toPathPart user, toPathPart repo, "pulls"] + (pullRequestOptionsToQueryString opts) -- | 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 +-- With authentification. -- -- > pullRequest' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" 562 pullRequest' :: Maybe Auth -> Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error PullRequest) @@ -131,7 +109,7 @@ updatePullRequestR user repo prid epr = -- | All the commits on a pull request, given the repo owner, repo name, and -- the number of the pull request. --- | With authentification +-- With authentification. -- -- > pullRequestCommits' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" 688 pullRequestCommits' :: Maybe Auth -> Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector Commit)) @@ -153,7 +131,7 @@ pullRequestCommitsR 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. --- | With authentification +-- With authentification. -- -- > pullRequestFiles' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" 688 pullRequestFiles' :: Maybe Auth -> Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector File)) diff --git a/stack-lts-2.yaml b/stack-lts-2.yaml index 6eccaf18..5a8eb996 100644 --- a/stack-lts-2.yaml +++ b/stack-lts-2.yaml @@ -5,6 +5,7 @@ extra-deps: - aeson-extra-0.2.3.0 - asn1-parse-0.9.4 - asn1-types-0.3.2 +- base-compat-0.9.1 - binary-orphans-0.1.3.0 - connection-0.2.5 - cryptonite-0.15 diff --git a/stack-lts-3.yaml b/stack-lts-3.yaml index 065b2e15..7b68091a 100644 --- a/stack-lts-3.yaml +++ b/stack-lts-3.yaml @@ -2,6 +2,7 @@ packages: - '.' - 'samples/' extra-deps: +- base-compat-0.9.1 - cryptonite-0.15 - http-link-header-1.0.1 - iso8601-time-0.1.4 diff --git a/stack-lts-4.yaml b/stack-lts-4.yaml index a8afc37c..e73113f5 100644 --- a/stack-lts-4.yaml +++ b/stack-lts-4.yaml @@ -2,6 +2,7 @@ packages: - '.' - 'samples/' extra-deps: +- base-compat-0.9.1 - cryptonite-0.15 - tls-1.3.8 resolver: lts-4.2 From 4dd62be8c5d380cc8f260cddb1510ac73f409663 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Fri, 20 May 2016 10:13:28 +0300 Subject: [PATCH 201/510] Allow GHC-8.0 --- .travis.yml | 9 ++-- github.cabal | 4 +- stack-ghc-8.0.yaml | 110 +++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 118 insertions(+), 5 deletions(-) create mode 100644 stack-ghc-8.0.yaml diff --git a/.travis.yml b/.travis.yml index a8905397..34081ed3 100644 --- a/.travis.yml +++ b/.travis.yml @@ -21,15 +21,18 @@ matrix: - env: BUILD=cabal CABALVER=1.18 GHCVER=7.8.4 compiler: ": #GHC 7.8.4" addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4], sources: [hvr-ghc]}} + - env: BUILD=cabal CABALVER=1.22 GHCVER=7.10.3 + compiler: ": #GHC 7.10.3" + addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3], sources: [hvr-ghc]}} + - env: BUILD=cabal CABALVER=1.24 GHCVER=8.0.1 + compiler: ": #GHC 8.0.1" + addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.1], sources: [hvr-ghc]}} - env: BUILD=cabal CABALVER=1.18 GHCVER=7.8.4 STACKAGESNAPSHOT=lts-2.22 compiler: ": #GHC 7.8.4 lts-2.22" addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4], sources: [hvr-ghc]}} - env: BUILD=cabal CABALVER=1.22 GHCVER=7.10.2 STACKAGESNAPSHOT=lts-3.22 compiler: ": #GHC 7.10.2 lts-3.22" addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.2], sources: [hvr-ghc]}} - - env: BUILD=cabal CABALVER=1.22 GHCVER=7.10.3 - compiler: ": #GHC 7.10.3" - addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3], sources: [hvr-ghc]}} - env: BUILD=cabal CABALVER=1.22 GHCVER=7.10.3 STACKAGESNAPSHOT=lts-4.2 compiler: ": #GHC 7.10.3 lts-4.2" addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3], sources: [hvr-ghc]}} diff --git a/github.cabal b/github.cabal index 98e1c84b..e81c8ad6 100644 --- a/github.cabal +++ b/github.cabal @@ -25,7 +25,7 @@ homepage: https://github.com/phadej/github copyright: Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016 Oleg Grenrus category: Network build-type: Simple -tested-with: GHC==7.8.4, GHC==7.10.3 +tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.1 cabal-version: >=1.10 extra-source-files: README.md, @@ -100,7 +100,7 @@ Library GitHub.Request -- Packages needed in order to build this package. - build-depends: base >= 4.7 && <4.9, + build-depends: base >=4.7 && <4.10, aeson >=0.7.0.6 && <0.12, attoparsec >=0.11.3.4 && <0.14, base-compat >=0.9.1 && <0.10, diff --git a/stack-ghc-8.0.yaml b/stack-ghc-8.0.yaml new file mode 100644 index 00000000..592b2ca4 --- /dev/null +++ b/stack-ghc-8.0.yaml @@ -0,0 +1,110 @@ +flags: + time-locale-compat: + old-locale: false +packages: +- '.' +setup-info: + ghc: + linux64: + 8.0.0.20160421: + url: https://downloads.haskell.org/~ghc/8.0.1-rc4/ghc-8.0.0.20160421-x86_64-unknown-linux.tar.xz + macosx: + 8.0.0.20160421: + url: https://downloads.haskell.org/~ghc/8.0.1-rc4/ghc-8.0.0.20160421-x86_64-apple-darwin.tar.xz +extra-deps: +- HUnit-1.3.1.1 +- QuickCheck-2.8.2 +- StateVar-1.1.0.4 +- adjunctions-4.3 +- aeson-0.11.2.0 +- aeson-compat-0.3.3.0 +- ansi-terminal-0.6.2.3 +- asn1-encoding-0.9.3 +- asn1-parse-0.9.4 +- asn1-types-0.3.2 +- async-2.1.0 +- attoparsec-0.13.0.2 +- base-compat-0.9.1 +- base-orphans-0.5.4 +- base16-bytestring-0.1.1.6 +- base64-bytestring-1.0.0.1 +- bifunctors-5.3 +- binary-orphans-0.1.4.0 +- blaze-builder-0.4.0.2 +- byteable-0.1.1 +- bytestring-conversion-0.3.1 +- case-insensitive-1.2.0.6 +- cereal-0.5.1.0 +- comonad-5 +- connection-0.2.5 +- contravariant-1.4 +- cookie-0.4.2 +- cryptohash-0.11.9 +- cryptonite-0.15 +- data-default-class-0.0.1 +- deepseq-generics-0.2.0.0 +- distributive-0.5.0.2 +- dlist-0.7.1.2 +- double-conversion-2.0.1.0 +- errors-2.1.2 +- exceptions-0.8.2.1 +- fail-4.9.0.0 +- file-embed-0.0.10 +- free-4.12.4 +- hashable-1.2.4.0 +- hourglass-0.2.10 +- hspec-2.2.3 +- hspec-core-2.2.3 +- hspec-discover-2.2.3 +- hspec-expectations-0.7.2 +- http-client-0.4.28 +- http-client-tls-0.2.4 +- http-link-header-1.0.1 +- http-types-0.9 +- iso8601-time-0.1.4 +- kan-extensions-5.0.1 +- keys-3.11 +- memory-0.12 +- mime-types-0.1.0.7 +- mtl-2.2.1 +- nats-1.1 +- network-2.6.2.1 +- network-uri-2.6.1.0 +- old-locale-1.0.0.7 +- parsec-3.1.11 +- pem-0.2.2 +- pointed-5 +- prelude-extras-0.4.0.3 +- primitive-0.6.1.0 +- profunctors-5.2 +- quickcheck-io-0.1.2 +- random-1.1 +- safe-0.3.9 +- scientific-0.3.4.6 +- semigroupoids-5.0.1 +- semigroups-0.18.1 +- setenv-0.1.1.3 +- socks-0.5.5 +- stm-2.4.4.1 +- streaming-commons-0.1.15.5 +- syb-0.6 +- tagged-0.8.4 +- text-1.2.2.1 +- text-binary-0.2.1 +- tf-random-0.5 +- time-locale-compat-0.1.1.1 +- tls-1.3.8 +- transformers-compat-0.5.1.4 +- unexceptionalio-0.3.0 +- unordered-containers-0.2.7.0 +- vector-0.11.0.0 +- vector-binary-instances-0.2.3.2 +- vector-instances-3.3.1 +- void-0.7.1 +- x509-1.6.3 +- x509-store-1.6.1 +- x509-system-1.6.3 +- x509-validation-1.6.3 +- zlib-0.6.1.1 +compiler-check: match-exact +resolver: ghc-8.0.0.20160421 From 5be6db0eaf3f31f3a1d02ec476551c6d2c6bc3a4 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sun, 22 May 2016 17:59:55 +0300 Subject: [PATCH 202/510] Use official GHC-8.0.1 --- stack-ghc-8.0.yaml | 23 +++++++---------------- stack-lts-2.yaml | 4 ++-- stack-lts-3.yaml | 6 +++--- stack-lts-4.yaml | 4 ++-- stack-lts-5.yaml | 4 ++-- 5 files changed, 16 insertions(+), 25 deletions(-) diff --git a/stack-ghc-8.0.yaml b/stack-ghc-8.0.yaml index 592b2ca4..90f9616d 100644 --- a/stack-ghc-8.0.yaml +++ b/stack-ghc-8.0.yaml @@ -1,20 +1,7 @@ -flags: - time-locale-compat: - old-locale: false +resolver: ghc-8.0.1 packages: - '.' -setup-info: - ghc: - linux64: - 8.0.0.20160421: - url: https://downloads.haskell.org/~ghc/8.0.1-rc4/ghc-8.0.0.20160421-x86_64-unknown-linux.tar.xz - macosx: - 8.0.0.20160421: - url: https://downloads.haskell.org/~ghc/8.0.1-rc4/ghc-8.0.0.20160421-x86_64-apple-darwin.tar.xz extra-deps: -- HUnit-1.3.1.1 -- QuickCheck-2.8.2 -- StateVar-1.1.0.4 - adjunctions-4.3 - aeson-0.11.2.0 - aeson-compat-0.3.3.0 @@ -61,6 +48,7 @@ extra-deps: - http-client-tls-0.2.4 - http-link-header-1.0.1 - http-types-0.9 +- HUnit-1.3.1.1 - iso8601-time-0.1.4 - kan-extensions-5.0.1 - keys-3.11 @@ -77,6 +65,7 @@ extra-deps: - prelude-extras-0.4.0.3 - primitive-0.6.1.0 - profunctors-5.2 +- QuickCheck-2.8.2 - quickcheck-io-0.1.2 - random-1.1 - safe-0.3.9 @@ -85,6 +74,7 @@ extra-deps: - semigroups-0.18.1 - setenv-0.1.1.3 - socks-0.5.5 +- StateVar-1.1.0.4 - stm-2.4.4.1 - streaming-commons-0.1.15.5 - syb-0.6 @@ -106,5 +96,6 @@ extra-deps: - x509-system-1.6.3 - x509-validation-1.6.3 - zlib-0.6.1.1 -compiler-check: match-exact -resolver: ghc-8.0.0.20160421 +flags: + time-locale-compat: + old-locale: false diff --git a/stack-lts-2.yaml b/stack-lts-2.yaml index 5a8eb996..d909cd7e 100644 --- a/stack-lts-2.yaml +++ b/stack-lts-2.yaml @@ -1,6 +1,7 @@ +resolver: lts-2.22 packages: - '.' -- 'samples/' +- samples/ extra-deps: - aeson-extra-0.2.3.0 - asn1-parse-0.9.4 @@ -17,7 +18,6 @@ extra-deps: - x509-store-1.6.1 - x509-system-1.6.3 - x509-validation-1.6.3 -resolver: lts-2.22 flags: github: aeson-compat: false diff --git a/stack-lts-3.yaml b/stack-lts-3.yaml index 7b68091a..5162f85f 100644 --- a/stack-lts-3.yaml +++ b/stack-lts-3.yaml @@ -1,6 +1,7 @@ +resolver: lts-3.22 packages: - '.' -- 'samples/' +- samples/ extra-deps: - base-compat-0.9.1 - cryptonite-0.15 @@ -8,7 +9,6 @@ extra-deps: - iso8601-time-0.1.4 - memory-0.12 - tls-1.3.8 -resolver: lts-3.22 flags: github: - aeson-compat: false + aeson-compat: false diff --git a/stack-lts-4.yaml b/stack-lts-4.yaml index e73113f5..ab1937e3 100644 --- a/stack-lts-4.yaml +++ b/stack-lts-4.yaml @@ -1,8 +1,8 @@ +resolver: lts-4.2 packages: - '.' -- 'samples/' +- samples/ extra-deps: - base-compat-0.9.1 - cryptonite-0.15 - tls-1.3.8 -resolver: lts-4.2 diff --git a/stack-lts-5.yaml b/stack-lts-5.yaml index c0228d93..163be5ba 100644 --- a/stack-lts-5.yaml +++ b/stack-lts-5.yaml @@ -1,5 +1,5 @@ +resolver: lts-5.16 packages: - '.' -- 'samples/' +- samples/ extra-deps: [] -resolver: lts-5.16 From 30ba6832c84aac346fba8365b5d19400799b7f8c Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sun, 22 May 2016 21:24:50 +0300 Subject: [PATCH 203/510] Add integer-simple none constraint --- travis-install.sh | 6 +++--- travis-script.sh | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/travis-install.sh b/travis-install.sh index 911eddb1..4ab1f882 100644 --- a/travis-install.sh +++ b/travis-install.sh @@ -1,4 +1,4 @@ -set -e +set -ex case $BUILD in stack) @@ -23,7 +23,7 @@ case $BUILD in fi cabal update -v sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config - cabal install --only-dependencies --enable-tests --enable-benchmarks --dry -v > installplan.txt + cabal install --constraint="integer-simple installed" --only-dependencies --enable-tests --enable-benchmarks --dry -v > installplan.txt sed -i -e '1,/^Resolving /d' installplan.txt; cat installplan.txt # check whether current requested install-plan matches cached package-db snapshot @@ -36,7 +36,7 @@ case $BUILD in echo "cabal build-cache MISS"; rm -rf $HOME/.cabsnap; mkdir -p $HOME/.ghc $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin; - cabal install --only-dependencies --enable-tests --enable-benchmarks; + cabal install --constraint="integer-simple installed" --only-dependencies --enable-tests --enable-benchmarks; fi # snapshot package-db on cache miss diff --git a/travis-script.sh b/travis-script.sh index 6303342b..0b38968a 100644 --- a/travis-script.sh +++ b/travis-script.sh @@ -13,7 +13,7 @@ case $BUILD in ;; cabal) if [ -f configure.ac ]; then autoreconf -i; fi - cabal configure --enable-tests --enable-benchmarks -v2 # -v2 provides useful information for debugging + cabal configure --constraint="integer-simple installed" --enable-tests --enable-benchmarks -v2 # -v2 provides useful information for debugging cabal build # this builds all libraries and executables (including tests/benchmarks) cabal test --show-details=always From 371a7c446683095f753507129645a19270406a60 Mon Sep 17 00:00:00 2001 From: Sidharth Kapur Date: Fri, 20 May 2016 14:48:44 -0500 Subject: [PATCH 204/510] Change repoMasterBranch to repoDefaultBranch --- src/GitHub/Data/Repos.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/GitHub/Data/Repos.hs b/src/GitHub/Data/Repos.hs index 91e9b4db..c0dc54ef 100644 --- a/src/GitHub/Data/Repos.hs +++ b/src/GitHub/Data/Repos.hs @@ -58,7 +58,7 @@ data Repo = Repo { ,repoOwner :: !SimpleOwner ,repoName :: !(Name Repo) ,repoLanguage :: !(Maybe Language) - ,repoMasterBranch :: !(Maybe Text) + ,repoDefaultBranch :: !(Maybe Text) ,repoPushedAt :: !(Maybe UTCTime) -- ^ this is Nothing for new repositories ,repoId :: !(Id Repo) ,repoUrl :: !Text @@ -176,7 +176,7 @@ instance FromJSON Repo where <*> o .: "owner" <*> o .: "name" <*> o .:? "language" - <*> o .:? "master_branch" + <*> o .:? "default_branch" <*> o .:? "pushed_at" <*> o .: "id" <*> o .: "url" From 769892a8ae2ce9d82f5d907ff68070fe51d1101c Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 23 May 2016 00:16:29 +0300 Subject: [PATCH 205/510] Add repoDefaultBranch-test --- spec/GitHub/ReposSpec.hs | 21 +++++++++++++++------ 1 file changed, 15 insertions(+), 6 deletions(-) diff --git a/spec/GitHub/ReposSpec.hs b/spec/GitHub/ReposSpec.hs index bda2780b..5b6ab190 100644 --- a/spec/GitHub/ReposSpec.hs +++ b/spec/GitHub/ReposSpec.hs @@ -2,14 +2,15 @@ {-# LANGUAGE TemplateHaskell #-} module GitHub.ReposSpec where -import GitHub.Auth (Auth (..)) -import GitHub.Endpoints.Repos (RepoPublicity (..), currentUserRepos, - languagesFor', userRepos') +import GitHub (Auth (..), Repo (..), RepoPublicity (..), + executeRequest, repositoryR) +import GitHub.Endpoints.Repos (currentUserRepos, languagesFor', userRepos') import Data.Either.Compat (isRight) import Data.String (fromString) import System.Environment (lookupEnv) -import Test.Hspec (Spec, describe, it, pendingWith, shouldSatisfy) +import Test.Hspec (Spec, describe, it, pendingWith, shouldBe, + shouldSatisfy) import qualified Data.HashMap.Strict as HM @@ -26,14 +27,22 @@ withAuth action = do spec :: Spec spec = do + describe "repositoryR" $ do + it "works" $ withAuth $ \auth -> do + er <- executeRequest auth $ repositoryR "phadej" "github" + er `shouldSatisfy` isRight + let Right r = er + -- https://github.com/phadej/github/pull/219 + repoDefaultBranch r `shouldBe` Just "master" + describe "currentUserRepos" $ do it "works" $ withAuth $ \auth -> do - cs <- currentUserRepos auth RepoPublicityAll + cs <- currentUserRepos auth RepoPublicityAll cs `shouldSatisfy` isRight describe "userRepos" $ do it "works" $ withAuth $ \auth -> do - cs <- userRepos' (Just auth) "phadej" RepoPublicityAll + cs <- userRepos' (Just auth) "phadej" RepoPublicityAll cs `shouldSatisfy` isRight describe "languagesFor'" $ do From e44dc58f94b263784860dad28a4d7747579492fc Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 23 May 2016 09:09:06 +0300 Subject: [PATCH 206/510] Update CHANGELOG so far --- CHANGELOG.md | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 103e2629..43121aa8 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,9 +1,12 @@ -Changes for 0.14.3 - +Changes for 0.15.0 + +- Reworked `PullRequest` (notably `pullRequestsFor`) +- GHC-8.0.1 support +- Change `repoMasterBranch` to `repoDefaultBranch` in `Repo` +- Add `listTeamReposR` +- Add `myStarredAcceptStarR` +- Add `HeaderQuery` to `Request` - Add `Hashable Auth` instance - -Changes for 0.14.2 - - Add `mkUserId`, `mkUserName`, `fromUserId`, `fromOrganizationId` Changes for 0.14.1 From 8294eab6d6a4eda907219a979630050b9e6d227b Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 23 May 2016 09:22:52 +0300 Subject: [PATCH 207/510] Remove uses of BS8.pack --- src/GitHub/Data/Webhooks/Validate.hs | 26 ++++++++++++++------------ src/GitHub/Endpoints/Issues.hs | 15 ++++++++------- src/GitHub/Endpoints/Repos.hs | 16 +++++++++------- src/GitHub/Endpoints/Repos/Commits.hs | 10 +++++----- 4 files changed, 36 insertions(+), 31 deletions(-) diff --git a/src/GitHub/Data/Webhooks/Validate.hs b/src/GitHub/Data/Webhooks/Validate.hs index 0ca26283..3915fbbc 100644 --- a/src/GitHub/Data/Webhooks/Validate.hs +++ b/src/GitHub/Data/Webhooks/Validate.hs @@ -14,28 +14,30 @@ module GitHub.Data.Webhooks.Validate ( import Prelude () import Prelude.Compat -import Crypto.Hash -import Data.Byteable (constEqBytes, toBytes) -import qualified Data.ByteString.Base16 as Hex -import qualified Data.ByteString.Char8 as BS -import Data.Monoid +import Crypto.Hash (HMAC, SHA1, hmac, hmacGetDigest) +import Data.Byteable (constEqBytes, toBytes) +import Data.ByteString (ByteString) +import Data.Monoid ((<>)) +import Data.Text (Text) +import qualified Data.ByteString.Base16 as Hex +import qualified Data.Text.Encoding as TE -- | Validates a given payload against a given HMAC hexdigest using a given -- secret. -- Returns 'True' iff the given hash is non-empty and it's a valid signature of -- the payload. isValidPayload - :: String -- ^ the secret - -> Maybe String -- ^ the hash provided by the remote party - -- in @X-Hub-Signature@ (if any), - -- including the 'sha1=...' prefix - -> BS.ByteString -- ^ the body + :: Text -- ^ the secret + -> Maybe Text -- ^ the hash provided by the remote party + -- in @X-Hub-Signature@ (if any), + -- including the 'sha1=...' prefix + -> ByteString -- ^ the body -> Bool isValidPayload secret shaOpt payload = maybe False (constEqBytes sign) shaOptBS where - shaOptBS = BS.pack <$> shaOpt + shaOptBS = TE.encodeUtf8 <$> shaOpt hexDigest = Hex.encode . toBytes . hmacGetDigest - hm = hmac (BS.pack secret) payload :: HMAC SHA1 + hm = hmac (TE.encodeUtf8 secret) payload :: HMAC SHA1 sign = "sha1=" <> hexDigest hm diff --git a/src/GitHub/Endpoints/Issues.hs b/src/GitHub/Endpoints/Issues.hs index f3e7a6c0..026b691c 100644 --- a/src/GitHub/Endpoints/Issues.hs +++ b/src/GitHub/Endpoints/Issues.hs @@ -33,7 +33,8 @@ import Data.Text (Text) import Data.Time.ISO8601 (formatISO8601) import Data.Vector (Vector) -import qualified Data.ByteString.Char8 as BS8 +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE -- | Details on a specific issue, given the repo owner and name, and the issue -- number.' @@ -81,18 +82,18 @@ issuesForRepoR user reqRepoName issueLimitations = convert AnyMilestone = ("milestone", Just "*") convert NoMilestone = ("milestone", Just "none") - convert (MilestoneId n) = ("milestone", Just . BS8.pack $ show n) + convert (MilestoneId n) = ("milestone", Just . TE.encodeUtf8 . T.pack $ show n) convert Open = ("state", Just "open") convert OnlyClosed = ("state", Just "closed") convert Unassigned = ("assignee", Just "none") convert AnyAssignment = ("assignee", Just "") - convert (AssignedTo u) = ("assignee", Just $ BS8.pack u) - convert (Mentions u) = ("mentioned", Just $ BS8.pack u) - convert (Labels l) = ("labels", Just . BS8.pack $ intercalate "," l) + convert (AssignedTo u) = ("assignee", Just . TE.encodeUtf8 . T.pack $ u) + convert (Mentions u) = ("mentioned", Just . TE.encodeUtf8 . T.pack $ u) + convert (Labels l) = ("labels", Just . TE.encodeUtf8 . T.pack $ intercalate "," l) convert Ascending = ("direction", Just "asc") convert Descending = ("direction", Just "desc") - convert (PerPage n) = ("per_page", Just . BS8.pack $ show n) - convert (Since t) = ("since", Just . BS8.pack $ formatISO8601 t) + convert (PerPage n) = ("per_page", Just . TE.encodeUtf8 . T.pack $ show n) + convert (Since t) = ("since", Just . TE.encodeUtf8 . T.pack $ formatISO8601 t) -- Creating new issues. diff --git a/src/GitHub/Endpoints/Repos.hs b/src/GitHub/Endpoints/Repos.hs index d053d461..0069ec1c 100644 --- a/src/GitHub/Endpoints/Repos.hs +++ b/src/GitHub/Endpoints/Repos.hs @@ -64,12 +64,14 @@ import Prelude.Compat import Control.Applicative ((<|>)) import Data.Aeson.Compat (encode) +import Data.Text (Text) import Data.Vector (Vector) import GitHub.Data import GitHub.Request -import qualified Data.ByteString.Char8 as BS8 +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE repoPublicityQueryString :: RepoPublicity -> QueryString repoPublicityQueryString RepoPublicityAll = [("type", Just "all")] @@ -313,26 +315,26 @@ branchesForR user repo = -- | 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 -> String -> Maybe String -> IO (Either Error Content) +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 -> String -> Maybe String -> IO (Either Error Content) +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 - -> String -- ^ file or directory - -> Maybe String -- ^ Git commit + -> 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 + Query ["repos", toPathPart user, toPathPart repo, "contents", T.unpack path] qs where - qs = maybe [] (\r -> [("ref", Just . BS8.pack $ r)]) ref + qs = maybe [] (\r -> [("ref", Just . TE.encodeUtf8 $ r)]) ref -- | The contents of a README file in a repo, given the repo owner and name -- diff --git a/src/GitHub/Endpoints/Repos/Commits.hs b/src/GitHub/Endpoints/Repos/Commits.hs index 16a68c0e..2fad1c04 100644 --- a/src/GitHub/Endpoints/Repos/Commits.hs +++ b/src/GitHub/Endpoints/Repos/Commits.hs @@ -27,9 +27,9 @@ module GitHub.Endpoints.Repos.Commits ( import Data.Time.ISO8601 (formatISO8601) import Data.Vector (Vector) -import qualified Data.ByteString as BS -import qualified Data.ByteString.Char8 as BS8 -import qualified Data.Text.Encoding as TE +import qualified Data.ByteString as BS +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE import GitHub.Data import GitHub.Request @@ -38,8 +38,8 @@ renderCommitQueryOption :: CommitQueryOption -> (BS.ByteString, Maybe BS.ByteStr renderCommitQueryOption (CommitQuerySha sha) = ("sha", Just $ TE.encodeUtf8 sha) renderCommitQueryOption (CommitQueryPath path) = ("path", Just $ TE.encodeUtf8 path) renderCommitQueryOption (CommitQueryAuthor author) = ("author", Just $ TE.encodeUtf8 author) -renderCommitQueryOption (CommitQuerySince date) = ("since", Just $ BS8.pack $ formatISO8601 date) -renderCommitQueryOption (CommitQueryUntil date) = ("until", Just $ BS8.pack $ formatISO8601 date) +renderCommitQueryOption (CommitQuerySince date) = ("since", Just $ TE.encodeUtf8 . T.pack $ formatISO8601 date) +renderCommitQueryOption (CommitQueryUntil date) = ("until", Just $ TE.encodeUtf8 . T.pack $ formatISO8601 date) -- | The commit history for a repo. -- From 13cfa732e7060570531839d2bd13c111fd4a1ff8 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 23 May 2016 17:31:00 +0300 Subject: [PATCH 208/510] Enable space-leak detection in CI --- .travis.yml | 3 +++ stack-lts-5.yaml | 2 +- travis-install.sh | 16 +++++++++++----- travis-script.sh | 20 +++++++++++++++----- 4 files changed, 30 insertions(+), 11 deletions(-) diff --git a/.travis.yml b/.travis.yml index 34081ed3..a6c2ed92 100644 --- a/.travis.yml +++ b/.travis.yml @@ -57,6 +57,9 @@ matrix: - env: BUILD=stack STACK_YAML=stack-lts-4.yaml compiler: ": #stack LTS4 OSX" os: osx + - env: BUILD=stack-space-leak + compiler: ": #STACK - space leak" + addons: {apt: {packages: [ghc-7.10.3], sources: [hvr-ghc]}} before_install: - unset CC diff --git a/stack-lts-5.yaml b/stack-lts-5.yaml index 163be5ba..127719a3 100644 --- a/stack-lts-5.yaml +++ b/stack-lts-5.yaml @@ -1,4 +1,4 @@ -resolver: lts-5.16 +resolver: lts-5.17 packages: - '.' - samples/ diff --git a/travis-install.sh b/travis-install.sh index 4ab1f882..61fc1fd6 100644 --- a/travis-install.sh +++ b/travis-install.sh @@ -1,21 +1,27 @@ set -ex case $BUILD in - stack) + stack*) mkdir -p ~/.local/bin; if [ `uname` = "Darwin" ]; then curl -kL https://www.stackage.org/stack/osx-x86_64 | tar xz --strip-components=1 --include '*/stack' -C ~/.local/bin; else curl -L https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack'; fi + stack --no-terminal setup - stack --no-terminal test --only-dependencies + + if [ $BUILD == "stack-space-leak" ]; then + stack build --test --fast --library-profiling --ghc-options=-rtsopts --only-dependencies + else + stack --no-terminal test --only-dependencies + fi ;; cabal) if [ -n "$STACKAGESNAPSHOT" ]; then - curl -sL https://www.stackage.org/$STACKAGESNAPSHOT/cabal.config | sed 's/constraints:/preferences:/' | grep -v installed > cabal.config - head cabal.config - fi + curl -sL https://www.stackage.org/$STACKAGESNAPSHOT/cabal.config | sed 's/constraints:/preferences:/' | grep -v installed > cabal.config + head cabal.config + fi cabal --version echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]" if [ -f $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz ]; then diff --git a/travis-script.sh b/travis-script.sh index 0b38968a..ef51e715 100644 --- a/travis-script.sh +++ b/travis-script.sh @@ -1,14 +1,24 @@ -set -e +set -ex + +SAMPLE_EXES="show-user list-followers list-following operational" case $BUILD in stack) stack --no-terminal test github stack --no-terminal build github-samples - # TODO: get executables from info - for testbin in show-user list-followers list-following operational; do - echo "Running " $testbin - stack exec github-$testbin + for testbin in $SAMPLE_EXES; do + echo "Running " $testbin + stack exec github-$testbin + done + ;; + stack-space-leak) + stack --no-terminal test --fast --library-profiling --ghc-options=-rtsopts --test-arguments='+RTS -K1K' github + stack --no-terminal build --fast --library-profiling --ghc-options=-rtsopts --executable-profiling --test-arguments='+RTS -K1K' github-samples + + for testbin in $SAMPLE_EXES; do + echo "Running " $testbin + stack exec github-$testbin done ;; cabal) From 0e0f5d0ae1129e8d5d0af9e2371eedcb85ff10ad Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 23 May 2016 18:06:33 +0300 Subject: [PATCH 209/510] FetchCount --- samples/Users/Followers/ListFollowers.hs | 2 +- samples/Users/Followers/ListFollowing.hs | 2 +- spec/GitHub/ActivitySpec.hs | 6 +++-- spec/GitHub/CommitsSpec.hs | 6 +++-- spec/GitHub/IssuesSpec.hs | 2 +- spec/GitHub/PullRequestsSpec.hs | 2 +- spec/GitHub/UsersSpec.hs | 6 +++-- src/GitHub/Data/Request.hs | 24 ++++++++++++++++- src/GitHub/Endpoints/Activity/Starring.hs | 16 ++++++------ src/GitHub/Endpoints/Activity/Watching.hs | 8 +++--- src/GitHub/Endpoints/Gists.hs | 4 +-- src/GitHub/Endpoints/Gists/Comments.hs | 4 +-- src/GitHub/Endpoints/GitData/References.hs | 4 +-- src/GitHub/Endpoints/Issues.hs | 4 +-- src/GitHub/Endpoints/Issues/Comments.hs | 4 +-- src/GitHub/Endpoints/Issues/Events.hs | 8 +++--- src/GitHub/Endpoints/Issues/Labels.hs | 12 ++++----- src/GitHub/Endpoints/Issues/Milestones.hs | 4 +-- src/GitHub/Endpoints/Organizations.hs | 4 +-- src/GitHub/Endpoints/Organizations/Members.hs | 6 ++--- src/GitHub/Endpoints/Organizations/Teams.hs | 14 +++++----- src/GitHub/Endpoints/PullRequests.hs | 12 ++++----- .../Endpoints/PullRequests/ReviewComments.hs | 4 +-- src/GitHub/Endpoints/Repos.hs | 26 +++++++++---------- src/GitHub/Endpoints/Repos/Collaborators.hs | 4 +-- src/GitHub/Endpoints/Repos/Comments.hs | 8 +++--- src/GitHub/Endpoints/Repos/Commits.hs | 6 ++--- src/GitHub/Endpoints/Repos/Forks.hs | 4 +-- src/GitHub/Endpoints/Repos/Webhooks.hs | 4 +-- src/GitHub/Endpoints/Users/Followers.hs | 8 +++--- src/GitHub/Request.hs | 8 ++++-- 31 files changed, 129 insertions(+), 97 deletions(-) diff --git a/samples/Users/Followers/ListFollowers.hs b/samples/Users/Followers/ListFollowers.hs index 8f608f61..a5ef346c 100644 --- a/samples/Users/Followers/ListFollowers.hs +++ b/samples/Users/Followers/ListFollowers.hs @@ -9,7 +9,7 @@ import qualified GitHub main :: IO () main = do auth <- getAuth - possibleUsers <- GitHub.executeRequestMaybe auth $ GitHub.usersFollowingR "mike-burns" Nothing + possibleUsers <- GitHub.executeRequestMaybe auth $ GitHub.usersFollowingR "mike-burns" GitHub.FetchAll putStrLn $ either (("Error: " <>) . tshow) (foldMap ((<> "\n") . formatUser)) possibleUsers diff --git a/samples/Users/Followers/ListFollowing.hs b/samples/Users/Followers/ListFollowing.hs index 6e6e006c..171f2fba 100644 --- a/samples/Users/Followers/ListFollowing.hs +++ b/samples/Users/Followers/ListFollowing.hs @@ -9,7 +9,7 @@ import qualified GitHub main :: IO () main = do auth <- getAuth - possibleUsers <- GitHub.executeRequestMaybe auth $ GitHub.usersFollowedByR "mike-burns" Nothing + possibleUsers <- GitHub.executeRequestMaybe auth $ GitHub.usersFollowedByR "mike-burns" GitHub.FetchAll putStrLn $ either (("Error: " <>) . tshow) (foldMap ((<> "\n") . formatUser)) possibleUsers diff --git a/spec/GitHub/ActivitySpec.hs b/spec/GitHub/ActivitySpec.hs index 71d62f1a..aaee99a7 100644 --- a/spec/GitHub/ActivitySpec.hs +++ b/spec/GitHub/ActivitySpec.hs @@ -2,6 +2,8 @@ {-# LANGUAGE TemplateHaskell #-} module GitHub.ActivitySpec where +import qualified GitHub + import GitHub.Auth (Auth (..)) import GitHub.Endpoints.Activity.Starring (myStarredAcceptStarR) import GitHub.Endpoints.Activity.Watching (watchersForR) @@ -29,11 +31,11 @@ spec :: Spec spec = do describe "watchersForR" $ do it "works" $ withAuth $ \auth -> do - cs <- executeRequest auth $ watchersForR "phadej" "github" Nothing + cs <- executeRequest auth $ watchersForR "phadej" "github" GitHub.FetchAll cs `shouldSatisfy` isRight V.length (fromRightS cs) `shouldSatisfy` (> 10) describe "myStarredR" $ do it "works" $ withAuth $ \auth -> do - cs <- executeRequest auth $ myStarredAcceptStarR (Just 31) + cs <- executeRequest auth $ myStarredAcceptStarR (GitHub.FetchAtLeast 31) cs `shouldSatisfy` isRight fromRightS cs `shouldSatisfy` (\xs -> V.length xs > 30) diff --git a/spec/GitHub/CommitsSpec.hs b/spec/GitHub/CommitsSpec.hs index b639d964..2ca4f1a4 100644 --- a/spec/GitHub/CommitsSpec.hs +++ b/spec/GitHub/CommitsSpec.hs @@ -2,6 +2,8 @@ {-# LANGUAGE TemplateHaskell #-} module GitHub.CommitsSpec where +import qualified GitHub + import GitHub.Auth (Auth (..)) import GitHub.Endpoints.Repos.Commits (Commit, commitSha, commitsFor', commitsForR, diffR, mkName) @@ -39,7 +41,7 @@ spec = do -- Page size is 30, so we get 60 commits it "limits the response" $ withAuth $ \auth -> do - cs <- executeRequest auth $ commitsForR "phadej" "github" (Just 40) + cs <- executeRequest auth $ commitsForR "phadej" "github" (GitHub.FetchAtLeast 40) cs `shouldSatisfy` isRight let cs' = fromRightS cs V.length cs' `shouldSatisfy` (< 70) @@ -48,7 +50,7 @@ spec = do describe "diff" $ do it "works" $ withAuth $ \auth -> do - cs <- executeRequest auth $ commitsForR "phadej" "github" (Just 30) + cs <- executeRequest auth $ commitsForR "phadej" "github" (GitHub.FetchAtLeast 30) cs `shouldSatisfy` isRight let commits = take 10 . V.toList . fromRightS $ cs let pairs = zip commits $ drop 1 commits diff --git a/spec/GitHub/IssuesSpec.hs b/spec/GitHub/IssuesSpec.hs index 354a84cb..a550ac63 100644 --- a/spec/GitHub/IssuesSpec.hs +++ b/spec/GitHub/IssuesSpec.hs @@ -25,7 +25,7 @@ spec = do describe "issuesForRepoR" $ do it "works" $ withAuth $ \auth -> for_ repos $ \(owner, repo) -> do cs <- GitHub.executeRequest auth $ - GitHub.issuesForRepoR owner repo [] Nothing + GitHub.issuesForRepoR owner repo [] GitHub.FetchAll cs `shouldSatisfy` isRight where repos = diff --git a/spec/GitHub/PullRequestsSpec.hs b/spec/GitHub/PullRequestsSpec.hs index 9ff0f3e6..4bb93796 100644 --- a/spec/GitHub/PullRequestsSpec.hs +++ b/spec/GitHub/PullRequestsSpec.hs @@ -26,7 +26,7 @@ spec = do describe "pullRequestsForR" $ do it "works" $ withAuth $ \auth -> for_ repos $ \(owner, repo) -> do cs <- GitHub.executeRequest auth $ - GitHub.pullRequestsForR owner repo opts Nothing + GitHub.pullRequestsForR owner repo opts GitHub.FetchAll cs `shouldSatisfy` isRight where repos = diff --git a/spec/GitHub/UsersSpec.hs b/spec/GitHub/UsersSpec.hs index 99842347..5c578c9c 100644 --- a/spec/GitHub/UsersSpec.hs +++ b/spec/GitHub/UsersSpec.hs @@ -10,6 +10,8 @@ import System.Environment (lookupEnv) import Test.Hspec (Spec, describe, it, pendingWith, shouldBe, shouldSatisfy) +import qualified GitHub + import GitHub.Data (Auth (..), Organization (..), User (..), fromOwner) import GitHub.Endpoints.Users (ownerInfoForR, userInfoCurrent', @@ -67,10 +69,10 @@ spec = do describe "usersFollowing" $ do it "works" $ withAuth $ \auth -> do - us <- executeRequest auth $ usersFollowingR "phadej" (Just 10) + us <- executeRequest auth $ usersFollowingR "phadej" (GitHub.FetchAtLeast 10) us `shouldSatisfy` isRight describe "usersFollowedBy" $ do it "works" $ withAuth $ \auth -> do - us <- executeRequest auth $ usersFollowedByR "phadej" (Just 10) + us <- executeRequest auth $ usersFollowedByR "phadej" (GitHub.FetchAtLeast 10) us `shouldSatisfy` isRight diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs index 5ee1c901..4f60c293 100644 --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -18,6 +18,7 @@ module GitHub.Data.Request ( toMethod, StatusMap(..), MergeResult(..), + FetchCount(..), Paths, IsPathPart(..), QueryString, @@ -106,6 +107,27 @@ instance Hashable (StatusMap a) where hashWithSalt salt StatusOnlyOk = hashWithSalt salt (0 :: Int) hashWithSalt salt StatusMerge = hashWithSalt salt (1 :: Int) +-- | 'PagedQuery' returns just some results, using this data we can specify how +-- many pages we want to fetch. +data FetchCount = FetchAtLeast !Word | FetchAll + deriving (Eq, Ord, Read, Show, Generic, Typeable) + +-- | This instance is there mostly for 'fromInteger'. +instance Num FetchCount where + fromInteger = FetchAtLeast . fromInteger + + FetchAtLeast a + FetchAtLeast b = FetchAtLeast (a * b) + _ + _ = FetchAll + + FetchAtLeast a * FetchAtLeast b = FetchAtLeast (a * b) + _ * _ = FetchAll + + abs = error "abs @FetchCount: not implemented" + signum = error "signum @FetchCount: not implemented" + negate = error "negate @FetchCount: not implemented" + +instance Hashable FetchCount + ------------------------------------------------------------------------------ -- Github request ------------------------------------------------------------------------------ @@ -118,7 +140,7 @@ instance Hashable (StatusMap a) where -- /Note:/ 'Request' is not 'Functor' on purpose. data Request (k :: Bool) a where Query :: FromJSON a => Paths -> QueryString -> Request k a - PagedQuery :: FromJSON (Vector a) => Paths -> QueryString -> Maybe Count -> Request k (Vector a) + PagedQuery :: FromJSON (Vector a) => Paths -> QueryString -> FetchCount -> Request k (Vector a) Command :: FromJSON a => CommandMethod a -> Paths -> LBS.ByteString -> Request 'True a StatusQuery :: StatusMap a -> Request k () -> Request k a HeaderQuery :: Types.RequestHeaders -> Request k a -> Request k a diff --git a/src/GitHub/Endpoints/Activity/Starring.hs b/src/GitHub/Endpoints/Activity/Starring.hs index 86828213..0b7c5ea0 100644 --- a/src/GitHub/Endpoints/Activity/Starring.hs +++ b/src/GitHub/Endpoints/Activity/Starring.hs @@ -29,11 +29,11 @@ import GitHub.Request -- > userInfoFor' Nothing "mike-burns" stargazersFor :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector SimpleUser)) stargazersFor auth user repo = - executeRequestMaybe auth $ stargazersForR user repo Nothing + executeRequestMaybe auth $ stargazersForR user repo FetchAll -- | List Stargazers. -- See -stargazersForR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector SimpleUser) +stargazersForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector SimpleUser) stargazersForR user repo = PagedQuery ["repos", toPathPart user, toPathPart repo, "stargazers"] [] @@ -42,31 +42,31 @@ stargazersForR user repo = -- > reposStarredBy Nothing "croaky" reposStarredBy :: Maybe Auth -> Name Owner -> IO (Either Error (Vector Repo)) reposStarredBy auth user = - executeRequestMaybe auth $ reposStarredByR user Nothing + executeRequestMaybe auth $ reposStarredByR user FetchAll -- | List repositories being starred. -- See -reposStarredByR :: Name Owner -> Maybe Count -> Request k (Vector Repo) +reposStarredByR :: Name Owner -> FetchCount -> Request k (Vector Repo) reposStarredByR user = PagedQuery ["users", toPathPart user, "starred"] [] -- | All the repos starred by the authenticated user. myStarred :: Auth -> IO (Either Error (Vector Repo)) myStarred auth = - executeRequest auth $ myStarredR Nothing + executeRequest auth $ myStarredR FetchAll -- | All the repos starred by the authenticated user. -- See -myStarredR :: Maybe Count -> Request 'True (Vector Repo) +myStarredR :: FetchCount -> Request 'True (Vector Repo) myStarredR = PagedQuery ["user", "starred"] [] -- | All the repos starred by the authenticated user. myStarredAcceptStar :: Auth -> IO (Either Error (Vector RepoStarred)) myStarredAcceptStar auth = - executeRequest auth $ myStarredAcceptStarR Nothing + executeRequest auth $ myStarredAcceptStarR FetchAll -- | All the repos starred by the authenticated user. -- See -myStarredAcceptStarR :: Maybe Count -> Request 'True (Vector RepoStarred) +myStarredAcceptStarR :: FetchCount -> Request 'True (Vector RepoStarred) myStarredAcceptStarR = HeaderQuery [("Accept", "application/vnd.github.v3.star+json")] . PagedQuery ["user", "starred"] [] diff --git a/src/GitHub/Endpoints/Activity/Watching.hs b/src/GitHub/Endpoints/Activity/Watching.hs index 7dc93299..f128832d 100644 --- a/src/GitHub/Endpoints/Activity/Watching.hs +++ b/src/GitHub/Endpoints/Activity/Watching.hs @@ -32,11 +32,11 @@ watchersFor = watchersFor' Nothing -- > watchersFor' (Just (User (user, password))) "thoughtbot" "paperclip" watchersFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector SimpleUser)) watchersFor' auth user repo = - executeRequestMaybe auth $ watchersForR user repo Nothing + executeRequestMaybe auth $ watchersForR user repo FetchAll -- | List watchers. -- See -watchersForR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector SimpleUser) +watchersForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector SimpleUser) watchersForR user repo limit = PagedQuery ["repos", toPathPart user, toPathPart repo, "watchers"] [] limit @@ -52,10 +52,10 @@ reposWatchedBy = reposWatchedBy' Nothing -- > reposWatchedBy' (Just (User (user, password))) "croaky" reposWatchedBy' :: Maybe Auth -> Name Owner -> IO (Either Error (Vector Repo)) reposWatchedBy' auth user = - executeRequestMaybe auth $ reposWatchedByR user Nothing + executeRequestMaybe auth $ reposWatchedByR user FetchAll -- | List repositories being watched. -- See -reposWatchedByR :: Name Owner -> Maybe Count -> Request k (Vector Repo) +reposWatchedByR :: Name Owner -> FetchCount -> Request k (Vector Repo) reposWatchedByR user = PagedQuery ["users", toPathPart user, "subscriptions"] [] diff --git a/src/GitHub/Endpoints/Gists.hs b/src/GitHub/Endpoints/Gists.hs index 537f3626..4aa959dc 100644 --- a/src/GitHub/Endpoints/Gists.hs +++ b/src/GitHub/Endpoints/Gists.hs @@ -23,7 +23,7 @@ import GitHub.Request -- > gists' (Just ("github-username", "github-password")) "mike-burns" gists' :: Maybe Auth -> Name Owner -> IO (Either Error (Vector Gist)) gists' auth user = - executeRequestMaybe auth $ gistsR user Nothing + executeRequestMaybe auth $ gistsR user FetchAll -- | The list of all public gists created by the user. -- @@ -33,7 +33,7 @@ gists = gists' Nothing -- | List gists. -- See -gistsR :: Name Owner -> Maybe Count -> Request k (Vector Gist) +gistsR :: Name Owner -> FetchCount -> Request k (Vector Gist) gistsR user = PagedQuery ["users", toPathPart user, "gists"] [] -- | A specific gist, given its id, with authentication credentials diff --git a/src/GitHub/Endpoints/Gists/Comments.hs b/src/GitHub/Endpoints/Gists/Comments.hs index 0298e1a0..e7ed852f 100644 --- a/src/GitHub/Endpoints/Gists/Comments.hs +++ b/src/GitHub/Endpoints/Gists/Comments.hs @@ -23,11 +23,11 @@ import GitHub.Request -- > commentsOn "1174060" commentsOn :: Name Gist -> IO (Either Error (Vector GistComment)) commentsOn gid = - executeRequest' $ commentsOnR gid Nothing + executeRequest' $ commentsOnR gid FetchAll -- | List comments on a gist. -- See -commentsOnR :: Name Gist -> Maybe Count -> Request k (Vector GistComment) +commentsOnR :: Name Gist -> FetchCount -> Request k (Vector GistComment) commentsOnR gid = PagedQuery ["gists", toPathPart gid, "comments"] [] diff --git a/src/GitHub/Endpoints/GitData/References.hs b/src/GitHub/Endpoints/GitData/References.hs index 7a1a5137..73418b72 100644 --- a/src/GitHub/Endpoints/GitData/References.hs +++ b/src/GitHub/Endpoints/GitData/References.hs @@ -50,7 +50,7 @@ referenceR user repo ref = -- > references "mike-burns" "github" references' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector GitReference)) references' auth user repo = - executeRequestMaybe auth $ referencesR user repo Nothing + executeRequestMaybe auth $ referencesR user repo FetchAll -- | The history of references for a repo. -- @@ -60,7 +60,7 @@ references = references' Nothing -- | Query all References. -- See -referencesR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector GitReference) +referencesR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector GitReference) referencesR user repo = PagedQuery ["repos", toPathPart user, toPathPart repo, "git", "refs"] [] diff --git a/src/GitHub/Endpoints/Issues.hs b/src/GitHub/Endpoints/Issues.hs index 026b691c..50463b16 100644 --- a/src/GitHub/Endpoints/Issues.hs +++ b/src/GitHub/Endpoints/Issues.hs @@ -63,7 +63,7 @@ issueR user reqRepoName reqIssueNumber = -- > issuesForRepo' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" [NoMilestone, OnlyClosed, Mentions "jyurek", Ascending] issuesForRepo' :: Maybe Auth -> Name Owner -> Name Repo -> [IssueLimitation] -> IO (Either Error (Vector Issue)) issuesForRepo' auth user reqRepoName issueLimitations = - executeRequestMaybe auth $ issuesForRepoR user reqRepoName issueLimitations Nothing + executeRequestMaybe auth $ issuesForRepoR user reqRepoName issueLimitations FetchAll -- | All issues for a repo (given the repo owner and name), with optional -- restrictions as described in the @IssueLimitation@ data type. @@ -74,7 +74,7 @@ issuesForRepo = issuesForRepo' Nothing -- | List issues for a repository. -- See -issuesForRepoR :: Name Owner -> Name Repo -> [IssueLimitation] -> Maybe Count -> Request k (Vector Issue) +issuesForRepoR :: Name Owner -> Name Repo -> [IssueLimitation] -> FetchCount -> Request k (Vector Issue) issuesForRepoR user reqRepoName issueLimitations = PagedQuery ["repos", toPathPart user, toPathPart reqRepoName, "issues"] qs where diff --git a/src/GitHub/Endpoints/Issues/Comments.hs b/src/GitHub/Endpoints/Issues/Comments.hs index a6f90234..20371aee 100644 --- a/src/GitHub/Endpoints/Issues/Comments.hs +++ b/src/GitHub/Endpoints/Issues/Comments.hs @@ -50,11 +50,11 @@ comments = comments' Nothing -- > comments' (User (user, password)) "thoughtbot" "paperclip" 635 comments' :: Maybe Auth -> Name Owner -> Name Repo -> Id Issue -> IO (Either Error (Vector IssueComment)) comments' auth user repo iid = - executeRequestMaybe auth $ commentsR user repo iid Nothing + executeRequestMaybe auth $ commentsR user repo iid FetchAll -- | List comments on an issue. -- See -commentsR :: Name Owner -> Name Repo -> Id Issue -> Maybe Count -> Request k (Vector IssueComment) +commentsR :: Name Owner -> Name Repo -> Id Issue -> FetchCount -> Request k (Vector IssueComment) commentsR user repo iid = PagedQuery ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "comments"] [] diff --git a/src/GitHub/Endpoints/Issues/Events.hs b/src/GitHub/Endpoints/Issues/Events.hs index 8e555c2d..3a6f73d4 100644 --- a/src/GitHub/Endpoints/Issues/Events.hs +++ b/src/GitHub/Endpoints/Issues/Events.hs @@ -34,11 +34,11 @@ eventsForIssue = eventsForIssue' Nothing -- > eventsForIssue' (User (user, password)) "thoughtbot" "paperclip" 49 eventsForIssue' :: Maybe Auth -> Name Owner -> Name Repo -> Id Issue -> IO (Either Error (Vector Event)) eventsForIssue' auth user repo iid = - executeRequestMaybe auth $ eventsForIssueR user repo iid Nothing + executeRequestMaybe auth $ eventsForIssueR user repo iid FetchAll -- | List events for an issue. -- See -eventsForIssueR :: Name Owner -> Name Repo -> Id Issue -> Maybe Count -> Request k (Vector Event) +eventsForIssueR :: Name Owner -> Name Repo -> Id Issue -> FetchCount -> Request k (Vector Event) eventsForIssueR user repo iid = PagedQuery ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "events"] [] @@ -53,11 +53,11 @@ eventsForRepo = eventsForRepo' Nothing -- > eventsForRepo' (User (user, password)) "thoughtbot" "paperclip" eventsForRepo' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Event)) eventsForRepo' auth user repo = - executeRequestMaybe auth $ eventsForRepoR user repo Nothing + executeRequestMaybe auth $ eventsForRepoR user repo FetchAll -- | List events for a repository. -- See -eventsForRepoR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector Event) +eventsForRepoR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Event) eventsForRepoR user repo = PagedQuery ["repos", toPathPart user, toPathPart repo, "issues", "events"] [] diff --git a/src/GitHub/Endpoints/Issues/Labels.hs b/src/GitHub/Endpoints/Issues/Labels.hs index 81ad0d50..a03bc94c 100644 --- a/src/GitHub/Endpoints/Issues/Labels.hs +++ b/src/GitHub/Endpoints/Issues/Labels.hs @@ -58,11 +58,11 @@ labelsOnRepo = labelsOnRepo' Nothing -- > labelsOnRepo' (Just (User (user password))) "thoughtbot" "paperclip" labelsOnRepo' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector IssueLabel)) labelsOnRepo' auth user repo = - executeRequestMaybe auth $ labelsOnRepoR user repo Nothing + executeRequestMaybe auth $ labelsOnRepoR user repo FetchAll -- | List all labels for this repository. -- See -labelsOnRepoR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector IssueLabel) +labelsOnRepoR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector IssueLabel) labelsOnRepoR user repo = PagedQuery ["repos", toPathPart user, toPathPart repo, "labels"] [] @@ -152,11 +152,11 @@ labelsOnIssue = labelsOnIssue' Nothing -- > labelsOnIssue' (Just (User (user password))) "thoughtbot" "paperclip" (Id 585) labelsOnIssue' :: Maybe Auth -> Name Owner -> Name Repo -> Id Issue -> IO (Either Error (Vector IssueLabel)) labelsOnIssue' auth user repo iid = - executeRequestMaybe auth $ labelsOnIssueR user repo iid Nothing + executeRequestMaybe auth $ labelsOnIssueR user repo iid FetchAll -- | List labels on an issue. -- See -labelsOnIssueR :: Name Owner -> Name Repo -> Id Issue -> Maybe Count -> Request k (Vector IssueLabel) +labelsOnIssueR :: Name Owner -> Name Repo -> Id Issue -> FetchCount -> Request k (Vector IssueLabel) labelsOnIssueR user repo iid = PagedQuery ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] [] @@ -251,10 +251,10 @@ labelsOnMilestone = labelsOnMilestone' Nothing -- > labelsOnMilestone' (Just (User (user password))) "thoughtbot" "paperclip" (Id 2) labelsOnMilestone' :: Maybe Auth -> Name Owner -> Name Repo -> Id Milestone -> IO (Either Error (Vector IssueLabel)) labelsOnMilestone' auth user repo mid = - executeRequestMaybe auth $ labelsOnMilestoneR user repo mid Nothing + executeRequestMaybe auth $ labelsOnMilestoneR user repo mid FetchAll -- | Query labels for every issue in a milestone. -- See -labelsOnMilestoneR :: Name Owner -> Name Repo -> Id Milestone -> Maybe Count -> Request k (Vector IssueLabel) +labelsOnMilestoneR :: Name Owner -> Name Repo -> Id Milestone -> FetchCount -> Request k (Vector IssueLabel) labelsOnMilestoneR user repo mid = PagedQuery ["repos", toPathPart user, toPathPart repo, "milestones", toPathPart mid, "labels"] [] diff --git a/src/GitHub/Endpoints/Issues/Milestones.hs b/src/GitHub/Endpoints/Issues/Milestones.hs index 91447df2..8e793154 100644 --- a/src/GitHub/Endpoints/Issues/Milestones.hs +++ b/src/GitHub/Endpoints/Issues/Milestones.hs @@ -30,11 +30,11 @@ milestones = milestones' Nothing -- > milestones' (User (user, passwordG) "thoughtbot" "paperclip" milestones' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Milestone)) milestones' auth user repo = - executeRequestMaybe auth $ milestonesR user repo Nothing + executeRequestMaybe auth $ milestonesR user repo FetchAll -- | List milestones for a repository. -- See -milestonesR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector Milestone) +milestonesR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Milestone) milestonesR user repo = PagedQuery ["repos", toPathPart user, toPathPart repo, "milestones"] [] -- | Details on a specific milestone, given it's milestone number. diff --git a/src/GitHub/Endpoints/Organizations.hs b/src/GitHub/Endpoints/Organizations.hs index d10d745a..7421a74d 100644 --- a/src/GitHub/Endpoints/Organizations.hs +++ b/src/GitHub/Endpoints/Organizations.hs @@ -23,7 +23,7 @@ import GitHub.Request -- > publicOrganizationsFor' (Just ("github-username", "github-password")) "mike-burns" publicOrganizationsFor' :: Maybe Auth -> Name User -> IO (Either Error (Vector SimpleOrganization)) publicOrganizationsFor' auth org = - executeRequestMaybe auth $ publicOrganizationsForR org Nothing + executeRequestMaybe auth $ publicOrganizationsForR org FetchAll -- | List user organizations. The public organizations for a user, given the user's login. -- @@ -33,7 +33,7 @@ publicOrganizationsFor = publicOrganizationsFor' Nothing -- | List user organizations. -- See -publicOrganizationsForR :: Name User -> Maybe Count -> Request k (Vector SimpleOrganization) +publicOrganizationsForR :: Name User -> FetchCount -> Request k (Vector SimpleOrganization) publicOrganizationsForR user = PagedQuery ["users", toPathPart user, "orgs"] [] -- | Details on a public organization. Takes the organization's login. diff --git a/src/GitHub/Endpoints/Organizations/Members.hs b/src/GitHub/Endpoints/Organizations/Members.hs index 398184c1..1e321f39 100644 --- a/src/GitHub/Endpoints/Organizations/Members.hs +++ b/src/GitHub/Endpoints/Organizations/Members.hs @@ -25,7 +25,7 @@ import GitHub.Request -- > membersOf' (Just $ OAuth "token") "thoughtbot" membersOf' :: Maybe Auth -> Name Organization -> IO (Either Error (Vector SimpleUser)) membersOf' auth org = - executeRequestMaybe auth $ membersOfR org Nothing + executeRequestMaybe auth $ membersOfR org FetchAll -- | All the users who are members of the specified organization, -- | without authentication. @@ -37,13 +37,13 @@ membersOf = membersOf' Nothing -- | All the users who are members of the specified organization. -- -- See -membersOfR :: Name Organization -> Maybe Count -> Request k (Vector SimpleUser) +membersOfR :: Name Organization -> FetchCount -> Request k (Vector SimpleUser) membersOfR organization = PagedQuery ["orgs", toPathPart organization, "members"] [] -- | 'membersOfR' with filters. -- -- See -membersOfWithR :: Name Organization -> OrgMemberFilter -> OrgMemberRole -> Maybe Count -> Request k (Vector SimpleUser) +membersOfWithR :: Name Organization -> OrgMemberFilter -> OrgMemberRole -> FetchCount -> Request k (Vector SimpleUser) membersOfWithR org f r = PagedQuery ["orgs", toPathPart org, "members"] [("filter", Just f'), ("role", Just r')] where f' = case f of diff --git a/src/GitHub/Endpoints/Organizations/Teams.hs b/src/GitHub/Endpoints/Organizations/Teams.hs index bd7a9784..13178fe9 100644 --- a/src/GitHub/Endpoints/Organizations/Teams.hs +++ b/src/GitHub/Endpoints/Organizations/Teams.hs @@ -52,7 +52,7 @@ import GitHub.Request -- > teamsOf' (Just $ OAuth "token") "thoughtbot" teamsOf' :: Maybe Auth -> Name Organization -> IO (Either Error (Vector SimpleTeam)) teamsOf' auth org = - executeRequestMaybe auth $ teamsOfR org Nothing + executeRequestMaybe auth $ teamsOfR org FetchAll -- | List the public teams of an Owner. -- @@ -62,7 +62,7 @@ teamsOf = teamsOf' Nothing -- | List teams. -- See -teamsOfR :: Name Organization -> Maybe Count -> Request k (Vector SimpleTeam) +teamsOfR :: Name Organization -> FetchCount -> Request k (Vector SimpleTeam) teamsOfR org = PagedQuery ["orgs", toPathPart org, "teams"] [] -- | The information for a single team, by team id. @@ -134,7 +134,7 @@ deleteTeamR tid = -- | List team members. -- -- See -listTeamMembersR :: Id Team -> TeamMemberRole -> Maybe Count -> Request 'True (Vector SimpleUser) +listTeamMembersR :: Id Team -> TeamMemberRole -> FetchCount -> Request 'True (Vector SimpleUser) listTeamMembersR tid r = PagedQuery ["teams", toPathPart tid, "members"] [("role", Just r')] where r' = case r of @@ -147,11 +147,11 @@ listTeamMembersR tid r = PagedQuery ["teams", toPathPart tid, "members"] [("role -- -- > listTeamRepos' (Just $ GitHub.OAuth token) (GitHub.mkTeamId team_id) listTeamRepos' :: Maybe Auth -> Id Team -> IO (Either Error (Vector Repo)) -listTeamRepos' auth tid = executeRequestMaybe auth $ listTeamReposR tid Nothing +listTeamRepos' auth tid = executeRequestMaybe auth $ listTeamReposR tid FetchAll -- | Query team repositories. -- See -listTeamReposR :: Id Team -> Maybe Count -> Request k (Vector Repo) +listTeamReposR :: Id Team -> FetchCount -> Request k (Vector Repo) listTeamReposR tid = PagedQuery ["teams", toPathPart tid, "repos"] [] -- | Retrieve repositories for a team. @@ -210,9 +210,9 @@ deleteTeamMembershipForR tid user = -- -- > listTeamsCurrent' (OAuth "token") listTeamsCurrent' :: Auth -> IO (Either Error (Vector Team)) -listTeamsCurrent' auth = executeRequest auth $ listTeamsCurrentR Nothing +listTeamsCurrent' auth = executeRequest auth $ listTeamsCurrentR FetchAll -- | List user teams. -- See -listTeamsCurrentR :: Maybe Count -> Request 'True (Vector Team) +listTeamsCurrentR :: FetchCount -> Request 'True (Vector Team) listTeamsCurrentR = PagedQuery ["user", "teams"] [] diff --git a/src/GitHub/Endpoints/PullRequests.hs b/src/GitHub/Endpoints/PullRequests.hs index 5cdc15fa..bd50e32f 100644 --- a/src/GitHub/Endpoints/PullRequests.hs +++ b/src/GitHub/Endpoints/PullRequests.hs @@ -41,13 +41,13 @@ import Data.Vector (Vector) -- > pullRequestsFor "rails" "rails" pullRequestsFor :: Name Owner -> Name Repo -> IO (Either Error (Vector SimplePullRequest)) pullRequestsFor user repo = - executeRequest' $ pullRequestsForR user repo defaultPullRequestOptions Nothing + executeRequest' $ pullRequestsForR user repo defaultPullRequestOptions FetchAll -- | List pull requests. -- See pullRequestsForR :: Name Owner -> Name Repo -> PullRequestOptions -- ^ State - -> Maybe Count + -> FetchCount -> Request k (Vector SimplePullRequest) pullRequestsForR user repo opts = PagedQuery ["repos", toPathPart user, toPathPart repo, "pulls"] @@ -114,7 +114,7 @@ updatePullRequestR user repo prid epr = -- > pullRequestCommits' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" 688 pullRequestCommits' :: Maybe Auth -> Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector Commit)) pullRequestCommits' auth user repo prid = - executeRequestMaybe auth $ pullRequestCommitsR user repo prid Nothing + executeRequestMaybe auth $ pullRequestCommitsR user repo prid FetchAll -- | All the commits on a pull request, given the repo owner, repo name, and -- the number of the pull request. @@ -125,7 +125,7 @@ pullRequestCommitsIO = pullRequestCommits' Nothing -- | List commits on a pull request. -- See -pullRequestCommitsR :: Name Owner -> Name Repo -> Id PullRequest -> Maybe Count -> Request k (Vector Commit) +pullRequestCommitsR :: Name Owner -> Name Repo -> Id PullRequest -> FetchCount -> Request k (Vector Commit) pullRequestCommitsR user repo prid = PagedQuery ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "commits"] [] @@ -136,7 +136,7 @@ pullRequestCommitsR user repo prid = -- > pullRequestFiles' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" 688 pullRequestFiles' :: Maybe Auth -> Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector File)) pullRequestFiles' auth user repo prid = - executeRequestMaybe auth $ pullRequestFilesR user repo prid Nothing + executeRequestMaybe auth $ pullRequestFilesR user repo prid FetchAll -- | The individual files that a pull request patches. Takes the repo owner and -- name, plus the number assigned to the pull request. @@ -147,7 +147,7 @@ pullRequestFiles = pullRequestFiles' Nothing -- | List pull requests files. -- See -pullRequestFilesR :: Name Owner -> Name Repo -> Id PullRequest -> Maybe Count -> Request k (Vector File) +pullRequestFilesR :: Name Owner -> Name Repo -> Id PullRequest -> FetchCount -> Request k (Vector File) pullRequestFilesR user repo prid = PagedQuery ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "files"] [] diff --git a/src/GitHub/Endpoints/PullRequests/ReviewComments.hs b/src/GitHub/Endpoints/PullRequests/ReviewComments.hs index 24402266..9aedce0d 100644 --- a/src/GitHub/Endpoints/PullRequests/ReviewComments.hs +++ b/src/GitHub/Endpoints/PullRequests/ReviewComments.hs @@ -22,11 +22,11 @@ import GitHub.Request -- > 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 Nothing + executeRequest' $ pullRequestReviewCommentsR user repo prid FetchAll -- | List comments on a pull request. -- See -pullRequestReviewCommentsR :: Name Owner -> Name Repo -> Id PullRequest -> Maybe Count -> Request k (Vector Comment) +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"] [] diff --git a/src/GitHub/Endpoints/Repos.hs b/src/GitHub/Endpoints/Repos.hs index 0069ec1c..6938d60c 100644 --- a/src/GitHub/Endpoints/Repos.hs +++ b/src/GitHub/Endpoints/Repos.hs @@ -83,11 +83,11 @@ repoPublicityQueryString RepoPublicityPrivate = [("type", Just "private")] -- | List your repositories. currentUserRepos :: Auth -> RepoPublicity -> IO (Either Error (Vector Repo)) currentUserRepos auth publicity = - executeRequest auth $ currentUserReposR publicity Nothing + executeRequest auth $ currentUserReposR publicity FetchAll -- | List your repositories. -- See -currentUserReposR :: RepoPublicity -> Maybe Count -> Request k(Vector Repo) +currentUserReposR :: RepoPublicity -> FetchCount -> Request k(Vector Repo) currentUserReposR publicity = PagedQuery ["user", "repos"] qs where @@ -106,11 +106,11 @@ userRepos = userRepos' Nothing -- > userRepos' (Just (BasicAuth (user, password))) "mike-burns" All userRepos' :: Maybe Auth -> Name Owner -> RepoPublicity -> IO (Either Error (Vector Repo)) userRepos' auth user publicity = - executeRequestMaybe auth $ userReposR user publicity Nothing + executeRequestMaybe auth $ userReposR user publicity FetchAll -- | List user repositories. -- See -userReposR :: Name Owner -> RepoPublicity -> Maybe Count -> Request k(Vector Repo) +userReposR :: Name Owner -> RepoPublicity -> FetchCount -> Request k(Vector Repo) userReposR user publicity = PagedQuery ["users", toPathPart user, "repos"] qs where @@ -128,11 +128,11 @@ organizationRepos org = organizationRepos' Nothing org RepoPublicityAll -- > organizationRepos (Just (BasicAuth (user, password))) "thoughtbot" All organizationRepos' :: Maybe Auth -> Name Organization -> RepoPublicity -> IO (Either Error (Vector Repo)) organizationRepos' auth org publicity = - executeRequestMaybe auth $ organizationReposR org publicity Nothing + executeRequestMaybe auth $ organizationReposR org publicity FetchAll -- | List organization repositories. -- See -organizationReposR :: Name Organization -> RepoPublicity -> Maybe Count -> Request k (Vector Repo) +organizationReposR :: Name Organization -> RepoPublicity -> FetchCount -> Request k (Vector Repo) organizationReposR org publicity = PagedQuery ["orgs", toPathPart org, "repos"] qs where @@ -217,14 +217,14 @@ contributors = contributors' Nothing -- > contributors' (Just (BasicAuth (user, password))) "thoughtbot" "paperclip" contributors' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Contributor)) contributors' auth user repo = - executeRequestMaybe auth $ contributorsR user repo False Nothing + executeRequestMaybe auth $ contributorsR user repo False FetchAll -- | List contributors. -- See contributorsR :: Name Owner -> Name Repo -> Bool -- ^ Include anonymous - -> Maybe Count + -> FetchCount -> Request k (Vector Contributor) contributorsR user repo anon = PagedQuery ["repos", toPathPart user, toPathPart repo, "contributors"] qs @@ -248,7 +248,7 @@ contributorsWithAnonymous = contributorsWithAnonymous' Nothing -- > contributorsWithAnonymous' (Just (BasicAuth (user, password))) "thoughtbot" "paperclip" contributorsWithAnonymous' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Contributor)) contributorsWithAnonymous' auth user repo = - executeRequestMaybe auth $ contributorsR user repo True Nothing + executeRequestMaybe auth $ contributorsR user repo True FetchAll -- | The programming languages used in a repo along with the number of -- characters written in that language. Takes the repo owner and name. @@ -284,11 +284,11 @@ tagsFor = tagsFor' Nothing -- > tagsFor' (Just (BasicAuth (user, password))) "thoughtbot" "paperclip" tagsFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Tag)) tagsFor' auth user repo = - executeRequestMaybe auth $ tagsForR user repo Nothing + executeRequestMaybe auth $ tagsForR user repo FetchAll -- | List tags. -- See -tagsForR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector Tag) +tagsForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Tag) tagsForR user repo = PagedQuery ["repos", toPathPart user, toPathPart repo, "tags"] [] @@ -304,11 +304,11 @@ branchesFor = branchesFor' Nothing -- > branchesFor' (Just (BasicAuth (user, password))) "thoughtbot" "paperclip" branchesFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Branch)) branchesFor' auth user repo = - executeRequestMaybe auth $ branchesForR user repo Nothing + executeRequestMaybe auth $ branchesForR user repo FetchAll -- | List branches. -- See -branchesForR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector Branch) +branchesForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Branch) branchesForR user repo = PagedQuery ["repos", toPathPart user, toPathPart repo, "branches"] [] diff --git a/src/GitHub/Endpoints/Repos/Collaborators.hs b/src/GitHub/Endpoints/Repos/Collaborators.hs index 34ffca78..732b8068 100644 --- a/src/GitHub/Endpoints/Repos/Collaborators.hs +++ b/src/GitHub/Endpoints/Repos/Collaborators.hs @@ -28,11 +28,11 @@ collaboratorsOn = collaboratorsOn' Nothing -- With authentication. collaboratorsOn' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector SimpleUser)) collaboratorsOn' auth user repo = - executeRequestMaybe auth $ collaboratorsOnR user repo Nothing + executeRequestMaybe auth $ collaboratorsOnR user repo FetchAll -- | List collaborators. -- See -collaboratorsOnR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector SimpleUser) +collaboratorsOnR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector SimpleUser) collaboratorsOnR user repo = PagedQuery ["repos", toPathPart user, toPathPart repo, "collaborators"] [] diff --git a/src/GitHub/Endpoints/Repos/Comments.hs b/src/GitHub/Endpoints/Repos/Comments.hs index 95966ec6..bcc13a1c 100644 --- a/src/GitHub/Endpoints/Repos/Comments.hs +++ b/src/GitHub/Endpoints/Repos/Comments.hs @@ -35,11 +35,11 @@ commentsFor = commentsFor' Nothing -- > commentsFor "thoughtbot" "paperclip" commentsFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Comment)) commentsFor' auth user repo = - executeRequestMaybe auth $ commentsForR user repo Nothing + executeRequestMaybe auth $ commentsForR user repo FetchAll -- | List commit comments for a repository. -- See -commentsForR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector Comment) +commentsForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Comment) commentsForR user repo = PagedQuery ["repos", toPathPart user, toPathPart repo, "comments"] [] @@ -55,11 +55,11 @@ commitCommentsFor = commitCommentsFor' Nothing -- > commitCommentsFor "thoughtbot" "paperclip" "41f685f6e01396936bb8cd98e7cca517e2c7d96b" commitCommentsFor' :: Maybe Auth -> Name Owner -> Name Repo -> Name Commit -> IO (Either Error (Vector Comment)) commitCommentsFor' auth user repo sha = - executeRequestMaybe auth $ commitCommentsForR user repo sha Nothing + executeRequestMaybe auth $ commitCommentsForR user repo sha FetchAll -- | List comments for a single commit. -- See -commitCommentsForR :: Name Owner -> Name Repo -> Name Commit -> Maybe Count -> Request k (Vector Comment) +commitCommentsForR :: Name Owner -> Name Repo -> Name Commit -> FetchCount -> Request k (Vector Comment) commitCommentsForR user repo sha = PagedQuery ["repos", toPathPart user, toPathPart repo, "commits", toPathPart sha, "comments"] [] diff --git a/src/GitHub/Endpoints/Repos/Commits.hs b/src/GitHub/Endpoints/Repos/Commits.hs index 2fad1c04..28baa0c2 100644 --- a/src/GitHub/Endpoints/Repos/Commits.hs +++ b/src/GitHub/Endpoints/Repos/Commits.hs @@ -57,7 +57,7 @@ commitsFor' auth user repo = -- | List commits on a repository. -- See -commitsForR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector Commit) +commitsForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Commit) commitsForR user repo limit = commitsWithOptionsForR user repo limit [] commitsWithOptionsFor :: Name Owner -> Name Repo -> [CommitQueryOption] -> IO (Either Error (Vector Commit)) @@ -70,11 +70,11 @@ commitsWithOptionsFor = commitsWithOptionsFor' Nothing -- > commitsWithOptionsFor' (Just (BasicAuth (user, password))) "mike-burns" "github" [CommitQueryAuthor "djeik"] commitsWithOptionsFor' :: Maybe Auth -> Name Owner -> Name Repo -> [CommitQueryOption] -> IO (Either Error (Vector Commit)) commitsWithOptionsFor' auth user repo opts = - executeRequestMaybe auth $ commitsWithOptionsForR user repo Nothing opts + executeRequestMaybe auth $ commitsWithOptionsForR user repo FetchAll opts -- | List commits on a repository. -- See -commitsWithOptionsForR :: Name Owner -> Name Repo -> Maybe Count -> [CommitQueryOption] -> Request k (Vector Commit) +commitsWithOptionsForR :: Name Owner -> Name Repo -> FetchCount -> [CommitQueryOption] -> Request k (Vector Commit) commitsWithOptionsForR user repo limit opts = PagedQuery ["repos", toPathPart user, toPathPart repo, "commits"] qs limit where diff --git a/src/GitHub/Endpoints/Repos/Forks.hs b/src/GitHub/Endpoints/Repos/Forks.hs index a8734a5c..779b6c89 100644 --- a/src/GitHub/Endpoints/Repos/Forks.hs +++ b/src/GitHub/Endpoints/Repos/Forks.hs @@ -28,10 +28,10 @@ forksFor = forksFor' Nothing -- > forksFor' (Just (User (user, password))) "thoughtbot" "paperclip" forksFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Repo)) forksFor' auth user repo = - executeRequestMaybe auth $ forksForR user repo Nothing + executeRequestMaybe auth $ forksForR user repo FetchAll -- | List forks. -- See -forksForR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector Repo) +forksForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Repo) forksForR user repo = PagedQuery ["repos", toPathPart user, toPathPart repo, "forks"] [] diff --git a/src/GitHub/Endpoints/Repos/Webhooks.hs b/src/GitHub/Endpoints/Repos/Webhooks.hs index fa225ac5..b8d1abe8 100644 --- a/src/GitHub/Endpoints/Repos/Webhooks.hs +++ b/src/GitHub/Endpoints/Repos/Webhooks.hs @@ -44,11 +44,11 @@ import GitHub.Request webhooksFor' :: Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector RepoWebhook)) webhooksFor' auth user repo = - executeRequest auth $ webhooksForR user repo Nothing + executeRequest auth $ webhooksForR user repo FetchAll -- | List hooks. -- See -webhooksForR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector RepoWebhook) +webhooksForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector RepoWebhook) webhooksForR user repo = PagedQuery ["repos", toPathPart user, toPathPart repo, "hooks"] [] diff --git a/src/GitHub/Endpoints/Users/Followers.hs b/src/GitHub/Endpoints/Users/Followers.hs index b1ee7690..bc255310 100644 --- a/src/GitHub/Endpoints/Users/Followers.hs +++ b/src/GitHub/Endpoints/Users/Followers.hs @@ -23,11 +23,11 @@ import GitHub.Request -- > usersFollowing "mike-burns" usersFollowing :: Name User -> IO (Either Error (Vector SimpleUser)) usersFollowing user = - executeRequest' $ usersFollowingR user Nothing + executeRequest' $ usersFollowingR user FetchAll -- | List followers of a user. -- See -usersFollowingR :: Name User -> Maybe Count -> Request k (Vector SimpleUser) +usersFollowingR :: Name User -> FetchCount -> Request k (Vector SimpleUser) usersFollowingR user = PagedQuery ["users", toPathPart user, "followers"] [] -- | All the users that the given user follows. @@ -35,9 +35,9 @@ usersFollowingR user = PagedQuery ["users", toPathPart user, "followers"] [] -- > usersFollowedBy "mike-burns" usersFollowedBy :: Name User -> IO (Either Error (Vector SimpleUser)) usersFollowedBy user = - executeRequest' $ usersFollowedByR user Nothing + executeRequest' $ usersFollowedByR user FetchAll -- | List users followed by another user. -- See -usersFollowedByR :: Name User -> Maybe Count -> Request k (Vector SimpleUser) +usersFollowedByR :: Name User -> FetchCount -> Request k (Vector SimpleUser) usersFollowedByR user = PagedQuery ["users", toPathPart user, "following"] [] diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index d1118153..146d20fb 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -106,6 +106,10 @@ executeRequest auth req = do #endif pure x +lessFetchCount :: Int -> FetchCount -> Bool +lessFetchCount _ FetchAll = True +lessFetchCount i (FetchAtLeast j) = i < fromIntegral j + -- | Like 'executeRequest' but with provided 'Manager'. executeRequestWithMgr :: Manager -> Auth @@ -124,7 +128,7 @@ executeRequestWithMgr mgr auth req = runExceptT $ httpReq <- makeHttpRequest (Just auth) req performPagedRequest httpLbs' predicate httpReq where - predicate = maybe (const True) (\l' -> (< l') . V.length ) l + predicate v = lessFetchCount (V.length v) l Command m _ _ -> do httpReq <- makeHttpRequest (Just auth) req res <- httpLbs' httpReq @@ -167,7 +171,7 @@ executeRequestWithMgr' mgr req = runExceptT $ httpReq <- makeHttpRequest Nothing req performPagedRequest httpLbs' predicate httpReq where - predicate = maybe (const True) (\l' -> (< l') . V.length) l + predicate v = lessFetchCount (V.length v) l StatusQuery sm _ -> do httpReq <- makeHttpRequest Nothing req res <- httpLbs' httpReq From 5f2871b18e7f786e0abffd227ab4980dc7f51dfa Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 23 May 2016 18:52:12 +0300 Subject: [PATCH 210/510] Introduce internal prelude --- .stylish-haskell.yaml | 6 +- github.cabal | 17 ++++++ samples/Teams/DeleteTeam.hs | 4 +- samples/Teams/EditTeam.hs | 4 +- samples/Teams/ListTeamsCurrent.hs | 4 +- .../Teams/Memberships/AddTeamMembershipFor.hs | 4 +- .../Memberships/DeleteTeamMembershipFor.hs | 4 +- .../Memberships/TeamMembershipInfoFor.hs | 4 +- samples/Teams/TeamInfoFor.hs | 4 +- samples/src/Common.hs | 13 +--- src/GitHub/Auth.hs | 9 +-- src/GitHub/Data.hs | 7 +-- src/GitHub/Data/Activities.hs | 17 +----- src/GitHub/Data/Comments.hs | 17 +----- src/GitHub/Data/Content.hs | 20 +------ src/GitHub/Data/Definitions.hs | 3 - src/GitHub/Data/Gists.hs | 17 +----- src/GitHub/Data/GitData.hs | 18 +----- src/GitHub/Data/Id.hs | 9 +-- src/GitHub/Data/Issues.hs | 18 +----- src/GitHub/Data/Name.hs | 11 +--- src/GitHub/Data/PullRequests.hs | 19 +----- src/GitHub/Data/Repos.hs | 20 +------ src/GitHub/Data/Request.hs | 18 ++---- src/GitHub/Data/Search.hs | 16 +---- src/GitHub/Data/Teams.hs | 22 ++----- src/GitHub/Data/URL.hs | 13 +--- src/GitHub/Data/Webhooks.hs | 20 +------ src/GitHub/Data/Webhooks/Validate.hs | 7 +-- src/GitHub/Endpoints/Activity/Starring.hs | 4 +- src/GitHub/Endpoints/Activity/Watching.hs | 2 +- src/GitHub/Endpoints/Gists.hs | 2 +- src/GitHub/Endpoints/Gists/Comments.hs | 3 +- src/GitHub/Endpoints/GitData/Blobs.hs | 1 + src/GitHub/Endpoints/GitData/Commits.hs | 1 + src/GitHub/Endpoints/GitData/References.hs | 5 +- src/GitHub/Endpoints/GitData/Trees.hs | 2 +- src/GitHub/Endpoints/Issues.hs | 11 +--- src/GitHub/Endpoints/Issues/Comments.hs | 6 +- src/GitHub/Endpoints/Issues/Events.hs | 3 +- src/GitHub/Endpoints/Issues/Labels.hs | 2 - src/GitHub/Endpoints/Issues/Milestones.hs | 3 +- src/GitHub/Endpoints/Organizations.hs | 2 +- src/GitHub/Endpoints/Organizations/Members.hs | 4 +- src/GitHub/Endpoints/Organizations/Teams.hs | 9 +-- src/GitHub/Endpoints/PullRequests.hs | 6 +- .../Endpoints/PullRequests/ReviewComments.hs | 2 +- src/GitHub/Endpoints/Repos.hs | 13 +--- src/GitHub/Endpoints/Repos/Collaborators.hs | 2 +- src/GitHub/Endpoints/Repos/Comments.hs | 2 +- src/GitHub/Endpoints/Repos/Commits.hs | 9 +-- src/GitHub/Endpoints/Repos/Forks.hs | 2 +- src/GitHub/Endpoints/Repos/Webhooks.hs | 8 +-- src/GitHub/Endpoints/Search.hs | 8 +-- src/GitHub/Endpoints/Users.hs | 2 +- src/GitHub/Endpoints/Users/Followers.hs | 3 +- src/GitHub/Internal/Prelude.hs | 59 +++++++++++++++++++ src/GitHub/Request.hs | 17 ++---- 58 files changed, 153 insertions(+), 385 deletions(-) create mode 100644 src/GitHub/Internal/Prelude.hs diff --git a/.stylish-haskell.yaml b/.stylish-haskell.yaml index 0d13efa4..56d5acea 100644 --- a/.stylish-haskell.yaml +++ b/.stylish-haskell.yaml @@ -8,6 +8,8 @@ steps: - trailing_whitespace: {} columns: 80 language_extensions: - - MultiParamTypeClasses - - FlexibleContexts - DataKinds + - ExplicitForAll + - FlexibleContexts + - MultiParamTypeClasses + - StandaloneDeriving diff --git a/github.cabal b/github.cabal index e81c8ad6..a2144925 100644 --- a/github.cabal +++ b/github.cabal @@ -49,8 +49,23 @@ Library default-language: Haskell2010 ghc-options: -Wall hs-source-dirs: src + default-extensions: + NoImplicitPrelude + DataKinds + DeriveDataTypeable + DeriveGeneric + OverloadedStrings + ScopedTypeVariables + other-extensions: + CPP + FlexibleContexts + FlexibleInstances + GADTs + KindSignatures + StandaloneDeriving exposed-modules: GitHub + GitHub.Internal.Prelude GitHub.Auth GitHub.Data GitHub.Data.Comments @@ -142,6 +157,8 @@ test-suite github-test default-language: Haskell2010 type: exitcode-stdio-1.0 hs-source-dirs: spec + other-extensions: + TemplateHaskell other-modules: GitHub.ActivitySpec GitHub.CommitsSpec diff --git a/samples/Teams/DeleteTeam.hs b/samples/Teams/DeleteTeam.hs index 484102ff..b354d94c 100644 --- a/samples/Teams/DeleteTeam.hs +++ b/samples/Teams/DeleteTeam.hs @@ -1,10 +1,8 @@ +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} module Main (main) where import Common -import Prelude () - -import Data.String (fromString) import qualified GitHub import qualified GitHub.Endpoints.Organizations.Teams as GitHub diff --git a/samples/Teams/EditTeam.hs b/samples/Teams/EditTeam.hs index e5485d46..7e3f63a1 100644 --- a/samples/Teams/EditTeam.hs +++ b/samples/Teams/EditTeam.hs @@ -1,10 +1,8 @@ +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} module Main (main) where import Common -import Prelude () - -import Data.String (fromString) import qualified GitHub import qualified GitHub.Endpoints.Organizations.Teams as GitHub diff --git a/samples/Teams/ListTeamsCurrent.hs b/samples/Teams/ListTeamsCurrent.hs index aa7718ec..4e75aa6a 100644 --- a/samples/Teams/ListTeamsCurrent.hs +++ b/samples/Teams/ListTeamsCurrent.hs @@ -1,10 +1,8 @@ +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} module Main (main) where import Common -import Prelude () - -import Data.String (fromString) import qualified GitHub import qualified GitHub.Endpoints.Organizations.Teams as GitHub diff --git a/samples/Teams/Memberships/AddTeamMembershipFor.hs b/samples/Teams/Memberships/AddTeamMembershipFor.hs index faad9435..b07bee73 100644 --- a/samples/Teams/Memberships/AddTeamMembershipFor.hs +++ b/samples/Teams/Memberships/AddTeamMembershipFor.hs @@ -1,10 +1,8 @@ +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} module Main (main) where import Common -import Prelude () - -import Data.String (fromString) import qualified GitHub import qualified GitHub.Endpoints.Organizations.Teams as GitHub diff --git a/samples/Teams/Memberships/DeleteTeamMembershipFor.hs b/samples/Teams/Memberships/DeleteTeamMembershipFor.hs index 9c7da148..1d7b7ed5 100644 --- a/samples/Teams/Memberships/DeleteTeamMembershipFor.hs +++ b/samples/Teams/Memberships/DeleteTeamMembershipFor.hs @@ -1,10 +1,8 @@ +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} module Main (main) where import Common -import Prelude () - -import Data.String (fromString) import qualified GitHub import qualified GitHub.Endpoints.Organizations.Teams as GitHub diff --git a/samples/Teams/Memberships/TeamMembershipInfoFor.hs b/samples/Teams/Memberships/TeamMembershipInfoFor.hs index 1596df5f..89a6fa82 100644 --- a/samples/Teams/Memberships/TeamMembershipInfoFor.hs +++ b/samples/Teams/Memberships/TeamMembershipInfoFor.hs @@ -1,10 +1,8 @@ +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} module Main (main) where import Common -import Prelude () - -import Data.String (fromString) import qualified GitHub import qualified GitHub.Endpoints.Organizations.Teams as GitHub diff --git a/samples/Teams/TeamInfoFor.hs b/samples/Teams/TeamInfoFor.hs index a2ca4c8e..c128e8b8 100644 --- a/samples/Teams/TeamInfoFor.hs +++ b/samples/Teams/TeamInfoFor.hs @@ -1,10 +1,8 @@ +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} module Main (main) where import Common -import Prelude () - -import Data.String (fromString) import qualified GitHub import qualified GitHub.Endpoints.Organizations.Teams as GitHub diff --git a/samples/src/Common.hs b/samples/src/Common.hs index c48f8588..6051d2a4 100644 --- a/samples/src/Common.hs +++ b/samples/src/Common.hs @@ -1,25 +1,18 @@ +{-# LANGUAGE NoImplicitPrelude #-} module Common ( -- * Common stuff getAuth, tshow, -- * Re-exports - (<>), - fromString, - Text, putStrLn, getArgs, Proxy(..), - module Prelude.Compat, + module GitHub.Internal.Prelude, ) where -import Prelude () -import Prelude.Compat hiding (putStrLn) +import GitHub.Internal.Prelude hiding (putStrLn) -import Data.Monoid ((<>)) import Data.Proxy (Proxy (..)) -import Data.String (fromString) -import Data.String (fromString) -import Data.Text (Text) import Data.Text.IO (putStrLn) import System.Environment (lookupEnv) import System.Environment (getArgs) diff --git a/src/GitHub/Auth.hs b/src/GitHub/Auth.hs index 09475664..dd56de97 100644 --- a/src/GitHub/Auth.hs +++ b/src/GitHub/Auth.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -7,12 +5,7 @@ -- module GitHub.Auth where -import Control.DeepSeq (NFData (..)) -import Control.DeepSeq.Generics (genericRnf) -import Data.Binary (Binary) -import Data.Data (Data, Typeable) -import Data.Hashable (Hashable) -import GHC.Generics (Generic) +import GitHub.Internal.Prelude import qualified Data.ByteString as BS diff --git a/src/GitHub/Data.hs b/src/GitHub/Data.hs index 65c48289..235558ba 100644 --- a/src/GitHub/Data.hs +++ b/src/GitHub/Data.hs @@ -1,6 +1,4 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -49,10 +47,7 @@ module GitHub.Data ( module GitHub.Data.Webhooks, ) where -import Prelude () -import Prelude.Compat - -import Data.Text (Text) +import GitHub.Internal.Prelude import GitHub.Auth import GitHub.Data.Activities diff --git a/src/GitHub/Data/Activities.hs b/src/GitHub/Data/Activities.hs index 21e46ad5..4e62c32f 100644 --- a/src/GitHub/Data/Activities.hs +++ b/src/GitHub/Data/Activities.hs @@ -1,6 +1,3 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -8,18 +5,8 @@ -- module GitHub.Data.Activities where -import Prelude () -import Prelude.Compat - -import Control.DeepSeq (NFData (..)) -import Control.DeepSeq.Generics (genericRnf) -import Data.Aeson.Compat (FromJSON (..), withObject, (.:)) -import Data.Binary (Binary) -import Data.Data (Data, Typeable) -import Data.Time (UTCTime) -import GHC.Generics (Generic) - -import GitHub.Data.Repos (Repo) +import GitHub.Data.Repos (Repo) +import GitHub.Internal.Prelude data RepoStarred = RepoStarred { repoStarredStarredAt :: !UTCTime diff --git a/src/GitHub/Data/Comments.hs b/src/GitHub/Data/Comments.hs index 61cbfca6..5983cb0e 100644 --- a/src/GitHub/Data/Comments.hs +++ b/src/GitHub/Data/Comments.hs @@ -1,6 +1,3 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -8,21 +5,9 @@ -- module GitHub.Data.Comments where -import Prelude () -import Prelude.Compat - -import Control.DeepSeq (NFData (..)) -import Control.DeepSeq.Generics (genericRnf) -import Data.Aeson.Compat (FromJSON (..), ToJSON (..), object, withObject, - (.:), (.:?), (.=)) -import Data.Binary.Orphans (Binary) -import Data.Data (Data, Typeable) -import Data.Text (Text) -import Data.Time (UTCTime) -import GHC.Generics (Generic) - import GitHub.Data.Definitions import GitHub.Data.Id +import GitHub.Internal.Prelude data Comment = Comment { commentPosition :: !(Maybe Int) diff --git a/src/GitHub/Data/Content.hs b/src/GitHub/Data/Content.hs index 14519a5e..5fee96a4 100644 --- a/src/GitHub/Data/Content.hs +++ b/src/GitHub/Data/Content.hs @@ -1,6 +1,3 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -8,20 +5,7 @@ -- module GitHub.Data.Content where -import Prelude () -import Prelude.Compat - -import Control.DeepSeq (NFData (..)) -import Control.DeepSeq.Generics (genericRnf) -import Data.Aeson.Compat (FromJSON (..), Value (..), withObject, - withText, (.:)) -import Data.Binary.Orphans (Binary) -import Data.Data (Data, Typeable) -import Data.Text (Text) -import Data.Vector (Vector) -import GHC.Generics (Generic) - -import qualified Data.Text as T +import GitHub.Internal.Prelude data Content = ContentFile !ContentFileData @@ -91,7 +75,7 @@ instance FromJSON ContentItemType where case t of "file" -> return ItemFile "dir" -> return ItemDir - _ -> fail $ "Invalid ContentItemType: " ++ T.unpack t + _ -> fail $ "Invalid ContentItemType: " ++ unpack t instance FromJSON ContentInfo where parseJSON = withObject "ContentInfo" $ \o -> diff --git a/src/GitHub/Data/Definitions.hs b/src/GitHub/Data/Definitions.hs index a652e670..0a3f022b 100644 --- a/src/GitHub/Data/Definitions.hs +++ b/src/GitHub/Data/Definitions.hs @@ -1,6 +1,3 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause diff --git a/src/GitHub/Data/Gists.hs b/src/GitHub/Data/Gists.hs index 53fc6cb4..0da92af8 100644 --- a/src/GitHub/Data/Gists.hs +++ b/src/GitHub/Data/Gists.hs @@ -1,6 +1,3 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -8,23 +5,11 @@ -- module GitHub.Data.Gists where -import Prelude () -import Prelude.Compat - import GitHub.Data.Definitions import GitHub.Data.Id (Id) import GitHub.Data.Name (Name) import GitHub.Data.Repos (Language) - -import Control.DeepSeq (NFData (..)) -import Control.DeepSeq.Generics (genericRnf) -import Data.Aeson.Compat (FromJSON (..), withObject, (.:), (.:?)) -import Data.Binary (Binary) -import Data.Data (Data, Typeable) -import Data.HashMap.Strict (HashMap) -import Data.Text (Text) -import Data.Time (UTCTime) -import GHC.Generics (Generic) +import GitHub.Internal.Prelude data Gist = Gist { gistUser :: !SimpleUser diff --git a/src/GitHub/Data/GitData.hs b/src/GitHub/Data/GitData.hs index 5a9012a8..f49b4b8a 100644 --- a/src/GitHub/Data/GitData.hs +++ b/src/GitHub/Data/GitData.hs @@ -1,6 +1,3 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -8,22 +5,9 @@ -- module GitHub.Data.GitData where -import Prelude () -import Prelude.Compat - import GitHub.Data.Definitions import GitHub.Data.Name (Name) - -import Control.DeepSeq (NFData (..)) -import Control.DeepSeq.Generics (genericRnf) -import Data.Aeson.Compat (FromJSON (..), ToJSON (..), object, withObject, - (.!=), (.:), (.:?), (.=)) -import Data.Binary (Binary) -import Data.Data (Data, Typeable) -import Data.Text (Text) -import Data.Time (UTCTime) -import Data.Vector (Vector) -import GHC.Generics (Generic) +import GitHub.Internal.Prelude import qualified Data.Vector as V diff --git a/src/GitHub/Data/Id.hs b/src/GitHub/Data/Id.hs index bda2976c..e584c86e 100644 --- a/src/GitHub/Data/Id.hs +++ b/src/GitHub/Data/Id.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -11,12 +9,7 @@ module GitHub.Data.Id ( untagId, ) where -import Control.DeepSeq (NFData (..)) -import Data.Aeson.Compat (FromJSON (..), ToJSON (..)) -import Data.Binary (Binary) -import Data.Data (Data, Typeable) -import Data.Hashable (Hashable) -import GHC.Generics (Generic) +import GitHub.Internal.Prelude -- | Numeric identifier. newtype Id entity = Id Int diff --git a/src/GitHub/Data/Issues.hs b/src/GitHub/Data/Issues.hs index 15a931c4..c11b1cec 100644 --- a/src/GitHub/Data/Issues.hs +++ b/src/GitHub/Data/Issues.hs @@ -1,6 +1,3 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -8,23 +5,10 @@ -- module GitHub.Data.Issues where -import Prelude () -import Prelude.Compat - import GitHub.Data.Definitions import GitHub.Data.Id (Id) import GitHub.Data.PullRequests - -import Control.DeepSeq (NFData (..)) -import Control.DeepSeq.Generics (genericRnf) -import Data.Aeson.Compat (FromJSON (..), ToJSON (..), Value (..), object, - withObject, (.:), (.:?), (.=)) -import Data.Binary (Binary) -import Data.Data (Data, Typeable) -import Data.Text (Text) -import Data.Time (UTCTime) -import Data.Vector (Vector) -import GHC.Generics (Generic) +import GitHub.Internal.Prelude data Issue = Issue { issueClosedAt :: Maybe UTCTime diff --git a/src/GitHub/Data/Name.hs b/src/GitHub/Data/Name.hs index 024f7175..43f48734 100644 --- a/src/GitHub/Data/Name.hs +++ b/src/GitHub/Data/Name.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -11,14 +9,7 @@ module GitHub.Data.Name ( untagName, ) where -import Control.DeepSeq (NFData (..)) -import Data.Aeson.Compat (FromJSON (..), ToJSON (..)) -import Data.Binary.Orphans (Binary) -import Data.Data (Data, Typeable) -import Data.Hashable (Hashable) -import Data.String (IsString (..)) -import Data.Text (Text) -import GHC.Generics (Generic) +import GitHub.Internal.Prelude newtype Name entity = N Text deriving (Eq, Ord, Show, Generic, Typeable, Data) diff --git a/src/GitHub/Data/PullRequests.hs b/src/GitHub/Data/PullRequests.hs index f7915881..9e6746e3 100644 --- a/src/GitHub/Data/PullRequests.hs +++ b/src/GitHub/Data/PullRequests.hs @@ -1,6 +1,3 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -31,25 +28,11 @@ module GitHub.Data.PullRequests ( setPullRequestOptionsBase, ) where -import Prelude () -import Prelude.Compat - import GitHub.Data.Definitions import GitHub.Data.Id (Id) import GitHub.Data.Repos (Repo) import GitHub.Data.URL (URL) - -import Control.DeepSeq (NFData (..)) -import Control.DeepSeq.Generics (genericRnf) -import Data.Aeson.Compat (FromJSON (..), ToJSON (..), Value (..), object, - withObject, (.!=), (.:), (.:?), (.=)) -import Data.Aeson.Types (typeMismatch) -import Data.Binary.Orphans (Binary) -import Data.Data (Data, Typeable) -import Data.Maybe (catMaybes) -import Data.Text (Text) -import Data.Time (UTCTime) -import GHC.Generics (Generic) +import GitHub.Internal.Prelude import qualified Data.Text.Encoding as TE diff --git a/src/GitHub/Data/Repos.hs b/src/GitHub/Data/Repos.hs index c0dc54ef..4f7e9ede 100644 --- a/src/GitHub/Data/Repos.hs +++ b/src/GitHub/Data/Repos.hs @@ -1,8 +1,5 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE OverloadedStrings #-} #define UNSAFE 1 ----------------------------------------------------------------------------- -- | @@ -14,25 +11,10 @@ -- orphan-ish instance. module GitHub.Data.Repos where -import Prelude () -import Prelude.Compat - import GitHub.Data.Definitions import GitHub.Data.Id (Id) import GitHub.Data.Name (Name) - ---import Control.Arrow (first) -- Data.Bifunctor would be better -import Control.DeepSeq (NFData (..)) -import Control.DeepSeq.Generics (genericRnf) -import Data.Aeson.Compat (FromJSON (..), ToJSON (..), object, withObject, - withText, (.:), (.:?), (.=)) -import Data.Binary (Binary) -import Data.Data (Data, Typeable) -import Data.Hashable (Hashable (..)) -import Data.String (IsString (..)) -import Data.Text (Text) -import Data.Time (UTCTime) -import GHC.Generics (Generic) +import GitHub.Internal.Prelude import qualified Data.HashMap.Strict as HM diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs index 4f60c293..e13368e8 100644 --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -1,11 +1,7 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE StandaloneDeriving #-} ----------------------------------------------------------------------------- -- | @@ -25,21 +21,15 @@ module GitHub.Data.Request ( Count, ) where -import Data.Aeson.Compat (FromJSON) -import Data.Hashable (Hashable (..)) -import Data.Typeable (Typeable) -import Data.Vector (Vector) -import GHC.Generics (Generic) +import GitHub.Internal.Prelude +import GitHub.Data.Definitions (Count, QueryString) +import GitHub.Data.Id (Id, untagId) +import GitHub.Data.Name (Name, untagName) import qualified Data.ByteString.Lazy as LBS import qualified Data.Text as T import qualified Network.HTTP.Types as Types import qualified Network.HTTP.Types.Method as Method - -import GitHub.Data.Definitions (Count, QueryString) -import GitHub.Data.Id (Id, untagId) -import GitHub.Data.Name (Name, untagName) - ------------------------------------------------------------------------------ -- Auxillary types ------------------------------------------------------------------------------ diff --git a/src/GitHub/Data/Search.hs b/src/GitHub/Data/Search.hs index c2c46198..6d0924ba 100644 --- a/src/GitHub/Data/Search.hs +++ b/src/GitHub/Data/Search.hs @@ -1,6 +1,3 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -8,19 +5,8 @@ -- module GitHub.Data.Search where -import Prelude () -import Prelude.Compat - import GitHub.Data.Repos (Repo) - -import Control.DeepSeq (NFData (..)) -import Control.DeepSeq.Generics (genericRnf) -import Data.Aeson.Compat (FromJSON (..), withObject, (.!=), (.:), (.:?)) -import Data.Binary (Binary) -import Data.Data (Data, Typeable) -import Data.Text (Text) -import Data.Vector (Vector) -import GHC.Generics (Generic) +import GitHub.Internal.Prelude import qualified Data.Vector as V diff --git a/src/GitHub/Data/Teams.hs b/src/GitHub/Data/Teams.hs index 694288a9..cb883864 100644 --- a/src/GitHub/Data/Teams.hs +++ b/src/GitHub/Data/Teams.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | @@ -8,24 +9,11 @@ -- module GitHub.Data.Teams where -import Prelude () -import Prelude.Compat - import GitHub.Data.Definitions - -import Control.DeepSeq (NFData (..)) -import Control.DeepSeq.Generics (genericRnf) -import Data.Aeson.Compat (FromJSON (..), ToJSON (..), Value (..), object, - withObject, (.!=), (.:), (.:?), (.=)) -import Data.Binary (Binary) -import Data.Data (Data, Typeable) -import Data.Text (Text) -import Data.Vector (Vector) -import GHC.Generics (Generic) - -import GitHub.Data.Id (Id) -import GitHub.Data.Name (Name) -import GitHub.Data.Repos (Repo) +import GitHub.Data.Id (Id) +import GitHub.Data.Name (Name) +import GitHub.Data.Repos (Repo) +import GitHub.Internal.Prelude data Privacy = PrivacyClosed diff --git a/src/GitHub/Data/URL.hs b/src/GitHub/Data/URL.hs index 9ab236df..5dea2a7e 100644 --- a/src/GitHub/Data/URL.hs +++ b/src/GitHub/Data/URL.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -10,16 +8,7 @@ module GitHub.Data.URL ( getUrl, ) where -import Prelude () -import Prelude.Compat - -import Control.DeepSeq (NFData (..)) -import Control.DeepSeq.Generics (genericRnf) -import Data.Aeson.Compat (FromJSON (..), ToJSON (..), withText) -import Data.Binary.Orphans (Binary) -import Data.Data (Data, Typeable) -import Data.Text (Text) -import GHC.Generics (Generic) +import GitHub.Internal.Prelude -- | Data representing URLs in responses. -- diff --git a/src/GitHub/Data/Webhooks.hs b/src/GitHub/Data/Webhooks.hs index b52b867d..dbc5695a 100644 --- a/src/GitHub/Data/Webhooks.hs +++ b/src/GitHub/Data/Webhooks.hs @@ -1,6 +1,3 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -8,21 +5,8 @@ -- module GitHub.Data.Webhooks where -import Prelude () -import Prelude.Compat - -import GitHub.Data.Id (Id) - -import Control.DeepSeq (NFData (..)) -import Control.DeepSeq.Generics (genericRnf) -import Data.Aeson.Compat (FromJSON (..), ToJSON (..), Value (..), object, - withObject, (.:), (.=)) -import Data.Binary.Orphans (Binary) -import Data.Data (Data, Typeable) -import Data.Text (Text) -import Data.Time (UTCTime) -import Data.Vector (Vector) -import GHC.Generics (Generic) +import GitHub.Data.Id (Id) +import GitHub.Internal.Prelude import qualified Data.Map as M diff --git a/src/GitHub/Data/Webhooks/Validate.hs b/src/GitHub/Data/Webhooks/Validate.hs index 3915fbbc..b8e8fe9b 100644 --- a/src/GitHub/Data/Webhooks/Validate.hs +++ b/src/GitHub/Data/Webhooks/Validate.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -11,14 +9,11 @@ module GitHub.Data.Webhooks.Validate ( isValidPayload ) where -import Prelude () -import Prelude.Compat +import GitHub.Internal.Prelude import Crypto.Hash (HMAC, SHA1, hmac, hmacGetDigest) import Data.Byteable (constEqBytes, toBytes) import Data.ByteString (ByteString) -import Data.Monoid ((<>)) -import Data.Text (Text) import qualified Data.ByteString.Base16 as Hex import qualified Data.Text.Encoding as TE diff --git a/src/GitHub/Endpoints/Activity/Starring.hs b/src/GitHub/Endpoints/Activity/Starring.hs index 0b7c5ea0..d08645b2 100644 --- a/src/GitHub/Endpoints/Activity/Starring.hs +++ b/src/GitHub/Endpoints/Activity/Starring.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -19,10 +17,10 @@ module GitHub.Endpoints.Activity.Starring ( module GitHub.Data, ) where -import Data.Vector (Vector) import GitHub.Auth import GitHub.Data import GitHub.Request +import GitHub.Internal.Prelude -- | The list of users that have starred the specified Github repo. -- diff --git a/src/GitHub/Endpoints/Activity/Watching.hs b/src/GitHub/Endpoints/Activity/Watching.hs index f128832d..95ab457e 100644 --- a/src/GitHub/Endpoints/Activity/Watching.hs +++ b/src/GitHub/Endpoints/Activity/Watching.hs @@ -15,7 +15,7 @@ module GitHub.Endpoints.Activity.Watching ( module GitHub.Data, ) where -import Data.Vector (Vector) +import GitHub.Internal.Prelude import GitHub.Auth import GitHub.Data import GitHub.Request diff --git a/src/GitHub/Endpoints/Gists.hs b/src/GitHub/Endpoints/Gists.hs index 4aa959dc..ead659ec 100644 --- a/src/GitHub/Endpoints/Gists.hs +++ b/src/GitHub/Endpoints/Gists.hs @@ -14,9 +14,9 @@ module GitHub.Endpoints.Gists ( module GitHub.Data, ) where -import Data.Vector (Vector) import GitHub.Data import GitHub.Request +import GitHub.Internal.Prelude -- | The list of all gists created by the user -- diff --git a/src/GitHub/Endpoints/Gists/Comments.hs b/src/GitHub/Endpoints/Gists/Comments.hs index e7ed852f..1ca8a23c 100644 --- a/src/GitHub/Endpoints/Gists/Comments.hs +++ b/src/GitHub/Endpoints/Gists/Comments.hs @@ -13,10 +13,9 @@ module GitHub.Endpoints.Gists.Comments ( module GitHub.Data, ) where -import Data.Vector (Vector) - import GitHub.Data import GitHub.Request +import GitHub.Internal.Prelude -- | All the comments on a Gist, given the Gist ID. -- diff --git a/src/GitHub/Endpoints/GitData/Blobs.hs b/src/GitHub/Endpoints/GitData/Blobs.hs index f473b09a..b9c3d5dd 100644 --- a/src/GitHub/Endpoints/GitData/Blobs.hs +++ b/src/GitHub/Endpoints/GitData/Blobs.hs @@ -14,6 +14,7 @@ module GitHub.Endpoints.GitData.Blobs ( import GitHub.Data import GitHub.Request +import GitHub.Internal.Prelude -- | Query a blob by SHA1. -- diff --git a/src/GitHub/Endpoints/GitData/Commits.hs b/src/GitHub/Endpoints/GitData/Commits.hs index c4c51ef5..6bdd51d7 100644 --- a/src/GitHub/Endpoints/GitData/Commits.hs +++ b/src/GitHub/Endpoints/GitData/Commits.hs @@ -13,6 +13,7 @@ module GitHub.Endpoints.GitData.Commits ( import GitHub.Data import GitHub.Request +import GitHub.Internal.Prelude -- | A single commit, by SHA1. -- diff --git a/src/GitHub/Endpoints/GitData/References.hs b/src/GitHub/Endpoints/GitData/References.hs index 73418b72..8db53bfc 100644 --- a/src/GitHub/Endpoints/GitData/References.hs +++ b/src/GitHub/Endpoints/GitData/References.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE DataKinds #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -20,11 +19,9 @@ module GitHub.Endpoints.GitData.References ( module GitHub.Data, ) where -import Data.Aeson.Compat (encode) -import Data.Vector (Vector) - import GitHub.Data import GitHub.Request +import GitHub.Internal.Prelude -- | A single reference by the ref name. -- diff --git a/src/GitHub/Endpoints/GitData/Trees.hs b/src/GitHub/Endpoints/GitData/Trees.hs index 661737a0..fecc3a27 100644 --- a/src/GitHub/Endpoints/GitData/Trees.hs +++ b/src/GitHub/Endpoints/GitData/Trees.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -18,6 +17,7 @@ module GitHub.Endpoints.GitData.Trees ( import GitHub.Data import GitHub.Request +import GitHub.Internal.Prelude -- | A tree for a SHA1. -- diff --git a/src/GitHub/Endpoints/Issues.hs b/src/GitHub/Endpoints/Issues.hs index 50463b16..6ff8f763 100644 --- a/src/GitHub/Endpoints/Issues.hs +++ b/src/GitHub/Endpoints/Issues.hs @@ -1,6 +1,4 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -25,14 +23,9 @@ module GitHub.Endpoints.Issues ( ) where import GitHub.Data +import GitHub.Internal.Prelude import GitHub.Request -import Data.Aeson.Compat (encode) -import Data.List (intercalate) -import Data.Text (Text) -import Data.Time.ISO8601 (formatISO8601) -import Data.Vector (Vector) - import qualified Data.Text as T import qualified Data.Text.Encoding as TE diff --git a/src/GitHub/Endpoints/Issues/Comments.hs b/src/GitHub/Endpoints/Issues/Comments.hs index 20371aee..e12ec595 100644 --- a/src/GitHub/Endpoints/Issues/Comments.hs +++ b/src/GitHub/Endpoints/Issues/Comments.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE DataKinds #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -19,10 +18,7 @@ module GitHub.Endpoints.Issues.Comments ( module GitHub.Data, ) where -import Data.Aeson.Compat (encode) -import Data.Text (Text) -import Data.Vector (Vector) - +import GitHub.Internal.Prelude import GitHub.Data import GitHub.Request diff --git a/src/GitHub/Endpoints/Issues/Events.hs b/src/GitHub/Endpoints/Issues/Events.hs index 3a6f73d4..fe8d4015 100644 --- a/src/GitHub/Endpoints/Issues/Events.hs +++ b/src/GitHub/Endpoints/Issues/Events.hs @@ -18,10 +18,9 @@ module GitHub.Endpoints.Issues.Events ( module GitHub.Data, ) where -import Data.Vector (Vector) - import GitHub.Data import GitHub.Request +import GitHub.Internal.Prelude -- | All events that have happened on an issue. -- diff --git a/src/GitHub/Endpoints/Issues/Labels.hs b/src/GitHub/Endpoints/Issues/Labels.hs index a03bc94c..b7e5192b 100644 --- a/src/GitHub/Endpoints/Issues/Labels.hs +++ b/src/GitHub/Endpoints/Issues/Labels.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause diff --git a/src/GitHub/Endpoints/Issues/Milestones.hs b/src/GitHub/Endpoints/Issues/Milestones.hs index 8e793154..5e4869c6 100644 --- a/src/GitHub/Endpoints/Issues/Milestones.hs +++ b/src/GitHub/Endpoints/Issues/Milestones.hs @@ -14,10 +14,9 @@ module GitHub.Endpoints.Issues.Milestones ( module GitHub.Data, ) where -import Data.Vector (Vector) - import GitHub.Data import GitHub.Request +import GitHub.Internal.Prelude -- | All milestones in the repo. -- diff --git a/src/GitHub/Endpoints/Organizations.hs b/src/GitHub/Endpoints/Organizations.hs index 7421a74d..8bc3f746 100644 --- a/src/GitHub/Endpoints/Organizations.hs +++ b/src/GitHub/Endpoints/Organizations.hs @@ -14,9 +14,9 @@ module GitHub.Endpoints.Organizations ( module GitHub.Data, ) where -import Data.Vector (Vector) import GitHub.Data import GitHub.Request +import GitHub.Internal.Prelude -- | The public organizations for a user, given the user's login, with authorization -- diff --git a/src/GitHub/Endpoints/Organizations/Members.hs b/src/GitHub/Endpoints/Organizations/Members.hs index 1e321f39..333279db 100644 --- a/src/GitHub/Endpoints/Organizations/Members.hs +++ b/src/GitHub/Endpoints/Organizations/Members.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -14,10 +13,9 @@ module GitHub.Endpoints.Organizations.Members ( module GitHub.Data, ) where -import Data.Vector (Vector) - import GitHub.Data import GitHub.Request +import GitHub.Internal.Prelude -- | All the users who are members of the specified organization, -- | with or without authentication. diff --git a/src/GitHub/Endpoints/Organizations/Teams.hs b/src/GitHub/Endpoints/Organizations/Teams.hs index 13178fe9..ff25a8e9 100644 --- a/src/GitHub/Endpoints/Organizations/Teams.hs +++ b/src/GitHub/Endpoints/Organizations/Teams.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -36,14 +34,9 @@ module GitHub.Endpoints.Organizations.Teams ( module GitHub.Data, ) where -import Prelude () -import Prelude.Compat - -import Data.Aeson.Compat (encode) -import Data.Vector (Vector) - import GitHub.Data import GitHub.Request +import GitHub.Internal.Prelude -- | List teams. List the teams of an Owner. -- When authenticated, lists private teams visible to the authenticated user. diff --git a/src/GitHub/Endpoints/PullRequests.hs b/src/GitHub/Endpoints/PullRequests.hs index bd50e32f..2578023e 100644 --- a/src/GitHub/Endpoints/PullRequests.hs +++ b/src/GitHub/Endpoints/PullRequests.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -32,9 +30,7 @@ module GitHub.Endpoints.PullRequests ( import GitHub.Data import GitHub.Request - -import Data.Aeson.Compat (Value, encode, object, (.=)) -import Data.Vector (Vector) +import GitHub.Internal.Prelude -- | All open pull requests for the repo, by owner and repo name. -- diff --git a/src/GitHub/Endpoints/PullRequests/ReviewComments.hs b/src/GitHub/Endpoints/PullRequests/ReviewComments.hs index 9aedce0d..5c6528df 100644 --- a/src/GitHub/Endpoints/PullRequests/ReviewComments.hs +++ b/src/GitHub/Endpoints/PullRequests/ReviewComments.hs @@ -13,9 +13,9 @@ module GitHub.Endpoints.PullRequests.ReviewComments ( module GitHub.Data, ) where -import Data.Vector (Vector) import GitHub.Data import GitHub.Request +import GitHub.Internal.Prelude -- | All the comments on a pull request with the given ID. -- diff --git a/src/GitHub/Endpoints/Repos.hs b/src/GitHub/Endpoints/Repos.hs index 6938d60c..10a6d85d 100644 --- a/src/GitHub/Endpoints/Repos.hs +++ b/src/GitHub/Endpoints/Repos.hs @@ -1,7 +1,3 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -59,16 +55,9 @@ module GitHub.Endpoints.Repos ( module GitHub.Data, ) where -import Prelude () -import Prelude.Compat - -import Control.Applicative ((<|>)) -import Data.Aeson.Compat (encode) -import Data.Text (Text) -import Data.Vector (Vector) - import GitHub.Data import GitHub.Request +import GitHub.Internal.Prelude import qualified Data.Text as T import qualified Data.Text.Encoding as TE diff --git a/src/GitHub/Endpoints/Repos/Collaborators.hs b/src/GitHub/Endpoints/Repos/Collaborators.hs index 732b8068..6753e9fa 100644 --- a/src/GitHub/Endpoints/Repos/Collaborators.hs +++ b/src/GitHub/Endpoints/Repos/Collaborators.hs @@ -14,9 +14,9 @@ module GitHub.Endpoints.Repos.Collaborators ( module GitHub.Data, ) where -import Data.Vector (Vector) import GitHub.Data import GitHub.Request +import GitHub.Internal.Prelude -- | All the users who have collaborated on a repo. -- diff --git a/src/GitHub/Endpoints/Repos/Comments.hs b/src/GitHub/Endpoints/Repos/Comments.hs index bcc13a1c..30db12ab 100644 --- a/src/GitHub/Endpoints/Repos/Comments.hs +++ b/src/GitHub/Endpoints/Repos/Comments.hs @@ -19,9 +19,9 @@ module GitHub.Endpoints.Repos.Comments ( module GitHub.Data, ) where -import Data.Vector (Vector) import GitHub.Data import GitHub.Request +import GitHub.Internal.Prelude -- | All the comments on a Github repo. -- diff --git a/src/GitHub/Endpoints/Repos/Commits.hs b/src/GitHub/Endpoints/Repos/Commits.hs index 28baa0c2..01b971bc 100644 --- a/src/GitHub/Endpoints/Repos/Commits.hs +++ b/src/GitHub/Endpoints/Repos/Commits.hs @@ -1,5 +1,4 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -24,16 +23,14 @@ module GitHub.Endpoints.Repos.Commits ( module GitHub.Data, ) where -import Data.Time.ISO8601 (formatISO8601) -import Data.Vector (Vector) +import GitHub.Internal.Prelude +import GitHub.Data +import GitHub.Request import qualified Data.ByteString as BS import qualified Data.Text as T import qualified Data.Text.Encoding as TE -import GitHub.Data -import GitHub.Request - renderCommitQueryOption :: CommitQueryOption -> (BS.ByteString, Maybe BS.ByteString) renderCommitQueryOption (CommitQuerySha sha) = ("sha", Just $ TE.encodeUtf8 sha) renderCommitQueryOption (CommitQueryPath path) = ("path", Just $ TE.encodeUtf8 path) diff --git a/src/GitHub/Endpoints/Repos/Forks.hs b/src/GitHub/Endpoints/Repos/Forks.hs index 779b6c89..76be374d 100644 --- a/src/GitHub/Endpoints/Repos/Forks.hs +++ b/src/GitHub/Endpoints/Repos/Forks.hs @@ -12,9 +12,9 @@ module GitHub.Endpoints.Repos.Forks ( module GitHub.Data, ) where -import Data.Vector (Vector) import GitHub.Data import GitHub.Request +import GitHub.Internal.Prelude -- | All the repos that are forked off the given repo. -- diff --git a/src/GitHub/Endpoints/Repos/Webhooks.hs b/src/GitHub/Endpoints/Repos/Webhooks.hs index b8d1abe8..39f4d762 100644 --- a/src/GitHub/Endpoints/Repos/Webhooks.hs +++ b/src/GitHub/Endpoints/Repos/Webhooks.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE DataKinds #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -33,14 +32,9 @@ module GitHub.Endpoints.Repos.Webhooks ( deleteRepoWebhookR, ) where -import Prelude () -import Prelude.Compat - -import Data.Aeson.Compat (encode) -import Data.Vector (Vector) - import GitHub.Data import GitHub.Request +import GitHub.Internal.Prelude webhooksFor' :: Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector RepoWebhook)) webhooksFor' auth user repo = diff --git a/src/GitHub/Endpoints/Search.hs b/src/GitHub/Endpoints/Search.hs index e92230a9..41d62d74 100644 --- a/src/GitHub/Endpoints/Search.hs +++ b/src/GitHub/Endpoints/Search.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -19,12 +18,11 @@ module GitHub.Endpoints.Search( module GitHub.Data, ) where -import Data.Text (Text) - -import qualified Data.Text.Encoding as TE - import GitHub.Data import GitHub.Request +import GitHub.Internal.Prelude + +import qualified Data.Text.Encoding as TE -- | Perform a repository search. -- With authentication. diff --git a/src/GitHub/Endpoints/Users.hs b/src/GitHub/Endpoints/Users.hs index 19876dab..477a121a 100644 --- a/src/GitHub/Endpoints/Users.hs +++ b/src/GitHub/Endpoints/Users.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE DataKinds #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -18,6 +17,7 @@ module GitHub.Endpoints.Users ( import GitHub.Data import GitHub.Request +import GitHub.Internal.Prelude -- | The information for a single user, by login name. -- With authentification diff --git a/src/GitHub/Endpoints/Users/Followers.hs b/src/GitHub/Endpoints/Users/Followers.hs index bc255310..719a85d6 100644 --- a/src/GitHub/Endpoints/Users/Followers.hs +++ b/src/GitHub/Endpoints/Users/Followers.hs @@ -13,10 +13,9 @@ module GitHub.Endpoints.Users.Followers ( module GitHub.Data, ) where -import Data.Vector (Vector) - import GitHub.Data import GitHub.Request +import GitHub.Internal.Prelude -- | All the users following the given user. -- diff --git a/src/GitHub/Internal/Prelude.hs b/src/GitHub/Internal/Prelude.hs new file mode 100644 index 00000000..39c95fb8 --- /dev/null +++ b/src/GitHub/Internal/Prelude.hs @@ -0,0 +1,59 @@ +{-# LANGUAGE NoImplicitPrelude #-} +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +-- This module may change between minor releases. Do not rely on it contents. +module GitHub.Internal.Prelude ( + module Prelude.Compat, + -- * Commonly used types + UTCTime, + HashMap, + Text, pack, unpack, + Vector, + -- * Commonly used typeclasses + Binary, + Data, Typeable, + Generic, + Hashable(..), + IsString(..), + NFData(..), genericRnf, + Semigroup(..), + -- * Aeson + FromJSON(..), ToJSON(..), Value(..), + encode, + withText, withObject, (.:), (.:?), (.!=), (.=), object, typeMismatch, + -- * Control.Applicative + (<|>), + -- * Data.Maybe + catMaybes, + -- * Data.List + intercalate, + -- * Data.Time.ISO8601 + formatISO8601, + ) where + +import Control.Applicative ((<|>)) +import Control.DeepSeq (NFData (..)) +import Control.DeepSeq.Generics (genericRnf) +import Data.Aeson.Compat (FromJSON (..), ToJSON (..), Value (..), encode, + object, withObject, withText, (.!=), (.:), + (.:?), (.=)) +import Data.Aeson.Types (typeMismatch) +import Data.Binary (Binary) +import Data.Binary.Orphans () +import Data.Data (Data, Typeable) +import Data.Hashable (Hashable (..)) +import Data.HashMap.Strict (HashMap) +import Data.List (intercalate) +import Data.Maybe (catMaybes) +import Data.Semigroup (Semigroup (..)) +import Data.String (IsString (..)) +import Data.Text (Text, pack, unpack) +import Data.Time (UTCTime) +import Data.Time.ISO8601 (formatISO8601) +import Data.Vector (Vector) +import Data.Vector.Instances () +import GHC.Generics (Generic) +import Prelude.Compat diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index 146d20fb..a27f8e8f 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -1,12 +1,7 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} ----------------------------------------------------------------------------- -- | @@ -54,8 +49,7 @@ module GitHub.Request ( performPagedRequest, ) where -import Prelude () -import Prelude.Compat +import GitHub.Internal.Prelude #if MIN_VERSION_mtl(2,2,0) import Control.Monad.Except (MonadError (..)) @@ -66,11 +60,8 @@ import Control.Monad.Error (MonadError (..)) import Control.Monad.Catch (MonadCatch (..), MonadThrow) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Except (ExceptT (..), runExceptT) -import Data.Aeson.Compat (FromJSON, eitherDecode) -import Data.List (find, intercalate) -import Data.Semigroup (Semigroup (..)) -import Data.Text (Text) -import Data.Vector.Instances () +import Data.Aeson.Compat (eitherDecode) +import Data.List (find) import Network.HTTP.Client (CookieJar, HttpException (..), Manager, RequestBody (..), Response (..), From 802dd5491bdd2f564f9fedcdb8cb75c881c28dc0 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 23 May 2016 22:17:08 +0300 Subject: [PATCH 211/510] URL type for all *Url fields --- samples/Users/ShowUser.hs | 2 +- src/GitHub/Data/Comments.hs | 7 +++-- src/GitHub/Data/Content.hs | 7 +++-- src/GitHub/Data/Definitions.hs | 51 ++++++++++++++------------------- src/GitHub/Data/Gists.hs | 13 +++++---- src/GitHub/Data/GitData.hs | 35 +++++++++++----------- src/GitHub/Data/Issues.hs | 17 +++++------ src/GitHub/Data/PullRequests.hs | 10 +++---- src/GitHub/Data/Repos.hs | 17 +++++------ src/GitHub/Data/Request.hs | 2 +- src/GitHub/Data/Search.hs | 9 +++--- src/GitHub/Data/Teams.hs | 15 +++++----- src/GitHub/Data/Webhooks.hs | 5 ++-- src/GitHub/Internal/Prelude.hs | 8 +++--- 14 files changed, 99 insertions(+), 99 deletions(-) diff --git a/samples/Users/ShowUser.hs b/samples/Users/ShowUser.hs index b9c5d433..d5b8f09a 100644 --- a/samples/Users/ShowUser.hs +++ b/samples/Users/ShowUser.hs @@ -20,7 +20,7 @@ formatUser user = (formatName userName login) <> "\t" <> (fromMaybe "" company) <> "\t" <> (fromMaybe "" location) <> "\n" <> (fromMaybe "" blog) <> "\t" <> "<" <> (fromMaybe "" email) <> ">" <> "\n" <> - htmlUrl <> "\t" <> tshow createdAt <> "\n" <> + GitHub.getUrl htmlUrl <> "\t" <> tshow createdAt <> "\n" <> "hireable: " <> formatHireable (fromMaybe False isHireable) <> "\n\n" <> (fromMaybe "" bio) where diff --git a/src/GitHub/Data/Comments.hs b/src/GitHub/Data/Comments.hs index 5983cb0e..c257d5e0 100644 --- a/src/GitHub/Data/Comments.hs +++ b/src/GitHub/Data/Comments.hs @@ -6,7 +6,8 @@ module GitHub.Data.Comments where import GitHub.Data.Definitions -import GitHub.Data.Id +import GitHub.Data.Id (Id) +import GitHub.Data.URL (URL) import GitHub.Internal.Prelude data Comment = Comment { @@ -15,8 +16,8 @@ data Comment = Comment { ,commentBody :: !Text ,commentCommitId :: !(Maybe Text) ,commentUpdatedAt :: !UTCTime - ,commentHtmlUrl :: !(Maybe Text) - ,commentUrl :: !Text + ,commentHtmlUrl :: !(Maybe URL) + ,commentUrl :: !URL ,commentCreatedAt :: !(Maybe UTCTime) ,commentPath :: !(Maybe Text) ,commentUser :: !SimpleUser diff --git a/src/GitHub/Data/Content.hs b/src/GitHub/Data/Content.hs index 5fee96a4..4347aab3 100644 --- a/src/GitHub/Data/Content.hs +++ b/src/GitHub/Data/Content.hs @@ -5,6 +5,7 @@ -- module GitHub.Data.Content where +import GitHub.Data.URL import GitHub.Internal.Prelude data Content @@ -45,9 +46,9 @@ data ContentInfo = ContentInfo { contentName :: !Text ,contentPath :: !Text ,contentSha :: !Text - ,contentUrl :: !Text - ,contentGitUrl :: !Text - ,contentHtmlUrl :: !Text + ,contentUrl :: !URL + ,contentGitUrl :: !URL + ,contentHtmlUrl :: !URL } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData ContentInfo where rnf = genericRnf diff --git a/src/GitHub/Data/Definitions.hs b/src/GitHub/Data/Definitions.hs index 0a3f022b..8b64b405 100644 --- a/src/GitHub/Data/Definitions.hs +++ b/src/GitHub/Data/Definitions.hs @@ -5,28 +5,19 @@ -- module GitHub.Data.Definitions where -import Prelude () -import Prelude.Compat - -import Control.DeepSeq (NFData (..)) -import Control.DeepSeq.Generics (genericRnf) -import Control.Monad (mfilter) -import Data.Aeson.Compat (FromJSON (..), Object, withObject, withText, - (.:), (.:?)) -import Data.Aeson.Types (Parser) -import Data.Binary.Orphans (Binary) -import Data.Data (Data, Typeable) -import Data.Text (Text) -import Data.Time (UTCTime) -import GHC.Generics (Generic) -import Network.HTTP.Client (HttpException) +import GitHub.Internal.Prelude + +import Control.Monad (mfilter) +import Data.Aeson.Types (Parser) +import Network.HTTP.Client (HttpException) import qualified Control.Exception as E -import qualified Data.Text as T import qualified Data.ByteString as BS +import qualified Data.Text as T -import GitHub.Data.Id -import GitHub.Data.Name +import GitHub.Data.Id (Id) +import GitHub.Data.Name (Name) +import GitHub.Data.URL (URL) -- | Errors have been tagged according to their source, so you can more easily -- dispatch and handle them. @@ -49,8 +40,8 @@ instance Binary OwnerType data SimpleUser = SimpleUser { simpleUserId :: !(Id User) , simpleUserLogin :: !(Name User) - , simpleUserAvatarUrl :: !Text - , simpleUserUrl :: !Text + , simpleUserAvatarUrl :: !URL + , simpleUserUrl :: !URL , simpleUserType :: !OwnerType -- ^ Should always be 'OwnerUser' } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -61,8 +52,8 @@ instance Binary SimpleUser data SimpleOrganization = SimpleOrganization { simpleOrganizationId :: !(Id Organization) , simpleOrganizationLogin :: !(Name Organization) - , simpleOrganizationUrl :: !Text - , simpleOrganizationAvatarUrl :: !Text + , simpleOrganizationUrl :: !URL + , simpleOrganizationAvatarUrl :: !URL } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -73,8 +64,8 @@ instance Binary SimpleOrganization data SimpleOwner = SimpleOwner { simpleOwnerId :: !(Id Owner) , simpleOwnerLogin :: !(Name Owner) - , simpleOwnerUrl :: !Text - , simpleOwnerAvatarUrl :: !Text + , simpleOwnerUrl :: !URL + , simpleOwnerAvatarUrl :: !URL , simpleOwnerType :: !OwnerType } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -89,7 +80,7 @@ data User = User , userType :: !OwnerType -- ^ Should always be 'OwnerUser' , userCreatedAt :: !UTCTime , userPublicGists :: !Int - , userAvatarUrl :: !Text + , userAvatarUrl :: !URL , userFollowers :: !Int , userFollowing :: !Int , userHireable :: !(Maybe Bool) @@ -99,8 +90,8 @@ data User = User , userLocation :: !(Maybe Text) , userCompany :: !(Maybe Text) , userEmail :: !(Maybe Text) - , userUrl :: !Text - , userHtmlUrl :: !Text + , userUrl :: !URL + , userHtmlUrl :: !URL } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -116,13 +107,13 @@ data Organization = Organization , organizationLocation :: !(Maybe Text) , organizationFollowers :: !Int , organizationCompany :: !(Maybe Text) - , organizationAvatarUrl :: !Text + , organizationAvatarUrl :: !URL , organizationPublicGists :: !Int - , organizationHtmlUrl :: !Text + , organizationHtmlUrl :: !URL , organizationEmail :: !(Maybe Text) , organizationFollowing :: !Int , organizationPublicRepos :: !Int - , organizationUrl :: !Text + , organizationUrl :: !URL , organizationCreatedAt :: !UTCTime } deriving (Show, Data, Typeable, Eq, Ord, Generic) diff --git a/src/GitHub/Data/Gists.hs b/src/GitHub/Data/Gists.hs index 0da92af8..60e380c2 100644 --- a/src/GitHub/Data/Gists.hs +++ b/src/GitHub/Data/Gists.hs @@ -9,21 +9,22 @@ import GitHub.Data.Definitions import GitHub.Data.Id (Id) import GitHub.Data.Name (Name) import GitHub.Data.Repos (Language) +import GitHub.Data.URL (URL) import GitHub.Internal.Prelude data Gist = Gist { gistUser :: !SimpleUser - ,gistGitPushUrl :: !Text - ,gistUrl :: !Text + ,gistGitPushUrl :: !URL + ,gistUrl :: !URL ,gistDescription :: !(Maybe Text) ,gistCreatedAt :: !UTCTime ,gistPublic :: !Bool ,gistComments :: !Int ,gistUpdatedAt :: !UTCTime - ,gistHtmlUrl :: !Text + ,gistHtmlUrl :: !URL ,gistId :: !(Name Gist) ,gistFiles :: !(HashMap Text GistFile) - ,gistGitPullUrl :: !Text + ,gistGitPullUrl :: !URL } deriving (Show, Data, Typeable, Eq, Generic) instance NFData Gist where rnf = genericRnf @@ -46,7 +47,7 @@ instance FromJSON Gist where data GistFile = GistFile { gistFileType :: !Text - ,gistFileRawUrl :: !Text + ,gistFileRawUrl :: !URL ,gistFileSize :: !Int ,gistFileLanguage :: !(Maybe Language) ,gistFileFilename :: !Text @@ -67,7 +68,7 @@ instance FromJSON GistFile where data GistComment = GistComment { gistCommentUser :: !SimpleUser - ,gistCommentUrl :: !Text + ,gistCommentUrl :: !URL ,gistCommentCreatedAt :: !UTCTime ,gistCommentBody :: !Text ,gistCommentUpdatedAt :: !UTCTime diff --git a/src/GitHub/Data/GitData.hs b/src/GitHub/Data/GitData.hs index f49b4b8a..1bc582fc 100644 --- a/src/GitHub/Data/GitData.hs +++ b/src/GitHub/Data/GitData.hs @@ -7,6 +7,7 @@ module GitHub.Data.GitData where import GitHub.Data.Definitions import GitHub.Data.Name (Name) +import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import qualified Data.Vector as V @@ -31,7 +32,7 @@ instance Binary Stats data Commit = Commit { commitSha :: !(Name Commit) ,commitParents :: !(Vector Tree) - ,commitUrl :: !Text + ,commitUrl :: !URL ,commitGitCommit :: !GitCommit ,commitCommitter :: !(Maybe SimpleUser) ,commitAuthor :: !(Maybe SimpleUser) @@ -44,7 +45,7 @@ instance Binary Commit data Tree = Tree { treeSha :: !(Name Tree) - ,treeUrl :: !Text + ,treeUrl :: !URL ,treeGitTrees :: !(Vector GitTree) } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -55,7 +56,7 @@ data GitTree = GitTree { gitTreeType :: !Text ,gitTreeSha :: !(Name GitTree) -- Can be empty for submodule - ,gitTreeUrl :: !(Maybe Text) + ,gitTreeUrl :: !(Maybe URL) ,gitTreeSize :: !(Maybe Int) ,gitTreePath :: !Text ,gitTreeMode :: !Text @@ -66,7 +67,7 @@ instance Binary GitTree data GitCommit = GitCommit { gitCommitMessage :: !Text - ,gitCommitUrl :: !Text + ,gitCommitUrl :: !URL ,gitCommitCommitter :: !GitUser ,gitCommitAuthor :: !GitUser ,gitCommitTree :: !Tree @@ -78,7 +79,7 @@ instance NFData GitCommit where rnf = genericRnf instance Binary GitCommit data Blob = Blob { - blobUrl :: !Text + blobUrl :: !URL ,blobEncoding :: !Text ,blobContent :: !Text ,blobSha :: !(Name Blob) @@ -90,8 +91,8 @@ instance Binary Blob data Tag = Tag { tagName :: !Text - ,tagZipballUrl :: !Text - ,tagTarballUrl :: !Text + ,tagZipballUrl :: !URL + ,tagTarballUrl :: !URL ,tagCommit :: !BranchCommit } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -107,7 +108,7 @@ instance NFData Branch where rnf = genericRnf data BranchCommit = BranchCommit { branchCommitSha :: !Text - ,branchCommitUrl :: !Text + ,branchCommitUrl :: !URL } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData BranchCommit where rnf = genericRnf @@ -116,16 +117,16 @@ instance Binary BranchCommit data Diff = Diff { diffStatus :: !Text ,diffBehindBy :: !Int - ,diffPatchUrl :: !Text - ,diffUrl :: !Text + ,diffPatchUrl :: !URL + ,diffUrl :: !URL ,diffBaseCommit :: !Commit ,diffCommits :: !(Vector Commit) ,diffTotalCommits :: !Int - ,diffHtmlUrl :: !Text + ,diffHtmlUrl :: !URL ,diffFiles :: !(Vector File) ,diffAheadBy :: !Int - ,diffDiffUrl :: !Text - ,diffPermalinkUrl :: !Text + ,diffDiffUrl :: !URL + ,diffPermalinkUrl :: !URL } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Diff where rnf = genericRnf @@ -141,7 +142,7 @@ instance Binary NewGitReference data GitReference = GitReference { gitReferenceObject :: !GitObject - ,gitReferenceUrl :: !Text + ,gitReferenceUrl :: !URL ,gitReferenceRef :: !Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -151,7 +152,7 @@ instance Binary GitReference data GitObject = GitObject { gitObjectType :: !Text ,gitObjectSha :: !Text - ,gitObjectUrl :: !Text + ,gitObjectUrl :: !URL } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData GitObject where rnf = genericRnf @@ -167,9 +168,9 @@ instance NFData GitUser where rnf = genericRnf instance Binary GitUser data File = File { - fileBlobUrl :: !Text + fileBlobUrl :: !URL ,fileStatus :: !Text - ,fileRawUrl :: !Text + ,fileRawUrl :: !URL ,fileAdditions :: !Int ,fileSha :: !Text ,fileChanges :: !Int diff --git a/src/GitHub/Data/Issues.hs b/src/GitHub/Data/Issues.hs index c11b1cec..51a8d908 100644 --- a/src/GitHub/Data/Issues.hs +++ b/src/GitHub/Data/Issues.hs @@ -8,13 +8,14 @@ module GitHub.Data.Issues where import GitHub.Data.Definitions import GitHub.Data.Id (Id) import GitHub.Data.PullRequests +import GitHub.Data.URL (URL) import GitHub.Internal.Prelude data Issue = Issue { issueClosedAt :: Maybe UTCTime ,issueUpdatedAt :: UTCTime - ,issueEventsUrl :: Text - ,issueHtmlUrl :: Maybe Text + ,issueEventsUrl :: URL + ,issueHtmlUrl :: Maybe URL ,issueClosedBy :: Maybe SimpleUser ,issueLabels :: (Vector IssueLabel) ,issueNumber :: Int @@ -22,7 +23,7 @@ data Issue = Issue { ,issueUser :: SimpleUser ,issueTitle :: Text ,issuePullRequest :: Maybe PullRequestReference - ,issueUrl :: Text + ,issueUrl :: URL ,issueCreatedAt :: UTCTime ,issueBody :: Maybe Text ,issueState :: Text @@ -65,7 +66,7 @@ data Milestone = Milestone { ,milestoneClosedIssues :: Int ,milestoneDescription :: Maybe Text ,milestoneTitle :: Text - ,milestoneUrl :: Text + ,milestoneUrl :: URL ,milestoneCreatedAt :: UTCTime ,milestoneState :: Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -75,7 +76,7 @@ instance Binary Milestone data IssueLabel = IssueLabel { labelColor :: Text - ,labelUrl :: Text + ,labelUrl :: URL ,labelName :: Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -85,8 +86,8 @@ instance Binary IssueLabel data IssueComment = IssueComment { issueCommentUpdatedAt :: UTCTime ,issueCommentUser :: SimpleUser - ,issueCommentUrl :: Text - ,issueCommentHtmlUrl :: Text + ,issueCommentUrl :: URL + ,issueCommentHtmlUrl :: URL ,issueCommentCreatedAt :: UTCTime ,issueCommentBody :: Text ,issueCommentId :: Int @@ -124,7 +125,7 @@ data Event = Event { eventActor :: !SimpleUser ,eventType :: !EventType ,eventCommitId :: !(Maybe Text) - ,eventUrl :: !Text + ,eventUrl :: !URL ,eventCreatedAt :: !UTCTime ,eventId :: !Int ,eventIssue :: !(Maybe Issue) diff --git a/src/GitHub/Data/PullRequests.hs b/src/GitHub/Data/PullRequests.hs index 9e6746e3..812c866f 100644 --- a/src/GitHub/Data/PullRequests.hs +++ b/src/GitHub/Data/PullRequests.hs @@ -46,7 +46,7 @@ data SimplePullRequest = SimplePullRequest , simplePullRequestHtmlUrl :: !URL , simplePullRequestUpdatedAt :: !UTCTime , simplePullRequestBody :: !Text - , simplePullRequestIssueUrl :: !Text + , simplePullRequestIssueUrl :: !URL , simplePullRequestDiffUrl :: !URL , simplePullRequestUrl :: !URL , simplePullRequestLinks :: !PullRequestLinks @@ -68,7 +68,7 @@ data PullRequest = PullRequest , pullRequestHtmlUrl :: !URL , pullRequestUpdatedAt :: !UTCTime , pullRequestBody :: !Text - , pullRequestIssueUrl :: !Text + , pullRequestIssueUrl :: !URL , pullRequestDiffUrl :: !URL , pullRequestUrl :: !URL , pullRequestLinks :: !PullRequestLinks @@ -165,9 +165,9 @@ instance NFData PullRequestEventType where rnf = genericRnf instance Binary PullRequestEventType data PullRequestReference = PullRequestReference - { pullRequestReferenceHtmlUrl :: !(Maybe Text) - , pullRequestReferencePatchUrl :: !(Maybe Text) - , pullRequestReferenceDiffUrl :: !(Maybe Text) + { pullRequestReferenceHtmlUrl :: !(Maybe URL) + , pullRequestReferencePatchUrl :: !(Maybe URL) + , pullRequestReferenceDiffUrl :: !(Maybe URL) } deriving (Eq, Ord, Show, Generic, Typeable, Data) diff --git a/src/GitHub/Data/Repos.hs b/src/GitHub/Data/Repos.hs index 4f7e9ede..9bcbf447 100644 --- a/src/GitHub/Data/Repos.hs +++ b/src/GitHub/Data/Repos.hs @@ -14,6 +14,7 @@ module GitHub.Data.Repos where import GitHub.Data.Definitions import GitHub.Data.Id (Id) import GitHub.Data.Name (Name) +import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import qualified Data.HashMap.Strict as HM @@ -23,17 +24,17 @@ import Unsafe.Coerce (unsafeCoerce) #endif data Repo = Repo { - repoSshUrl :: !(Maybe Text) + repoSshUrl :: !(Maybe URL) ,repoDescription :: !(Maybe Text) ,repoCreatedAt :: !(Maybe UTCTime) - ,repoHtmlUrl :: !Text - ,repoSvnUrl :: !(Maybe Text) + ,repoHtmlUrl :: !URL + ,repoSvnUrl :: !(Maybe URL) ,repoForks :: !(Maybe Int) ,repoHomepage :: !(Maybe Text) ,repoFork :: !(Maybe Bool) - ,repoGitUrl :: !(Maybe Text) + ,repoGitUrl :: !(Maybe URL) ,repoPrivate :: !Bool - ,repoCloneUrl :: !(Maybe Text) + ,repoCloneUrl :: !(Maybe URL) ,repoSize :: !(Maybe Int) ,repoUpdatedAt :: !(Maybe UTCTime) ,repoWatchers :: !(Maybe Int) @@ -43,14 +44,14 @@ data Repo = Repo { ,repoDefaultBranch :: !(Maybe Text) ,repoPushedAt :: !(Maybe UTCTime) -- ^ this is Nothing for new repositories ,repoId :: !(Id Repo) - ,repoUrl :: !Text + ,repoUrl :: !URL ,repoOpenIssues :: !(Maybe Int) ,repoHasWiki :: !(Maybe Bool) ,repoHasIssues :: !(Maybe Bool) ,repoHasDownloads :: !(Maybe Bool) ,repoParent :: !(Maybe RepoRef) ,repoSource :: !(Maybe RepoRef) - ,repoHooksUrl :: !Text + ,repoHooksUrl :: !URL ,repoStargazersCount :: !Int } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -124,7 +125,7 @@ instance IsString Language where data Contributor -- | An existing Github user, with their number of contributions, avatar -- URL, login, URL, ID, and Gravatar ID. - = KnownContributor !Int !Text !(Name User) !Text !(Id User) !Text + = KnownContributor !Int !URL !(Name User) !URL !(Id User) !Text -- | An unknown Github user with their number of contributions and recorded name. | AnonymousContributor !Int !Text deriving (Show, Data, Typeable, Eq, Ord, Generic) diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs index e13368e8..188332a7 100644 --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -21,10 +21,10 @@ module GitHub.Data.Request ( Count, ) where -import GitHub.Internal.Prelude import GitHub.Data.Definitions (Count, QueryString) import GitHub.Data.Id (Id, untagId) import GitHub.Data.Name (Name, untagName) +import GitHub.Internal.Prelude import qualified Data.ByteString.Lazy as LBS import qualified Data.Text as T diff --git a/src/GitHub/Data/Search.hs b/src/GitHub/Data/Search.hs index 6d0924ba..daaf0bc2 100644 --- a/src/GitHub/Data/Search.hs +++ b/src/GitHub/Data/Search.hs @@ -5,7 +5,8 @@ -- module GitHub.Data.Search where -import GitHub.Data.Repos (Repo) +import GitHub.Data.Repos (Repo) +import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import qualified Data.Vector as V @@ -27,9 +28,9 @@ data Code = Code { codeName :: !Text ,codePath :: !Text ,codeSha :: !Text - ,codeUrl :: !Text - ,codeGitUrl :: !Text - ,codeHtmlUrl :: !Text + ,codeUrl :: !URL + ,codeGitUrl :: !URL + ,codeHtmlUrl :: !URL ,codeRepo :: !Repo } deriving (Show, Data, Typeable, Eq, Ord, Generic) diff --git a/src/GitHub/Data/Teams.hs b/src/GitHub/Data/Teams.hs index cb883864..9ab433e9 100644 --- a/src/GitHub/Data/Teams.hs +++ b/src/GitHub/Data/Teams.hs @@ -13,6 +13,7 @@ import GitHub.Data.Definitions import GitHub.Data.Id (Id) import GitHub.Data.Name (Name) import GitHub.Data.Repos (Repo) +import GitHub.Data.URL (URL) import GitHub.Internal.Prelude data Privacy = @@ -34,14 +35,14 @@ instance Binary Permission data SimpleTeam = SimpleTeam { simpleTeamId :: !(Id Team) - ,simpleTeamUrl :: !Text + ,simpleTeamUrl :: !URL ,simpleTeamName :: !Text -- TODO (0.15.0): unify this and 'simpleTeamSlug' as in 'Team'. ,simpleTeamSlug :: !(Name Team) ,simpleTeamDescription :: !(Maybe Text) ,simpleTeamPrivacy :: !(Maybe Privacy) ,simpleTeamPermission :: !Permission - ,simpleTeamMembersUrl :: !Text - ,simpleTeamRepositoriesUrl :: !Text + ,simpleTeamMembersUrl :: !URL + ,simpleTeamRepositoriesUrl :: !URL } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData SimpleTeam where rnf = genericRnf @@ -49,14 +50,14 @@ instance Binary SimpleTeam data Team = Team { teamId :: !(Id Team) - ,teamUrl :: !Text + ,teamUrl :: !URL ,teamName :: !(Name Team) ,teamSlug :: !Text ,teamDescription :: !(Maybe Text) ,teamPrivacy :: !(Maybe Privacy) ,teamPermission :: !Permission - ,teamMembersUrl :: !Text - ,teamRepositoriesUrl :: !Text + ,teamMembersUrl :: !URL + ,teamRepositoriesUrl :: !URL ,teamMembersCount :: !Int ,teamReposCount :: !Int ,teamOrganization :: !SimpleOrganization @@ -103,7 +104,7 @@ instance NFData ReqState where rnf = genericRnf instance Binary ReqState data TeamMembership = TeamMembership { - teamMembershipUrl :: !Text, + teamMembershipUrl :: !URL, teamMembershipRole :: !Role, teamMembershipReqState :: !ReqState } deriving (Show, Data, Typeable, Eq, Ord, Generic) diff --git a/src/GitHub/Data/Webhooks.hs b/src/GitHub/Data/Webhooks.hs index dbc5695a..1c9db40b 100644 --- a/src/GitHub/Data/Webhooks.hs +++ b/src/GitHub/Data/Webhooks.hs @@ -6,13 +6,14 @@ module GitHub.Data.Webhooks where import GitHub.Data.Id (Id) +import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import qualified Data.Map as M data RepoWebhook = RepoWebhook { - repoWebhookUrl :: !Text - ,repoWebhookTestUrl :: !Text + repoWebhookUrl :: !URL + ,repoWebhookTestUrl :: !URL ,repoWebhookId :: !(Id RepoWebhook) ,repoWebhookName :: !Text ,repoWebhookActive :: !Bool diff --git a/src/GitHub/Internal/Prelude.hs b/src/GitHub/Internal/Prelude.hs index 39c95fb8..533fa1f2 100644 --- a/src/GitHub/Internal/Prelude.hs +++ b/src/GitHub/Internal/Prelude.hs @@ -21,7 +21,7 @@ module GitHub.Internal.Prelude ( NFData(..), genericRnf, Semigroup(..), -- * Aeson - FromJSON(..), ToJSON(..), Value(..), + FromJSON(..), ToJSON(..), Value(..), Object, encode, withText, withObject, (.:), (.:?), (.!=), (.=), object, typeMismatch, -- * Control.Applicative @@ -37,9 +37,9 @@ module GitHub.Internal.Prelude ( import Control.Applicative ((<|>)) import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) -import Data.Aeson.Compat (FromJSON (..), ToJSON (..), Value (..), encode, - object, withObject, withText, (.!=), (.:), - (.:?), (.=)) +import Data.Aeson.Compat (FromJSON (..), Object, ToJSON (..), Value (..), + encode, object, withObject, withText, (.!=), + (.:), (.:?), (.=)) import Data.Aeson.Types (typeMismatch) import Data.Binary (Binary) import Data.Binary.Orphans () From d2f53c4eeaa70b85bc246e0fa31ebd663577fa09 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 24 May 2016 08:52:47 +0300 Subject: [PATCH 212/510] Change Parts to [Text] --- src/GitHub/Auth.hs | 2 +- src/GitHub/Data/Request.hs | 8 ++++---- src/GitHub/Endpoints/GitData/References.hs | 4 ++-- src/GitHub/Endpoints/Issues/Events.hs | 2 +- src/GitHub/Endpoints/Repos.hs | 3 +-- src/GitHub/Endpoints/Repos/Commits.hs | 2 +- src/GitHub/Endpoints/Repos/Webhooks.hs | 4 ++-- src/GitHub/Request.hs | 17 ++++++++++------- 8 files changed, 22 insertions(+), 20 deletions(-) diff --git a/src/GitHub/Auth.hs b/src/GitHub/Auth.hs index dd56de97..05ac6e30 100644 --- a/src/GitHub/Auth.hs +++ b/src/GitHub/Auth.hs @@ -15,7 +15,7 @@ type Token = BS.ByteString data Auth = BasicAuth BS.ByteString BS.ByteString | OAuth Token -- ^ token - | EnterpriseOAuth String -- custom API endpoint without + | EnterpriseOAuth Text -- custom API endpoint without -- trailing slash Token -- token deriving (Show, Data, Typeable, Eq, Ord, Generic) diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs index 188332a7..7ccfbe37 100644 --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -34,16 +34,16 @@ import qualified Network.HTTP.Types.Method as Method -- Auxillary types ------------------------------------------------------------------------------ -type Paths = [String] +type Paths = [Text] class IsPathPart a where - toPathPart :: a -> String + toPathPart :: a -> Text instance IsPathPart (Name a) where - toPathPart = T.unpack . untagName + toPathPart = untagName instance IsPathPart (Id a) where - toPathPart = show . untagId + toPathPart = T.pack . show . untagId -- | Http method of requests with body. data CommandMethod a where diff --git a/src/GitHub/Endpoints/GitData/References.hs b/src/GitHub/Endpoints/GitData/References.hs index 8db53bfc..a96e847d 100644 --- a/src/GitHub/Endpoints/GitData/References.hs +++ b/src/GitHub/Endpoints/GitData/References.hs @@ -75,12 +75,12 @@ createReferenceR user repo newRef = -- | Limited references by a namespace. -- -- > namespacedReferences "thoughtbot" "paperclip" "tags" -namespacedReferences :: Name Owner -> Name Repo -> String -> IO (Either Error [GitReference]) +namespacedReferences :: Name Owner -> Name Repo -> Text -> IO (Either Error [GitReference]) namespacedReferences user repo namespace = executeRequest' $ namespacedReferencesR user repo namespace -- | Query namespaced references. -- See -namespacedReferencesR :: Name Owner -> Name Repo -> String -> Request k [GitReference] +namespacedReferencesR :: Name Owner -> Name Repo -> Text -> Request k [GitReference] namespacedReferencesR user repo namespace = Query ["repos", toPathPart user, toPathPart repo, "git", "refs", namespace] [] diff --git a/src/GitHub/Endpoints/Issues/Events.hs b/src/GitHub/Endpoints/Issues/Events.hs index fe8d4015..0581099e 100644 --- a/src/GitHub/Endpoints/Issues/Events.hs +++ b/src/GitHub/Endpoints/Issues/Events.hs @@ -77,4 +77,4 @@ event' auth user repo eid = -- See eventR :: Name Owner -> Name Repo -> Id Event -> Request k Event eventR user repo eid = - Query ["repos", toPathPart user, toPathPart repo, "issues", "events", show eid] [] + Query ["repos", toPathPart user, toPathPart repo, "issues", "events", toPathPart eid] [] diff --git a/src/GitHub/Endpoints/Repos.hs b/src/GitHub/Endpoints/Repos.hs index 10a6d85d..6c5bb14e 100644 --- a/src/GitHub/Endpoints/Repos.hs +++ b/src/GitHub/Endpoints/Repos.hs @@ -59,7 +59,6 @@ import GitHub.Data import GitHub.Request import GitHub.Internal.Prelude -import qualified Data.Text as T import qualified Data.Text.Encoding as TE repoPublicityQueryString :: RepoPublicity -> QueryString @@ -321,7 +320,7 @@ contentsForR :: Name Owner -> Maybe Text -- ^ Git commit -> Request k Content contentsForR user repo path ref = - Query ["repos", toPathPart user, toPathPart repo, "contents", T.unpack path] qs + Query ["repos", toPathPart user, toPathPart repo, "contents", path] qs where qs = maybe [] (\r -> [("ref", Just . TE.encodeUtf8 $ r)]) ref diff --git a/src/GitHub/Endpoints/Repos/Commits.hs b/src/GitHub/Endpoints/Repos/Commits.hs index 01b971bc..ff11f31d 100644 --- a/src/GitHub/Endpoints/Repos/Commits.hs +++ b/src/GitHub/Endpoints/Repos/Commits.hs @@ -115,4 +115,4 @@ diff' auth user repo base headref = -- See diffR :: Name Owner -> Name Repo -> Name Commit -> Name Commit -> Request k Diff diffR user repo base headref = - Query ["repos", toPathPart user, toPathPart repo, "compare", toPathPart base ++ "..." ++ toPathPart headref] [] + Query ["repos", toPathPart user, toPathPart repo, "compare", toPathPart base <> "..." <> toPathPart headref] [] diff --git a/src/GitHub/Endpoints/Repos/Webhooks.hs b/src/GitHub/Endpoints/Repos/Webhooks.hs index 39f4d762..5fa7b784 100644 --- a/src/GitHub/Endpoints/Repos/Webhooks.hs +++ b/src/GitHub/Endpoints/Repos/Webhooks.hs @@ -106,10 +106,10 @@ deleteRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> Request 'True deleteRepoWebhookR user repo hookId = Command Delete (createWebhookOpPath user repo hookId Nothing) mempty -createBaseWebhookPath :: Name Owner -> Name Repo -> Id RepoWebhook -> [String] +createBaseWebhookPath :: Name Owner -> Name Repo -> Id RepoWebhook -> Paths createBaseWebhookPath user repo hookId = ["repos", toPathPart user, toPathPart repo, "hooks", toPathPart hookId] -createWebhookOpPath :: Name Owner -> Name Repo -> Id RepoWebhook -> Maybe String -> [String] +createWebhookOpPath :: Name Owner -> Name Repo -> Id RepoWebhook -> Maybe Text -> Paths createWebhookOpPath owner reqName webhookId Nothing = createBaseWebhookPath owner reqName webhookId createWebhookOpPath owner reqName webhookId (Just operation) = createBaseWebhookPath owner reqName webhookId ++ [operation] diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index a27f8e8f..a8b5bf34 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -99,7 +99,7 @@ executeRequest auth req = do lessFetchCount :: Int -> FetchCount -> Bool lessFetchCount _ FetchAll = True -lessFetchCount i (FetchAtLeast j) = i < fromIntegral j +lessFetchCount i (FetchAtLeast j) = i < fromIntegral j -- | Like 'executeRequest' but with provided 'Manager'. executeRequestWithMgr :: Manager @@ -207,21 +207,21 @@ makeHttpRequest auth r = case r of req' <- makeHttpRequest auth req return $ setCheckStatus (Just sm) req' Query paths qs -> do - req <- parseUrl $ url paths + req <- parseUrl' $ url paths return $ setReqHeaders . setCheckStatus Nothing . setAuthRequest auth . setQueryString qs $ req PagedQuery paths qs _ -> do - req <- parseUrl $ url paths + req <- parseUrl' $ url paths return $ setReqHeaders . setCheckStatus Nothing . setAuthRequest auth . setQueryString qs $ req Command m paths body -> do - req <- parseUrl $ url paths + req <- parseUrl' $ url paths return $ setReqHeaders . setCheckStatus Nothing . setAuthRequest auth @@ -232,10 +232,13 @@ makeHttpRequest auth r = case r of req' <- makeHttpRequest auth req return $ req' { requestHeaders = h <> requestHeaders req' } where - url :: Paths -> String - url paths = baseUrl ++ '/' : intercalate "/" paths + parseUrl' :: MonadThrow m => Text -> m HTTP.Request + parseUrl' = parseUrl . T.unpack - baseUrl :: String + url :: Paths -> Text + url paths = baseUrl <> "/" <> T.intercalate "/" paths + + baseUrl :: Text baseUrl = case auth of Just (EnterpriseOAuth endpoint _) -> endpoint _ -> "https://api.github.com" From 1a71bd8c7da0c0088311597ea738a7fc387ab3cc Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 24 May 2016 08:54:46 +0300 Subject: [PATCH 213/510] More String to Text --- src/GitHub/Endpoints/PullRequests.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/GitHub/Endpoints/PullRequests.hs b/src/GitHub/Endpoints/PullRequests.hs index 2578023e..46aae86b 100644 --- a/src/GitHub/Endpoints/PullRequests.hs +++ b/src/GitHub/Endpoints/PullRequests.hs @@ -159,19 +159,19 @@ isPullRequestMergedR user repo prid = StatusQuery StatusOnlyOk $ Query ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "merge"] [] -- | Merge a pull request. -mergePullRequest :: Auth -> Name Owner -> Name Repo -> Id PullRequest -> Maybe String -> IO (Either Error MergeResult) +mergePullRequest :: Auth -> Name Owner -> Name Repo -> Id PullRequest -> Maybe Text -> IO (Either Error MergeResult) 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 Owner -> Name Repo -> Id PullRequest -> Maybe String -> Request 'True MergeResult +mergePullRequestR :: Name Owner -> Name Repo -> Id PullRequest -> Maybe Text -> Request 'True MergeResult mergePullRequestR user repo prid commitMessage = StatusQuery StatusMerge $ Command Put paths (encode $ buildCommitMessageMap commitMessage) where paths = ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "merge"] - buildCommitMessageMap :: Maybe String -> Value + buildCommitMessageMap :: Maybe Text -> Value buildCommitMessageMap (Just msg) = object ["commit_message" .= msg ] buildCommitMessageMap Nothing = object [] From 12825903777cf65524d4f150f29c3fd22db86a48 Mon Sep 17 00:00:00 2001 From: Todd Mohney Date: Fri, 12 Aug 2016 15:48:45 -0400 Subject: [PATCH 214/510] Add API wrapper functions for fetching deploy keys - fetch list of all deploy keys - fetch deploy key by ID --- src/GitHub/Data/DeployKeys.hs | 30 ++++++++++++++++++++ src/GitHub/Endpoints/Repos/DeployKeys.hs | 35 ++++++++++++++++++++++++ 2 files changed, 65 insertions(+) create mode 100644 src/GitHub/Data/DeployKeys.hs create mode 100644 src/GitHub/Endpoints/Repos/DeployKeys.hs diff --git a/src/GitHub/Data/DeployKeys.hs b/src/GitHub/Data/DeployKeys.hs new file mode 100644 index 00000000..0764b125 --- /dev/null +++ b/src/GitHub/Data/DeployKeys.hs @@ -0,0 +1,30 @@ +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Todd Mohney +-- +module GitHub.Data.DeployKeys where + +import GitHub.Data.Id (Id) +import GitHub.Data.URL (URL) +import GitHub.Internal.Prelude + +data RepoDeployKey = RepoDeployKey { + repoDeployKeyId :: !(Id RepoDeployKey) + ,repoDeployKeyKey :: !Text + ,repoDeployKeyUrl :: !URL + ,repoDeployKeyTitle :: !Text + ,repoDeployKeyVerified :: !Bool + ,repoDeployKeyCreatedAt :: !UTCTime + ,repoDeployKeyReadOnly :: !Bool +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance FromJSON RepoDeployKey where + parseJSON = withObject "RepoDeployKey" $ \o -> + RepoDeployKey <$> o .: "id" + <*> o .: "key" + <*> o .: "url" + <*> o .: "title" + <*> o .: "verified" + <*> o .: "created_at" + <*> o .: "read_only" diff --git a/src/GitHub/Endpoints/Repos/DeployKeys.hs b/src/GitHub/Endpoints/Repos/DeployKeys.hs new file mode 100644 index 00000000..bb32f000 --- /dev/null +++ b/src/GitHub/Endpoints/Repos/DeployKeys.hs @@ -0,0 +1,35 @@ +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Todd Mohney +-- +-- The deploy keys API, as described at +-- +module GitHub.Endpoints.Repos.DeployKeys ( + -- * Querying deploy keys + deployKeysFor', + deployKeysForR, + deployKeyFor', + deployKeyForR, +) where + +import GitHub.Data +import GitHub.Request +import GitHub.Internal.Prelude + +-- * Querying deploy keys +deployKeysFor' :: Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector RepoDeployKey)) +deployKeysFor' auth user repo = + executeRequest auth $ deployKeysForR user repo FetchAll + +deployKeysForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector RepoDeployKey) +deployKeysForR user repo = + PagedQuery ["repos", toPathPart user, toPathPart repo, "keys"] [] + +deployKeyFor' :: Auth -> Name Owner -> Name Repo -> Id RepoDeployKey -> IO (Either Error RepoDeployKey) +deployKeyFor' auth user repo keyId = + executeRequest auth $ deployKeyForR user repo keyId + +deployKeyForR :: Name Owner -> Name Repo -> Id RepoDeployKey -> Request k RepoDeployKey +deployKeyForR user repo keyId = + Query ["repos", toPathPart user, toPathPart repo, "keys", toPathPart keyId] [] From 85b9970c3523350d49805fe917b41fffa50b5dc7 Mon Sep 17 00:00:00 2001 From: Todd Mohney Date: Fri, 12 Aug 2016 16:26:24 -0400 Subject: [PATCH 215/510] Add API wrapper functions for creating/deleting deploy keys --- github.cabal | 2 + samples/github-samples.cabal | 162 +++++++++++------------ src/GitHub/Data.hs | 4 +- src/GitHub/Data/DeployKeys.hs | 20 +++ src/GitHub/Endpoints/Repos/DeployKeys.hs | 31 ++++- 5 files changed, 136 insertions(+), 83 deletions(-) diff --git a/github.cabal b/github.cabal index a2144925..8e719b6f 100644 --- a/github.cabal +++ b/github.cabal @@ -83,6 +83,7 @@ Library GitHub.Data.Teams GitHub.Data.Activities GitHub.Data.URL + GitHub.Data.DeployKeys GitHub.Data.Webhooks GitHub.Data.Webhooks.Validate GitHub.Endpoints.Activity.Starring @@ -109,6 +110,7 @@ Library GitHub.Endpoints.Repos.Commits GitHub.Endpoints.Repos.Forks GitHub.Endpoints.Repos.Webhooks + GitHub.Endpoints.Repos.DeployKeys GitHub.Endpoints.Search GitHub.Endpoints.Users GitHub.Endpoints.Users.Followers diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index eb607530..2bd437ee 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -1,4 +1,4 @@ --- This file has been generated from package.yaml by hpack version 0.13.0. +-- This file has been generated from package.yaml by hpack version 0.9.0. -- -- see: https://github.com/sol/hpack @@ -20,10 +20,10 @@ library Common default-language: Haskell2010 -executable github-add-team-membership-for - main-is: AddTeamMembershipFor.hs +executable github-edit-team + main-is: EditTeam.hs hs-source-dirs: - Teams/Memberships + Teams ghc-options: -Wall build-depends: base @@ -32,12 +32,17 @@ executable github-add-team-membership-for , text , github-samples other-modules: - DeleteTeamMembershipFor - TeamMembershipInfoFor + DeleteTeam + ListRepos + ListTeamsCurrent + Memberships.AddTeamMembershipFor + Memberships.DeleteTeamMembershipFor + Memberships.TeamMembershipInfoFor + TeamInfoFor default-language: Haskell2010 -executable github-delete-team - main-is: DeleteTeam.hs +executable github-list-team-current + main-is: ListTeamsCurrent.hs hs-source-dirs: Teams ghc-options: -Wall @@ -48,19 +53,19 @@ executable github-delete-team , text , github-samples other-modules: + DeleteTeam EditTeam ListRepos - ListTeamsCurrent Memberships.AddTeamMembershipFor Memberships.DeleteTeamMembershipFor Memberships.TeamMembershipInfoFor TeamInfoFor default-language: Haskell2010 -executable github-delete-team-membership-for - main-is: DeleteTeamMembershipFor.hs +executable github-operational + main-is: Operational.hs hs-source-dirs: - Teams/Memberships + Operational ghc-options: -Wall build-depends: base @@ -68,13 +73,15 @@ executable github-delete-team-membership-for , github , text , github-samples - other-modules: - AddTeamMembershipFor - TeamMembershipInfoFor + , http-client + , http-client-tls + , operational + , transformers + , transformers-compat default-language: Haskell2010 -executable github-edit-team - main-is: EditTeam.hs +executable github-list-team-repos + main-is: ListRepos.hs hs-source-dirs: Teams ghc-options: -Wall @@ -86,7 +93,7 @@ executable github-edit-team , github-samples other-modules: DeleteTeam - ListRepos + EditTeam ListTeamsCurrent Memberships.AddTeamMembershipFor Memberships.DeleteTeamMembershipFor @@ -94,10 +101,10 @@ executable github-edit-team TeamInfoFor default-language: Haskell2010 -executable github-list-followers - main-is: ListFollowers.hs +executable github-delete-team + main-is: DeleteTeam.hs hs-source-dirs: - Users/Followers + Teams ghc-options: -Wall build-depends: base @@ -106,29 +113,35 @@ executable github-list-followers , text , github-samples other-modules: - Example - ListFollowing + EditTeam + ListRepos + ListTeamsCurrent + Memberships.AddTeamMembershipFor + Memberships.DeleteTeamMembershipFor + Memberships.TeamMembershipInfoFor + TeamInfoFor default-language: Haskell2010 -executable github-list-followers-example - main-is: Example.hs +executable github-delete-team-membership-for + main-is: DeleteTeamMembershipFor.hs hs-source-dirs: - Users/Followers + Teams/Memberships ghc-options: -Wall build-depends: base , base-compat , github , text + , github-samples other-modules: - ListFollowers - ListFollowing + AddTeamMembershipFor + TeamMembershipInfoFor default-language: Haskell2010 -executable github-list-following - main-is: ListFollowing.hs +executable github-show-user-2 + main-is: ShowUser2.hs hs-source-dirs: - Users/Followers + Users ghc-options: -Wall build-depends: base @@ -137,14 +150,16 @@ executable github-list-following , text , github-samples other-modules: - Example - ListFollowers + Followers.Example + Followers.ListFollowers + Followers.ListFollowing + ShowUser default-language: Haskell2010 -executable github-list-team-current - main-is: ListTeamsCurrent.hs +executable github-show-user + main-is: ShowUser.hs hs-source-dirs: - Teams + Users ghc-options: -Wall build-depends: base @@ -153,19 +168,16 @@ executable github-list-team-current , text , github-samples other-modules: - DeleteTeam - EditTeam - ListRepos - Memberships.AddTeamMembershipFor - Memberships.DeleteTeamMembershipFor - Memberships.TeamMembershipInfoFor - TeamInfoFor + Followers.Example + Followers.ListFollowers + Followers.ListFollowing + ShowUser2 default-language: Haskell2010 -executable github-list-team-repos - main-is: ListRepos.hs +executable github-list-following + main-is: ListFollowing.hs hs-source-dirs: - Teams + Users/Followers ghc-options: -Wall build-depends: base @@ -174,37 +186,29 @@ executable github-list-team-repos , text , github-samples other-modules: - DeleteTeam - EditTeam - ListTeamsCurrent - Memberships.AddTeamMembershipFor - Memberships.DeleteTeamMembershipFor - Memberships.TeamMembershipInfoFor - TeamInfoFor + Example + ListFollowers default-language: Haskell2010 -executable github-operational - main-is: Operational.hs +executable github-list-followers-example + main-is: Example.hs hs-source-dirs: - Operational + Users/Followers ghc-options: -Wall build-depends: base , base-compat , github , text - , github-samples - , http-client - , http-client-tls - , operational - , transformers - , transformers-compat + other-modules: + ListFollowers + ListFollowing default-language: Haskell2010 -executable github-show-user - main-is: ShowUser.hs +executable github-add-team-membership-for + main-is: AddTeamMembershipFor.hs hs-source-dirs: - Users + Teams/Memberships ghc-options: -Wall build-depends: base @@ -213,16 +217,14 @@ executable github-show-user , text , github-samples other-modules: - Followers.Example - Followers.ListFollowers - Followers.ListFollowing - ShowUser2 + DeleteTeamMembershipFor + TeamMembershipInfoFor default-language: Haskell2010 -executable github-show-user-2 - main-is: ShowUser2.hs +executable github-team-membership-info-for + main-is: TeamMembershipInfoFor.hs hs-source-dirs: - Users + Teams/Memberships ghc-options: -Wall build-depends: base @@ -231,16 +233,14 @@ executable github-show-user-2 , text , github-samples other-modules: - Followers.Example - Followers.ListFollowers - Followers.ListFollowing - ShowUser + AddTeamMembershipFor + DeleteTeamMembershipFor default-language: Haskell2010 -executable github-team-membership-info-for - main-is: TeamMembershipInfoFor.hs +executable github-list-followers + main-is: ListFollowers.hs hs-source-dirs: - Teams/Memberships + Users/Followers ghc-options: -Wall build-depends: base @@ -249,8 +249,8 @@ executable github-team-membership-info-for , text , github-samples other-modules: - AddTeamMembershipFor - DeleteTeamMembershipFor + Example + ListFollowing default-language: Haskell2010 executable github-teaminfo-for diff --git a/src/GitHub/Data.hs b/src/GitHub/Data.hs index 235558ba..c63b7741 100644 --- a/src/GitHub/Data.hs +++ b/src/GitHub/Data.hs @@ -35,6 +35,7 @@ module GitHub.Data ( module GitHub.Data.Comments, module GitHub.Data.Content, module GitHub.Data.Definitions, + module GitHub.Data.DeployKeys, module GitHub.Data.Gists, module GitHub.Data.GitData, module GitHub.Data.Issues, @@ -44,7 +45,7 @@ module GitHub.Data ( module GitHub.Data.Search, module GitHub.Data.Teams, module GitHub.Data.URL, - module GitHub.Data.Webhooks, + module GitHub.Data.Webhooks ) where import GitHub.Internal.Prelude @@ -54,6 +55,7 @@ import GitHub.Data.Activities import GitHub.Data.Comments import GitHub.Data.Content import GitHub.Data.Definitions +import GitHub.Data.DeployKeys import GitHub.Data.Gists import GitHub.Data.GitData import GitHub.Data.Id diff --git a/src/GitHub/Data/DeployKeys.hs b/src/GitHub/Data/DeployKeys.hs index 0764b125..c93f0b6d 100644 --- a/src/GitHub/Data/DeployKeys.hs +++ b/src/GitHub/Data/DeployKeys.hs @@ -28,3 +28,23 @@ instance FromJSON RepoDeployKey where <*> o .: "verified" <*> o .: "created_at" <*> o .: "read_only" + +data NewRepoDeployKey = NewRepoDeployKey { + newRepoDeployKeyKey :: !Text + ,newRepoDeployKeyTitle :: !Text + ,newRepoDeployKeyReadOnly :: !Bool +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance ToJSON NewRepoDeployKey where + toJSON (NewRepoDeployKey key title readOnly) = + object [ + "key" .= key + , "title" .= title + , "read_only" .= readOnly + ] + +instance FromJSON NewRepoDeployKey where + parseJSON = withObject "RepoDeployKey" $ \o -> + NewRepoDeployKey <$> o .: "key" + <*> o .: "title" + <*> o .: "read_only" diff --git a/src/GitHub/Endpoints/Repos/DeployKeys.hs b/src/GitHub/Endpoints/Repos/DeployKeys.hs index bb32f000..45dc0c3f 100644 --- a/src/GitHub/Endpoints/Repos/DeployKeys.hs +++ b/src/GitHub/Endpoints/Repos/DeployKeys.hs @@ -11,13 +11,21 @@ module GitHub.Endpoints.Repos.DeployKeys ( deployKeysForR, deployKeyFor', deployKeyForR, + + -- ** Create + createRepoDeployKey', + createRepoDeployKeyR, + + -- ** Delete + deleteRepoDeployKey', + deleteRepoDeployKeyR, ) where import GitHub.Data import GitHub.Request import GitHub.Internal.Prelude --- * Querying deploy keys +-- | Querying deploy keys deployKeysFor' :: Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector RepoDeployKey)) deployKeysFor' auth user repo = executeRequest auth $ deployKeysForR user repo FetchAll @@ -26,6 +34,7 @@ deployKeysForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Rep deployKeysForR user repo = PagedQuery ["repos", toPathPart user, toPathPart repo, "keys"] [] +-- | Querying a deploy key deployKeyFor' :: Auth -> Name Owner -> Name Repo -> Id RepoDeployKey -> IO (Either Error RepoDeployKey) deployKeyFor' auth user repo keyId = executeRequest auth $ deployKeyForR user repo keyId @@ -33,3 +42,23 @@ deployKeyFor' auth user repo keyId = deployKeyForR :: Name Owner -> Name Repo -> Id RepoDeployKey -> Request k RepoDeployKey deployKeyForR user repo keyId = Query ["repos", toPathPart user, toPathPart repo, "keys", toPathPart keyId] [] + +-- | Create a deploy key +createRepoDeployKey' :: Auth -> Name Owner -> Name Repo -> NewRepoDeployKey -> IO (Either Error RepoDeployKey) +createRepoDeployKey' auth user repo key = + executeRequest auth $ createRepoDeployKeyR user repo key + +-- | Create a deploy key. +createRepoDeployKeyR :: Name Owner -> Name Repo -> NewRepoDeployKey -> Request 'True RepoDeployKey +createRepoDeployKeyR user repo key = + Command Post ["repos", toPathPart user, toPathPart repo, "keys"] (encode key) + +deleteRepoDeployKey' :: Auth -> Name Owner -> Name Repo -> Id RepoDeployKey -> IO (Either Error ()) +deleteRepoDeployKey' auth user repo keyId = + executeRequest auth $ deleteRepoDeployKeyR user repo keyId + +-- | Delete a deploy key. +-- See +deleteRepoDeployKeyR :: Name Owner -> Name Repo -> Id RepoDeployKey -> Request 'True () +deleteRepoDeployKeyR user repo keyId = + Command Delete ["repos", toPathPart user, toPathPart repo, "keys", toPathPart keyId] mempty From 3c23ebbc3c871866299a102f019f33538ae82ec5 Mon Sep 17 00:00:00 2001 From: Todd Mohney Date: Fri, 12 Aug 2016 17:14:29 -0400 Subject: [PATCH 216/510] Add usage examples - creating deploy key - listing all deploy keys - listing a deploy key by ID - deleting a deploy key --- samples/Repos/DeployKeys/CreateDeployKey.hs | 23 +++++++ samples/Repos/DeployKeys/DeleteDeployKey.hs | 14 +++++ samples/Repos/DeployKeys/ListDeployKeys.hs | 20 ++++++ samples/Repos/DeployKeys/ShowDeployKey.hs | 20 ++++++ samples/github-samples.cabal | 69 +++++++++++++++++++++ samples/package.yaml | 21 +++++++ 6 files changed, 167 insertions(+) create mode 100644 samples/Repos/DeployKeys/CreateDeployKey.hs create mode 100644 samples/Repos/DeployKeys/DeleteDeployKey.hs create mode 100644 samples/Repos/DeployKeys/ListDeployKeys.hs create mode 100644 samples/Repos/DeployKeys/ShowDeployKey.hs diff --git a/samples/Repos/DeployKeys/CreateDeployKey.hs b/samples/Repos/DeployKeys/CreateDeployKey.hs new file mode 100644 index 00000000..20d4e02a --- /dev/null +++ b/samples/Repos/DeployKeys/CreateDeployKey.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main (main) where + +import GitHub.Data.Id (Id (..)) +import qualified GitHub.Data.DeployKeys as DK +import qualified GitHub.Endpoints.Repos.DeployKeys as DK +import qualified GitHub.Auth as Auth +import Data.List +import Data.Text (Text) + +main :: IO () +main = do + let auth = Auth.OAuth "auth_token" + eDeployKey <- DK.createRepoDeployKey' auth "your_owner" "your_repo" newDeployKey + case eDeployKey of + (Left err) -> putStrLn $ "Error: " ++ (show err) + (Right deployKey) -> putStrLn $ show deployKey + +newDeployKey :: DK.NewRepoDeployKey +newDeployKey = DK.NewRepoDeployKey publicKey "test-key" True + where + publicKey :: Text + publicKey = "your_public_key" diff --git a/samples/Repos/DeployKeys/DeleteDeployKey.hs b/samples/Repos/DeployKeys/DeleteDeployKey.hs new file mode 100644 index 00000000..5ec89733 --- /dev/null +++ b/samples/Repos/DeployKeys/DeleteDeployKey.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main (main) where + +import GitHub.Data.Id (Id (..)) +import qualified GitHub.Endpoints.Repos.DeployKeys as DK +import qualified GitHub.Auth as Auth + +main :: IO () +main = do + let auth = Auth.OAuth "auth_token" + eDeployKey <- DK.deleteRepoDeployKey' auth "your_owner" "your_repo" (Id 18530161) + case eDeployKey of + (Left err) -> putStrLn $ "Error: " ++ (show err) + (Right _) -> putStrLn $ "Deleted deploy key!" diff --git a/samples/Repos/DeployKeys/ListDeployKeys.hs b/samples/Repos/DeployKeys/ListDeployKeys.hs new file mode 100644 index 00000000..650d1c9a --- /dev/null +++ b/samples/Repos/DeployKeys/ListDeployKeys.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main (main) where + +import qualified GitHub.Data.DeployKeys as DK +import qualified GitHub.Endpoints.Repos.DeployKeys as DK +import qualified GitHub.Auth as Auth +import Data.List +import Data.Vector (toList) + +main :: IO () +main = do + let auth = Auth.OAuth "auth_token" + eDeployKeys <- DK.deployKeysFor' auth "your_owner" "your_repo" + case eDeployKeys of + (Left err) -> putStrLn $ "Error: " ++ (show err) + (Right deployKeys) -> putStrLn $ intercalate "\n" $ map formatRepoDeployKey (toList deployKeys) + +formatRepoDeployKey :: DK.RepoDeployKey -> String +formatRepoDeployKey = show + diff --git a/samples/Repos/DeployKeys/ShowDeployKey.hs b/samples/Repos/DeployKeys/ShowDeployKey.hs new file mode 100644 index 00000000..48e06b94 --- /dev/null +++ b/samples/Repos/DeployKeys/ShowDeployKey.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main (main) where + +import GitHub.Data.Id (Id (..)) +import qualified GitHub.Data.DeployKeys as DK +import qualified GitHub.Endpoints.Repos.DeployKeys as DK +import qualified GitHub.Auth as Auth + +main :: IO () +main = do + let auth = Auth.OAuth "auth_token" + eDeployKey <- DK.deployKeyFor' auth "your_owner" "your_repo" (Id 18528451) + case eDeployKey of + (Left err) -> putStrLn $ "Error: " ++ (show err) + (Right deployKey) -> putStrLn $ formatRepoDeployKey deployKey + +formatRepoDeployKey :: DK.RepoDeployKey -> String +formatRepoDeployKey = show + + diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index 2bd437ee..58555afa 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -80,6 +80,40 @@ executable github-operational , transformers-compat default-language: Haskell2010 +executable github-show-deploy-key + main-is: ShowDeployKey.hs + hs-source-dirs: + Repos/DeployKeys + ghc-options: -Wall + build-depends: + base + , base-compat + , github + , text + , github-samples + other-modules: + CreateDeployKey + DeleteDeployKey + ListDeployKeys + default-language: Haskell2010 + +executable github-delete-deploy-key + main-is: DeleteDeployKey.hs + hs-source-dirs: + Repos/DeployKeys + ghc-options: -Wall + build-depends: + base + , base-compat + , github + , text + , github-samples + other-modules: + CreateDeployKey + ListDeployKeys + ShowDeployKey + default-language: Haskell2010 + executable github-list-team-repos main-is: ListRepos.hs hs-source-dirs: @@ -122,6 +156,24 @@ executable github-delete-team TeamInfoFor default-language: Haskell2010 +executable github-list-deploy-keys-for + main-is: ListDeployKeys.hs + hs-source-dirs: + Repos/DeployKeys + ghc-options: -Wall + build-depends: + base + , base-compat + , github + , text + , github-samples + , vector + other-modules: + CreateDeployKey + DeleteDeployKey + ShowDeployKey + default-language: Haskell2010 + executable github-delete-team-membership-for main-is: DeleteTeamMembershipFor.hs hs-source-dirs: @@ -205,6 +257,23 @@ executable github-list-followers-example ListFollowing default-language: Haskell2010 +executable github-create-deploy-key + main-is: CreateDeployKey.hs + hs-source-dirs: + Repos/DeployKeys + ghc-options: -Wall + build-depends: + base + , base-compat + , github + , text + , github-samples + other-modules: + DeleteDeployKey + ListDeployKeys + ShowDeployKey + default-language: Haskell2010 + executable github-add-team-membership-for main-is: AddTeamMembershipFor.hs hs-source-dirs: diff --git a/samples/package.yaml b/samples/package.yaml index af03e708..eae199e7 100644 --- a/samples/package.yaml +++ b/samples/package.yaml @@ -85,3 +85,24 @@ executables: - operational - transformers - transformers-compat + github-list-deploy-keys-for: + main: ListDeployKeys.hs + source-dirs: Repos/DeployKeys + dependencies: + - github-samples + - vector + github-show-deploy-key: + main: ShowDeployKey.hs + source-dirs: Repos/DeployKeys + dependencies: + - github-samples + github-create-deploy-key: + main: CreateDeployKey.hs + source-dirs: Repos/DeployKeys + dependencies: + - github-samples + github-delete-deploy-key: + main: DeleteDeployKey.hs + source-dirs: Repos/DeployKeys + dependencies: + - github-samples From 833cf0ff74cf01b9573d2d4e770c4dd60debdb4f Mon Sep 17 00:00:00 2001 From: Jacob Errington Date: Sun, 11 Sep 2016 15:37:06 -0400 Subject: [PATCH 217/510] Add WebhookPingEvent constructor for RepoWebhookEvent The relevant FromJSON and ToJSON instances have also been amended to parse and emit the "ping" string. --- src/GitHub/Data/Webhooks.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/GitHub/Data/Webhooks.hs b/src/GitHub/Data/Webhooks.hs index 1c9db40b..aa8101c5 100644 --- a/src/GitHub/Data/Webhooks.hs +++ b/src/GitHub/Data/Webhooks.hs @@ -40,6 +40,7 @@ data RepoWebhookEvent = | WebhookIssuesEvent | WebhookMemberEvent | WebhookPageBuildEvent + | WebhookPingEvent | WebhookPublicEvent | WebhookPullRequestReviewCommentEvent | WebhookPullRequestEvent @@ -107,6 +108,7 @@ instance FromJSON RepoWebhookEvent where parseJSON (String "issues") = pure WebhookIssuesEvent parseJSON (String "member") = pure WebhookMemberEvent parseJSON (String "page_build") = pure WebhookPageBuildEvent + parseJSON (String "ping") = pure WebhookPingEvent parseJSON (String "public") = pure WebhookPublicEvent parseJSON (String "pull_request_review_comment") = pure WebhookPullRequestReviewCommentEvent parseJSON (String "pull_request") = pure WebhookPullRequestEvent @@ -130,6 +132,7 @@ instance ToJSON RepoWebhookEvent where toJSON (WebhookIssuesEvent) = String "issues" toJSON (WebhookMemberEvent) = String "member" toJSON (WebhookPageBuildEvent) = String "page_build" + toJSON (WebhookPingEvent) = String "ping" toJSON (WebhookPublicEvent) = String "public" toJSON (WebhookPullRequestReviewCommentEvent) = String "pull_request_review_comment" toJSON (WebhookPullRequestEvent) = String "pull_request" From abcfc2a608d2c30ce6f5eac47d348cee97c41a0b Mon Sep 17 00:00:00 2001 From: Jacob Errington Date: Sun, 11 Sep 2016 15:51:38 -0400 Subject: [PATCH 218/510] Resolve warning regarding parseUrlThrow The http-client library introduced a new name for `parseUrl` in version 0.4.30, `parseUrlThrow`, and deprecated the use of `parseUrl`. This causes a warning during compilation. Since we support http-client above `0.4.8.1`, I have added some additional CPP conditional compilation to import and use `parseUrl` for older versions of http-client, and to import and use `parseUrlThrow` in the newer versions. --- src/GitHub/Request.hs | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index a8b5bf34..840c08e0 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -66,8 +66,13 @@ import Data.List (find) import Network.HTTP.Client (CookieJar, HttpException (..), Manager, RequestBody (..), Response (..), applyBasicAuth, checkStatus, httpLbs, - method, newManager, parseUrl, requestBody, + method, newManager, requestBody, requestHeaders, setQueryString) +#if MIN_VERSION_http_client(0,4,30) +import Network.HTTP.Client (parseUrlThrow) +#else +import Network.HTTP.Client (parseUrl) +#endif import Network.HTTP.Client.Internal (setUri) import Network.HTTP.Client.TLS (tlsManagerSettings) import Network.HTTP.Link.Parser (parseLinkHeaderBS) @@ -233,7 +238,11 @@ makeHttpRequest auth r = case r of return $ req' { requestHeaders = h <> requestHeaders req' } where parseUrl' :: MonadThrow m => Text -> m HTTP.Request +#if MIN_VERSION_http_client(0,4,30) + parseUrl' = parseUrlThrow . T.unpack +#else parseUrl' = parseUrl . T.unpack +#endif url :: Paths -> Text url paths = baseUrl <> "/" <> T.intercalate "/" paths From 27901e44f6d7a2093ed7acbf19af1b2b55570d3b Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 12 Sep 2016 14:01:58 +0300 Subject: [PATCH 219/510] FetchCount instances, and reformat --- .stylish-haskell.yaml | 12 +- github.cabal | 1 - samples/Repos/DeployKeys/CreateDeployKey.hs | 2 - samples/Repos/DeployKeys/ListDeployKeys.hs | 2 +- samples/github-samples.cabal | 214 +++++++++--------- src/GitHub/Auth.hs | 1 + src/GitHub/Data.hs | 3 +- src/GitHub/Data/Activities.hs | 1 + src/GitHub/Data/Comments.hs | 1 + src/GitHub/Data/Content.hs | 1 + src/GitHub/Data/Definitions.hs | 1 + src/GitHub/Data/DeployKeys.hs | 1 + src/GitHub/Data/Gists.hs | 1 + src/GitHub/Data/GitData.hs | 1 + src/GitHub/Data/Id.hs | 1 + src/GitHub/Data/Issues.hs | 1 + src/GitHub/Data/Name.hs | 1 + src/GitHub/Data/PullRequests.hs | 1 + src/GitHub/Data/Repos.hs | 5 +- src/GitHub/Data/Request.hs | 3 + src/GitHub/Data/Search.hs | 1 + src/GitHub/Data/Teams.hs | 1 + src/GitHub/Data/URL.hs | 1 + src/GitHub/Data/Webhooks.hs | 2 + src/GitHub/Data/Webhooks/Validate.hs | 1 + src/GitHub/Endpoints/Activity/Starring.hs | 9 +- src/GitHub/Endpoints/Activity/Watching.hs | 3 +- src/GitHub/Endpoints/Gists.hs | 3 +- src/GitHub/Endpoints/Gists/Comments.hs | 3 +- src/GitHub/Endpoints/GitData/Blobs.hs | 3 +- src/GitHub/Endpoints/GitData/Commits.hs | 3 +- src/GitHub/Endpoints/GitData/References.hs | 3 +- src/GitHub/Endpoints/GitData/Trees.hs | 3 +- src/GitHub/Endpoints/Issues.hs | 1 + src/GitHub/Endpoints/Issues/Comments.hs | 3 +- src/GitHub/Endpoints/Issues/Events.hs | 3 +- src/GitHub/Endpoints/Issues/Labels.hs | 9 +- src/GitHub/Endpoints/Issues/Milestones.hs | 3 +- src/GitHub/Endpoints/Organizations.hs | 3 +- src/GitHub/Endpoints/Organizations/Members.hs | 3 +- src/GitHub/Endpoints/Organizations/Teams.hs | 3 +- src/GitHub/Endpoints/PullRequests.hs | 3 +- .../Endpoints/PullRequests/ReviewComments.hs | 3 +- src/GitHub/Endpoints/Repos.hs | 3 +- src/GitHub/Endpoints/Repos/Collaborators.hs | 3 +- src/GitHub/Endpoints/Repos/Comments.hs | 3 +- src/GitHub/Endpoints/Repos/Commits.hs | 5 +- src/GitHub/Endpoints/Repos/DeployKeys.hs | 3 +- src/GitHub/Endpoints/Repos/Forks.hs | 3 +- src/GitHub/Endpoints/Repos/Webhooks.hs | 3 +- src/GitHub/Endpoints/Search.hs | 3 +- src/GitHub/Endpoints/Users.hs | 3 +- src/GitHub/Endpoints/Users/Followers.hs | 3 +- src/GitHub/Internal/Prelude.hs | 13 +- src/GitHub/Request.hs | 30 +-- stack-lts-5.yaml | 2 +- 56 files changed, 223 insertions(+), 178 deletions(-) diff --git a/.stylish-haskell.yaml b/.stylish-haskell.yaml index 56d5acea..480cae6b 100644 --- a/.stylish-haskell.yaml +++ b/.stylish-haskell.yaml @@ -1,15 +1,17 @@ steps: - imports: align: group + list_align: after_alias + long_list_align: new_line + empty_list_align: right_after + list_padding: module_name - language_pragmas: style: vertical remove_redundant: true - - records: {} - trailing_whitespace: {} columns: 80 language_extensions: - - DataKinds - - ExplicitForAll - - FlexibleContexts - MultiParamTypeClasses - - StandaloneDeriving + - FlexibleContexts + - ExplicitForAll + - DataKinds diff --git a/github.cabal b/github.cabal index 8e719b6f..c584f746 100644 --- a/github.cabal +++ b/github.cabal @@ -50,7 +50,6 @@ Library ghc-options: -Wall hs-source-dirs: src default-extensions: - NoImplicitPrelude DataKinds DeriveDataTypeable DeriveGeneric diff --git a/samples/Repos/DeployKeys/CreateDeployKey.hs b/samples/Repos/DeployKeys/CreateDeployKey.hs index 20d4e02a..f95f3079 100644 --- a/samples/Repos/DeployKeys/CreateDeployKey.hs +++ b/samples/Repos/DeployKeys/CreateDeployKey.hs @@ -1,11 +1,9 @@ {-# LANGUAGE OverloadedStrings #-} module Main (main) where -import GitHub.Data.Id (Id (..)) import qualified GitHub.Data.DeployKeys as DK import qualified GitHub.Endpoints.Repos.DeployKeys as DK import qualified GitHub.Auth as Auth -import Data.List import Data.Text (Text) main :: IO () diff --git a/samples/Repos/DeployKeys/ListDeployKeys.hs b/samples/Repos/DeployKeys/ListDeployKeys.hs index 650d1c9a..bde0b665 100644 --- a/samples/Repos/DeployKeys/ListDeployKeys.hs +++ b/samples/Repos/DeployKeys/ListDeployKeys.hs @@ -4,7 +4,7 @@ module Main (main) where import qualified GitHub.Data.DeployKeys as DK import qualified GitHub.Endpoints.Repos.DeployKeys as DK import qualified GitHub.Auth as Auth -import Data.List +import Data.List (intercalate) import Data.Vector (toList) main :: IO () diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index 58555afa..228575c9 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -1,4 +1,4 @@ --- This file has been generated from package.yaml by hpack version 0.9.0. +-- This file has been generated from package.yaml by hpack version 0.14.1. -- -- see: https://github.com/sol/hpack @@ -20,31 +20,10 @@ library Common default-language: Haskell2010 -executable github-edit-team - main-is: EditTeam.hs - hs-source-dirs: - Teams - ghc-options: -Wall - build-depends: - base - , base-compat - , github - , text - , github-samples - other-modules: - DeleteTeam - ListRepos - ListTeamsCurrent - Memberships.AddTeamMembershipFor - Memberships.DeleteTeamMembershipFor - Memberships.TeamMembershipInfoFor - TeamInfoFor - default-language: Haskell2010 - -executable github-list-team-current - main-is: ListTeamsCurrent.hs +executable github-add-team-membership-for + main-is: AddTeamMembershipFor.hs hs-source-dirs: - Teams + Teams/Memberships ghc-options: -Wall build-depends: base @@ -53,35 +32,12 @@ executable github-list-team-current , text , github-samples other-modules: - DeleteTeam - EditTeam - ListRepos - Memberships.AddTeamMembershipFor - Memberships.DeleteTeamMembershipFor - Memberships.TeamMembershipInfoFor - TeamInfoFor - default-language: Haskell2010 - -executable github-operational - main-is: Operational.hs - hs-source-dirs: - Operational - ghc-options: -Wall - build-depends: - base - , base-compat - , github - , text - , github-samples - , http-client - , http-client-tls - , operational - , transformers - , transformers-compat + DeleteTeamMembershipFor + TeamMembershipInfoFor default-language: Haskell2010 -executable github-show-deploy-key - main-is: ShowDeployKey.hs +executable github-create-deploy-key + main-is: CreateDeployKey.hs hs-source-dirs: Repos/DeployKeys ghc-options: -Wall @@ -92,9 +48,9 @@ executable github-show-deploy-key , text , github-samples other-modules: - CreateDeployKey DeleteDeployKey ListDeployKeys + ShowDeployKey default-language: Haskell2010 executable github-delete-deploy-key @@ -114,8 +70,8 @@ executable github-delete-deploy-key ShowDeployKey default-language: Haskell2010 -executable github-list-team-repos - main-is: ListRepos.hs +executable github-delete-team + main-is: DeleteTeam.hs hs-source-dirs: Teams ghc-options: -Wall @@ -126,8 +82,8 @@ executable github-list-team-repos , text , github-samples other-modules: - DeleteTeam EditTeam + ListRepos ListTeamsCurrent Memberships.AddTeamMembershipFor Memberships.DeleteTeamMembershipFor @@ -135,8 +91,24 @@ executable github-list-team-repos TeamInfoFor default-language: Haskell2010 -executable github-delete-team - main-is: DeleteTeam.hs +executable github-delete-team-membership-for + main-is: DeleteTeamMembershipFor.hs + hs-source-dirs: + Teams/Memberships + ghc-options: -Wall + build-depends: + base + , base-compat + , github + , text + , github-samples + other-modules: + AddTeamMembershipFor + TeamMembershipInfoFor + default-language: Haskell2010 + +executable github-edit-team + main-is: EditTeam.hs hs-source-dirs: Teams ghc-options: -Wall @@ -147,7 +119,7 @@ executable github-delete-team , text , github-samples other-modules: - EditTeam + DeleteTeam ListRepos ListTeamsCurrent Memberships.AddTeamMembershipFor @@ -174,10 +146,10 @@ executable github-list-deploy-keys-for ShowDeployKey default-language: Haskell2010 -executable github-delete-team-membership-for - main-is: DeleteTeamMembershipFor.hs +executable github-list-followers + main-is: ListFollowers.hs hs-source-dirs: - Teams/Memberships + Users/Followers ghc-options: -Wall build-depends: base @@ -186,32 +158,29 @@ executable github-delete-team-membership-for , text , github-samples other-modules: - AddTeamMembershipFor - TeamMembershipInfoFor + Example + ListFollowing default-language: Haskell2010 -executable github-show-user-2 - main-is: ShowUser2.hs +executable github-list-followers-example + main-is: Example.hs hs-source-dirs: - Users + Users/Followers ghc-options: -Wall build-depends: base , base-compat , github , text - , github-samples other-modules: - Followers.Example - Followers.ListFollowers - Followers.ListFollowing - ShowUser + ListFollowers + ListFollowing default-language: Haskell2010 -executable github-show-user - main-is: ShowUser.hs +executable github-list-following + main-is: ListFollowing.hs hs-source-dirs: - Users + Users/Followers ghc-options: -Wall build-depends: base @@ -220,16 +189,14 @@ executable github-show-user , text , github-samples other-modules: - Followers.Example - Followers.ListFollowers - Followers.ListFollowing - ShowUser2 + Example + ListFollowers default-language: Haskell2010 -executable github-list-following - main-is: ListFollowing.hs +executable github-list-team-current + main-is: ListTeamsCurrent.hs hs-source-dirs: - Users/Followers + Teams ghc-options: -Wall build-depends: base @@ -238,27 +205,56 @@ executable github-list-following , text , github-samples other-modules: - Example - ListFollowers + DeleteTeam + EditTeam + ListRepos + Memberships.AddTeamMembershipFor + Memberships.DeleteTeamMembershipFor + Memberships.TeamMembershipInfoFor + TeamInfoFor default-language: Haskell2010 -executable github-list-followers-example - main-is: Example.hs +executable github-list-team-repos + main-is: ListRepos.hs hs-source-dirs: - Users/Followers + Teams ghc-options: -Wall build-depends: base , base-compat , github , text + , github-samples other-modules: - ListFollowers - ListFollowing + DeleteTeam + EditTeam + ListTeamsCurrent + Memberships.AddTeamMembershipFor + Memberships.DeleteTeamMembershipFor + Memberships.TeamMembershipInfoFor + TeamInfoFor default-language: Haskell2010 -executable github-create-deploy-key - main-is: CreateDeployKey.hs +executable github-operational + main-is: Operational.hs + hs-source-dirs: + Operational + ghc-options: -Wall + build-depends: + base + , base-compat + , github + , text + , github-samples + , http-client + , http-client-tls + , operational + , transformers + , transformers-compat + default-language: Haskell2010 + +executable github-show-deploy-key + main-is: ShowDeployKey.hs hs-source-dirs: Repos/DeployKeys ghc-options: -Wall @@ -269,15 +265,15 @@ executable github-create-deploy-key , text , github-samples other-modules: + CreateDeployKey DeleteDeployKey ListDeployKeys - ShowDeployKey default-language: Haskell2010 -executable github-add-team-membership-for - main-is: AddTeamMembershipFor.hs +executable github-show-user + main-is: ShowUser.hs hs-source-dirs: - Teams/Memberships + Users ghc-options: -Wall build-depends: base @@ -286,14 +282,16 @@ executable github-add-team-membership-for , text , github-samples other-modules: - DeleteTeamMembershipFor - TeamMembershipInfoFor + Followers.Example + Followers.ListFollowers + Followers.ListFollowing + ShowUser2 default-language: Haskell2010 -executable github-team-membership-info-for - main-is: TeamMembershipInfoFor.hs +executable github-show-user-2 + main-is: ShowUser2.hs hs-source-dirs: - Teams/Memberships + Users ghc-options: -Wall build-depends: base @@ -302,14 +300,16 @@ executable github-team-membership-info-for , text , github-samples other-modules: - AddTeamMembershipFor - DeleteTeamMembershipFor + Followers.Example + Followers.ListFollowers + Followers.ListFollowing + ShowUser default-language: Haskell2010 -executable github-list-followers - main-is: ListFollowers.hs +executable github-team-membership-info-for + main-is: TeamMembershipInfoFor.hs hs-source-dirs: - Users/Followers + Teams/Memberships ghc-options: -Wall build-depends: base @@ -318,8 +318,8 @@ executable github-list-followers , text , github-samples other-modules: - Example - ListFollowing + AddTeamMembershipFor + DeleteTeamMembershipFor default-language: Haskell2010 executable github-teaminfo-for diff --git a/src/GitHub/Auth.hs b/src/GitHub/Auth.hs index 05ac6e30..c197fb4a 100644 --- a/src/GitHub/Auth.hs +++ b/src/GitHub/Auth.hs @@ -6,6 +6,7 @@ module GitHub.Auth where import GitHub.Internal.Prelude +import Prelude () import qualified Data.ByteString as BS diff --git a/src/GitHub/Data.hs b/src/GitHub/Data.hs index c63b7741..9700ff1b 100644 --- a/src/GitHub/Data.hs +++ b/src/GitHub/Data.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -49,6 +49,7 @@ module GitHub.Data ( ) where import GitHub.Internal.Prelude +import Prelude () import GitHub.Auth import GitHub.Data.Activities diff --git a/src/GitHub/Data/Activities.hs b/src/GitHub/Data/Activities.hs index 4e62c32f..90943d36 100644 --- a/src/GitHub/Data/Activities.hs +++ b/src/GitHub/Data/Activities.hs @@ -7,6 +7,7 @@ module GitHub.Data.Activities where import GitHub.Data.Repos (Repo) import GitHub.Internal.Prelude +import Prelude () data RepoStarred = RepoStarred { repoStarredStarredAt :: !UTCTime diff --git a/src/GitHub/Data/Comments.hs b/src/GitHub/Data/Comments.hs index c257d5e0..0343834a 100644 --- a/src/GitHub/Data/Comments.hs +++ b/src/GitHub/Data/Comments.hs @@ -9,6 +9,7 @@ import GitHub.Data.Definitions import GitHub.Data.Id (Id) import GitHub.Data.URL (URL) import GitHub.Internal.Prelude +import Prelude () data Comment = Comment { commentPosition :: !(Maybe Int) diff --git a/src/GitHub/Data/Content.hs b/src/GitHub/Data/Content.hs index 4347aab3..9c17b81e 100644 --- a/src/GitHub/Data/Content.hs +++ b/src/GitHub/Data/Content.hs @@ -7,6 +7,7 @@ module GitHub.Data.Content where import GitHub.Data.URL import GitHub.Internal.Prelude +import Prelude () data Content = ContentFile !ContentFileData diff --git a/src/GitHub/Data/Definitions.hs b/src/GitHub/Data/Definitions.hs index 8b64b405..325cec76 100644 --- a/src/GitHub/Data/Definitions.hs +++ b/src/GitHub/Data/Definitions.hs @@ -6,6 +6,7 @@ module GitHub.Data.Definitions where import GitHub.Internal.Prelude +import Prelude () import Control.Monad (mfilter) import Data.Aeson.Types (Parser) diff --git a/src/GitHub/Data/DeployKeys.hs b/src/GitHub/Data/DeployKeys.hs index c93f0b6d..bca594c9 100644 --- a/src/GitHub/Data/DeployKeys.hs +++ b/src/GitHub/Data/DeployKeys.hs @@ -8,6 +8,7 @@ module GitHub.Data.DeployKeys where import GitHub.Data.Id (Id) import GitHub.Data.URL (URL) import GitHub.Internal.Prelude +import Prelude () data RepoDeployKey = RepoDeployKey { repoDeployKeyId :: !(Id RepoDeployKey) diff --git a/src/GitHub/Data/Gists.hs b/src/GitHub/Data/Gists.hs index 60e380c2..4ed59f75 100644 --- a/src/GitHub/Data/Gists.hs +++ b/src/GitHub/Data/Gists.hs @@ -11,6 +11,7 @@ import GitHub.Data.Name (Name) import GitHub.Data.Repos (Language) import GitHub.Data.URL (URL) import GitHub.Internal.Prelude +import Prelude () data Gist = Gist { gistUser :: !SimpleUser diff --git a/src/GitHub/Data/GitData.hs b/src/GitHub/Data/GitData.hs index 1bc582fc..c1761e9e 100644 --- a/src/GitHub/Data/GitData.hs +++ b/src/GitHub/Data/GitData.hs @@ -9,6 +9,7 @@ import GitHub.Data.Definitions import GitHub.Data.Name (Name) import GitHub.Data.URL (URL) import GitHub.Internal.Prelude +import Prelude () import qualified Data.Vector as V diff --git a/src/GitHub/Data/Id.hs b/src/GitHub/Data/Id.hs index e584c86e..e0dcfe27 100644 --- a/src/GitHub/Data/Id.hs +++ b/src/GitHub/Data/Id.hs @@ -10,6 +10,7 @@ module GitHub.Data.Id ( ) where import GitHub.Internal.Prelude +import Prelude () -- | Numeric identifier. newtype Id entity = Id Int diff --git a/src/GitHub/Data/Issues.hs b/src/GitHub/Data/Issues.hs index 51a8d908..9457caa5 100644 --- a/src/GitHub/Data/Issues.hs +++ b/src/GitHub/Data/Issues.hs @@ -10,6 +10,7 @@ import GitHub.Data.Id (Id) import GitHub.Data.PullRequests import GitHub.Data.URL (URL) import GitHub.Internal.Prelude +import Prelude () data Issue = Issue { issueClosedAt :: Maybe UTCTime diff --git a/src/GitHub/Data/Name.hs b/src/GitHub/Data/Name.hs index 43f48734..6f9fff53 100644 --- a/src/GitHub/Data/Name.hs +++ b/src/GitHub/Data/Name.hs @@ -10,6 +10,7 @@ module GitHub.Data.Name ( ) where import GitHub.Internal.Prelude +import Prelude () newtype Name entity = N Text deriving (Eq, Ord, Show, Generic, Typeable, Data) diff --git a/src/GitHub/Data/PullRequests.hs b/src/GitHub/Data/PullRequests.hs index 812c866f..5ce84f7a 100644 --- a/src/GitHub/Data/PullRequests.hs +++ b/src/GitHub/Data/PullRequests.hs @@ -33,6 +33,7 @@ import GitHub.Data.Id (Id) import GitHub.Data.Repos (Repo) import GitHub.Data.URL (URL) import GitHub.Internal.Prelude +import Prelude () import qualified Data.Text.Encoding as TE diff --git a/src/GitHub/Data/Repos.hs b/src/GitHub/Data/Repos.hs index 9bcbf447..409b4b25 100644 --- a/src/GitHub/Data/Repos.hs +++ b/src/GitHub/Data/Repos.hs @@ -1,5 +1,5 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleInstances #-} #define UNSAFE 1 ----------------------------------------------------------------------------- -- | @@ -16,6 +16,7 @@ import GitHub.Data.Id (Id) import GitHub.Data.Name (Name) import GitHub.Data.URL (URL) import GitHub.Internal.Prelude +import Prelude () import qualified Data.HashMap.Strict as HM diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs index 7ccfbe37..604fcd82 100644 --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -102,6 +102,7 @@ instance Hashable (StatusMap a) where data FetchCount = FetchAtLeast !Word | FetchAll deriving (Eq, Ord, Read, Show, Generic, Typeable) + -- | This instance is there mostly for 'fromInteger'. instance Num FetchCount where fromInteger = FetchAtLeast . fromInteger @@ -117,6 +118,8 @@ instance Num FetchCount where negate = error "negate @FetchCount: not implemented" instance Hashable FetchCount +instance Binary FetchCount +instance NFData FetchCount where rnf = genericRnf ------------------------------------------------------------------------------ -- Github request diff --git a/src/GitHub/Data/Search.hs b/src/GitHub/Data/Search.hs index daaf0bc2..cd19da19 100644 --- a/src/GitHub/Data/Search.hs +++ b/src/GitHub/Data/Search.hs @@ -8,6 +8,7 @@ module GitHub.Data.Search where import GitHub.Data.Repos (Repo) import GitHub.Data.URL (URL) import GitHub.Internal.Prelude +import Prelude () import qualified Data.Vector as V diff --git a/src/GitHub/Data/Teams.hs b/src/GitHub/Data/Teams.hs index 9ab433e9..2ee0b63c 100644 --- a/src/GitHub/Data/Teams.hs +++ b/src/GitHub/Data/Teams.hs @@ -15,6 +15,7 @@ import GitHub.Data.Name (Name) import GitHub.Data.Repos (Repo) import GitHub.Data.URL (URL) import GitHub.Internal.Prelude +import Prelude () data Privacy = PrivacyClosed diff --git a/src/GitHub/Data/URL.hs b/src/GitHub/Data/URL.hs index 5dea2a7e..9b29b673 100644 --- a/src/GitHub/Data/URL.hs +++ b/src/GitHub/Data/URL.hs @@ -9,6 +9,7 @@ module GitHub.Data.URL ( ) where import GitHub.Internal.Prelude +import Prelude () -- | Data representing URLs in responses. -- diff --git a/src/GitHub/Data/Webhooks.hs b/src/GitHub/Data/Webhooks.hs index aa8101c5..2e49e2e6 100644 --- a/src/GitHub/Data/Webhooks.hs +++ b/src/GitHub/Data/Webhooks.hs @@ -5,6 +5,8 @@ -- module GitHub.Data.Webhooks where +import Prelude () + import GitHub.Data.Id (Id) import GitHub.Data.URL (URL) import GitHub.Internal.Prelude diff --git a/src/GitHub/Data/Webhooks/Validate.hs b/src/GitHub/Data/Webhooks/Validate.hs index b8e8fe9b..00884a5d 100644 --- a/src/GitHub/Data/Webhooks/Validate.hs +++ b/src/GitHub/Data/Webhooks/Validate.hs @@ -10,6 +10,7 @@ module GitHub.Data.Webhooks.Validate ( ) where import GitHub.Internal.Prelude +import Prelude () import Crypto.Hash (HMAC, SHA1, hmac, hmacGetDigest) import Data.Byteable (constEqBytes, toBytes) diff --git a/src/GitHub/Endpoints/Activity/Starring.hs b/src/GitHub/Endpoints/Activity/Starring.hs index d08645b2..1661305b 100644 --- a/src/GitHub/Endpoints/Activity/Starring.hs +++ b/src/GitHub/Endpoints/Activity/Starring.hs @@ -19,8 +19,9 @@ module GitHub.Endpoints.Activity.Starring ( import GitHub.Auth import GitHub.Data -import GitHub.Request import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () -- | The list of users that have starred the specified Github repo. -- @@ -40,7 +41,7 @@ stargazersForR user repo = -- > reposStarredBy Nothing "croaky" reposStarredBy :: Maybe Auth -> Name Owner -> IO (Either Error (Vector Repo)) reposStarredBy auth user = - executeRequestMaybe auth $ reposStarredByR user FetchAll + executeRequestMaybe auth $ reposStarredByR user FetchAll -- | List repositories being starred. -- See @@ -51,7 +52,7 @@ reposStarredByR user = -- | All the repos starred by the authenticated user. myStarred :: Auth -> IO (Either Error (Vector Repo)) myStarred auth = - executeRequest auth $ myStarredR FetchAll + executeRequest auth $ myStarredR FetchAll -- | All the repos starred by the authenticated user. -- See @@ -62,7 +63,7 @@ myStarredR = PagedQuery ["user", "starred"] [] -- | All the repos starred by the authenticated user. myStarredAcceptStar :: Auth -> IO (Either Error (Vector RepoStarred)) myStarredAcceptStar auth = - executeRequest auth $ myStarredAcceptStarR FetchAll + executeRequest auth $ myStarredAcceptStarR FetchAll -- | All the repos starred by the authenticated user. -- See diff --git a/src/GitHub/Endpoints/Activity/Watching.hs b/src/GitHub/Endpoints/Activity/Watching.hs index 95ab457e..9e096053 100644 --- a/src/GitHub/Endpoints/Activity/Watching.hs +++ b/src/GitHub/Endpoints/Activity/Watching.hs @@ -15,10 +15,11 @@ module GitHub.Endpoints.Activity.Watching ( module GitHub.Data, ) where -import GitHub.Internal.Prelude import GitHub.Auth import GitHub.Data +import GitHub.Internal.Prelude import GitHub.Request +import Prelude () -- | The list of users that are watching the specified Github repo. -- diff --git a/src/GitHub/Endpoints/Gists.hs b/src/GitHub/Endpoints/Gists.hs index ead659ec..6804a092 100644 --- a/src/GitHub/Endpoints/Gists.hs +++ b/src/GitHub/Endpoints/Gists.hs @@ -15,8 +15,9 @@ module GitHub.Endpoints.Gists ( ) where import GitHub.Data -import GitHub.Request import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () -- | The list of all gists created by the user -- diff --git a/src/GitHub/Endpoints/Gists/Comments.hs b/src/GitHub/Endpoints/Gists/Comments.hs index 1ca8a23c..60a27caa 100644 --- a/src/GitHub/Endpoints/Gists/Comments.hs +++ b/src/GitHub/Endpoints/Gists/Comments.hs @@ -14,8 +14,9 @@ module GitHub.Endpoints.Gists.Comments ( ) where import GitHub.Data -import GitHub.Request import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () -- | All the comments on a Gist, given the Gist ID. -- diff --git a/src/GitHub/Endpoints/GitData/Blobs.hs b/src/GitHub/Endpoints/GitData/Blobs.hs index b9c3d5dd..33ab8437 100644 --- a/src/GitHub/Endpoints/GitData/Blobs.hs +++ b/src/GitHub/Endpoints/GitData/Blobs.hs @@ -13,8 +13,9 @@ module GitHub.Endpoints.GitData.Blobs ( ) where import GitHub.Data -import GitHub.Request import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () -- | Query a blob by SHA1. -- diff --git a/src/GitHub/Endpoints/GitData/Commits.hs b/src/GitHub/Endpoints/GitData/Commits.hs index 6bdd51d7..87bb6fac 100644 --- a/src/GitHub/Endpoints/GitData/Commits.hs +++ b/src/GitHub/Endpoints/GitData/Commits.hs @@ -12,8 +12,9 @@ module GitHub.Endpoints.GitData.Commits ( ) where import GitHub.Data -import GitHub.Request import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () -- | A single commit, by SHA1. -- diff --git a/src/GitHub/Endpoints/GitData/References.hs b/src/GitHub/Endpoints/GitData/References.hs index a96e847d..7e0c6d57 100644 --- a/src/GitHub/Endpoints/GitData/References.hs +++ b/src/GitHub/Endpoints/GitData/References.hs @@ -20,8 +20,9 @@ module GitHub.Endpoints.GitData.References ( ) where import GitHub.Data -import GitHub.Request import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () -- | A single reference by the ref name. -- diff --git a/src/GitHub/Endpoints/GitData/Trees.hs b/src/GitHub/Endpoints/GitData/Trees.hs index fecc3a27..29f27abe 100644 --- a/src/GitHub/Endpoints/GitData/Trees.hs +++ b/src/GitHub/Endpoints/GitData/Trees.hs @@ -16,8 +16,9 @@ module GitHub.Endpoints.GitData.Trees ( ) where import GitHub.Data -import GitHub.Request import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () -- | A tree for a SHA1. -- diff --git a/src/GitHub/Endpoints/Issues.hs b/src/GitHub/Endpoints/Issues.hs index 6ff8f763..8998d08d 100644 --- a/src/GitHub/Endpoints/Issues.hs +++ b/src/GitHub/Endpoints/Issues.hs @@ -25,6 +25,7 @@ module GitHub.Endpoints.Issues ( import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request +import Prelude () import qualified Data.Text as T import qualified Data.Text.Encoding as TE diff --git a/src/GitHub/Endpoints/Issues/Comments.hs b/src/GitHub/Endpoints/Issues/Comments.hs index e12ec595..81a9b52c 100644 --- a/src/GitHub/Endpoints/Issues/Comments.hs +++ b/src/GitHub/Endpoints/Issues/Comments.hs @@ -18,9 +18,10 @@ module GitHub.Endpoints.Issues.Comments ( module GitHub.Data, ) where -import GitHub.Internal.Prelude import GitHub.Data +import GitHub.Internal.Prelude import GitHub.Request +import Prelude () -- | A specific comment, by ID. -- diff --git a/src/GitHub/Endpoints/Issues/Events.hs b/src/GitHub/Endpoints/Issues/Events.hs index 0581099e..bf108cee 100644 --- a/src/GitHub/Endpoints/Issues/Events.hs +++ b/src/GitHub/Endpoints/Issues/Events.hs @@ -19,8 +19,9 @@ module GitHub.Endpoints.Issues.Events ( ) where import GitHub.Data -import GitHub.Request import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () -- | All events that have happened on an issue. -- diff --git a/src/GitHub/Endpoints/Issues/Labels.hs b/src/GitHub/Endpoints/Issues/Labels.hs index b7e5192b..3e4829f7 100644 --- a/src/GitHub/Endpoints/Issues/Labels.hs +++ b/src/GitHub/Endpoints/Issues/Labels.hs @@ -35,15 +35,10 @@ module GitHub.Endpoints.Issues.Labels ( module GitHub.Data, ) where -import Prelude () -import Prelude.Compat - -import Data.Aeson.Compat (encode, object, (.=)) -import Data.Foldable (toList) -import Data.Vector (Vector) - import GitHub.Data +import GitHub.Internal.Prelude import GitHub.Request +import Prelude () -- | All the labels available to use on any issue in the repo. -- diff --git a/src/GitHub/Endpoints/Issues/Milestones.hs b/src/GitHub/Endpoints/Issues/Milestones.hs index 5e4869c6..65106975 100644 --- a/src/GitHub/Endpoints/Issues/Milestones.hs +++ b/src/GitHub/Endpoints/Issues/Milestones.hs @@ -15,8 +15,9 @@ module GitHub.Endpoints.Issues.Milestones ( ) where import GitHub.Data -import GitHub.Request import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () -- | All milestones in the repo. -- diff --git a/src/GitHub/Endpoints/Organizations.hs b/src/GitHub/Endpoints/Organizations.hs index 8bc3f746..098d39cc 100644 --- a/src/GitHub/Endpoints/Organizations.hs +++ b/src/GitHub/Endpoints/Organizations.hs @@ -15,8 +15,9 @@ module GitHub.Endpoints.Organizations ( ) where import GitHub.Data -import GitHub.Request import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () -- | The public organizations for a user, given the user's login, with authorization -- diff --git a/src/GitHub/Endpoints/Organizations/Members.hs b/src/GitHub/Endpoints/Organizations/Members.hs index 333279db..f3588f56 100644 --- a/src/GitHub/Endpoints/Organizations/Members.hs +++ b/src/GitHub/Endpoints/Organizations/Members.hs @@ -14,8 +14,9 @@ module GitHub.Endpoints.Organizations.Members ( ) where import GitHub.Data -import GitHub.Request import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () -- | All the users who are members of the specified organization, -- | with or without authentication. diff --git a/src/GitHub/Endpoints/Organizations/Teams.hs b/src/GitHub/Endpoints/Organizations/Teams.hs index ff25a8e9..8e8e9564 100644 --- a/src/GitHub/Endpoints/Organizations/Teams.hs +++ b/src/GitHub/Endpoints/Organizations/Teams.hs @@ -35,8 +35,9 @@ module GitHub.Endpoints.Organizations.Teams ( ) where import GitHub.Data -import GitHub.Request import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () -- | List teams. List the teams of an Owner. -- When authenticated, lists private teams visible to the authenticated user. diff --git a/src/GitHub/Endpoints/PullRequests.hs b/src/GitHub/Endpoints/PullRequests.hs index 46aae86b..5b79951d 100644 --- a/src/GitHub/Endpoints/PullRequests.hs +++ b/src/GitHub/Endpoints/PullRequests.hs @@ -29,8 +29,9 @@ module GitHub.Endpoints.PullRequests ( ) where import GitHub.Data -import GitHub.Request import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () -- | All open pull requests for the repo, by owner and repo name. -- diff --git a/src/GitHub/Endpoints/PullRequests/ReviewComments.hs b/src/GitHub/Endpoints/PullRequests/ReviewComments.hs index 5c6528df..3fe77333 100644 --- a/src/GitHub/Endpoints/PullRequests/ReviewComments.hs +++ b/src/GitHub/Endpoints/PullRequests/ReviewComments.hs @@ -14,8 +14,9 @@ module GitHub.Endpoints.PullRequests.ReviewComments ( ) where import GitHub.Data -import GitHub.Request import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () -- | All the comments on a pull request with the given ID. -- diff --git a/src/GitHub/Endpoints/Repos.hs b/src/GitHub/Endpoints/Repos.hs index 6c5bb14e..3a588bf2 100644 --- a/src/GitHub/Endpoints/Repos.hs +++ b/src/GitHub/Endpoints/Repos.hs @@ -56,8 +56,9 @@ module GitHub.Endpoints.Repos ( ) where import GitHub.Data -import GitHub.Request import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () import qualified Data.Text.Encoding as TE diff --git a/src/GitHub/Endpoints/Repos/Collaborators.hs b/src/GitHub/Endpoints/Repos/Collaborators.hs index 6753e9fa..36b47c89 100644 --- a/src/GitHub/Endpoints/Repos/Collaborators.hs +++ b/src/GitHub/Endpoints/Repos/Collaborators.hs @@ -15,8 +15,9 @@ module GitHub.Endpoints.Repos.Collaborators ( ) where import GitHub.Data -import GitHub.Request import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () -- | All the users who have collaborated on a repo. -- diff --git a/src/GitHub/Endpoints/Repos/Comments.hs b/src/GitHub/Endpoints/Repos/Comments.hs index 30db12ab..6fd4dcc7 100644 --- a/src/GitHub/Endpoints/Repos/Comments.hs +++ b/src/GitHub/Endpoints/Repos/Comments.hs @@ -20,8 +20,9 @@ module GitHub.Endpoints.Repos.Comments ( ) where import GitHub.Data -import GitHub.Request import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () -- | All the comments on a Github repo. -- diff --git a/src/GitHub/Endpoints/Repos/Commits.hs b/src/GitHub/Endpoints/Repos/Commits.hs index ff11f31d..b6ccf5be 100644 --- a/src/GitHub/Endpoints/Repos/Commits.hs +++ b/src/GitHub/Endpoints/Repos/Commits.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -23,9 +23,10 @@ module GitHub.Endpoints.Repos.Commits ( module GitHub.Data, ) where -import GitHub.Internal.Prelude import GitHub.Data +import GitHub.Internal.Prelude import GitHub.Request +import Prelude () import qualified Data.ByteString as BS import qualified Data.Text as T diff --git a/src/GitHub/Endpoints/Repos/DeployKeys.hs b/src/GitHub/Endpoints/Repos/DeployKeys.hs index 45dc0c3f..99db6ad2 100644 --- a/src/GitHub/Endpoints/Repos/DeployKeys.hs +++ b/src/GitHub/Endpoints/Repos/DeployKeys.hs @@ -22,8 +22,9 @@ module GitHub.Endpoints.Repos.DeployKeys ( ) where import GitHub.Data -import GitHub.Request import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () -- | Querying deploy keys deployKeysFor' :: Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector RepoDeployKey)) diff --git a/src/GitHub/Endpoints/Repos/Forks.hs b/src/GitHub/Endpoints/Repos/Forks.hs index 76be374d..8b95c208 100644 --- a/src/GitHub/Endpoints/Repos/Forks.hs +++ b/src/GitHub/Endpoints/Repos/Forks.hs @@ -13,8 +13,9 @@ module GitHub.Endpoints.Repos.Forks ( ) where import GitHub.Data -import GitHub.Request import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () -- | All the repos that are forked off the given repo. -- diff --git a/src/GitHub/Endpoints/Repos/Webhooks.hs b/src/GitHub/Endpoints/Repos/Webhooks.hs index 5fa7b784..5a5d6810 100644 --- a/src/GitHub/Endpoints/Repos/Webhooks.hs +++ b/src/GitHub/Endpoints/Repos/Webhooks.hs @@ -33,8 +33,9 @@ module GitHub.Endpoints.Repos.Webhooks ( ) where import GitHub.Data -import GitHub.Request import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () webhooksFor' :: Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector RepoWebhook)) webhooksFor' auth user repo = diff --git a/src/GitHub/Endpoints/Search.hs b/src/GitHub/Endpoints/Search.hs index 41d62d74..86f125d3 100644 --- a/src/GitHub/Endpoints/Search.hs +++ b/src/GitHub/Endpoints/Search.hs @@ -19,8 +19,9 @@ module GitHub.Endpoints.Search( ) where import GitHub.Data -import GitHub.Request import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () import qualified Data.Text.Encoding as TE diff --git a/src/GitHub/Endpoints/Users.hs b/src/GitHub/Endpoints/Users.hs index 477a121a..71ebca84 100644 --- a/src/GitHub/Endpoints/Users.hs +++ b/src/GitHub/Endpoints/Users.hs @@ -16,8 +16,9 @@ module GitHub.Endpoints.Users ( ) where import GitHub.Data -import GitHub.Request import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () -- | The information for a single user, by login name. -- With authentification diff --git a/src/GitHub/Endpoints/Users/Followers.hs b/src/GitHub/Endpoints/Users/Followers.hs index 719a85d6..f112e424 100644 --- a/src/GitHub/Endpoints/Users/Followers.hs +++ b/src/GitHub/Endpoints/Users/Followers.hs @@ -14,8 +14,9 @@ module GitHub.Endpoints.Users.Followers ( ) where import GitHub.Data -import GitHub.Request import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () -- | All the users following the given user. -- diff --git a/src/GitHub/Internal/Prelude.hs b/src/GitHub/Internal/Prelude.hs index 533fa1f2..49680f00 100644 --- a/src/GitHub/Internal/Prelude.hs +++ b/src/GitHub/Internal/Prelude.hs @@ -29,7 +29,7 @@ module GitHub.Internal.Prelude ( -- * Data.Maybe catMaybes, -- * Data.List - intercalate, + intercalate, toList, -- * Data.Time.ISO8601 formatISO8601, ) where @@ -37,13 +37,14 @@ module GitHub.Internal.Prelude ( import Control.Applicative ((<|>)) import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) -import Data.Aeson.Compat (FromJSON (..), Object, ToJSON (..), Value (..), - encode, object, withObject, withText, (.!=), - (.:), (.:?), (.=)) +import Data.Aeson.Compat + (FromJSON (..), Object, ToJSON (..), Value (..), encode, object, + withObject, withText, (.!=), (.:), (.:?), (.=)) import Data.Aeson.Types (typeMismatch) import Data.Binary (Binary) -import Data.Binary.Orphans () +import Data.Binary.Orphans () import Data.Data (Data, Typeable) +import Data.Foldable (toList) import Data.Hashable (Hashable (..)) import Data.HashMap.Strict (HashMap) import Data.List (intercalate) @@ -54,6 +55,6 @@ import Data.Text (Text, pack, unpack) import Data.Time (UTCTime) import Data.Time.ISO8601 (formatISO8601) import Data.Vector (Vector) -import Data.Vector.Instances () +import Data.Vector.Instances () import GHC.Generics (Generic) import Prelude.Compat diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index 840c08e0..6161bc8c 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -1,8 +1,8 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE StandaloneDeriving #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -50,6 +50,7 @@ module GitHub.Request ( ) where import GitHub.Internal.Prelude +import Prelude () #if MIN_VERSION_mtl(2,2,0) import Control.Monad.Except (MonadError (..)) @@ -63,23 +64,22 @@ import Control.Monad.Trans.Except (ExceptT (..), runExceptT) import Data.Aeson.Compat (eitherDecode) import Data.List (find) -import Network.HTTP.Client (CookieJar, HttpException (..), Manager, - RequestBody (..), Response (..), - applyBasicAuth, checkStatus, httpLbs, - method, newManager, requestBody, - requestHeaders, setQueryString) +import Network.HTTP.Client + (CookieJar, HttpException (..), Manager, RequestBody (..), + Response (..), applyBasicAuth, checkStatus, httpLbs, method, newManager, + requestBody, requestHeaders, setQueryString) #if MIN_VERSION_http_client(0,4,30) -import Network.HTTP.Client (parseUrlThrow) +import Network.HTTP.Client (parseUrlThrow) #else -import Network.HTTP.Client (parseUrl) +import Network.HTTP.Client (parseUrl) #endif import Network.HTTP.Client.Internal (setUri) import Network.HTTP.Client.TLS (tlsManagerSettings) import Network.HTTP.Link.Parser (parseLinkHeaderBS) -import Network.HTTP.Link.Types (Link (..), LinkParam (..), href, - linkParams) -import Network.HTTP.Types (Method, RequestHeaders, ResponseHeaders, - Status (..)) +import Network.HTTP.Link.Types + (Link (..), LinkParam (..), href, linkParams) +import Network.HTTP.Types + (Method, RequestHeaders, ResponseHeaders, Status (..)) import Network.URI (URI) import qualified Control.Exception as E diff --git a/stack-lts-5.yaml b/stack-lts-5.yaml index 127719a3..591b123f 100644 --- a/stack-lts-5.yaml +++ b/stack-lts-5.yaml @@ -1,4 +1,4 @@ -resolver: lts-5.17 +resolver: lts-5.18 packages: - '.' - samples/ From 30b679d26d36714af5ee760dd5e62409cb909784 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 13 Sep 2016 10:29:13 +0300 Subject: [PATCH 220/510] Bump bounds --- github.cabal | 7 ++-- src/GitHub/Data/Repos.hs | 14 ++++++-- src/GitHub/Request.hs | 75 +++++++++++++++++++++++++--------------- stack-nightly.yaml | 7 ++-- 4 files changed, 67 insertions(+), 36 deletions(-) diff --git a/github.cabal b/github.cabal index c584f746..7fbe4539 100644 --- a/github.cabal +++ b/github.cabal @@ -117,8 +117,7 @@ Library -- Packages needed in order to build this package. build-depends: base >=4.7 && <4.10, - aeson >=0.7.0.6 && <0.12, - attoparsec >=0.11.3.4 && <0.14, + aeson >=0.7.0.6 && <1.1, base-compat >=0.9.1 && <0.10, base16-bytestring >=0.1.1.6 && <0.2, binary >=0.7.1.0 && <0.9, @@ -131,8 +130,8 @@ Library deepseq-generics >=0.1.1.2 && <0.3, exceptions >=0.8.0.2 && <0.9, hashable >=1.2.3.3 && <1.3, - http-client >=0.4.8.1 && <0.5, - http-client-tls >=0.2.2 && <0.3, + http-client >=0.4.8.1 && <0.6, + http-client-tls >=0.2.2 && <0.4, http-link-header >=1.0.1 && <1.1, http-types >=0.8.6 && <0.10, iso8601-time >=0.1.4 && <0.2, diff --git a/src/GitHub/Data/Repos.hs b/src/GitHub/Data/Repos.hs index 409b4b25..8e3c9343 100644 --- a/src/GitHub/Data/Repos.hs +++ b/src/GitHub/Data/Repos.hs @@ -8,7 +8,7 @@ -- -- This module also exports -- @'FromJSON' a => 'FromJSON' ('HM.HashMap' 'Language' a)@ --- orphan-ish instance. +-- orphan-ish instance for @aeson < 1@ module GitHub.Data.Repos where import GitHub.Data.Definitions @@ -19,10 +19,13 @@ import GitHub.Internal.Prelude import Prelude () import qualified Data.HashMap.Strict as HM - -#if UNSAFE +#if MIN_VERSION_aeson(1,0,0) +import Data.Aeson.Types (FromJSONKey (..), fromJSONKeyCoerce) +#else +#ifdef UNSAFE import Unsafe.Coerce (unsafeCoerce) #endif +#endif data Repo = Repo { repoSshUrl :: !(Maybe URL) @@ -237,6 +240,10 @@ instance FromJSON Language where instance ToJSON Language where toJSON = toJSON . getLanguage +#if MIN_VERSION_aeson(1,0,0) +instance FromJSONKey Language where + fromJSONKey = fromJSONKeyCoerce +#else instance FromJSON a => FromJSON (HM.HashMap Language a) where parseJSON = fmap mapKeyLanguage . parseJSON where @@ -248,3 +255,4 @@ instance FromJSON a => FromJSON (HM.HashMap Language a) where mapKey :: (Eq k2, Hashable k2) => (k1 -> k2) -> HM.HashMap k1 a -> HM.HashMap k2 a mapKey f = HM.fromList . map (first f) . HM.toList #endif +#endif diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index 6161bc8c..7d192c6d 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -65,28 +65,27 @@ import Data.Aeson.Compat (eitherDecode) import Data.List (find) import Network.HTTP.Client - (CookieJar, HttpException (..), Manager, RequestBody (..), - Response (..), applyBasicAuth, checkStatus, httpLbs, method, newManager, - requestBody, requestHeaders, setQueryString) -#if MIN_VERSION_http_client(0,4,30) -import Network.HTTP.Client (parseUrlThrow) -#else -import Network.HTTP.Client (parseUrl) -#endif + (HttpException (..), Manager, RequestBody (..), Response (..), + applyBasicAuth, httpLbs, method, newManager, requestBody, + requestHeaders, setQueryString) import Network.HTTP.Client.Internal (setUri) import Network.HTTP.Client.TLS (tlsManagerSettings) import Network.HTTP.Link.Parser (parseLinkHeaderBS) import Network.HTTP.Link.Types (Link (..), LinkParam (..), href, linkParams) -import Network.HTTP.Types - (Method, RequestHeaders, ResponseHeaders, Status (..)) +import Network.HTTP.Types (Method, RequestHeaders, Status (..)) import Network.URI (URI) -import qualified Control.Exception as E -import qualified Data.ByteString.Lazy as LBS -import qualified Data.Text as T -import qualified Data.Vector as V -import qualified Network.HTTP.Client as HTTP +#if !MIN_VERSION_http_client(0,5,0) +import qualified Control.Exception as E +import Network.HTTP.Types (ResponseHeaders) +#endif + +import qualified Data.ByteString.Lazy as LBS +import qualified Data.Text as T +import qualified Data.Vector as V +import qualified Network.HTTP.Client as HTTP +import qualified Network.HTTP.Client.Internal as HTTP import GitHub.Auth (Auth (..)) import GitHub.Data (Error (..)) @@ -239,9 +238,9 @@ makeHttpRequest auth r = case r of where parseUrl' :: MonadThrow m => Text -> m HTTP.Request #if MIN_VERSION_http_client(0,4,30) - parseUrl' = parseUrlThrow . T.unpack + parseUrl' = HTTP.parseRequest . T.unpack #else - parseUrl' = parseUrl . T.unpack + parseUrl' = HTTP.parseUrl . T.unpack #endif url :: Paths -> Text @@ -256,7 +255,11 @@ makeHttpRequest auth r = case r of setReqHeaders req = req { requestHeaders = reqHeaders <> requestHeaders req } setCheckStatus :: Maybe (StatusMap a) -> HTTP.Request -> HTTP.Request - setCheckStatus sm req = req { checkStatus = successOrMissing sm } +#if MIN_VERSION_http_client(0,5,0) + setCheckStatus sm req = req { HTTP.checkResponse = successOrMissing sm } +#else + setCheckStatus sm req = req { HTTP.checkStatus = successOrMissing sm } +#endif setMethod :: Method -> HTTP.Request -> HTTP.Request setMethod m req = req { method = m } @@ -278,15 +281,7 @@ makeHttpRequest auth r = case r of getOAuthHeader (EnterpriseOAuth _ token) = [("Authorization", "token " <> token)] getOAuthHeader _ = [] - successOrMissing :: Maybe (StatusMap a) -> Status -> ResponseHeaders -> CookieJar -> Maybe E.SomeException - successOrMissing sm s@(Status sci _) hs cookiejar - | check = Nothing - | otherwise = Just $ E.toException $ StatusCodeException s hs cookiejar - where - check = case sm of - Nothing -> 200 <= sci && sci < 300 - Just StatusOnlyOk -> sci == 204 || sci == 404 - Just StatusMerge -> sci `elem` [204, 405, 409] + -- | Query @Link@ header with @rel=next@ from the request headers. getNextUrl :: Response a -> Maybe URI @@ -357,5 +352,31 @@ performPagedRequest httpLbs' predicate initReq = do go (acc <> m) res' req' (_, _) -> return acc +------------------------------------------------------------------------------- +-- Internal +------------------------------------------------------------------------------- + +#if MIN_VERSION_http_client(0,5,0) +successOrMissing :: Maybe (StatusMap a) -> HTTP.Request -> HTTP.Response HTTP.BodyReader -> IO () +successOrMissing sm _req res + | check = pure () + | otherwise = do + chunk <- HTTP.brReadSome (HTTP.responseBody res) 1024 + let res' = fmap (const ()) res + HTTP.throwHttp $ HTTP.StatusCodeException res' (LBS.toStrict chunk) + where + Status sci _ = HTTP.responseStatus res +#else +successOrMissing :: Maybe (StatusMap a) -> Status -> ResponseHeaders -> HTTP.CookieJar -> Maybe E.SomeException +successOrMissing sm s@(Status sci _) hs cookiejar + | check = Nothing + | otherwise = Just $ E.toException $ StatusCodeException s hs cookiejar + where +#endif + check = case sm of + Nothing -> 200 <= sci && sci < 300 + Just StatusOnlyOk -> sci == 204 || sci == 404 + Just StatusMerge -> sci `elem` [204, 405, 409] + onHttpException :: MonadError Error m => HttpException -> m a onHttpException = throwError . HTTPError diff --git a/stack-nightly.yaml b/stack-nightly.yaml index 81e4d4ff..14000e13 100644 --- a/stack-nightly.yaml +++ b/stack-nightly.yaml @@ -1,8 +1,11 @@ -resolver: nightly-2016-05-13 +resolver: nightly-2016-09-12 packages: - '.' - 'samples/' -extra-deps: [] +extra-deps: +- aeson-1.0.0.0 +- http-client-0.5.3.1 +- http-client-tls-0.3.1 flags: github: aeson-compat: true From 98347144be925de18751c5656226cb847e5be3df Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 13 Sep 2016 15:49:06 +0300 Subject: [PATCH 221/510] Rework options, add currentUserIssuesR and organizationIssuesR --- CHANGELOG.md | 3 + github.cabal | 6 +- spec/GitHub/IssuesSpec.hs | 5 +- spec/GitHub/PullRequestsSpec.hs | 7 +- src/GitHub.hs | 5 +- src/GitHub/Data.hs | 4 + src/GitHub/Data/Issues.hs | 190 ++++------ src/GitHub/Data/Milestone.hs | 42 +++ src/GitHub/Data/Options.hs | 530 +++++++++++++++++++++++++++ src/GitHub/Data/PullRequests.hs | 123 +------ src/GitHub/Endpoints/Issues.hs | 47 +-- src/GitHub/Endpoints/PullRequests.hs | 14 +- src/GitHub/Endpoints/Repos.hs | 53 ++- src/GitHub/Request.hs | 3 +- 14 files changed, 730 insertions(+), 302 deletions(-) create mode 100644 src/GitHub/Data/Milestone.hs create mode 100644 src/GitHub/Data/Options.hs diff --git a/CHANGELOG.md b/CHANGELOG.md index 43121aa8..84527b7b 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,7 @@ Changes for 0.15.0 - Reworked `PullRequest` (notably `pullRequestsFor`) +- Reworked PR and Issue filtering - GHC-8.0.1 support - Change `repoMasterBranch` to `repoDefaultBranch` in `Repo` - Add `listTeamReposR` @@ -8,6 +9,8 @@ Changes for 0.15.0 - Add `HeaderQuery` to `Request` - Add `Hashable Auth` instance - Add `mkUserId`, `mkUserName`, `fromUserId`, `fromOrganizationId` +- Add 'userIssuesR' +- Add 'organizationIssuesR' Changes for 0.14.1 diff --git a/github.cabal b/github.cabal index 7fbe4539..f5a99047 100644 --- a/github.cabal +++ b/github.cabal @@ -67,22 +67,24 @@ Library GitHub.Internal.Prelude GitHub.Auth GitHub.Data + GitHub.Data.Activities GitHub.Data.Comments GitHub.Data.Content GitHub.Data.Definitions + GitHub.Data.DeployKeys GitHub.Data.Gists GitHub.Data.GitData GitHub.Data.Id GitHub.Data.Issues GitHub.Data.Name + GitHub.Data.Milestone + GitHub.Data.Options GitHub.Data.PullRequests GitHub.Data.Repos GitHub.Data.Request GitHub.Data.Search GitHub.Data.Teams - GitHub.Data.Activities GitHub.Data.URL - GitHub.Data.DeployKeys GitHub.Data.Webhooks GitHub.Data.Webhooks.Validate GitHub.Endpoints.Activity.Starring diff --git a/spec/GitHub/IssuesSpec.hs b/spec/GitHub/IssuesSpec.hs index a550ac63..9eb41093 100644 --- a/spec/GitHub/IssuesSpec.hs +++ b/spec/GitHub/IssuesSpec.hs @@ -3,6 +3,9 @@ module GitHub.IssuesSpec where import qualified GitHub +import Prelude () +import Prelude.Compat + import Data.Either.Compat (isRight) import Data.Foldable (for_) import Data.String (fromString) @@ -25,7 +28,7 @@ spec = do describe "issuesForRepoR" $ do it "works" $ withAuth $ \auth -> for_ repos $ \(owner, repo) -> do cs <- GitHub.executeRequest auth $ - GitHub.issuesForRepoR owner repo [] GitHub.FetchAll + GitHub.issuesForRepoR owner repo mempty GitHub.FetchAll cs `shouldSatisfy` isRight where repos = diff --git a/spec/GitHub/PullRequestsSpec.hs b/spec/GitHub/PullRequestsSpec.hs index 4bb93796..78d1ab1c 100644 --- a/spec/GitHub/PullRequestsSpec.hs +++ b/spec/GitHub/PullRequestsSpec.hs @@ -3,9 +3,11 @@ module GitHub.PullRequestsSpec where import qualified GitHub +import Prelude () +import Prelude.Compat + import Data.Either.Compat (isRight) import Data.Foldable (for_) -import Data.Function.Compat ((&)) import Data.String (fromString) import System.Environment (lookupEnv) import Test.Hspec (Spec, describe, it, pendingWith, shouldSatisfy) @@ -34,5 +36,4 @@ spec = do , ("phadej", "github") , ("haskell", "cabal") ] - opts = GitHub.defaultPullRequestOptions - & GitHub.setPullRequestOptionsState GitHub.PullRequestStateClosed + opts = GitHub.stateClosed diff --git a/src/GitHub.hs b/src/GitHub.hs index 3c53cfb5..ce452a10 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -92,9 +92,8 @@ module GitHub ( -- * Issues -- | See -- - -- Missing endpoints: - -- - -- * List issues + currentUserIssuesR, + organizationIssuesR, issueR, issuesForRepoR, createIssueR, diff --git a/src/GitHub/Data.hs b/src/GitHub/Data.hs index 9700ff1b..1a8e9c1b 100644 --- a/src/GitHub/Data.hs +++ b/src/GitHub/Data.hs @@ -39,6 +39,8 @@ module GitHub.Data ( module GitHub.Data.Gists, module GitHub.Data.GitData, module GitHub.Data.Issues, + module GitHub.Data.Milestone, + module GitHub.Data.Options, module GitHub.Data.PullRequests, module GitHub.Data.Repos, module GitHub.Data.Request, @@ -62,9 +64,11 @@ import GitHub.Data.GitData import GitHub.Data.Id import GitHub.Data.Issues import GitHub.Data.Name +import GitHub.Data.Milestone import GitHub.Data.PullRequests import GitHub.Data.Repos import GitHub.Data.Request +import GitHub.Data.Options import GitHub.Data.Search import GitHub.Data.Teams import GitHub.Data.URL diff --git a/src/GitHub/Data/Issues.hs b/src/GitHub/Data/Issues.hs index 9457caa5..eb05efc2 100644 --- a/src/GitHub/Data/Issues.hs +++ b/src/GitHub/Data/Issues.hs @@ -10,39 +10,42 @@ import GitHub.Data.Id (Id) import GitHub.Data.PullRequests import GitHub.Data.URL (URL) import GitHub.Internal.Prelude +import GitHub.Data.Milestone (Milestone) import Prelude () -data Issue = Issue { - issueClosedAt :: Maybe UTCTime - ,issueUpdatedAt :: UTCTime - ,issueEventsUrl :: URL - ,issueHtmlUrl :: Maybe URL - ,issueClosedBy :: Maybe SimpleUser - ,issueLabels :: (Vector IssueLabel) - ,issueNumber :: Int - ,issueAssignee :: Maybe SimpleUser - ,issueUser :: SimpleUser - ,issueTitle :: Text - ,issuePullRequest :: Maybe PullRequestReference - ,issueUrl :: URL - ,issueCreatedAt :: UTCTime - ,issueBody :: Maybe Text - ,issueState :: Text - ,issueId :: Id Issue - ,issueComments :: Int - ,issueMilestone :: Maybe Milestone -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data Issue = Issue + { issueClosedAt :: Maybe UTCTime + , issueUpdatedAt :: UTCTime + , issueEventsUrl :: URL + , issueHtmlUrl :: Maybe URL + , issueClosedBy :: Maybe SimpleUser + , issueLabels :: (Vector IssueLabel) + , issueNumber :: Int + , issueAssignee :: Maybe SimpleUser + , issueUser :: SimpleUser + , issueTitle :: Text + , issuePullRequest :: Maybe PullRequestReference + , issueUrl :: URL + , issueCreatedAt :: UTCTime + , issueBody :: Maybe Text + , issueState :: Text + , issueId :: Id Issue + , issueComments :: Int + , issueMilestone :: Maybe Milestone + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Issue where rnf = genericRnf instance Binary Issue -data NewIssue = NewIssue { - newIssueTitle :: Text -, newIssueBody :: Maybe Text -, newIssueAssignee :: Maybe Text -, newIssueMilestone :: Maybe Int -, newIssueLabels :: Maybe (Vector Text) -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data NewIssue = NewIssue + { newIssueTitle :: Text + , newIssueBody :: Maybe Text + , newIssueAssignee :: Maybe Text + , newIssueMilestone :: Maybe (Id Milestone) + , newIssueLabels :: Maybe (Vector Text) + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData NewIssue where rnf = genericRnf instance Binary NewIssue @@ -52,29 +55,13 @@ data EditIssue = EditIssue { , editIssueBody :: Maybe Text , editIssueAssignee :: Maybe Text , editIssueState :: Maybe Text -, editIssueMilestone :: Maybe Int +, editIssueMilestone :: Maybe (Id Milestone) , editIssueLabels :: Maybe (Vector Text) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData EditIssue where rnf = genericRnf instance Binary EditIssue -data Milestone = Milestone { - milestoneCreator :: SimpleUser - ,milestoneDueOn :: Maybe UTCTime - ,milestoneOpenIssues :: Int - ,milestoneNumber :: Int - ,milestoneClosedIssues :: Int - ,milestoneDescription :: Maybe Text - ,milestoneTitle :: Text - ,milestoneUrl :: URL - ,milestoneCreatedAt :: UTCTime - ,milestoneState :: Text -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData Milestone where rnf = genericRnf -instance Binary Milestone - data IssueLabel = IssueLabel { labelColor :: Text ,labelUrl :: URL @@ -135,76 +122,52 @@ data Event = Event { instance NFData Event where rnf = genericRnf instance Binary Event --- | A data structure for describing how to filter issues. This is used by --- @issuesForRepo@. -data IssueLimitation = - AnyMilestone -- ^ Issues appearing in any milestone. [default] - | NoMilestone -- ^ Issues without a milestone. - | MilestoneId Int -- ^ Only issues that are in the milestone with the given id. - | Open -- ^ Only open issues. [default] - | OnlyClosed -- ^ Only closed issues. - | Unassigned -- ^ Issues to which no one has been assigned ownership. - | AnyAssignment -- ^ All issues regardless of assignment. [default] - | AssignedTo String -- ^ Only issues assigned to the user with the given login. - | Mentions String -- ^ Issues which mention the given string, taken to be a user's login. - | Labels [String] -- ^ A list of labels to filter by. - | Ascending -- ^ Sort ascending. - | Descending -- ^ Sort descending. [default] - | Since UTCTime -- ^ Only issues created since the specified date and time. - | PerPage Int -- ^ Download this many issues per query - deriving (Eq, Ord, Show, Typeable, Data, Generic) - -instance NFData IssueLimitation where rnf = genericRnf -instance Binary IssueLimitation - --- JSON instances - instance FromJSON Event where - parseJSON = withObject "Event" $ \o -> - Event <$> o .: "actor" - <*> o .: "event" - <*> o .:? "commit_id" - <*> o .: "url" - <*> o .: "created_at" - <*> o .: "id" - <*> o .:? "issue" + parseJSON = withObject "Event" $ \o -> Event + <$> o .: "actor" + <*> o .: "event" + <*> o .:? "commit_id" + <*> o .: "url" + <*> o .: "created_at" + <*> o .: "id" + <*> o .:? "issue" instance FromJSON EventType where - parseJSON (String "closed") = pure Closed - parseJSON (String "reopened") = pure Reopened - parseJSON (String "subscribed") = pure Subscribed - parseJSON (String "merged") = pure Merged - parseJSON (String "referenced") = pure Referenced - parseJSON (String "mentioned") = pure Mentioned - parseJSON (String "assigned") = pure Assigned - parseJSON (String "unsubscribed") = pure Unsubscribed - parseJSON (String "unassigned") = pure ActorUnassigned - parseJSON (String "labeled") = pure Labeled - parseJSON (String "unlabeled") = pure Unlabeled - parseJSON (String "milestoned") = pure Milestoned - parseJSON (String "demilestoned") = pure Demilestoned - parseJSON (String "renamed") = pure Renamed - parseJSON (String "locked") = pure Locked - parseJSON (String "unlocked") = pure Unlocked - parseJSON (String "head_ref_deleted") = pure HeadRefDeleted - parseJSON (String "head_ref_restored") = pure HeadRefRestored - parseJSON _ = fail "Could not build an EventType" + parseJSON (String "closed") = pure Closed + parseJSON (String "reopened") = pure Reopened + parseJSON (String "subscribed") = pure Subscribed + parseJSON (String "merged") = pure Merged + parseJSON (String "referenced") = pure Referenced + parseJSON (String "mentioned") = pure Mentioned + parseJSON (String "assigned") = pure Assigned + parseJSON (String "unsubscribed") = pure Unsubscribed + parseJSON (String "unassigned") = pure ActorUnassigned + parseJSON (String "labeled") = pure Labeled + parseJSON (String "unlabeled") = pure Unlabeled + parseJSON (String "milestoned") = pure Milestoned + parseJSON (String "demilestoned") = pure Demilestoned + parseJSON (String "renamed") = pure Renamed + parseJSON (String "locked") = pure Locked + parseJSON (String "unlocked") = pure Unlocked + parseJSON (String "head_ref_deleted") = pure HeadRefDeleted + parseJSON (String "head_ref_restored") = pure HeadRefRestored + parseJSON _ = fail "Could not build an EventType" instance FromJSON IssueLabel where - parseJSON = withObject "IssueLabel" $ \o -> - IssueLabel <$> o .: "color" - <*> o .: "url" - <*> o .: "name" + parseJSON = withObject "IssueLabel" $ \o -> IssueLabel + <$> o .: "color" + <*> o .: "url" + <*> o .: "name" instance FromJSON IssueComment where - parseJSON = withObject "IssueComment" $ \o -> - IssueComment <$> o .: "updated_at" - <*> o .: "user" - <*> o .: "url" - <*> o .: "html_url" - <*> o .: "created_at" - <*> o .: "body" - <*> o .: "id" + parseJSON = withObject "IssueComment" $ \o -> IssueComment + <$> o .: "updated_at" + <*> o .: "user" + <*> o .: "url" + <*> o .: "html_url" + <*> o .: "created_at" + <*> o .: "body" + <*> o .: "id" instance FromJSON Issue where parseJSON = withObject "Issue" $ \o -> @@ -246,16 +209,3 @@ instance ToJSON EditIssue where , "labels" .= ls ] where notNull (_, Null) = False notNull (_, _) = True - -instance FromJSON Milestone where - parseJSON = withObject "Milestone" $ \o -> - Milestone <$> o .: "creator" - <*> o .: "due_on" - <*> o .: "open_issues" - <*> o .: "number" - <*> o .: "closed_issues" - <*> o .: "description" - <*> o .: "title" - <*> o .: "url" - <*> o .: "created_at" - <*> o .: "state" diff --git a/src/GitHub/Data/Milestone.hs b/src/GitHub/Data/Milestone.hs new file mode 100644 index 00000000..8141e2c8 --- /dev/null +++ b/src/GitHub/Data/Milestone.hs @@ -0,0 +1,42 @@ +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +module GitHub.Data.Milestone where + +import GitHub.Data.Definitions +import GitHub.Data.Id (Id) +import GitHub.Data.URL (URL) +import GitHub.Internal.Prelude +import Prelude () + +data Milestone = Milestone + { milestoneCreator :: !SimpleUser + , milestoneDueOn :: !(Maybe UTCTime) + , milestoneOpenIssues :: !Int + , milestoneNumber :: !(Id Milestone) + , milestoneClosedIssues :: !Int + , milestoneDescription :: !(Maybe Text) + , milestoneTitle :: !Text + , milestoneUrl :: !URL + , milestoneCreatedAt :: !UTCTime + , milestoneState :: !Text + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Milestone where rnf = genericRnf +instance Binary Milestone + +instance FromJSON Milestone where + parseJSON = withObject "Milestone" $ \o -> Milestone + <$> o .: "creator" + <*> o .: "due_on" + <*> o .: "open_issues" + <*> o .: "number" + <*> o .: "closed_issues" + <*> o .: "description" + <*> o .: "title" + <*> o .: "url" + <*> o .: "created_at" + <*> o .: "state" diff --git a/src/GitHub/Data/Options.hs b/src/GitHub/Data/Options.hs new file mode 100644 index 00000000..f5885925 --- /dev/null +++ b/src/GitHub/Data/Options.hs @@ -0,0 +1,530 @@ +{-# LANGUAGE RecordWildCards #-} +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +module GitHub.Data.Options ( + -- * Common modifiers + stateOpen, + stateClosed, + stateAll, + sortAscending, + sortDescending, + sortByCreated, + sortByUpdated, + -- * Pull Requests + PullRequestMod, + prModToQueryString, + optionsBase, + optionsNoBase, + optionsHead, + optionsNoHead, + sortByPopularity, + sortByLongRunning, + -- * Issues + IssueMod, + issueModToQueryString, + sortByComments, + optionsLabels, + optionsSince, + optionsAssignedIssues, + optionsCreatedIssues, + optionsMentionedIssues, + optionsSubscribedIssues, + optionsAllIssues, + -- * Repo issues + IssueRepoMod, + issueRepoModToQueryString, + optionsAnyMilestone, + optionsNoMilestone, + optionsAnyAssignee, + optionsNoAssignee, + -- * Data + IssueState (..), + ) where + +import GitHub.Data.Definitions +import GitHub.Data.Id (Id, untagId) +import GitHub.Data.Name (Name, untagName) +import GitHub.Internal.Prelude +import GitHub.Data.Milestone (Milestone) +import Prelude () + +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE + +------------------------------------------------------------------------------- +-- Data +------------------------------------------------------------------------------- + +-- | Issue or PullRewuest state +data IssueState + = StateOpen + | StateClosed + deriving + (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) + +instance ToJSON IssueState where + toJSON StateOpen = String "open" + toJSON StateClosed = String "closed" + +instance FromJSON IssueState where + parseJSON (String "open") = pure StateOpen + parseJSON (String "closed") = pure StateClosed + parseJSON v = typeMismatch "IssueState" v + +instance NFData IssueState where rnf = genericRnf +instance Binary IssueState + +data SortDirection + = SortAscending + | SortDescending + deriving + (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) + +instance NFData SortDirection where rnf = genericRnf +instance Binary SortDirection + +-- PR + +data SortPR + = SortPRCreated + | SortPRUpdated + | SortPRPopularity + | SortPRLongRunning + deriving + (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) + +instance NFData SortPR where rnf = genericRnf +instance Binary SortPR + +-- Issue +data IssueFilter + = IssueFilterAssigned + | IssueFilterCreated + | IssueFilterMentioned + | IssueFilterSubscribed + | IssueFilterAll + deriving + (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) + +instance NFData IssueFilter where rnf = genericRnf +instance Binary IssueFilter + +data SortIssue + = SortIssueCreated + | SortIssueUpdated + | SortIssueComments + deriving + (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) + +instance NFData SortIssue where rnf = genericRnf +instance Binary SortIssue + +data FilterBy a + = FilterAny + | FilterNone + | FilterBy a + deriving + (Eq, Ord, Show, Generic, Typeable, Data) + +------------------------------------------------------------------------------- +-- Classes +------------------------------------------------------------------------------- + +class HasState mod where + state :: Maybe IssueState -> mod + +stateOpen :: HasState mod => mod +stateOpen = state (Just StateOpen) + +stateClosed :: HasState mod => mod +stateClosed = state (Just StateClosed) + +stateAll :: HasState mod => mod +stateAll = state Nothing + +instance HasState PullRequestMod where + state s = PRMod $ \opts -> + opts { pullRequestOptionsState = s } + +instance HasState IssueMod where + state s = IssueMod $ \opts -> + opts { issueOptionsState = s } + + +class HasDirection mod where + sortDir :: SortDirection -> mod + +sortAscending :: HasDirection mod => mod +sortAscending = sortDir SortAscending + +sortDescending :: HasDirection mod => mod +sortDescending = sortDir SortDescending + +instance HasDirection PullRequestMod where + sortDir x = PRMod $ \opts -> + opts { pullRequestOptionsDirection = x } + +instance HasDirection IssueMod where + sortDir x = IssueMod $ \opts -> + opts { issueOptionsDirection = x } + + +class HasCreatedUpdated mod where + sortByCreated :: mod + sortByUpdated :: mod + +instance HasCreatedUpdated PullRequestMod where + sortByCreated = PRMod $ \opts -> + opts { pullRequestOptionsSort = SortPRCreated } + sortByUpdated = PRMod $ \opts -> + opts { pullRequestOptionsSort = SortPRUpdated } + +instance HasCreatedUpdated IssueMod where + sortByCreated = IssueMod $ \opts -> + opts { issueOptionsSort = SortIssueCreated } + sortByUpdated = IssueMod $ \opts -> + opts { issueOptionsSort = SortIssueUpdated } + +------------------------------------------------------------------------------- +-- Pull Request +------------------------------------------------------------------------------- + +-- | See . +data PullRequestOptions = PullRequestOptions + { pullRequestOptionsState :: !(Maybe IssueState) + , pullRequestOptionsHead :: !(Maybe Text) + , pullRequestOptionsBase :: !(Maybe Text) + , pullRequestOptionsSort :: !SortPR + , pullRequestOptionsDirection :: !SortDirection + } + deriving + (Eq, Ord, Show, Generic, Typeable, Data) + +defaultPullRequestOptions :: PullRequestOptions +defaultPullRequestOptions = PullRequestOptions + { pullRequestOptionsState = Just StateOpen + , pullRequestOptionsHead = Nothing + , pullRequestOptionsBase = Nothing + , pullRequestOptionsSort = SortPRCreated + , pullRequestOptionsDirection = SortDescending + } + +-- | See . +newtype PullRequestMod = PRMod (PullRequestOptions -> PullRequestOptions) + +instance Semigroup PullRequestMod where + PRMod f <> PRMod g = PRMod (g . f) + +instance Monoid PullRequestMod where + mempty = PRMod id + mappend = (<>) + +toPullRequestOptions :: PullRequestMod -> PullRequestOptions +toPullRequestOptions (PRMod f) = f defaultPullRequestOptions + +prModToQueryString :: PullRequestMod -> QueryString +prModToQueryString = pullRequestOptionsToQueryString . toPullRequestOptions + +pullRequestOptionsToQueryString :: PullRequestOptions -> QueryString +pullRequestOptionsToQueryString (PullRequestOptions st head_ base sort dir) = + [ mk "state" state' + , mk "sort" sort' + , mk "direction" direction' + ] ++ catMaybes + [ mk "head" <$> head' + , mk "base" <$> base' + ] + where + mk k v = (k, Just v) + state' = case st of + Nothing -> "all" + Just StateOpen -> "open" + Just StateClosed -> "closed" + sort' = case sort of + SortPRCreated -> "created" + SortPRUpdated -> "updated" + SortPRPopularity -> "popularity" + SortPRLongRunning -> "long-running" + direction' = case dir of + SortDescending -> "desc" + SortAscending -> "asc" + head' = fmap TE.encodeUtf8 head_ + base' = fmap TE.encodeUtf8 base + +------------------------------------------------------------------------------- +-- Pull request modifiers +------------------------------------------------------------------------------- + +optionsBase :: Text -> PullRequestMod +optionsBase x = PRMod $ \opts -> + opts { pullRequestOptionsBase = Just x } + +optionsNoBase :: PullRequestMod +optionsNoBase = PRMod $ \opts -> + opts { pullRequestOptionsBase = Nothing } + +optionsHead :: Text -> PullRequestMod +optionsHead x = PRMod $ \opts -> + opts { pullRequestOptionsHead = Just x } + +optionsNoHead :: PullRequestMod +optionsNoHead = PRMod $ \opts -> + opts { pullRequestOptionsHead = Nothing } + +sortByPopularity :: PullRequestMod +sortByPopularity = PRMod $ \opts -> + opts { pullRequestOptionsSort = SortPRPopularity } + +sortByLongRunning :: PullRequestMod +sortByLongRunning = PRMod $ \opts -> + opts { pullRequestOptionsSort = SortPRLongRunning } + +------------------------------------------------------------------------------- +-- Issues +------------------------------------------------------------------------------- + +-- | See . +data IssueOptions = IssueOptions + { issueOptionsFilter :: !IssueFilter + , issueOptionsState :: !(Maybe IssueState) + , issueOptionsLabels :: ![Text] -- TODO: change to newtype + , issueOptionsSort :: !SortIssue + , issueOptionsDirection :: !SortDirection + , issueOptionsSince :: !(Maybe UTCTime) + } + deriving + (Eq, Ord, Show, Generic, Typeable, Data) + +defaultIssueOptions :: IssueOptions +defaultIssueOptions = IssueOptions + { issueOptionsFilter = IssueFilterAssigned + , issueOptionsState = Just StateOpen + , issueOptionsLabels = [] + , issueOptionsSort = SortIssueCreated + , issueOptionsDirection = SortDescending + , issueOptionsSince = Nothing + } + +-- | See . +newtype IssueMod = IssueMod (IssueOptions -> IssueOptions) + +instance Semigroup IssueMod where + IssueMod f <> IssueMod g = IssueMod (g . f) + +instance Monoid IssueMod where + mempty = IssueMod id + mappend = (<>) + +toIssueOptions :: IssueMod -> IssueOptions +toIssueOptions (IssueMod f) = f defaultIssueOptions + +issueModToQueryString :: IssueMod -> QueryString +issueModToQueryString = issueOptionsToQueryString . toIssueOptions + +issueOptionsToQueryString :: IssueOptions -> QueryString +issueOptionsToQueryString (IssueOptions filt st labels sort dir since) = + [ mk "state" state' + , mk "sort" sort' + , mk "direction" direction' + , mk "filter" filt' + ] ++ catMaybes + [ mk "labels" <$> labels' + , mk "since" <$> since' + ] + where + mk k v = (k, Just v) + filt' = case filt of + IssueFilterAssigned -> "assigned" + IssueFilterCreated -> "created" + IssueFilterMentioned -> "mentioned" + IssueFilterSubscribed -> "subscribed" + IssueFilterAll -> "all" + state' = case st of + Nothing -> "all" + Just StateOpen -> "open" + Just StateClosed -> "closed" + sort' = case sort of + SortIssueCreated -> "created" + SortIssueUpdated -> "updated" + SortIssueComments -> "comments" + direction' = case dir of + SortDescending -> "desc" + SortAscending -> "asc" + + since' = fmap (TE.encodeUtf8 . T.pack . show) since + labels' = TE.encodeUtf8 . T.intercalate "," <$> nullToNothing labels + +nullToNothing :: Foldable f => f a -> Maybe (f a) +nullToNothing xs + | null xs = Nothing + | otherwise = Just xs + +------------------------------------------------------------------------------- +-- Issues modifiers +------------------------------------------------------------------------------- + +class HasComments mod where + sortByComments :: mod + +instance HasComments IssueMod where + sortByComments = IssueMod $ \opts -> + opts { issueOptionsSort = SortIssueComments } + +instance HasComments IssueRepoMod where + sortByComments = IssueRepoMod $ \opts -> + opts { issueRepoOptionsSort = SortIssueComments } + + +class HasLabels mod where + optionsLabels :: [Text] -> mod + +instance HasLabels IssueMod where + optionsLabels lbls = IssueMod $ \opts -> + opts { issueOptionsLabels = lbls } + +instance HasLabels IssueRepoMod where + optionsLabels lbls = IssueRepoMod $ \opts -> + opts { issueRepoOptionsLabels = lbls } + + +class HasSince mod where + optionsSince :: UTCTime -> mod + optionsSinceAll :: mod + +instance HasSince IssueMod where + optionsSince since = IssueMod $ \opts -> + opts { issueOptionsSince = Just since } + optionsSinceAll = IssueMod $ \opts -> + opts { issueOptionsSince = Nothing } + +instance HasSince IssueRepoMod where + optionsSince since = IssueRepoMod $ \opts -> + opts { issueRepoOptionsSince = Just since } + optionsSinceAll = IssueRepoMod $ \opts -> + opts { issueRepoOptionsSince = Nothing } + +------------------------------------------------------------------------------- +-- Only issues modifiers +------------------------------------------------------------------------------- + +optionsAssignedIssues, optionsCreatedIssues, optionsMentionedIssues, + optionsSubscribedIssues, optionsAllIssues :: IssueMod +optionsAssignedIssues = issueFilter IssueFilterAssigned +optionsCreatedIssues = issueFilter IssueFilterCreated +optionsMentionedIssues = issueFilter IssueFilterMentioned +optionsSubscribedIssues = issueFilter IssueFilterSubscribed +optionsAllIssues = issueFilter IssueFilterAll + +issueFilter :: IssueFilter -> IssueMod +issueFilter f = IssueMod $ \opts -> + opts { issueOptionsFilter = f } + +------------------------------------------------------------------------------- +-- Issues repo +------------------------------------------------------------------------------- + +data IssueRepoOptions = IssueRepoOptions + { issueRepoOptionsMilestone :: !(FilterBy (Id Milestone)) + , issueRepoOptionsState :: !(Maybe IssueState) + , issueRepoOptionsAssignee :: !(FilterBy (Name User)) + , issueRepoOptionsCreator :: !(Maybe (Name User)) + , issueRepoOptionsMentioned :: !(Maybe (Name User)) + , issueRepoOptionsLabels :: ![Text] + , issueRepoOptionsSort :: !SortIssue + , issueRepoOptionsDirection :: !SortDirection + , issueRepoOptionsSince :: !(Maybe UTCTime) + } + deriving + (Eq, Ord, Show, Generic, Typeable, Data) + +defaultIssueRepoOptions :: IssueRepoOptions +defaultIssueRepoOptions = IssueRepoOptions + { issueRepoOptionsMilestone = FilterAny + , issueRepoOptionsState = (Just StateOpen) + , issueRepoOptionsAssignee = FilterAny + , issueRepoOptionsCreator = Nothing + , issueRepoOptionsMentioned = Nothing + , issueRepoOptionsLabels = [] + , issueRepoOptionsSort = SortIssueCreated + , issueRepoOptionsDirection = SortDescending + , issueRepoOptionsSince = Nothing + } + +-- | See . +newtype IssueRepoMod = IssueRepoMod (IssueRepoOptions -> IssueRepoOptions) + +instance Semigroup IssueRepoMod where + IssueRepoMod f <> IssueRepoMod g = IssueRepoMod (g . f) + +instance Monoid IssueRepoMod where + mempty = IssueRepoMod id + mappend = (<>) + +toIssueRepoOptions :: IssueRepoMod -> IssueRepoOptions +toIssueRepoOptions (IssueRepoMod f) = f defaultIssueRepoOptions + +issueRepoModToQueryString :: IssueRepoMod -> QueryString +issueRepoModToQueryString = issueRepoOptionsToQueryString . toIssueRepoOptions + +issueRepoOptionsToQueryString :: IssueRepoOptions -> QueryString +issueRepoOptionsToQueryString IssueRepoOptions {..} = + [ mk "milestone" milestone' + , mk "assignee" assignee' + , mk "state" state' + , mk "sort" sort' + , mk "direction" direction' + ] ++ catMaybes + [ mk "labels" <$> labels' + , mk "since" <$> since' + , mk "creator" <$> creator' + , mk "mentioned" <$> mentioned' + ] + where + mk k v = (k, Just v) + filt f x = case x of + FilterAny -> "*" + FilterNone -> "none" + FilterBy x' -> TE.encodeUtf8 (f x') + + milestone' = filt (T.pack . show . untagId) issueRepoOptionsMilestone + assignee' = filt untagName issueRepoOptionsAssignee + + state' = case issueRepoOptionsState of + Nothing -> "all" + Just StateOpen -> "open" + Just StateClosed -> "closed" + sort' = case issueRepoOptionsSort of + SortIssueCreated -> "created" + SortIssueUpdated -> "updated" + SortIssueComments -> "comments" + direction' = case issueRepoOptionsDirection of + SortDescending -> "desc" + SortAscending -> "asc" + + since' = TE.encodeUtf8 . T.pack . show <$> issueRepoOptionsSince + labels' = TE.encodeUtf8 . T.intercalate "," <$> nullToNothing issueRepoOptionsLabels + creator' = TE.encodeUtf8 . untagName <$> issueRepoOptionsCreator + mentioned' = TE.encodeUtf8 . untagName <$> issueRepoOptionsMentioned + +------------------------------------------------------------------------------- +-- Issues repo modifiers +------------------------------------------------------------------------------- + +optionsAnyMilestone :: IssueRepoMod +optionsAnyMilestone = IssueRepoMod $ \opts -> + opts { issueRepoOptionsMilestone = FilterAny } + +optionsNoMilestone :: IssueRepoMod +optionsNoMilestone = IssueRepoMod $ \opts -> + opts { issueRepoOptionsMilestone = FilterNone } + +optionsAnyAssignee :: IssueRepoMod +optionsAnyAssignee = IssueRepoMod $ \opts -> + opts { issueRepoOptionsAssignee = FilterAny } + +optionsNoAssignee :: IssueRepoMod +optionsNoAssignee = IssueRepoMod $ \opts -> + opts { issueRepoOptionsAssignee = FilterNone } diff --git a/src/GitHub/Data/PullRequests.hs b/src/GitHub/Data/PullRequests.hs index 5ce84f7a..56445cdf 100644 --- a/src/GitHub/Data/PullRequests.hs +++ b/src/GitHub/Data/PullRequests.hs @@ -13,36 +13,22 @@ module GitHub.Data.PullRequests ( PullRequestEvent(..), PullRequestEventType(..), PullRequestReference(..), - PullRequestState(..), - PullRequestSort(..), - PullRequestSortDirection(..), - -- * Pull Request listing options - PullRequestOptions, - defaultPullRequestOptions, - pullRequestOptionsToQueryString, - setPullRequestOptionsState, - setPullRequestOptionsStateAll, - setPullRequestOptionsSort, - setPullRequestOptionsDirection, - setPullRequestOptionsHead, - setPullRequestOptionsBase, ) where import GitHub.Data.Definitions import GitHub.Data.Id (Id) +import GitHub.Data.Options (IssueState (..)) import GitHub.Data.Repos (Repo) import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () -import qualified Data.Text.Encoding as TE - data SimplePullRequest = SimplePullRequest { simplePullRequestClosedAt :: !(Maybe UTCTime) , simplePullRequestCreatedAt :: !UTCTime , simplePullRequestUser :: !SimpleUser , simplePullRequestPatchUrl :: !URL - , simplePullRequestState :: !PullRequestState + , simpleIssueState :: !IssueState , simplePullRequestNumber :: !Int , simplePullRequestHtmlUrl :: !URL , simplePullRequestUpdatedAt :: !UTCTime @@ -64,7 +50,7 @@ data PullRequest = PullRequest , pullRequestCreatedAt :: !UTCTime , pullRequestUser :: !SimpleUser , pullRequestPatchUrl :: !URL - , pullRequestState :: !PullRequestState + , pullRequestState :: !IssueState , pullRequestNumber :: !Int , pullRequestHtmlUrl :: !URL , pullRequestUpdatedAt :: !UTCTime @@ -95,7 +81,7 @@ instance Binary PullRequest data EditPullRequest = EditPullRequest { editPullRequestTitle :: !(Maybe Text) , editPullRequestBody :: !(Maybe Text) - , editPullRequestState :: !(Maybe PullRequestState) + , editPullRequestState :: !(Maybe IssueState) } deriving (Show, Generic) instance NFData EditPullRequest where rnf = genericRnf @@ -175,98 +161,6 @@ data PullRequestReference = PullRequestReference instance NFData PullRequestReference where rnf = genericRnf instance Binary PullRequestReference -data PullRequestState - = PullRequestStateOpen - | PullRequestStateClosed - deriving (Eq, Ord, Show, Generic, Typeable, Data) - -instance NFData PullRequestState where rnf = genericRnf -instance Binary PullRequestState - -data PullRequestSort - = PullRequestSortCreated - | PulLRequestSortUpdated - | PullRequestSortPopularity - | PullRequestSortLongRunning - deriving (Eq, Ord, Show, Generic, Typeable, Data) - -instance NFData PullRequestSort where rnf = genericRnf -instance Binary PullRequestSort - -data PullRequestSortDirection - = PullRequestSortDesc - | PullRequestSortAsc - deriving (Eq, Ord, Show, Generic, Typeable, Data) - -instance NFData PullRequestSortDirection where rnf = genericRnf -instance Binary PullRequestSortDirection - --- | See . -data PullRequestOptions = PullRequestOptions - { pullRequestOptionsState :: !(Maybe PullRequestState) - , pullRequestOptionsHead :: !(Maybe Text) - , pullRequestOptionsBase :: !(Maybe Text) - , pullRequestOptionsSort :: !PullRequestSort - , pullRequestOptionsDirection :: !PullRequestSortDirection - } - -defaultPullRequestOptions :: PullRequestOptions -defaultPullRequestOptions = PullRequestOptions - (Just PullRequestStateOpen) - Nothing - Nothing - PullRequestSortCreated - PullRequestSortDesc - -setPullRequestOptionsState :: PullRequestState -> PullRequestOptions -> PullRequestOptions -setPullRequestOptionsState x opts = opts - { pullRequestOptionsState = Just x } - -setPullRequestOptionsStateAll :: PullRequestOptions -> PullRequestOptions -setPullRequestOptionsStateAll opts = opts - { pullRequestOptionsState = Nothing } - -setPullRequestOptionsSort :: PullRequestSort -> PullRequestOptions -> PullRequestOptions -setPullRequestOptionsSort x opts = opts - { pullRequestOptionsSort = x } - -setPullRequestOptionsDirection :: PullRequestSortDirection -> PullRequestOptions -> PullRequestOptions -setPullRequestOptionsDirection x opts = opts - { pullRequestOptionsDirection = x } - -setPullRequestOptionsHead :: Text -> PullRequestOptions -> PullRequestOptions -setPullRequestOptionsHead x opts = opts - { pullRequestOptionsHead = Just x } - -setPullRequestOptionsBase :: Text -> PullRequestOptions -> PullRequestOptions -setPullRequestOptionsBase x opts = opts - { pullRequestOptionsBase = Just x } - -pullRequestOptionsToQueryString :: PullRequestOptions -> QueryString -pullRequestOptionsToQueryString (PullRequestOptions state head_ base sort dir) = - [ mk "state" state' - , mk "sort" sort' - , mk "direction" direction' - ] ++ catMaybes - [ mk "head" <$> head' - , mk "base" <$> base' - ] - where - mk k v = (k, Just v) - state' = case state of - Nothing -> "all" - Just PullRequestStateOpen -> "open" - Just PullRequestStateClosed -> "closed" - sort' = case sort of - PullRequestSortCreated -> "created" - PulLRequestSortUpdated -> "updated" - PullRequestSortPopularity -> "popularity" - PullRequestSortLongRunning -> "long-running" - direction' = case dir of - PullRequestSortDesc -> "desc" - PullRequestSortAsc -> "asc" - head' = fmap TE.encodeUtf8 head_ - base' = fmap TE.encodeUtf8 base ------------------------------------------------------------------------------- -- JSON instances @@ -292,15 +186,6 @@ instance FromJSON SimplePullRequest where <*> o .: "title" <*> o .: "id" -instance ToJSON PullRequestState where - toJSON PullRequestStateOpen = String "open" - toJSON PullRequestStateClosed = String "closed" - -instance FromJSON PullRequestState where - parseJSON (String "open") = pure PullRequestStateOpen - parseJSON (String "closed") = pure PullRequestStateClosed - parseJSON v = typeMismatch "PulLRequestState" v - instance ToJSON EditPullRequest where toJSON (EditPullRequest t b s) = object $ filter notNull [ "title" .= t, "body" .= b, "state" .= s ] diff --git a/src/GitHub/Endpoints/Issues.hs b/src/GitHub/Endpoints/Issues.hs index 8998d08d..b2b7555c 100644 --- a/src/GitHub/Endpoints/Issues.hs +++ b/src/GitHub/Endpoints/Issues.hs @@ -6,13 +6,14 @@ -- -- The issues API as described on . module GitHub.Endpoints.Issues ( + currentUserIssuesR, + organizationIssuesR, issue, issue', issueR, issuesForRepo, issuesForRepo', issuesForRepoR, - IssueLimitation(..), createIssue, createIssueR, newIssue, @@ -27,8 +28,15 @@ import GitHub.Internal.Prelude import GitHub.Request import Prelude () -import qualified Data.Text as T -import qualified Data.Text.Encoding as TE +-- | See . +currentUserIssuesR :: IssueMod -> FetchCount -> Request k (Vector Issue) +currentUserIssuesR opts = + PagedQuery ["user", "issues"] (issueModToQueryString opts) + +-- | See . +organizationIssuesR :: Name Organization -> IssueMod -> FetchCount -> Request k (Vector Issue) +organizationIssuesR org opts = + PagedQuery ["orgs", toPathPart org, "issues"] (issueModToQueryString opts) -- | Details on a specific issue, given the repo owner and name, and the issue -- number.' @@ -52,42 +60,27 @@ issueR user reqRepoName reqIssueNumber = Query ["repos", toPathPart user, toPathPart reqRepoName, "issues", toPathPart reqIssueNumber] [] -- | All issues for a repo (given the repo owner and name), with optional --- restrictions as described in the @IssueLimitation@ data type. +-- restrictions as described in the 'IssueRepoMod' data type. -- -- > issuesForRepo' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" [NoMilestone, OnlyClosed, Mentions "jyurek", Ascending] -issuesForRepo' :: Maybe Auth -> Name Owner -> Name Repo -> [IssueLimitation] -> IO (Either Error (Vector Issue)) -issuesForRepo' auth user reqRepoName issueLimitations = - executeRequestMaybe auth $ issuesForRepoR user reqRepoName issueLimitations FetchAll +issuesForRepo' :: Maybe Auth -> Name Owner -> Name Repo -> IssueRepoMod -> IO (Either Error (Vector Issue)) +issuesForRepo' auth user reqRepoName opts = + executeRequestMaybe auth $ issuesForRepoR user reqRepoName opts FetchAll -- | All issues for a repo (given the repo owner and name), with optional --- restrictions as described in the @IssueLimitation@ data type. +-- restrictions as described in the 'IssueRepoMod' data type. -- -- > issuesForRepo "thoughtbot" "paperclip" [NoMilestone, OnlyClosed, Mentions "jyurek", Ascending] -issuesForRepo :: Name Owner -> Name Repo -> [IssueLimitation] -> IO (Either Error (Vector Issue)) +issuesForRepo :: Name Owner -> Name Repo -> IssueRepoMod -> IO (Either Error (Vector Issue)) issuesForRepo = issuesForRepo' Nothing -- | List issues for a repository. -- See -issuesForRepoR :: Name Owner -> Name Repo -> [IssueLimitation] -> FetchCount -> Request k (Vector Issue) -issuesForRepoR user reqRepoName issueLimitations = +issuesForRepoR :: Name Owner -> Name Repo -> IssueRepoMod -> FetchCount -> Request k (Vector Issue) +issuesForRepoR user reqRepoName opts = PagedQuery ["repos", toPathPart user, toPathPart reqRepoName, "issues"] qs where - qs = map convert issueLimitations - - convert AnyMilestone = ("milestone", Just "*") - convert NoMilestone = ("milestone", Just "none") - convert (MilestoneId n) = ("milestone", Just . TE.encodeUtf8 . T.pack $ show n) - convert Open = ("state", Just "open") - convert OnlyClosed = ("state", Just "closed") - convert Unassigned = ("assignee", Just "none") - convert AnyAssignment = ("assignee", Just "") - convert (AssignedTo u) = ("assignee", Just . TE.encodeUtf8 . T.pack $ u) - convert (Mentions u) = ("mentioned", Just . TE.encodeUtf8 . T.pack $ u) - convert (Labels l) = ("labels", Just . TE.encodeUtf8 . T.pack $ intercalate "," l) - convert Ascending = ("direction", Just "asc") - convert Descending = ("direction", Just "desc") - convert (PerPage n) = ("per_page", Just . TE.encodeUtf8 . T.pack $ show n) - convert (Since t) = ("since", Just . TE.encodeUtf8 . T.pack $ formatISO8601 t) + qs = issueRepoModToQueryString opts -- Creating new issues. diff --git a/src/GitHub/Endpoints/PullRequests.hs b/src/GitHub/Endpoints/PullRequests.hs index 5b79951d..04c2247f 100644 --- a/src/GitHub/Endpoints/PullRequests.hs +++ b/src/GitHub/Endpoints/PullRequests.hs @@ -38,17 +38,19 @@ import Prelude () -- > pullRequestsFor "rails" "rails" pullRequestsFor :: Name Owner -> Name Repo -> IO (Either Error (Vector SimplePullRequest)) pullRequestsFor user repo = - executeRequest' $ pullRequestsForR user repo defaultPullRequestOptions FetchAll + executeRequest' $ pullRequestsForR user repo mempty FetchAll -- | List pull requests. -- See -pullRequestsForR :: Name Owner -> Name Repo - -> PullRequestOptions -- ^ State - -> FetchCount - -> Request k (Vector SimplePullRequest) +pullRequestsForR + :: Name Owner + -> Name Repo + -> PullRequestMod + -> FetchCount + -> Request k (Vector SimplePullRequest) pullRequestsForR user repo opts = PagedQuery ["repos", toPathPart user, toPathPart repo, "pulls"] - (pullRequestOptionsToQueryString opts) + (prModToQueryString opts) -- | 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. diff --git a/src/GitHub/Endpoints/Repos.hs b/src/GitHub/Endpoints/Repos.hs index 3a588bf2..d5be2120 100644 --- a/src/GitHub/Endpoints/Repos.hs +++ b/src/GitHub/Endpoints/Repos.hs @@ -76,7 +76,7 @@ currentUserRepos auth publicity = -- | List your repositories. -- See -currentUserReposR :: RepoPublicity -> FetchCount -> Request k(Vector Repo) +currentUserReposR :: RepoPublicity -> FetchCount -> Request k (Vector Repo) currentUserReposR publicity = PagedQuery ["user", "repos"] qs where @@ -93,7 +93,11 @@ userRepos = userRepos' Nothing -- With authentication. -- -- > userRepos' (Just (BasicAuth (user, password))) "mike-burns" All -userRepos' :: Maybe Auth -> Name Owner -> RepoPublicity -> IO (Either Error (Vector Repo)) +userRepos' + :: Maybe Auth + -> Name Owner + -> RepoPublicity + -> IO (Either Error (Vector Repo)) userRepos' auth user publicity = executeRequestMaybe auth $ userReposR user publicity FetchAll @@ -115,13 +119,21 @@ organizationRepos org = organizationRepos' Nothing org RepoPublicityAll -- With authentication. -- -- > organizationRepos (Just (BasicAuth (user, password))) "thoughtbot" All -organizationRepos' :: Maybe Auth -> Name Organization -> RepoPublicity -> IO (Either Error (Vector Repo)) +organizationRepos' + :: Maybe Auth + -> Name Organization + -> RepoPublicity + -> IO (Either Error (Vector Repo)) organizationRepos' auth org publicity = executeRequestMaybe auth $ organizationReposR org publicity FetchAll -- | List organization repositories. -- See -organizationReposR :: Name Organization -> RepoPublicity -> FetchCount -> Request k (Vector Repo) +organizationReposR + :: Name Organization + -> RepoPublicity + -> FetchCount + -> Request k (Vector Repo) organizationReposR org publicity = PagedQuery ["orgs", toPathPart org, "repos"] qs where @@ -176,11 +188,12 @@ createOrganizationRepoR org nrepo = -- | Edit an existing repository. -- -- > editRepo (BasicAuth (user, password)) "some_user" "some_repo" def {editDescription = Just "some description"} -editRepo :: Auth - -> Name Owner -- ^ owner - -> Name Repo -- ^ repository name - -> EditRepo - -> IO (Either Error Repo) +editRepo + :: Auth + -> Name Owner -- ^ owner + -> Name Repo -- ^ repository name + -> EditRepo + -> IO (Either Error Repo) editRepo auth user repo body = executeRequest auth $ editRepoR user repo body @@ -210,11 +223,12 @@ contributors' auth user repo = -- | List contributors. -- See -contributorsR :: Name Owner - -> Name Repo - -> Bool -- ^ Include anonymous - -> FetchCount - -> Request k (Vector Contributor) +contributorsR + :: Name Owner + -> Name Repo + -> Bool -- ^ Include anonymous + -> FetchCount + -> Request k (Vector Contributor) contributorsR user repo anon = PagedQuery ["repos", toPathPart user, toPathPart repo, "contributors"] qs where @@ -315,11 +329,12 @@ contentsFor' :: Maybe Auth -> Name Owner -> Name Repo -> Text -> Maybe Text -> 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 + :: 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 diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index 7d192c6d..a652525a 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -68,7 +68,6 @@ import Network.HTTP.Client (HttpException (..), Manager, RequestBody (..), Response (..), applyBasicAuth, httpLbs, method, newManager, requestBody, requestHeaders, setQueryString) -import Network.HTTP.Client.Internal (setUri) import Network.HTTP.Client.TLS (tlsManagerSettings) import Network.HTTP.Link.Parser (parseLinkHeaderBS) import Network.HTTP.Link.Types @@ -346,7 +345,7 @@ performPagedRequest httpLbs' predicate initReq = do go acc res req = case (predicate acc, getNextUrl res) of (True, Just uri) -> do - req' <- setUri req uri + req' <- HTTP.setUri req uri res' <- httpLbs' req' m <- parseResponse res' go (acc <> m) res' req' From b933c950c46f4a2c4c2bfb8df4f4ed6a2ceae946 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 13 Sep 2016 16:18:40 +0300 Subject: [PATCH 222/510] Add labels newtype (Name IssueLabel) --- src/GitHub/Data/Activities.hs | 9 +- src/GitHub/Data/Comments.hs | 41 +++--- src/GitHub/Data/Definitions.hs | 20 +++ src/GitHub/Data/DeployKeys.hs | 65 ++++----- src/GitHub/Data/Issues.hs | 235 ++++++++++++++++----------------- src/GitHub/Data/Options.hs | 14 +- 6 files changed, 200 insertions(+), 184 deletions(-) diff --git a/src/GitHub/Data/Activities.hs b/src/GitHub/Data/Activities.hs index 90943d36..67896cb9 100644 --- a/src/GitHub/Data/Activities.hs +++ b/src/GitHub/Data/Activities.hs @@ -9,10 +9,11 @@ import GitHub.Data.Repos (Repo) import GitHub.Internal.Prelude import Prelude () -data RepoStarred = RepoStarred { - repoStarredStarredAt :: !UTCTime - ,repoStarredRepo :: !Repo -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data RepoStarred = RepoStarred + { repoStarredStarredAt :: !UTCTime + , repoStarredRepo :: !Repo + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData RepoStarred where rnf = genericRnf instance Binary RepoStarred diff --git a/src/GitHub/Data/Comments.hs b/src/GitHub/Data/Comments.hs index 0343834a..9c966e7a 100644 --- a/src/GitHub/Data/Comments.hs +++ b/src/GitHub/Data/Comments.hs @@ -11,19 +11,20 @@ import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () -data Comment = Comment { - commentPosition :: !(Maybe Int) - ,commentLine :: !(Maybe Int) - ,commentBody :: !Text - ,commentCommitId :: !(Maybe Text) - ,commentUpdatedAt :: !UTCTime - ,commentHtmlUrl :: !(Maybe URL) - ,commentUrl :: !URL - ,commentCreatedAt :: !(Maybe UTCTime) - ,commentPath :: !(Maybe Text) - ,commentUser :: !SimpleUser - ,commentId :: !(Id Comment) -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data Comment = Comment + { commentPosition :: !(Maybe Int) + , commentLine :: !(Maybe Int) + , commentBody :: !Text + , commentCommitId :: !(Maybe Text) + , commentUpdatedAt :: !UTCTime + , commentHtmlUrl :: !(Maybe URL) + , commentUrl :: !URL + , commentCreatedAt :: !(Maybe UTCTime) + , commentPath :: !(Maybe Text) + , commentUser :: !SimpleUser + , commentId :: !(Id Comment) + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Comment where rnf = genericRnf instance Binary Comment @@ -42,9 +43,10 @@ instance FromJSON Comment where <*> o .: "user" <*> o .: "id" -data NewComment = NewComment { - newCommentBody :: !Text -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data NewComment = NewComment + { newCommentBody :: !Text + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData NewComment where rnf = genericRnf instance Binary NewComment @@ -52,9 +54,10 @@ instance Binary NewComment instance ToJSON NewComment where toJSON (NewComment b) = object [ "body" .= b ] -data EditComment = EditComment { - editCommentBody :: !Text -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data EditComment = EditComment + { editCommentBody :: !Text + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData EditComment where rnf = genericRnf instance Binary EditComment diff --git a/src/GitHub/Data/Definitions.hs b/src/GitHub/Data/Definitions.hs index 325cec76..c4a5c95d 100644 --- a/src/GitHub/Data/Definitions.hs +++ b/src/GitHub/Data/Definitions.hs @@ -238,3 +238,23 @@ type QueryString = [(BS.ByteString, Maybe BS.ByteString)] -- | Count of elements type Count = Int + +------------------------------------------------------------------------------- +-- IssueLabel +------------------------------------------------------------------------------- + +data IssueLabel = IssueLabel + { labelColor :: !Text + , labelUrl :: !URL + , labelName :: !(Name IssueLabel) + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData IssueLabel where rnf = genericRnf +instance Binary IssueLabel + +instance FromJSON IssueLabel where + parseJSON = withObject "IssueLabel" $ \o -> IssueLabel + <$> o .: "color" + <*> o .: "url" + <*> o .: "name" diff --git a/src/GitHub/Data/DeployKeys.hs b/src/GitHub/Data/DeployKeys.hs index bca594c9..7dd1bb1d 100644 --- a/src/GitHub/Data/DeployKeys.hs +++ b/src/GitHub/Data/DeployKeys.hs @@ -10,42 +10,43 @@ import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () -data RepoDeployKey = RepoDeployKey { - repoDeployKeyId :: !(Id RepoDeployKey) - ,repoDeployKeyKey :: !Text - ,repoDeployKeyUrl :: !URL - ,repoDeployKeyTitle :: !Text - ,repoDeployKeyVerified :: !Bool - ,repoDeployKeyCreatedAt :: !UTCTime - ,repoDeployKeyReadOnly :: !Bool -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data RepoDeployKey = RepoDeployKey + { repoDeployKeyId :: !(Id RepoDeployKey) + , repoDeployKeyKey :: !Text + , repoDeployKeyUrl :: !URL + , repoDeployKeyTitle :: !Text + , repoDeployKeyVerified :: !Bool + , repoDeployKeyCreatedAt :: !UTCTime + , repoDeployKeyReadOnly :: !Bool + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance FromJSON RepoDeployKey where - parseJSON = withObject "RepoDeployKey" $ \o -> - RepoDeployKey <$> o .: "id" - <*> o .: "key" - <*> o .: "url" - <*> o .: "title" - <*> o .: "verified" - <*> o .: "created_at" - <*> o .: "read_only" + parseJSON = withObject "RepoDeployKey" $ \o -> RepoDeployKey + <$> o .: "id" + <*> o .: "key" + <*> o .: "url" + <*> o .: "title" + <*> o .: "verified" + <*> o .: "created_at" + <*> o .: "read_only" -data NewRepoDeployKey = NewRepoDeployKey { - newRepoDeployKeyKey :: !Text - ,newRepoDeployKeyTitle :: !Text - ,newRepoDeployKeyReadOnly :: !Bool -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data NewRepoDeployKey = NewRepoDeployKey + { newRepoDeployKeyKey :: !Text + , newRepoDeployKeyTitle :: !Text + , newRepoDeployKeyReadOnly :: !Bool + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance ToJSON NewRepoDeployKey where - toJSON (NewRepoDeployKey key title readOnly) = - object [ - "key" .= key - , "title" .= title - , "read_only" .= readOnly - ] + toJSON (NewRepoDeployKey key title readOnly) = object + [ "key" .= key + , "title" .= title + , "read_only" .= readOnly + ] instance FromJSON NewRepoDeployKey where - parseJSON = withObject "RepoDeployKey" $ \o -> - NewRepoDeployKey <$> o .: "key" - <*> o .: "title" - <*> o .: "read_only" + parseJSON = withObject "RepoDeployKey" $ \o -> NewRepoDeployKey + <$> o .: "key" + <*> o .: "title" + <*> o .: "read_only" diff --git a/src/GitHub/Data/Issues.hs b/src/GitHub/Data/Issues.hs index eb05efc2..fb70c626 100644 --- a/src/GitHub/Data/Issues.hs +++ b/src/GitHub/Data/Issues.hs @@ -7,117 +7,112 @@ module GitHub.Data.Issues where import GitHub.Data.Definitions import GitHub.Data.Id (Id) +import GitHub.Data.Milestone (Milestone) +import GitHub.Data.Name (Name) import GitHub.Data.PullRequests import GitHub.Data.URL (URL) import GitHub.Internal.Prelude -import GitHub.Data.Milestone (Milestone) import Prelude () data Issue = Issue - { issueClosedAt :: Maybe UTCTime - , issueUpdatedAt :: UTCTime - , issueEventsUrl :: URL - , issueHtmlUrl :: Maybe URL - , issueClosedBy :: Maybe SimpleUser - , issueLabels :: (Vector IssueLabel) - , issueNumber :: Int - , issueAssignee :: Maybe SimpleUser - , issueUser :: SimpleUser - , issueTitle :: Text - , issuePullRequest :: Maybe PullRequestReference - , issueUrl :: URL - , issueCreatedAt :: UTCTime - , issueBody :: Maybe Text - , issueState :: Text - , issueId :: Id Issue - , issueComments :: Int - , issueMilestone :: Maybe Milestone + { issueClosedAt :: !(Maybe UTCTime) + , issueUpdatedAt :: !UTCTime + , issueEventsUrl :: !URL + , issueHtmlUrl :: !(Maybe URL) + , issueClosedBy :: !(Maybe SimpleUser) + , issueLabels :: (Vector (Name IssueLabel)) + , issueNumber :: !Int + , issueAssignee :: !(Maybe SimpleUser) + , issueUser :: !SimpleUser + , issueTitle :: !Text + , issuePullRequest :: !(Maybe PullRequestReference) + , issueUrl :: !URL + , issueCreatedAt :: !UTCTime + , issueBody :: !(Maybe Text) + , issueState :: !Text + , issueId :: !(Id Issue) + , issueComments :: !Int + , issueMilestone :: !(Maybe Milestone) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Issue where rnf = genericRnf instance Binary Issue data NewIssue = NewIssue - { newIssueTitle :: Text - , newIssueBody :: Maybe Text - , newIssueAssignee :: Maybe Text - , newIssueMilestone :: Maybe (Id Milestone) - , newIssueLabels :: Maybe (Vector Text) + { newIssueTitle :: !Text + , newIssueBody :: !(Maybe Text) + , newIssueAssignee :: !(Maybe Text) + , newIssueMilestone :: !(Maybe (Id Milestone)) + , newIssueLabels :: !(Maybe (Vector (Name IssueLabel))) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData NewIssue where rnf = genericRnf instance Binary NewIssue -data EditIssue = EditIssue { - editIssueTitle :: Maybe Text -, editIssueBody :: Maybe Text -, editIssueAssignee :: Maybe Text -, editIssueState :: Maybe Text -, editIssueMilestone :: Maybe (Id Milestone) -, editIssueLabels :: Maybe (Vector Text) -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data EditIssue = EditIssue + { editIssueTitle :: !(Maybe Text) + , editIssueBody :: !(Maybe Text) + , editIssueAssignee :: !(Maybe Text) + , editIssueState :: !(Maybe Text) + , editIssueMilestone :: !(Maybe (Id Milestone)) + , editIssueLabels :: !(Maybe (Vector (Name IssueLabel))) + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData EditIssue where rnf = genericRnf instance Binary EditIssue -data IssueLabel = IssueLabel { - labelColor :: Text - ,labelUrl :: URL - ,labelName :: Text -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData IssueLabel where rnf = genericRnf -instance Binary IssueLabel - -data IssueComment = IssueComment { - issueCommentUpdatedAt :: UTCTime - ,issueCommentUser :: SimpleUser - ,issueCommentUrl :: URL - ,issueCommentHtmlUrl :: URL - ,issueCommentCreatedAt :: UTCTime - ,issueCommentBody :: Text - ,issueCommentId :: Int -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data IssueComment = IssueComment + { issueCommentUpdatedAt :: !UTCTime + , issueCommentUser :: !SimpleUser + , issueCommentUrl :: !URL + , issueCommentHtmlUrl :: !URL + , issueCommentCreatedAt :: !UTCTime + , issueCommentBody :: !Text + , issueCommentId :: !Int + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData IssueComment where rnf = genericRnf instance Binary IssueComment -data EventType = - Mentioned -- ^ The actor was @mentioned in an issue body. - | Subscribed -- ^ The actor subscribed to receive notifications for an issue. - | Unsubscribed -- ^ The issue was unsubscribed from by the actor. - | Referenced -- ^ The issue was referenced from a commit message. The commit_id attribute is the commit SHA1 of where that happened. - | Merged -- ^ The issue was merged by the actor. The commit_id attribute is the SHA1 of the HEAD commit that was merged. - | Assigned -- ^ The issue was assigned to the actor. - | Closed -- ^ The issue was closed by the actor. When the commit_id is present, it identifies the commit that closed the issue using “closes / fixes #NN” syntax. - | Reopened -- ^ The issue was reopened by the actor. - | ActorUnassigned -- ^ The issue was unassigned to the actor - | Labeled -- ^ A label was added to the issue. - | Unlabeled -- ^ A label was removed from the issue. - | Milestoned -- ^ The issue was added to a milestone. - | Demilestoned -- ^ The issue was removed from a milestone. - | Renamed -- ^ The issue title was changed. - | Locked -- ^ The issue was locked by the actor. - | Unlocked -- ^ The issue was unlocked by the actor. - | HeadRefDeleted -- ^ The pull request’s branch was deleted. - | HeadRefRestored -- ^ The pull request’s branch was restored. - deriving (Show, Data, Typeable, Eq, Ord, Generic) +data EventType + = Mentioned -- ^ The actor was @mentioned in an issue body. + | Subscribed -- ^ The actor subscribed to receive notifications for an issue. + | Unsubscribed -- ^ The issue was unsubscribed from by the actor. + | Referenced -- ^ The issue was referenced from a commit message. The commit_id attribute is the commit SHA1 of where that happened. + | Merged -- ^ The issue was merged by the actor. The commit_id attribute is the SHA1 of the HEAD commit that was merged. + | Assigned -- ^ The issue was assigned to the actor. + | Closed -- ^ The issue was closed by the actor. When the commit_id is present, it identifies the commit that closed the issue using “closes / fixes #NN” syntax. + | Reopened -- ^ The issue was reopened by the actor. + | ActorUnassigned -- ^ The issue was unassigned to the actor + | Labeled -- ^ A label was added to the issue. + | Unlabeled -- ^ A label was removed from the issue. + | Milestoned -- ^ The issue was added to a milestone. + | Demilestoned -- ^ The issue was removed from a milestone. + | Renamed -- ^ The issue title was changed. + | Locked -- ^ The issue was locked by the actor. + | Unlocked -- ^ The issue was unlocked by the actor. + | HeadRefDeleted -- ^ The pull request’s branch was deleted. + | HeadRefRestored -- ^ The pull request’s branch was restored. + deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic) instance NFData EventType where rnf = genericRnf instance Binary EventType -- | Issue event -data Event = Event { - eventActor :: !SimpleUser - ,eventType :: !EventType - ,eventCommitId :: !(Maybe Text) - ,eventUrl :: !URL - ,eventCreatedAt :: !UTCTime - ,eventId :: !Int - ,eventIssue :: !(Maybe Issue) -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data Event = Event + { eventActor :: !SimpleUser + , eventType :: !EventType + , eventCommitId :: !(Maybe Text) + , eventUrl :: !URL + , eventCreatedAt :: !UTCTime + , eventId :: !Int + , eventIssue :: !(Maybe Issue) + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Event where rnf = genericRnf instance Binary Event @@ -153,12 +148,6 @@ instance FromJSON EventType where parseJSON (String "head_ref_restored") = pure HeadRefRestored parseJSON _ = fail "Could not build an EventType" -instance FromJSON IssueLabel where - parseJSON = withObject "IssueLabel" $ \o -> IssueLabel - <$> o .: "color" - <*> o .: "url" - <*> o .: "name" - instance FromJSON IssueComment where parseJSON = withObject "IssueComment" $ \o -> IssueComment <$> o .: "updated_at" @@ -170,42 +159,44 @@ instance FromJSON IssueComment where <*> o .: "id" instance FromJSON Issue where - parseJSON = withObject "Issue" $ \o -> - Issue <$> o .:? "closed_at" - <*> o .: "updated_at" - <*> o .: "events_url" - <*> o .: "html_url" - <*> o .:? "closed_by" - <*> o .: "labels" - <*> o .: "number" - <*> o .:? "assignee" - <*> o .: "user" - <*> o .: "title" - <*> o .:? "pull_request" - <*> o .: "url" - <*> o .: "created_at" - <*> o .: "body" - <*> o .: "state" - <*> o .: "id" - <*> o .: "comments" - <*> o .:? "milestone" + parseJSON = withObject "Issue" $ \o -> Issue + <$> o .:? "closed_at" + <*> o .: "updated_at" + <*> o .: "events_url" + <*> o .: "html_url" + <*> o .:? "closed_by" + <*> o .: "labels" + <*> o .: "number" + <*> o .:? "assignee" + <*> o .: "user" + <*> o .: "title" + <*> o .:? "pull_request" + <*> o .: "url" + <*> o .: "created_at" + <*> o .: "body" + <*> o .: "state" + <*> o .: "id" + <*> o .: "comments" + <*> o .:? "milestone" instance ToJSON NewIssue where - toJSON (NewIssue t b a m ls) = - object - [ "title" .= t - , "body" .= b - , "assignee" .= a - , "milestone" .= m - , "labels" .= ls ] + toJSON (NewIssue t b a m ls) = object + [ "title" .= t + , "body" .= b + , "assignee" .= a + , "milestone" .= m + , "labels" .= ls + ] instance ToJSON EditIssue where - toJSON (EditIssue t b a s m ls) = - object $ filter notNull $ [ "title" .= t - , "body" .= b - , "assignee" .= a - , "state" .= s - , "milestone" .= m - , "labels" .= ls ] - where notNull (_, Null) = False - notNull (_, _) = True + toJSON (EditIssue t b a s m ls) = object $ filter notNull $ + [ "title" .= t + , "body" .= b + , "assignee" .= a + , "state" .= s + , "milestone" .= m + , "labels" .= ls + ] + where + notNull (_, Null) = False + notNull (_, _) = True diff --git a/src/GitHub/Data/Options.hs b/src/GitHub/Data/Options.hs index f5885925..39900719 100644 --- a/src/GitHub/Data/Options.hs +++ b/src/GitHub/Data/Options.hs @@ -290,7 +290,7 @@ sortByLongRunning = PRMod $ \opts -> data IssueOptions = IssueOptions { issueOptionsFilter :: !IssueFilter , issueOptionsState :: !(Maybe IssueState) - , issueOptionsLabels :: ![Text] -- TODO: change to newtype + , issueOptionsLabels :: ![Name IssueLabel] -- TODO: change to newtype , issueOptionsSort :: !SortIssue , issueOptionsDirection :: !SortDirection , issueOptionsSince :: !(Maybe UTCTime) @@ -355,7 +355,7 @@ issueOptionsToQueryString (IssueOptions filt st labels sort dir since) = SortAscending -> "asc" since' = fmap (TE.encodeUtf8 . T.pack . show) since - labels' = TE.encodeUtf8 . T.intercalate "," <$> nullToNothing labels + labels' = TE.encodeUtf8 . T.intercalate "," . fmap untagName <$> nullToNothing labels nullToNothing :: Foldable f => f a -> Maybe (f a) nullToNothing xs @@ -379,15 +379,15 @@ instance HasComments IssueRepoMod where class HasLabels mod where - optionsLabels :: [Text] -> mod + optionsLabels :: Foldable f => f (Name IssueLabel) -> mod instance HasLabels IssueMod where optionsLabels lbls = IssueMod $ \opts -> - opts { issueOptionsLabels = lbls } + opts { issueOptionsLabels = toList lbls } instance HasLabels IssueRepoMod where optionsLabels lbls = IssueRepoMod $ \opts -> - opts { issueRepoOptionsLabels = lbls } + opts { issueRepoOptionsLabels = toList lbls } class HasSince mod where @@ -432,7 +432,7 @@ data IssueRepoOptions = IssueRepoOptions , issueRepoOptionsAssignee :: !(FilterBy (Name User)) , issueRepoOptionsCreator :: !(Maybe (Name User)) , issueRepoOptionsMentioned :: !(Maybe (Name User)) - , issueRepoOptionsLabels :: ![Text] + , issueRepoOptionsLabels :: ![Name IssueLabel] , issueRepoOptionsSort :: !SortIssue , issueRepoOptionsDirection :: !SortDirection , issueRepoOptionsSince :: !(Maybe UTCTime) @@ -505,7 +505,7 @@ issueRepoOptionsToQueryString IssueRepoOptions {..} = SortAscending -> "asc" since' = TE.encodeUtf8 . T.pack . show <$> issueRepoOptionsSince - labels' = TE.encodeUtf8 . T.intercalate "," <$> nullToNothing issueRepoOptionsLabels + labels' = TE.encodeUtf8 . T.intercalate "," . fmap untagName <$> nullToNothing issueRepoOptionsLabels creator' = TE.encodeUtf8 . untagName <$> issueRepoOptionsCreator mentioned' = TE.encodeUtf8 . untagName <$> issueRepoOptionsMentioned From 535fa7eccb5de828e6168037537298593b97927c Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 13 Sep 2016 16:41:31 +0300 Subject: [PATCH 223/510] reformat and some newtypes --- spec/GitHub/SearchSpec.hs | 6 +- src/GitHub/Data/Gists.hs | 116 +++++----- src/GitHub/Data/GitData.hs | 398 +++++++++++++++++--------------- src/GitHub/Data/Issues.hs | 9 +- src/GitHub/Data/Options.hs | 25 +- src/GitHub/Data/PullRequests.hs | 16 +- src/GitHub/Data/Search.hs | 52 +++-- src/GitHub/Data/Webhooks.hs | 248 ++++++++++---------- 8 files changed, 459 insertions(+), 411 deletions(-) diff --git a/spec/GitHub/SearchSpec.hs b/spec/GitHub/SearchSpec.hs index 11f12ee6..97e311d4 100644 --- a/spec/GitHub/SearchSpec.hs +++ b/spec/GitHub/SearchSpec.hs @@ -14,7 +14,7 @@ import Test.Hspec (Spec, describe, it, pendingWith, shouldBe) import qualified Data.Vector as V -import GitHub.Data (Auth (..), Issue (..), mkId) +import GitHub.Data (Auth (..), Issue (..), mkId, IssueState (..)) import GitHub.Endpoints.Search (SearchResult (..), searchIssues') fromRightS :: Show a => Either a b -> b @@ -42,13 +42,13 @@ spec = do issueId issue1 `shouldBe` mkId (Proxy :: Proxy Issue) 123898390 issueNumber issue1 `shouldBe` 130 issueTitle issue1 `shouldBe` "Make test runner more robust" - issueState issue1 `shouldBe` "closed" + issueState issue1 `shouldBe` StateClosed let issue2 = issues V.! 1 issueId issue2 `shouldBe` mkId (Proxy :: Proxy Issue) 119694665 issueNumber issue2 `shouldBe` 127 issueTitle issue2 `shouldBe` "Decouple request creation from execution" - issueState issue2 `shouldBe` "open" + issueState issue2 `shouldBe` StateOpen it "performs an issue search via the API" $ withAuth $ \auth -> do let query = "Decouple in:title repo:phadej/github created:<=2015-12-01" diff --git a/src/GitHub/Data/Gists.hs b/src/GitHub/Data/Gists.hs index 4ed59f75..3e1fbe79 100644 --- a/src/GitHub/Data/Gists.hs +++ b/src/GitHub/Data/Gists.hs @@ -13,77 +13,79 @@ import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () -data Gist = Gist { - gistUser :: !SimpleUser - ,gistGitPushUrl :: !URL - ,gistUrl :: !URL - ,gistDescription :: !(Maybe Text) - ,gistCreatedAt :: !UTCTime - ,gistPublic :: !Bool - ,gistComments :: !Int - ,gistUpdatedAt :: !UTCTime - ,gistHtmlUrl :: !URL - ,gistId :: !(Name Gist) - ,gistFiles :: !(HashMap Text GistFile) - ,gistGitPullUrl :: !URL -} deriving (Show, Data, Typeable, Eq, Generic) +data Gist = Gist + { gistUser :: !SimpleUser + , gistGitPushUrl :: !URL + , gistUrl :: !URL + , gistDescription :: !(Maybe Text) + , gistCreatedAt :: !UTCTime + , gistPublic :: !Bool + , gistComments :: !Int + , gistUpdatedAt :: !UTCTime + , gistHtmlUrl :: !URL + , gistId :: !(Name Gist) + , gistFiles :: !(HashMap Text GistFile) + , gistGitPullUrl :: !URL + } deriving (Show, Data, Typeable, Eq, Generic) instance NFData Gist where rnf = genericRnf instance Binary Gist instance FromJSON Gist where - parseJSON = withObject "Gist" $ \o -> - Gist <$> o .: "owner" - <*> o .: "git_push_url" - <*> o .: "url" - <*> o .:? "description" - <*> o .: "created_at" - <*> o .: "public" - <*> o .: "comments" - <*> o .: "updated_at" - <*> o .: "html_url" - <*> o .: "id" - <*> o .: "files" - <*> o .: "git_push_url" + parseJSON = withObject "Gist" $ \o -> Gist + <$> o .: "owner" + <*> o .: "git_push_url" + <*> o .: "url" + <*> o .:? "description" + <*> o .: "created_at" + <*> o .: "public" + <*> o .: "comments" + <*> o .: "updated_at" + <*> o .: "html_url" + <*> o .: "id" + <*> o .: "files" + <*> o .: "git_push_url" -data GistFile = GistFile { - gistFileType :: !Text - ,gistFileRawUrl :: !URL - ,gistFileSize :: !Int - ,gistFileLanguage :: !(Maybe Language) - ,gistFileFilename :: !Text - ,gistFileContent :: !(Maybe Text) -} deriving (Show, Data, Typeable, Eq, Generic) +data GistFile = GistFile + { gistFileType :: !Text + , gistFileRawUrl :: !URL + , gistFileSize :: !Int + , gistFileLanguage :: !(Maybe Language) + , gistFileFilename :: !Text + , gistFileContent :: !(Maybe Text) + } + deriving (Show, Data, Typeable, Eq, Generic) instance NFData GistFile where rnf = genericRnf instance Binary GistFile instance FromJSON GistFile where - parseJSON = withObject "GistFile" $ \o -> - GistFile <$> o .: "type" - <*> o .: "raw_url" - <*> o .: "size" - <*> o .:? "language" - <*> o .: "filename" - <*> o .:? "content" + parseJSON = withObject "GistFile" $ \o -> GistFile + <$> o .: "type" + <*> o .: "raw_url" + <*> o .: "size" + <*> o .:? "language" + <*> o .: "filename" + <*> o .:? "content" -data GistComment = GistComment { - gistCommentUser :: !SimpleUser - ,gistCommentUrl :: !URL - ,gistCommentCreatedAt :: !UTCTime - ,gistCommentBody :: !Text - ,gistCommentUpdatedAt :: !UTCTime - ,gistCommentId :: !(Id GistComment) -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data GistComment = GistComment + { gistCommentUser :: !SimpleUser + , gistCommentUrl :: !URL + , gistCommentCreatedAt :: !UTCTime + , gistCommentBody :: !Text + , gistCommentUpdatedAt :: !UTCTime + , gistCommentId :: !(Id GistComment) + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData GistComment where rnf = genericRnf instance Binary GistComment instance FromJSON GistComment where - parseJSON = withObject "GistComment" $ \o -> - GistComment <$> o .: "user" - <*> o .: "url" - <*> o .: "created_at" - <*> o .: "body" - <*> o .: "updated_at" - <*> o .: "id" + parseJSON = withObject "GistComment" $ \o -> GistComment + <$> o .: "user" + <*> o .: "url" + <*> o .: "created_at" + <*> o .: "body" + <*> o .: "updated_at" + <*> o .: "id" diff --git a/src/GitHub/Data/GitData.hs b/src/GitHub/Data/GitData.hs index c1761e9e..5df5b953 100644 --- a/src/GitHub/Data/GitData.hs +++ b/src/GitHub/Data/GitData.hs @@ -14,171 +14,187 @@ import Prelude () import qualified Data.Vector as V -- | The options for querying commits. -data CommitQueryOption = CommitQuerySha !Text - | CommitQueryPath !Text - | CommitQueryAuthor !Text - | CommitQuerySince !UTCTime - | CommitQueryUntil !UTCTime - deriving (Show, Eq, Ord, Generic, Typeable, Data) - -data Stats = Stats { - statsAdditions :: !Int - ,statsTotal :: !Int - ,statsDeletions :: !Int -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data CommitQueryOption + = CommitQuerySha !Text + | CommitQueryPath !Text + | CommitQueryAuthor !Text + | CommitQuerySince !UTCTime + | CommitQueryUntil !UTCTime + deriving (Show, Eq, Ord, Generic, Typeable, Data) + +data Stats = Stats + { statsAdditions :: !Int + , statsTotal :: !Int + , statsDeletions :: !Int + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Stats where rnf = genericRnf instance Binary Stats -data Commit = Commit { - commitSha :: !(Name Commit) - ,commitParents :: !(Vector Tree) - ,commitUrl :: !URL - ,commitGitCommit :: !GitCommit - ,commitCommitter :: !(Maybe SimpleUser) - ,commitAuthor :: !(Maybe SimpleUser) - ,commitFiles :: !(Vector File) - ,commitStats :: !(Maybe Stats) -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data Commit = Commit + { commitSha :: !(Name Commit) + , commitParents :: !(Vector Tree) + , commitUrl :: !URL + , commitGitCommit :: !GitCommit + , commitCommitter :: !(Maybe SimpleUser) + , commitAuthor :: !(Maybe SimpleUser) + , commitFiles :: !(Vector File) + , commitStats :: !(Maybe Stats) + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Commit where rnf = genericRnf instance Binary Commit -data Tree = Tree { - treeSha :: !(Name Tree) - ,treeUrl :: !URL - ,treeGitTrees :: !(Vector GitTree) -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data Tree = Tree + { treeSha :: !(Name Tree) + , treeUrl :: !URL + , treeGitTrees :: !(Vector GitTree) + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Tree where rnf = genericRnf instance Binary Tree -data GitTree = GitTree { - gitTreeType :: !Text - ,gitTreeSha :: !(Name GitTree) - -- Can be empty for submodule - ,gitTreeUrl :: !(Maybe URL) - ,gitTreeSize :: !(Maybe Int) - ,gitTreePath :: !Text - ,gitTreeMode :: !Text -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data GitTree = GitTree + { gitTreeType :: !Text + , gitTreeSha :: !(Name GitTree) + -- Can be empty for submodule + , gitTreeUrl :: !(Maybe URL) + , gitTreeSize :: !(Maybe Int) + , gitTreePath :: !Text + , gitTreeMode :: !Text + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData GitTree where rnf = genericRnf instance Binary GitTree -data GitCommit = GitCommit { - gitCommitMessage :: !Text - ,gitCommitUrl :: !URL - ,gitCommitCommitter :: !GitUser - ,gitCommitAuthor :: !GitUser - ,gitCommitTree :: !Tree - ,gitCommitSha :: !(Maybe (Name GitCommit)) - ,gitCommitParents :: !(Vector Tree) -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data GitCommit = GitCommit + { gitCommitMessage :: !Text + , gitCommitUrl :: !URL + , gitCommitCommitter :: !GitUser + , gitCommitAuthor :: !GitUser + , gitCommitTree :: !Tree + , gitCommitSha :: !(Maybe (Name GitCommit)) + , gitCommitParents :: !(Vector Tree) + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData GitCommit where rnf = genericRnf instance Binary GitCommit -data Blob = Blob { - blobUrl :: !URL - ,blobEncoding :: !Text - ,blobContent :: !Text - ,blobSha :: !(Name Blob) - ,blobSize :: !Int -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data Blob = Blob + { blobUrl :: !URL + , blobEncoding :: !Text + , blobContent :: !Text + , blobSha :: !(Name Blob) + , blobSize :: !Int + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Blob where rnf = genericRnf instance Binary Blob -data Tag = Tag { - tagName :: !Text - ,tagZipballUrl :: !URL - ,tagTarballUrl :: !URL - ,tagCommit :: !BranchCommit -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data Tag = Tag + { tagName :: !Text + , tagZipballUrl :: !URL + , tagTarballUrl :: !URL + , tagCommit :: !BranchCommit + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Tag where rnf = genericRnf instance Binary Tag -data Branch = Branch { - branchName :: !Text - ,branchCommit :: !BranchCommit -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data Branch = Branch + { branchName :: !Text + , branchCommit :: !BranchCommit + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Branch where rnf = genericRnf -data BranchCommit = BranchCommit { - branchCommitSha :: !Text - ,branchCommitUrl :: !URL -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data BranchCommit = BranchCommit + { branchCommitSha :: !Text + , branchCommitUrl :: !URL + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData BranchCommit where rnf = genericRnf instance Binary BranchCommit -data Diff = Diff { - diffStatus :: !Text - ,diffBehindBy :: !Int - ,diffPatchUrl :: !URL - ,diffUrl :: !URL - ,diffBaseCommit :: !Commit - ,diffCommits :: !(Vector Commit) - ,diffTotalCommits :: !Int - ,diffHtmlUrl :: !URL - ,diffFiles :: !(Vector File) - ,diffAheadBy :: !Int - ,diffDiffUrl :: !URL - ,diffPermalinkUrl :: !URL -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data Diff = Diff + { diffStatus :: !Text + , diffBehindBy :: !Int + , diffPatchUrl :: !URL + , diffUrl :: !URL + , diffBaseCommit :: !Commit + , diffCommits :: !(Vector Commit) + , diffTotalCommits :: !Int + , diffHtmlUrl :: !URL + , diffFiles :: !(Vector File) + , diffAheadBy :: !Int + , diffDiffUrl :: !URL + , diffPermalinkUrl :: !URL + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Diff where rnf = genericRnf instance Binary Diff -data NewGitReference = NewGitReference { - newGitReferenceRef :: !Text - ,newGitReferenceSha :: !Text -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data NewGitReference = NewGitReference + { newGitReferenceRef :: !Text + , newGitReferenceSha :: !Text + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData NewGitReference where rnf = genericRnf instance Binary NewGitReference -data GitReference = GitReference { - gitReferenceObject :: !GitObject - ,gitReferenceUrl :: !URL - ,gitReferenceRef :: !Text -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data GitReference = GitReference + { gitReferenceObject :: !GitObject + , gitReferenceUrl :: !URL + , gitReferenceRef :: !Text + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData GitReference where rnf = genericRnf instance Binary GitReference -data GitObject = GitObject { - gitObjectType :: !Text - ,gitObjectSha :: !Text - ,gitObjectUrl :: !URL -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data GitObject = GitObject + { gitObjectType :: !Text + , gitObjectSha :: !Text + , gitObjectUrl :: !URL + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData GitObject where rnf = genericRnf instance Binary GitObject -data GitUser = GitUser { - gitUserName :: !Text - ,gitUserEmail :: !Text - ,gitUserDate :: !UTCTime -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data GitUser = GitUser + { gitUserName :: !Text + , gitUserEmail :: !Text + , gitUserDate :: !UTCTime + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData GitUser where rnf = genericRnf instance Binary GitUser -data File = File { - fileBlobUrl :: !URL - ,fileStatus :: !Text - ,fileRawUrl :: !URL - ,fileAdditions :: !Int - ,fileSha :: !Text - ,fileChanges :: !Int - ,filePatch :: !(Maybe Text) - ,fileFilename :: !Text - ,fileDeletions :: !Int -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data File = File + { fileBlobUrl :: !URL + , fileStatus :: !Text + , fileRawUrl :: !URL + , fileAdditions :: !Int + , fileSha :: !Text + , fileChanges :: !Int + , filePatch :: !(Maybe Text) + , fileFilename :: !Text + , fileDeletions :: !Int + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData File where rnf = genericRnf instance Binary File @@ -186,114 +202,116 @@ instance Binary File -- JSON instances instance FromJSON Stats where - parseJSON = withObject "Stats" $ \o -> - Stats <$> o .: "additions" - <*> o .: "total" - <*> o .: "deletions" + parseJSON = withObject "Stats" $ \o -> Stats + <$> o .: "additions" + <*> o .: "total" + <*> o .: "deletions" instance FromJSON Commit where - parseJSON = withObject "Commit" $ \o -> - Commit <$> o .: "sha" - <*> o .: "parents" - <*> o .: "url" - <*> o .: "commit" - <*> o .:? "committer" - <*> o .:? "author" - <*> o .:? "files" .!= V.empty - <*> o .:? "stats" + parseJSON = withObject "Commit" $ \o -> Commit + <$> o .: "sha" + <*> o .: "parents" + <*> o .: "url" + <*> o .: "commit" + <*> o .:? "committer" + <*> o .:? "author" + <*> o .:? "files" .!= V.empty + <*> o .:? "stats" instance FromJSON Tree where - parseJSON = withObject "Tree" $ \o -> - Tree <$> o .: "sha" - <*> o .: "url" - <*> o .:? "tree" .!= V.empty + parseJSON = withObject "Tree" $ \o -> Tree + <$> o .: "sha" + <*> o .: "url" + <*> o .:? "tree" .!= V.empty instance FromJSON GitTree where - parseJSON = withObject "GitTree" $ \o -> - GitTree <$> o .: "type" - <*> o .: "sha" - <*> o .:? "url" - <*> o .:? "size" - <*> o .: "path" - <*> o .: "mode" + parseJSON = withObject "GitTree" $ \o -> GitTree + <$> o .: "type" + <*> o .: "sha" + <*> o .:? "url" + <*> o .:? "size" + <*> o .: "path" + <*> o .: "mode" instance FromJSON GitCommit where - parseJSON = withObject "GitCommit" $ \o -> - GitCommit <$> o .: "message" - <*> o .: "url" - <*> o .: "committer" - <*> o .: "author" - <*> o .: "tree" - <*> o .:? "sha" - <*> o .:? "parents" .!= V.empty + parseJSON = withObject "GitCommit" $ \o -> GitCommit + <$> o .: "message" + <*> o .: "url" + <*> o .: "committer" + <*> o .: "author" + <*> o .: "tree" + <*> o .:? "sha" + <*> o .:? "parents" .!= V.empty instance FromJSON GitUser where - parseJSON = withObject "GitUser" $ \o -> - GitUser <$> o .: "name" - <*> o .: "email" - <*> o .: "date" + parseJSON = withObject "GitUser" $ \o -> GitUser + <$> o .: "name" + <*> o .: "email" + <*> o .: "date" instance FromJSON File where - parseJSON = withObject "File" $ \o -> - File <$> o .: "blob_url" - <*> o .: "status" - <*> o .: "raw_url" - <*> o .: "additions" - <*> o .: "sha" - <*> o .: "changes" - <*> o .:? "patch" - <*> o .: "filename" - <*> o .: "deletions" + parseJSON = withObject "File" $ \o -> File + <$> o .: "blob_url" + <*> o .: "status" + <*> o .: "raw_url" + <*> o .: "additions" + <*> o .: "sha" + <*> o .: "changes" + <*> o .:? "patch" + <*> o .: "filename" + <*> o .: "deletions" instance ToJSON NewGitReference where - toJSON (NewGitReference r s) = object [ "ref" .= r, "sha" .= s ] + toJSON (NewGitReference r s) = object [ "ref" .= r, "sha" .= s ] instance FromJSON GitReference where - parseJSON = withObject "GitReference" $ \o -> - GitReference <$> o .: "object" - <*> o .: "url" - <*> o .: "ref" + parseJSON = withObject "GitReference" $ \o -> GitReference + <$> o .: "object" + <*> o .: "url" + <*> o .: "ref" instance FromJSON GitObject where - parseJSON = withObject "GitObject" $ \o -> - GitObject <$> o .: "type" - <*> o .: "sha" - <*> o .: "url" + parseJSON = withObject "GitObject" $ \o -> GitObject + <$> o .: "type" + <*> o .: "sha" + <*> o .: "url" instance FromJSON Diff where - parseJSON = withObject "Diff" $ \o -> - Diff <$> o .: "status" - <*> o .: "behind_by" - <*> o .: "patch_url" - <*> o .: "url" - <*> o .: "base_commit" - <*> o .:? "commits" .!= V.empty - <*> o .: "total_commits" - <*> o .: "html_url" - <*> o .:? "files" .!= V.empty - <*> o .: "ahead_by" - <*> o .: "diff_url" - <*> o .: "permalink_url" + parseJSON = withObject "Diff" $ \o -> Diff + <$> o .: "status" + <*> o .: "behind_by" + <*> o .: "patch_url" + <*> o .: "url" + <*> o .: "base_commit" + <*> o .:? "commits" .!= V.empty + <*> o .: "total_commits" + <*> o .: "html_url" + <*> o .:? "files" .!= V.empty + <*> o .: "ahead_by" + <*> o .: "diff_url" + <*> o .: "permalink_url" instance FromJSON Blob where - parseJSON = withObject "Blob" $ \o -> - Blob <$> o .: "url" - <*> o .: "encoding" - <*> o .: "content" - <*> o .: "sha" - <*> o .: "size" + parseJSON = withObject "Blob" $ \o -> Blob + <$> o .: "url" + <*> o .: "encoding" + <*> o .: "content" + <*> o .: "sha" + <*> o .: "size" instance FromJSON Tag where - parseJSON = withObject "Tag" $ \o -> - Tag <$> o .: "name" + parseJSON = withObject "Tag" $ \o -> Tag + <$> o .: "name" <*> o .: "zipball_url" <*> o .: "tarball_url" <*> o .: "commit" instance FromJSON Branch where - parseJSON = withObject "Branch" $ \o -> - Branch <$> o .: "name" <*> o .: "commit" + parseJSON = withObject "Branch" $ \o -> Branch + <$> o .: "name" + <*> o .: "commit" instance FromJSON BranchCommit where - parseJSON = withObject "BranchCommit" $ \o -> - BranchCommit <$> o .: "sha" <*> o .: "url" + parseJSON = withObject "BranchCommit" $ \o -> BranchCommit + <$> o .: "sha" + <*> o .: "url" diff --git a/src/GitHub/Data/Issues.hs b/src/GitHub/Data/Issues.hs index fb70c626..7cb8d30f 100644 --- a/src/GitHub/Data/Issues.hs +++ b/src/GitHub/Data/Issues.hs @@ -9,6 +9,7 @@ import GitHub.Data.Definitions import GitHub.Data.Id (Id) import GitHub.Data.Milestone (Milestone) import GitHub.Data.Name (Name) +import GitHub.Data.Options (IssueState) import GitHub.Data.PullRequests import GitHub.Data.URL (URL) import GitHub.Internal.Prelude @@ -20,7 +21,7 @@ data Issue = Issue , issueEventsUrl :: !URL , issueHtmlUrl :: !(Maybe URL) , issueClosedBy :: !(Maybe SimpleUser) - , issueLabels :: (Vector (Name IssueLabel)) + , issueLabels :: (Vector IssueLabel) , issueNumber :: !Int , issueAssignee :: !(Maybe SimpleUser) , issueUser :: !SimpleUser @@ -29,7 +30,7 @@ data Issue = Issue , issueUrl :: !URL , issueCreatedAt :: !UTCTime , issueBody :: !(Maybe Text) - , issueState :: !Text + , issueState :: !IssueState , issueId :: !(Id Issue) , issueComments :: !Int , issueMilestone :: !(Maybe Milestone) @@ -54,8 +55,8 @@ instance Binary NewIssue data EditIssue = EditIssue { editIssueTitle :: !(Maybe Text) , editIssueBody :: !(Maybe Text) - , editIssueAssignee :: !(Maybe Text) - , editIssueState :: !(Maybe Text) + , editIssueAssignee :: !(Maybe (Name User)) + , editIssueState :: !(Maybe IssueState) , editIssueMilestone :: !(Maybe (Id Milestone)) , editIssueLabels :: !(Maybe (Vector (Name IssueLabel))) } diff --git a/src/GitHub/Data/Options.hs b/src/GitHub/Data/Options.hs index 39900719..5f0106d8 100644 --- a/src/GitHub/Data/Options.hs +++ b/src/GitHub/Data/Options.hs @@ -4,6 +4,7 @@ -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- +-- Module with modifiers for pull requests' and issues' listings. module GitHub.Data.Options ( -- * Common modifiers stateOpen, @@ -28,6 +29,7 @@ module GitHub.Data.Options ( sortByComments, optionsLabels, optionsSince, + optionsSinceAll, optionsAssignedIssues, optionsCreatedIssues, optionsMentionedIssues, @@ -42,6 +44,13 @@ module GitHub.Data.Options ( optionsNoAssignee, -- * Data IssueState (..), + -- * Internal + HasState, + HasDirection, + HasCreatedUpdated, + HasComments, + HasLabels, + HasSince, ) where import GitHub.Data.Definitions @@ -58,7 +67,7 @@ import qualified Data.Text.Encoding as TE -- Data ------------------------------------------------------------------------------- --- | Issue or PullRewuest state +-- | 'GitHub.Data.Issues.Issue' or 'GitHub.Data.PullRequests.PullRequest' state data IssueState = StateOpen | StateClosed @@ -153,6 +162,10 @@ instance HasState IssueMod where state s = IssueMod $ \opts -> opts { issueOptionsState = s } +instance HasState IssueRepoMod where + state s = IssueRepoMod $ \opts -> + opts { issueRepoOptionsState = s } + class HasDirection mod where sortDir :: SortDirection -> mod @@ -171,6 +184,10 @@ instance HasDirection IssueMod where sortDir x = IssueMod $ \opts -> opts { issueOptionsDirection = x } +instance HasDirection IssueRepoMod where + sortDir x = IssueRepoMod $ \opts -> + opts { issueRepoOptionsDirection = x } + class HasCreatedUpdated mod where sortByCreated :: mod @@ -188,6 +205,12 @@ instance HasCreatedUpdated IssueMod where sortByUpdated = IssueMod $ \opts -> opts { issueOptionsSort = SortIssueUpdated } +instance HasCreatedUpdated IssueRepoMod where + sortByCreated = IssueRepoMod $ \opts -> + opts { issueRepoOptionsSort = SortIssueCreated } + sortByUpdated = IssueRepoMod $ \opts -> + opts { issueRepoOptionsSort = SortIssueUpdated } + ------------------------------------------------------------------------------- -- Pull Request ------------------------------------------------------------------------------- diff --git a/src/GitHub/Data/PullRequests.hs b/src/GitHub/Data/PullRequests.hs index 56445cdf..3e48efc9 100644 --- a/src/GitHub/Data/PullRequests.hs +++ b/src/GitHub/Data/PullRequests.hs @@ -167,8 +167,7 @@ instance Binary PullRequestReference ------------------------------------------------------------------------------- instance FromJSON SimplePullRequest where - parseJSON = withObject "SimplePullRequest" $ \o -> - SimplePullRequest + parseJSON = withObject "SimplePullRequest" $ \o -> SimplePullRequest <$> o .:? "closed_at" <*> o .: "created_at" <*> o .: "user" @@ -200,8 +199,7 @@ instance ToJSON CreatePullRequest where object [ "issue" .= issueNum, "head" .= headPR, "base" .= basePR] instance FromJSON PullRequest where - parseJSON = withObject "PullRequest" $ \o -> - PullRequest + parseJSON = withObject "PullRequest" $ \o -> PullRequest <$> o .:? "closed_at" <*> o .: "created_at" <*> o .: "user" @@ -231,11 +229,11 @@ instance FromJSON PullRequest where <*> o .:? "mergeable" instance FromJSON PullRequestLinks where - parseJSON = withObject "PullRequestLinks" $ \o -> PullRequestLinks - <$> fmap getHref (o .: "review_comments") - <*> fmap getHref (o .: "comments") - <*> fmap getHref (o .: "html") - <*> fmap getHref (o .: "self") + parseJSON = withObject "PullRequestLinks" $ \o -> PullRequestLinks + <$> fmap getHref (o .: "review_comments") + <*> fmap getHref (o .: "comments") + <*> fmap getHref (o .: "html") + <*> fmap getHref (o .: "self") instance FromJSON PullRequestCommit where parseJSON = withObject "PullRequestCommit" $ \o -> PullRequestCommit diff --git a/src/GitHub/Data/Search.hs b/src/GitHub/Data/Search.hs index cd19da19..cfef5ca1 100644 --- a/src/GitHub/Data/Search.hs +++ b/src/GitHub/Data/Search.hs @@ -12,38 +12,40 @@ import Prelude () import qualified Data.Vector as V -data SearchResult entity = SearchResult { - searchResultTotalCount :: !Int - ,searchResultResults :: !(Vector entity) -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data SearchResult entity = SearchResult + { searchResultTotalCount :: !Int + , searchResultResults :: !(Vector entity) + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData entity => NFData (SearchResult entity) where rnf = genericRnf instance Binary entity => Binary (SearchResult entity) instance FromJSON entity => FromJSON (SearchResult entity) where - parseJSON = withObject "SearchResult" $ \o -> - SearchResult <$> o .: "total_count" - <*> o .:? "items" .!= V.empty - -data Code = Code { - codeName :: !Text - ,codePath :: !Text - ,codeSha :: !Text - ,codeUrl :: !URL - ,codeGitUrl :: !URL - ,codeHtmlUrl :: !URL - ,codeRepo :: !Repo -} deriving (Show, Data, Typeable, Eq, Ord, Generic) + parseJSON = withObject "SearchResult" $ \o -> SearchResult + <$> o .: "total_count" + <*> o .:? "items" .!= V.empty + +data Code = Code + { codeName :: !Text + , codePath :: !Text + , codeSha :: !Text + , codeUrl :: !URL + , codeGitUrl :: !URL + , codeHtmlUrl :: !URL + , codeRepo :: !Repo + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Code where rnf = genericRnf instance Binary Code instance FromJSON Code where - parseJSON = withObject "Code" $ \o -> - Code <$> o .: "name" - <*> o .: "path" - <*> o .: "sha" - <*> o .: "url" - <*> o .: "git_url" - <*> o .: "html_url" - <*> o .: "repository" + parseJSON = withObject "Code" $ \o -> Code + <$> o .: "name" + <*> o .: "path" + <*> o .: "sha" + <*> o .: "url" + <*> o .: "git_url" + <*> o .: "html_url" + <*> o .: "repository" diff --git a/src/GitHub/Data/Webhooks.hs b/src/GitHub/Data/Webhooks.hs index 2e49e2e6..ea0604e5 100644 --- a/src/GitHub/Data/Webhooks.hs +++ b/src/GitHub/Data/Webhooks.hs @@ -5,92 +5,96 @@ -- module GitHub.Data.Webhooks where -import Prelude () - import GitHub.Data.Id (Id) import GitHub.Data.URL (URL) import GitHub.Internal.Prelude +import Prelude () import qualified Data.Map as M -data RepoWebhook = RepoWebhook { - repoWebhookUrl :: !URL - ,repoWebhookTestUrl :: !URL - ,repoWebhookId :: !(Id RepoWebhook) - ,repoWebhookName :: !Text - ,repoWebhookActive :: !Bool - ,repoWebhookEvents :: !(Vector RepoWebhookEvent) - ,repoWebhookConfig :: !(M.Map Text Text) - ,repoWebhookLastResponse :: !RepoWebhookResponse - ,repoWebhookUpdatedAt :: !UTCTime - ,repoWebhookCreatedAt :: !UTCTime -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data RepoWebhook = RepoWebhook + { repoWebhookUrl :: !URL + , repoWebhookTestUrl :: !URL + , repoWebhookId :: !(Id RepoWebhook) + , repoWebhookName :: !Text + , repoWebhookActive :: !Bool + , repoWebhookEvents :: !(Vector RepoWebhookEvent) + , repoWebhookConfig :: !(M.Map Text Text) + , repoWebhookLastResponse :: !RepoWebhookResponse + , repoWebhookUpdatedAt :: !UTCTime + , repoWebhookCreatedAt :: !UTCTime + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData RepoWebhook where rnf = genericRnf instance Binary RepoWebhook -data RepoWebhookEvent = - WebhookWildcardEvent - | WebhookCommitCommentEvent - | WebhookCreateEvent - | WebhookDeleteEvent - | WebhookDeploymentEvent - | WebhookDeploymentStatusEvent - | WebhookForkEvent - | WebhookGollumEvent - | WebhookIssueCommentEvent - | WebhookIssuesEvent - | WebhookMemberEvent - | WebhookPageBuildEvent - | WebhookPingEvent - | WebhookPublicEvent - | WebhookPullRequestReviewCommentEvent - | WebhookPullRequestEvent - | WebhookPushEvent - | WebhookReleaseEvent - | WebhookStatusEvent - | WebhookTeamAddEvent - | WebhookWatchEvent - deriving (Show, Data, Typeable, Eq, Ord, Generic) +data RepoWebhookEvent + = WebhookWildcardEvent + | WebhookCommitCommentEvent + | WebhookCreateEvent + | WebhookDeleteEvent + | WebhookDeploymentEvent + | WebhookDeploymentStatusEvent + | WebhookForkEvent + | WebhookGollumEvent + | WebhookIssueCommentEvent + | WebhookIssuesEvent + | WebhookMemberEvent + | WebhookPageBuildEvent + | WebhookPingEvent + | WebhookPublicEvent + | WebhookPullRequestReviewCommentEvent + | WebhookPullRequestEvent + | WebhookPushEvent + | WebhookReleaseEvent + | WebhookStatusEvent + | WebhookTeamAddEvent + | WebhookWatchEvent + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData RepoWebhookEvent where rnf = genericRnf instance Binary RepoWebhookEvent -data RepoWebhookResponse = RepoWebhookResponse { - repoWebhookResponseCode :: !(Maybe Int) - ,repoWebhookResponseStatus :: !Text - ,repoWebhookResponseMessage :: !(Maybe Text) -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data RepoWebhookResponse = RepoWebhookResponse + { repoWebhookResponseCode :: !(Maybe Int) + , repoWebhookResponseStatus :: !Text + , repoWebhookResponseMessage :: !(Maybe Text) + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData RepoWebhookResponse where rnf = genericRnf instance Binary RepoWebhookResponse -data PingEvent = PingEvent { - pingEventZen :: !Text - ,pingEventHook :: !RepoWebhook - ,pingEventHookId :: !(Id RepoWebhook) -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data PingEvent = PingEvent + { pingEventZen :: !Text + , pingEventHook :: !RepoWebhook + , pingEventHookId :: !(Id RepoWebhook) + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData PingEvent where rnf = genericRnf instance Binary PingEvent -data NewRepoWebhook = NewRepoWebhook { - newRepoWebhookName :: !Text - ,newRepoWebhookConfig :: !(M.Map Text Text) - ,newRepoWebhookEvents :: !(Maybe (Vector RepoWebhookEvent)) - ,newRepoWebhookActive :: !(Maybe Bool) -} deriving (Eq, Ord, Show, Typeable, Data, Generic) +data NewRepoWebhook = NewRepoWebhook + { newRepoWebhookName :: !Text + , newRepoWebhookConfig :: !(M.Map Text Text) + , newRepoWebhookEvents :: !(Maybe (Vector RepoWebhookEvent)) + , newRepoWebhookActive :: !(Maybe Bool) + } + deriving (Eq, Ord, Show, Typeable, Data, Generic) instance NFData NewRepoWebhook where rnf = genericRnf instance Binary NewRepoWebhook -data EditRepoWebhook = EditRepoWebhook { - editRepoWebhookConfig :: !(Maybe (M.Map Text Text)) - ,editRepoWebhookEvents :: !(Maybe (Vector RepoWebhookEvent)) - ,editRepoWebhookAddEvents :: !(Maybe (Vector RepoWebhookEvent)) - ,editRepoWebhookRemoveEvents :: !(Maybe (Vector RepoWebhookEvent)) - ,editRepoWebhookActive :: !(Maybe Bool) -} deriving (Eq, Ord, Show, Typeable, Data, Generic) +data EditRepoWebhook = EditRepoWebhook + { editRepoWebhookConfig :: !(Maybe (M.Map Text Text)) + , editRepoWebhookEvents :: !(Maybe (Vector RepoWebhookEvent)) + , editRepoWebhookAddEvents :: !(Maybe (Vector RepoWebhookEvent)) + , editRepoWebhookRemoveEvents :: !(Maybe (Vector RepoWebhookEvent)) + , editRepoWebhookActive :: !(Maybe Bool) + } + deriving (Eq, Ord, Show, Typeable, Data, Generic) instance NFData EditRepoWebhook where rnf = genericRnf instance Binary EditRepoWebhook @@ -98,70 +102,70 @@ instance Binary EditRepoWebhook -- JSON instances instance FromJSON RepoWebhookEvent where - parseJSON (String "*") = pure WebhookWildcardEvent - parseJSON (String "commit_comment") = pure WebhookCommitCommentEvent - parseJSON (String "create") = pure WebhookCreateEvent - parseJSON (String "delete") = pure WebhookDeleteEvent - parseJSON (String "deployment") = pure WebhookDeploymentEvent - parseJSON (String "deployment_status") = pure WebhookDeploymentStatusEvent - parseJSON (String "fork") = pure WebhookForkEvent - parseJSON (String "gollum") = pure WebhookGollumEvent - parseJSON (String "issue_comment") = pure WebhookIssueCommentEvent - parseJSON (String "issues") = pure WebhookIssuesEvent - parseJSON (String "member") = pure WebhookMemberEvent - parseJSON (String "page_build") = pure WebhookPageBuildEvent - parseJSON (String "ping") = pure WebhookPingEvent - parseJSON (String "public") = pure WebhookPublicEvent - parseJSON (String "pull_request_review_comment") = pure WebhookPullRequestReviewCommentEvent - parseJSON (String "pull_request") = pure WebhookPullRequestEvent - parseJSON (String "push") = pure WebhookPushEvent - parseJSON (String "release") = pure WebhookReleaseEvent - parseJSON (String "status") = pure WebhookStatusEvent - parseJSON (String "team_add") = pure WebhookTeamAddEvent - parseJSON (String "watch") = pure WebhookWatchEvent - parseJSON _ = fail "Could not build a Webhook event" + parseJSON (String "*") = pure WebhookWildcardEvent + parseJSON (String "commit_comment") = pure WebhookCommitCommentEvent + parseJSON (String "create") = pure WebhookCreateEvent + parseJSON (String "delete") = pure WebhookDeleteEvent + parseJSON (String "deployment") = pure WebhookDeploymentEvent + parseJSON (String "deployment_status") = pure WebhookDeploymentStatusEvent + parseJSON (String "fork") = pure WebhookForkEvent + parseJSON (String "gollum") = pure WebhookGollumEvent + parseJSON (String "issue_comment") = pure WebhookIssueCommentEvent + parseJSON (String "issues") = pure WebhookIssuesEvent + parseJSON (String "member") = pure WebhookMemberEvent + parseJSON (String "page_build") = pure WebhookPageBuildEvent + parseJSON (String "ping") = pure WebhookPingEvent + parseJSON (String "public") = pure WebhookPublicEvent + parseJSON (String "pull_request_review_comment") = pure WebhookPullRequestReviewCommentEvent + parseJSON (String "pull_request") = pure WebhookPullRequestEvent + parseJSON (String "push") = pure WebhookPushEvent + parseJSON (String "release") = pure WebhookReleaseEvent + parseJSON (String "status") = pure WebhookStatusEvent + parseJSON (String "team_add") = pure WebhookTeamAddEvent + parseJSON (String "watch") = pure WebhookWatchEvent + parseJSON _ = fail "Could not build a Webhook event" instance ToJSON RepoWebhookEvent where - toJSON (WebhookWildcardEvent) = String "*" - toJSON (WebhookCommitCommentEvent) = String "commit_comment" - toJSON (WebhookCreateEvent) = String "create" - toJSON (WebhookDeleteEvent) = String "delete" - toJSON (WebhookDeploymentEvent) = String "deployment" - toJSON (WebhookDeploymentStatusEvent) = String "deployment_status" - toJSON (WebhookForkEvent) = String "fork" - toJSON (WebhookGollumEvent) = String "gollum" - toJSON (WebhookIssueCommentEvent) = String "issue_comment" - toJSON (WebhookIssuesEvent) = String "issues" - toJSON (WebhookMemberEvent) = String "member" - toJSON (WebhookPageBuildEvent) = String "page_build" - toJSON (WebhookPingEvent) = String "ping" - toJSON (WebhookPublicEvent) = String "public" - toJSON (WebhookPullRequestReviewCommentEvent) = String "pull_request_review_comment" - toJSON (WebhookPullRequestEvent) = String "pull_request" - toJSON (WebhookPushEvent) = String "push" - toJSON (WebhookReleaseEvent) = String "release" - toJSON (WebhookStatusEvent) = String "status" - toJSON (WebhookTeamAddEvent) = String "team_add" - toJSON (WebhookWatchEvent) = String "watch" + toJSON WebhookWildcardEvent = String "*" + toJSON WebhookCommitCommentEvent = String "commit_comment" + toJSON WebhookCreateEvent = String "create" + toJSON WebhookDeleteEvent = String "delete" + toJSON WebhookDeploymentEvent = String "deployment" + toJSON WebhookDeploymentStatusEvent = String "deployment_status" + toJSON WebhookForkEvent = String "fork" + toJSON WebhookGollumEvent = String "gollum" + toJSON WebhookIssueCommentEvent = String "issue_comment" + toJSON WebhookIssuesEvent = String "issues" + toJSON WebhookMemberEvent = String "member" + toJSON WebhookPageBuildEvent = String "page_build" + toJSON WebhookPingEvent = String "ping" + toJSON WebhookPublicEvent = String "public" + toJSON WebhookPullRequestReviewCommentEvent = String "pull_request_review_comment" + toJSON WebhookPullRequestEvent = String "pull_request" + toJSON WebhookPushEvent = String "push" + toJSON WebhookReleaseEvent = String "release" + toJSON WebhookStatusEvent = String "status" + toJSON WebhookTeamAddEvent = String "team_add" + toJSON WebhookWatchEvent = String "watch" instance FromJSON RepoWebhook where - parseJSON = withObject "RepoWebhook" $ \o -> - RepoWebhook <$> o .: "url" - <*> o .: "test_url" - <*> o .: "id" - <*> o .: "name" - <*> o .: "active" - <*> o .: "events" - <*> o .: "config" - <*> o .: "last_response" - <*> o .: "updated_at" - <*> o .: "created_at" + parseJSON = withObject "RepoWebhook" $ \o -> RepoWebhook + <$> o .: "url" + <*> o .: "test_url" + <*> o .: "id" + <*> o .: "name" + <*> o .: "active" + <*> o .: "events" + <*> o .: "config" + <*> o .: "last_response" + <*> o .: "updated_at" + <*> o .: "created_at" instance FromJSON RepoWebhookResponse where - parseJSON = withObject "RepoWebhookResponse" $ \o -> - RepoWebhookResponse <$> o .: "code" - <*> o .: "status" - <*> o .: "message" + parseJSON = withObject "RepoWebhookResponse" $ \o -> RepoWebhookResponse + <$> o .: "code" + <*> o .: "status" + <*> o .: "message" instance ToJSON NewRepoWebhook where toJSON (NewRepoWebhook { newRepoWebhookName = name @@ -191,7 +195,7 @@ instance ToJSON EditRepoWebhook where ] instance FromJSON PingEvent where - parseJSON = withObject "PingEvent" $ \o -> - PingEvent <$> o .: "zen" - <*> o .: "hook" - <*> o .: "hook_id" + parseJSON = withObject "PingEvent" $ \o -> PingEvent + <$> o .: "zen" + <*> o .: "hook" + <*> o .: "hook_id" From 5965743dcb3bb38219d11076cf7c85c8d0ac0e7b Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 13 Sep 2016 20:50:42 +0300 Subject: [PATCH 224/510] RO-RA-RW --- src/GitHub/Data/Request.hs | 24 +++++++++++++++++++-- src/GitHub/Endpoints/Activity/Starring.hs | 4 ++-- src/GitHub/Endpoints/GitData/References.hs | 2 +- src/GitHub/Endpoints/Issues.hs | 6 +++--- src/GitHub/Endpoints/Issues/Comments.hs | 4 ++-- src/GitHub/Endpoints/Issues/Labels.hs | 14 ++++++------ src/GitHub/Endpoints/Organizations/Teams.hs | 16 +++++++------- src/GitHub/Endpoints/PullRequests.hs | 6 +++--- src/GitHub/Endpoints/Repos.hs | 8 +++---- src/GitHub/Endpoints/Repos/DeployKeys.hs | 15 ++++++++----- src/GitHub/Endpoints/Repos/Webhooks.hs | 10 ++++----- src/GitHub/Endpoints/Users.hs | 2 +- src/GitHub/Request.hs | 15 +++++++------ 13 files changed, 76 insertions(+), 50 deletions(-) diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs index 604fcd82..b355292e 100644 --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -10,6 +10,7 @@ -- module GitHub.Data.Request ( Request(..), + RW(..), CommandMethod(..), toMethod, StatusMap(..), @@ -125,16 +126,35 @@ instance NFData FetchCount where rnf = genericRnf -- Github request ------------------------------------------------------------------------------ +-- | Type used as with @DataKinds@ to tag whether requests need authentication +-- or aren't read-only. +data RW + = RO -- ^ /Read-only/, doesn't necessarily requires authentication + | RA -- ^ /Read autenticated/ + | RW -- ^ /Read-write/, requires authentication + deriving (Eq, Ord, Read, Show, Enum, Bounded, Typeable, Data, Generic) + +{- +data SRO (rw :: RW) where + ROO :: SRO 'RO + ROA :: SRO 'RA + +-- | This class is used to describe read-only (but pontentially +class IReadOnly (rw :: RW) where iro :: SRO rw +instance IReadOnly 'RO where iro = ROO +instance IReadOnly 'RA where iro = ROA +-} + -- | Github request data type. -- -- * @k@ describes whether authentication is required. It's required for non-@GET@ requests. -- * @a@ is the result type -- -- /Note:/ 'Request' is not 'Functor' on purpose. -data Request (k :: Bool) a where +data Request (k :: RW) a where Query :: FromJSON a => Paths -> QueryString -> Request k a PagedQuery :: FromJSON (Vector a) => Paths -> QueryString -> FetchCount -> Request k (Vector a) - Command :: FromJSON a => CommandMethod a -> Paths -> LBS.ByteString -> Request 'True a + Command :: FromJSON a => CommandMethod a -> Paths -> LBS.ByteString -> Request 'RW a StatusQuery :: StatusMap a -> Request k () -> Request k a HeaderQuery :: Types.RequestHeaders -> Request k a -> Request k a deriving (Typeable) diff --git a/src/GitHub/Endpoints/Activity/Starring.hs b/src/GitHub/Endpoints/Activity/Starring.hs index 1661305b..5178cbce 100644 --- a/src/GitHub/Endpoints/Activity/Starring.hs +++ b/src/GitHub/Endpoints/Activity/Starring.hs @@ -56,7 +56,7 @@ myStarred auth = -- | All the repos starred by the authenticated user. -- See -myStarredR :: FetchCount -> Request 'True (Vector Repo) +myStarredR :: FetchCount -> Request 'RA (Vector Repo) myStarredR = PagedQuery ["user", "starred"] [] @@ -67,5 +67,5 @@ myStarredAcceptStar auth = -- | All the repos starred by the authenticated user. -- See -myStarredAcceptStarR :: FetchCount -> Request 'True (Vector RepoStarred) +myStarredAcceptStarR :: FetchCount -> Request 'RA (Vector RepoStarred) myStarredAcceptStarR = HeaderQuery [("Accept", "application/vnd.github.v3.star+json")] . PagedQuery ["user", "starred"] [] diff --git a/src/GitHub/Endpoints/GitData/References.hs b/src/GitHub/Endpoints/GitData/References.hs index 7e0c6d57..a15ddac3 100644 --- a/src/GitHub/Endpoints/GitData/References.hs +++ b/src/GitHub/Endpoints/GitData/References.hs @@ -69,7 +69,7 @@ createReference auth user repo newRef = -- | Create a reference. -- See -createReferenceR :: Name Owner -> Name Repo -> NewGitReference -> Request 'True GitReference +createReferenceR :: Name Owner -> Name Repo -> NewGitReference -> Request 'RW GitReference createReferenceR user repo newRef = Command Post ["repos", toPathPart user, toPathPart repo , "git", "refs"] (encode newRef) diff --git a/src/GitHub/Endpoints/Issues.hs b/src/GitHub/Endpoints/Issues.hs index b2b7555c..dc24db99 100644 --- a/src/GitHub/Endpoints/Issues.hs +++ b/src/GitHub/Endpoints/Issues.hs @@ -29,7 +29,7 @@ import GitHub.Request import Prelude () -- | See . -currentUserIssuesR :: IssueMod -> FetchCount -> Request k (Vector Issue) +currentUserIssuesR :: IssueMod -> FetchCount -> Request 'RA (Vector Issue) currentUserIssuesR opts = PagedQuery ["user", "issues"] (issueModToQueryString opts) @@ -99,7 +99,7 @@ createIssue auth user repo ni = -- | Create an issue. -- See -createIssueR :: Name Owner -> Name Repo -> NewIssue -> Request 'True Issue +createIssueR :: Name Owner -> Name Repo -> NewIssue -> Request 'RW Issue createIssueR user repo = Command Post ["repos", toPathPart user, toPathPart repo, "issues"] . encode @@ -119,6 +119,6 @@ editIssue auth user repo iss edit = -- | Edit an issue. -- See -editIssueR :: Name Owner -> Name Repo -> Id Issue -> EditIssue -> Request 'True Issue +editIssueR :: Name Owner -> Name Repo -> Id Issue -> EditIssue -> Request 'RW Issue editIssueR user repo iss = Command Patch ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iss] . encode diff --git a/src/GitHub/Endpoints/Issues/Comments.hs b/src/GitHub/Endpoints/Issues/Comments.hs index 81a9b52c..67bf0d3b 100644 --- a/src/GitHub/Endpoints/Issues/Comments.hs +++ b/src/GitHub/Endpoints/Issues/Comments.hs @@ -66,7 +66,7 @@ createComment auth user repo iss body = -- | Create a comment. -- See -createCommentR :: Name Owner -> Name Repo -> Id Issue -> Text -> Request 'True Comment +createCommentR :: Name Owner -> Name Repo -> Id Issue -> Text -> Request 'RW Comment createCommentR user repo iss body = Command Post parts (encode $ NewComment body) where @@ -83,7 +83,7 @@ editComment auth user repo commid body = -- | Edit a comment. -- See -editCommentR :: Name Owner -> Name Repo -> Id Comment -> Text -> Request 'True Comment +editCommentR :: Name Owner -> Name Repo -> Id Comment -> Text -> Request 'RW Comment editCommentR user repo commid body = Command Patch parts (encode $ EditComment body) where diff --git a/src/GitHub/Endpoints/Issues/Labels.hs b/src/GitHub/Endpoints/Issues/Labels.hs index 3e4829f7..eab8f4c6 100644 --- a/src/GitHub/Endpoints/Issues/Labels.hs +++ b/src/GitHub/Endpoints/Issues/Labels.hs @@ -87,7 +87,7 @@ createLabel auth user repo lbl color = -- | Create a label. -- See -createLabelR :: Name Owner -> Name Repo -> Name IssueLabel -> String -> Request 'True IssueLabel +createLabelR :: Name Owner -> Name Repo -> Name IssueLabel -> String -> Request 'RW IssueLabel createLabelR user repo lbl color = Command Post paths $ encode body where @@ -114,7 +114,7 @@ updateLabelR :: Name Owner -> Name IssueLabel -- ^ old label name -> Name IssueLabel -- ^ new label name -> String -- ^ new color - -> Request 'True IssueLabel + -> Request 'RW IssueLabel updateLabelR user repo oldLbl newLbl color = Command Patch paths (encode body) where @@ -130,7 +130,7 @@ deleteLabel auth user repo lbl = -- | Delete a label. -- See -deleteLabelR :: Name Owner -> Name Repo -> Name IssueLabel -> Request 'True () +deleteLabelR :: Name Owner -> Name Repo -> Name IssueLabel -> Request 'RW () deleteLabelR user repo lbl = Command Delete ["repos", toPathPart user, toPathPart repo, "labels", toPathPart lbl] mempty @@ -173,7 +173,7 @@ addLabelsToIssueR :: Foldable f -> Name Repo -> Id Issue -> f (Name IssueLabel) - -> Request 'True (Vector IssueLabel) + -> Request 'RW (Vector IssueLabel) addLabelsToIssueR user repo iid lbls = Command Post paths (encode $ toList lbls) where @@ -188,7 +188,7 @@ removeLabelFromIssue auth user repo iid lbl = -- | Remove a label from an issue. -- See -removeLabelFromIssueR :: Name Owner -> Name Repo -> Id Issue -> Name IssueLabel -> Request 'True () +removeLabelFromIssueR :: Name Owner -> Name Repo -> Id Issue -> Name IssueLabel -> Request 'RW () removeLabelFromIssueR user repo iid lbl = Command Delete ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels", toPathPart lbl] mempty @@ -214,7 +214,7 @@ replaceAllLabelsForIssueR :: Foldable f -> Name Repo -> Id Issue -> f (Name IssueLabel) - -> Request 'True (Vector IssueLabel) + -> Request 'RW (Vector IssueLabel) replaceAllLabelsForIssueR user repo iid lbls = Command Put paths (encode $ toList lbls) where @@ -229,7 +229,7 @@ removeAllLabelsFromIssue auth user repo iid = -- | Remove all labels from an issue. -- See -removeAllLabelsFromIssueR :: Name Owner -> Name Repo -> Id Issue -> Request 'True () +removeAllLabelsFromIssueR :: Name Owner -> Name Repo -> Id Issue -> Request 'RW () removeAllLabelsFromIssueR user repo iid = Command Delete ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] mempty diff --git a/src/GitHub/Endpoints/Organizations/Teams.hs b/src/GitHub/Endpoints/Organizations/Teams.hs index 8e8e9564..ba06ee6a 100644 --- a/src/GitHub/Endpoints/Organizations/Teams.hs +++ b/src/GitHub/Endpoints/Organizations/Teams.hs @@ -91,7 +91,7 @@ createTeamFor' auth org cteam = -- | Create team. -- See -createTeamForR :: Name Organization -> CreateTeam -> Request 'True Team +createTeamForR :: Name Organization -> CreateTeam -> Request 'RW Team createTeamForR org cteam = Command Post ["orgs", toPathPart org, "teams"] (encode cteam) @@ -107,7 +107,7 @@ editTeam' auth tid eteam = -- | Edit team. -- See -editTeamR :: Id Team -> EditTeam -> Request 'True Team +editTeamR :: Id Team -> EditTeam -> Request 'RW Team editTeamR tid eteam = Command Patch ["teams", toPathPart tid] (encode eteam) @@ -121,14 +121,14 @@ deleteTeam' auth tid = -- | Delete team. -- -- See -deleteTeamR :: Id Team -> Request 'True () +deleteTeamR :: Id Team -> Request 'RW () deleteTeamR tid = Command Delete ["teams", toPathPart tid] mempty -- | List team members. -- -- See -listTeamMembersR :: Id Team -> TeamMemberRole -> FetchCount -> Request 'True (Vector SimpleUser) +listTeamMembersR :: Id Team -> TeamMemberRole -> FetchCount -> Request 'RA (Vector SimpleUser) listTeamMembersR tid r = PagedQuery ["teams", toPathPart tid, "members"] [("role", Just r')] where r' = case r of @@ -177,13 +177,13 @@ teamMembershipInfoFor = teamMembershipInfoFor' Nothing -- | Add (or invite) a member to a team. -- -- > addTeamMembershipFor' (OAuth "token") 1010101 "mburns" RoleMember -addTeamMembershipFor' :: Auth -> Id Team -> Name Owner -> Role-> IO (Either Error TeamMembership) +addTeamMembershipFor' :: Auth -> Id Team -> Name Owner -> Role -> IO (Either Error TeamMembership) addTeamMembershipFor' auth tid user role = executeRequest auth $ addTeamMembershipForR tid user role -- | Add team membership. -- See -addTeamMembershipForR :: Id Team -> Name Owner -> Role -> Request 'True TeamMembership +addTeamMembershipForR :: Id Team -> Name Owner -> Role -> Request 'RW TeamMembership addTeamMembershipForR tid user role = Command Put ["teams", toPathPart tid, "memberships", toPathPart user] (encode $ CreateTeamMembership role) @@ -196,7 +196,7 @@ deleteTeamMembershipFor' auth tid user = -- | Remove team membership. -- See -deleteTeamMembershipForR :: Id Team -> Name Owner -> Request 'True () +deleteTeamMembershipForR :: Id Team -> Name Owner -> Request 'RW () deleteTeamMembershipForR tid user = Command Delete ["teams", toPathPart tid, "memberships", toPathPart user] mempty @@ -208,5 +208,5 @@ listTeamsCurrent' auth = executeRequest auth $ listTeamsCurrentR FetchAll -- | List user teams. -- See -listTeamsCurrentR :: FetchCount -> Request 'True (Vector Team) +listTeamsCurrentR :: FetchCount -> Request 'RW (Vector Team) listTeamsCurrentR = PagedQuery ["user", "teams"] [] diff --git a/src/GitHub/Endpoints/PullRequests.hs b/src/GitHub/Endpoints/PullRequests.hs index 04c2247f..7c5943e9 100644 --- a/src/GitHub/Endpoints/PullRequests.hs +++ b/src/GitHub/Endpoints/PullRequests.hs @@ -87,7 +87,7 @@ createPullRequest auth user repo cpr = createPullRequestR :: Name Owner -> Name Repo -> CreatePullRequest - -> Request 'True PullRequest + -> Request 'RW PullRequest createPullRequestR user repo cpr = Command Post ["repos", toPathPart user, toPathPart repo, "pulls"] (encode cpr) @@ -102,7 +102,7 @@ updatePullRequestR :: Name Owner -> Name Repo -> Id PullRequest -> EditPullRequest - -> Request 'True PullRequest + -> Request 'RW PullRequest updatePullRequestR user repo prid epr = Command Patch ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid] (encode epr) @@ -168,7 +168,7 @@ mergePullRequest auth user repo prid commitMessage = -- | Merge a pull request (Merge Button). -- https://developer.github.com/v3/pulls/#merge-a-pull-request-merge-button -mergePullRequestR :: Name Owner -> Name Repo -> Id PullRequest -> Maybe Text -> Request 'True MergeResult +mergePullRequestR :: Name Owner -> Name Repo -> Id PullRequest -> Maybe Text -> Request 'RW MergeResult mergePullRequestR user repo prid commitMessage = StatusQuery StatusMerge $ Command Put paths (encode $ buildCommitMessageMap commitMessage) where diff --git a/src/GitHub/Endpoints/Repos.hs b/src/GitHub/Endpoints/Repos.hs index d5be2120..d6a13587 100644 --- a/src/GitHub/Endpoints/Repos.hs +++ b/src/GitHub/Endpoints/Repos.hs @@ -168,7 +168,7 @@ createRepo' auth nrepo = -- | Create a new repository. -- See -createRepoR :: NewRepo -> Request 'True Repo +createRepoR :: NewRepo -> Request 'RW Repo createRepoR nrepo = Command Post ["user", "repos"] (encode nrepo) @@ -181,7 +181,7 @@ createOrganizationRepo' auth org nrepo = -- | Create a new repository for an organization. -- See -createOrganizationRepoR :: Name Organization -> NewRepo -> Request 'True Repo +createOrganizationRepoR :: Name Organization -> NewRepo -> Request 'RW Repo createOrganizationRepoR org nrepo = Command Post ["orgs", toPathPart org, "repos"] (encode nrepo) @@ -200,7 +200,7 @@ editRepo auth user repo body = -- | Edit an existing repository. -- See -editRepoR :: Name Owner -> Name Repo -> EditRepo -> Request 'True Repo +editRepoR :: Name Owner -> Name Repo -> EditRepo -> Request 'RW Repo editRepoR user repo body = Command Patch ["repos", toPathPart user, toPathPart repo] (encode b) where @@ -365,6 +365,6 @@ deleteRepo :: Auth -> Name Owner -> Name Repo -> IO (Either Error ()) deleteRepo auth user repo = executeRequest auth $ deleteRepoR user repo -deleteRepoR :: Name Owner -> Name Repo -> Request 'True () +deleteRepoR :: Name Owner -> Name Repo -> Request 'RW () deleteRepoR user repo = Command Delete ["repos", toPathPart user, toPathPart repo] mempty diff --git a/src/GitHub/Endpoints/Repos/DeployKeys.hs b/src/GitHub/Endpoints/Repos/DeployKeys.hs index 99db6ad2..025ee2c8 100644 --- a/src/GitHub/Endpoints/Repos/DeployKeys.hs +++ b/src/GitHub/Endpoints/Repos/DeployKeys.hs @@ -26,12 +26,14 @@ import GitHub.Internal.Prelude import GitHub.Request import Prelude () --- | Querying deploy keys +-- | Querying deploy keys. deployKeysFor' :: Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector RepoDeployKey)) deployKeysFor' auth user repo = executeRequest auth $ deployKeysForR user repo FetchAll -deployKeysForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector RepoDeployKey) +-- | Querying deploy keys. +-- See +deployKeysForR :: Name Owner -> Name Repo -> FetchCount -> Request 'RA (Vector RepoDeployKey) deployKeysForR user repo = PagedQuery ["repos", toPathPart user, toPathPart repo, "keys"] [] @@ -40,7 +42,9 @@ deployKeyFor' :: Auth -> Name Owner -> Name Repo -> Id RepoDeployKey -> IO (Eith deployKeyFor' auth user repo keyId = executeRequest auth $ deployKeyForR user repo keyId -deployKeyForR :: Name Owner -> Name Repo -> Id RepoDeployKey -> Request k RepoDeployKey +-- | Querying a deploy key. +-- See +deployKeyForR :: Name Owner -> Name Repo -> Id RepoDeployKey -> Request 'RA RepoDeployKey deployKeyForR user repo keyId = Query ["repos", toPathPart user, toPathPart repo, "keys", toPathPart keyId] [] @@ -50,7 +54,8 @@ createRepoDeployKey' auth user repo key = executeRequest auth $ createRepoDeployKeyR user repo key -- | Create a deploy key. -createRepoDeployKeyR :: Name Owner -> Name Repo -> NewRepoDeployKey -> Request 'True RepoDeployKey +-- See . +createRepoDeployKeyR :: Name Owner -> Name Repo -> NewRepoDeployKey -> Request 'RW RepoDeployKey createRepoDeployKeyR user repo key = Command Post ["repos", toPathPart user, toPathPart repo, "keys"] (encode key) @@ -60,6 +65,6 @@ deleteRepoDeployKey' auth user repo keyId = -- | Delete a deploy key. -- See -deleteRepoDeployKeyR :: Name Owner -> Name Repo -> Id RepoDeployKey -> Request 'True () +deleteRepoDeployKeyR :: Name Owner -> Name Repo -> Id RepoDeployKey -> Request 'RW () deleteRepoDeployKeyR user repo keyId = Command Delete ["repos", toPathPart user, toPathPart repo, "keys", toPathPart keyId] mempty diff --git a/src/GitHub/Endpoints/Repos/Webhooks.hs b/src/GitHub/Endpoints/Repos/Webhooks.hs index 5a5d6810..4e6c0bf6 100644 --- a/src/GitHub/Endpoints/Repos/Webhooks.hs +++ b/src/GitHub/Endpoints/Repos/Webhooks.hs @@ -63,7 +63,7 @@ createRepoWebhook' auth user repo hook = -- | Create a hook. -- See -createRepoWebhookR :: Name Owner -> Name Repo -> NewRepoWebhook -> Request 'True RepoWebhook +createRepoWebhookR :: Name Owner -> Name Repo -> NewRepoWebhook -> Request 'RW RepoWebhook createRepoWebhookR user repo hook = Command Post ["repos", toPathPart user, toPathPart repo, "hooks"] (encode hook) @@ -73,7 +73,7 @@ editRepoWebhook' auth user repo hookId hookEdit = -- | Edit a hook. -- See -editRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> EditRepoWebhook -> Request 'True RepoWebhook +editRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> EditRepoWebhook -> Request 'RW RepoWebhook editRepoWebhookR user repo hookId hookEdit = Command Patch ["repos", toPathPart user, toPathPart repo, "hooks", toPathPart hookId] (encode hookEdit) @@ -83,7 +83,7 @@ testPushRepoWebhook' auth user repo hookId = -- | Test a push hook. -- See -testPushRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> Request 'True Bool +testPushRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> Request 'RW Bool testPushRepoWebhookR user repo hookId = StatusQuery StatusOnlyOk $ Command Post (createWebhookOpPath user repo hookId $ Just "tests") (encode ()) @@ -93,7 +93,7 @@ pingRepoWebhook' auth user repo hookId = -- | Ping a hook. -- See -pingRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> Request 'True Bool +pingRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> Request 'RW Bool pingRepoWebhookR user repo hookId = StatusQuery StatusOnlyOk $ Command Post (createWebhookOpPath user repo hookId $ Just "pings") (encode ()) @@ -103,7 +103,7 @@ deleteRepoWebhook' auth user repo hookId = -- | Delete a hook. -- See -deleteRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> Request 'True () +deleteRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> Request 'RW () deleteRepoWebhookR user repo hookId = Command Delete (createWebhookOpPath user repo hookId Nothing) mempty diff --git a/src/GitHub/Endpoints/Users.hs b/src/GitHub/Endpoints/Users.hs index 71ebca84..592e6636 100644 --- a/src/GitHub/Endpoints/Users.hs +++ b/src/GitHub/Endpoints/Users.hs @@ -52,5 +52,5 @@ userInfoCurrent' auth = -- | Query the authenticated user. -- See -userInfoCurrentR :: Request 'True User +userInfoCurrentR :: Request 'RA User userInfoCurrentR = Query ["user"] [] diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index a652525a..7a02d78f 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -139,7 +139,7 @@ executeRequestWithMgr mgr auth req = runExceptT $ httpLbs' req' = lift (httpLbs req' mgr) `catch` onHttpException -- | Like 'executeRequest' but without authentication. -executeRequest' :: Request 'False a -> IO (Either Error a) +executeRequest' :: Request 'RO a -> IO (Either Error a) executeRequest' req = do manager <- newManager tlsManagerSettings x <- executeRequestWithMgr' manager req @@ -149,13 +149,14 @@ executeRequest' req = do pure x -- | Like 'executeRequestWithMgr' but without authentication. -executeRequestWithMgr' :: Manager - -> Request 'False a - -> IO (Either Error a) +executeRequestWithMgr' + :: Manager + -> Request 'RO a + -> IO (Either Error a) executeRequestWithMgr' mgr req = runExceptT $ execute req where - execute :: Request 'False a -> ExceptT Error IO a + execute :: Request 'RO b -> ExceptT Error IO b execute req' = case req' of Query {} -> do httpReq <- makeHttpRequest Nothing req @@ -178,12 +179,12 @@ executeRequestWithMgr' mgr req = runExceptT $ -- | Helper for picking between 'executeRequest' and 'executeRequest''. -- -- The use is discouraged. -executeRequestMaybe :: Maybe Auth -> Request 'False a +executeRequestMaybe :: Maybe Auth -> Request 'RO a -> IO (Either Error a) executeRequestMaybe = maybe executeRequest' executeRequest -- | Partial function to drop authentication need. -unsafeDropAuthRequirements :: Request 'True a -> Request k a +unsafeDropAuthRequirements :: Request k' a -> Request k a unsafeDropAuthRequirements (Query ps qs) = Query ps qs unsafeDropAuthRequirements r = error $ "Trying to drop authenatication from" ++ show r From 1ce5abba8c01c7a08cabdce30800fda273868895 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 13 Sep 2016 21:30:19 +0300 Subject: [PATCH 225/510] Split 'SimpleRequest' out of Request --- src/GitHub/Data.hs | 4 +- src/GitHub/Data/Milestone.hs | 4 +- src/GitHub/Data/Options.hs | 14 +- src/GitHub/Data/PullRequests.hs | 38 ++- src/GitHub/Data/Request.hs | 166 +++++++------ src/GitHub/Endpoints/Activity/Starring.hs | 6 +- src/GitHub/Endpoints/Activity/Watching.hs | 4 +- src/GitHub/Endpoints/Gists.hs | 6 +- src/GitHub/Endpoints/Gists/Comments.hs | 4 +- src/GitHub/Endpoints/GitData/Blobs.hs | 2 +- src/GitHub/Endpoints/GitData/Commits.hs | 2 +- src/GitHub/Endpoints/GitData/References.hs | 8 +- src/GitHub/Endpoints/GitData/Trees.hs | 4 +- src/GitHub/Endpoints/Issues.hs | 12 +- src/GitHub/Endpoints/Issues/Comments.hs | 8 +- src/GitHub/Endpoints/Issues/Events.hs | 6 +- src/GitHub/Endpoints/Issues/Labels.hs | 22 +- src/GitHub/Endpoints/Issues/Milestones.hs | 5 +- src/GitHub/Endpoints/Organizations.hs | 4 +- src/GitHub/Endpoints/Organizations/Members.hs | 6 +- src/GitHub/Endpoints/Organizations/Teams.hs | 28 ++- src/GitHub/Endpoints/PullRequests.hs | 16 +- .../Endpoints/PullRequests/ReviewComments.hs | 4 +- src/GitHub/Endpoints/Repos.hs | 28 +-- src/GitHub/Endpoints/Repos/Collaborators.hs | 4 +- src/GitHub/Endpoints/Repos/Comments.hs | 6 +- src/GitHub/Endpoints/Repos/Commits.hs | 6 +- src/GitHub/Endpoints/Repos/DeployKeys.hs | 8 +- src/GitHub/Endpoints/Repos/Forks.hs | 2 +- src/GitHub/Endpoints/Repos/Webhooks.hs | 14 +- src/GitHub/Endpoints/Search.hs | 9 +- src/GitHub/Endpoints/Users.hs | 6 +- src/GitHub/Endpoints/Users/Followers.hs | 6 +- src/GitHub/Request.hs | 229 +++++++++--------- 34 files changed, 380 insertions(+), 311 deletions(-) diff --git a/src/GitHub/Data.hs b/src/GitHub/Data.hs index 1a8e9c1b..c6cb79b3 100644 --- a/src/GitHub/Data.hs +++ b/src/GitHub/Data.hs @@ -63,12 +63,12 @@ import GitHub.Data.Gists import GitHub.Data.GitData import GitHub.Data.Id import GitHub.Data.Issues -import GitHub.Data.Name import GitHub.Data.Milestone +import GitHub.Data.Name +import GitHub.Data.Options import GitHub.Data.PullRequests import GitHub.Data.Repos import GitHub.Data.Request -import GitHub.Data.Options import GitHub.Data.Search import GitHub.Data.Teams import GitHub.Data.URL diff --git a/src/GitHub/Data/Milestone.hs b/src/GitHub/Data/Milestone.hs index 8141e2c8..26c861de 100644 --- a/src/GitHub/Data/Milestone.hs +++ b/src/GitHub/Data/Milestone.hs @@ -6,8 +6,8 @@ module GitHub.Data.Milestone where import GitHub.Data.Definitions -import GitHub.Data.Id (Id) -import GitHub.Data.URL (URL) +import GitHub.Data.Id (Id) +import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () diff --git a/src/GitHub/Data/Options.hs b/src/GitHub/Data/Options.hs index 5f0106d8..285dec0e 100644 --- a/src/GitHub/Data/Options.hs +++ b/src/GitHub/Data/Options.hs @@ -54,10 +54,10 @@ module GitHub.Data.Options ( ) where import GitHub.Data.Definitions -import GitHub.Data.Id (Id, untagId) -import GitHub.Data.Name (Name, untagName) +import GitHub.Data.Id (Id, untagId) +import GitHub.Data.Milestone (Milestone) +import GitHub.Data.Name (Name, untagName) import GitHub.Internal.Prelude -import GitHub.Data.Milestone (Milestone) import Prelude () import qualified Data.Text as T @@ -513,7 +513,7 @@ issueRepoOptionsToQueryString IssueRepoOptions {..} = FilterBy x' -> TE.encodeUtf8 (f x') milestone' = filt (T.pack . show . untagId) issueRepoOptionsMilestone - assignee' = filt untagName issueRepoOptionsAssignee + assignee' = filt untagName issueRepoOptionsAssignee state' = case issueRepoOptionsState of Nothing -> "all" @@ -538,11 +538,11 @@ issueRepoOptionsToQueryString IssueRepoOptions {..} = optionsAnyMilestone :: IssueRepoMod optionsAnyMilestone = IssueRepoMod $ \opts -> - opts { issueRepoOptionsMilestone = FilterAny } + opts { issueRepoOptionsMilestone = FilterAny } optionsNoMilestone :: IssueRepoMod optionsNoMilestone = IssueRepoMod $ \opts -> - opts { issueRepoOptionsMilestone = FilterNone } + opts { issueRepoOptionsMilestone = FilterNone } optionsAnyAssignee :: IssueRepoMod optionsAnyAssignee = IssueRepoMod $ \opts -> @@ -550,4 +550,4 @@ optionsAnyAssignee = IssueRepoMod $ \opts -> optionsNoAssignee :: IssueRepoMod optionsNoAssignee = IssueRepoMod $ \opts -> - opts { issueRepoOptionsAssignee = FilterNone } + opts { issueRepoOptionsAssignee = FilterNone } diff --git a/src/GitHub/Data/PullRequests.hs b/src/GitHub/Data/PullRequests.hs index 3e48efc9..e2b5cef3 100644 --- a/src/GitHub/Data/PullRequests.hs +++ b/src/GitHub/Data/PullRequests.hs @@ -13,12 +13,15 @@ module GitHub.Data.PullRequests ( PullRequestEvent(..), PullRequestEventType(..), PullRequestReference(..), + MergeResult(..), + statusMerge, ) where import GitHub.Data.Definitions import GitHub.Data.Id (Id) import GitHub.Data.Options (IssueState (..)) import GitHub.Data.Repos (Repo) +import GitHub.Data.Request (StatusMap) import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () @@ -40,7 +43,8 @@ data SimplePullRequest = SimplePullRequest , simplePullRequestMergedAt :: !(Maybe UTCTime) , simplePullRequestTitle :: !Text , simplePullRequestId :: !(Id PullRequest) - } deriving (Show, Data, Typeable, Eq, Ord, Generic) + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData SimplePullRequest where rnf = genericRnf instance Binary SimplePullRequest @@ -73,7 +77,8 @@ data PullRequest = PullRequest , pullRequestCommits :: !Count , pullRequestMerged :: !Bool , pullRequestMergeable :: !(Maybe Bool) - } deriving (Show, Data, Typeable, Eq, Ord, Generic) + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData PullRequest where rnf = genericRnf instance Binary PullRequest @@ -82,13 +87,14 @@ data EditPullRequest = EditPullRequest { editPullRequestTitle :: !(Maybe Text) , editPullRequestBody :: !(Maybe Text) , editPullRequestState :: !(Maybe IssueState) - } deriving (Show, Generic) + } + deriving (Show, Generic) instance NFData EditPullRequest where rnf = genericRnf instance Binary EditPullRequest -data CreatePullRequest = - CreatePullRequest +data CreatePullRequest + = CreatePullRequest { createPullRequestTitle :: !Text , createPullRequestBody :: !Text , createPullRequestHead :: !Text @@ -99,7 +105,7 @@ data CreatePullRequest = , createPullRequestHead :: !Text , createPullRequestBase :: !Text } - deriving (Show, Generic) + deriving (Show, Generic) instance NFData CreatePullRequest where rnf = genericRnf instance Binary CreatePullRequest @@ -109,7 +115,8 @@ data PullRequestLinks = PullRequestLinks , pullRequestLinksComments :: !URL , pullRequestLinksHtml :: !URL , pullRequestLinksSelf :: !URL - } deriving (Show, Data, Typeable, Eq, Ord, Generic) + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData PullRequestLinks where rnf = genericRnf instance Binary PullRequestLinks @@ -120,7 +127,8 @@ data PullRequestCommit = PullRequestCommit , pullRequestCommitSha :: !Text , pullRequestCommitUser :: !SimpleUser , pullRequestCommitRepo :: !Repo - } deriving (Show, Data, Typeable, Eq, Ord, Generic) + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData PullRequestCommit where rnf = genericRnf instance Binary PullRequestCommit @@ -275,3 +283,17 @@ newtype Href a = Href { getHref :: a } instance FromJSON a => FromJSON (Href a) where parseJSON = withObject "href object" $ \obj -> Href <$> obj .: "href" + +-- | Pull request merge results +data MergeResult + = MergeSuccessful + | MergeCannotPerform + | MergeConflict + deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable) + +statusMerge :: StatusMap MergeResult +statusMerge = + [ (204, MergeSuccessful) + , (405, MergeCannotPerform) + , (409, MergeConflict) + ] diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs index b355292e..04877130 100644 --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -9,12 +9,17 @@ -- Maintainer : Oleg Grenrus -- module GitHub.Data.Request ( - Request(..), + -- * Request + Request (..), + SimpleRequest (..), + -- * Smart constructors + query, pagedQuery, command, + -- * Auxiliary types RW(..), + StatusMap, + statusOnlyOk, CommandMethod(..), toMethod, - StatusMap(..), - MergeResult(..), FetchCount(..), Paths, IsPathPart(..), @@ -74,30 +79,6 @@ toMethod Patch = Method.methodPatch toMethod Put = Method.methodPut toMethod Delete = Method.methodDelete --- | Result of merge operation -data MergeResult = MergeSuccessful - | MergeCannotPerform - | MergeConflict - deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable) - -instance Hashable MergeResult - --- | Status code transform -data StatusMap a where - StatusOnlyOk :: StatusMap Bool - StatusMerge :: StatusMap MergeResult - deriving (Typeable) - -deriving instance Eq (StatusMap a) - -instance Show (StatusMap a) where - showsPrec _ StatusOnlyOk = showString "StatusOnlyOK" - showsPrec _ StatusMerge = showString "StatusMerge" - -instance Hashable (StatusMap a) where - hashWithSalt salt StatusOnlyOk = hashWithSalt salt (0 :: Int) - hashWithSalt salt StatusMerge = hashWithSalt salt (1 :: Int) - -- | 'PagedQuery' returns just some results, using this data we can specify how -- many pages we want to fetch. data FetchCount = FetchAtLeast !Word | FetchAll @@ -152,51 +133,87 @@ instance IReadOnly 'RA where iro = ROA -- -- /Note:/ 'Request' is not 'Functor' on purpose. data Request (k :: RW) a where - Query :: FromJSON a => Paths -> QueryString -> Request k a - PagedQuery :: FromJSON (Vector a) => Paths -> QueryString -> FetchCount -> Request k (Vector a) - Command :: FromJSON a => CommandMethod a -> Paths -> LBS.ByteString -> Request 'RW a - StatusQuery :: StatusMap a -> Request k () -> Request k a - HeaderQuery :: Types.RequestHeaders -> Request k a -> Request k a - deriving (Typeable) - -deriving instance Eq (Request k a) + SimpleQuery :: FromJSON a => SimpleRequest k a -> Request k a + StatusQuery :: StatusMap a -> SimpleRequest k () -> Request k a + HeaderQuery :: FromJSON a => Types.RequestHeaders -> SimpleRequest k a -> Request k a + deriving (Typeable) + +data SimpleRequest (k :: RW) a where + Query :: Paths -> QueryString -> SimpleRequest k a + PagedQuery :: Paths -> QueryString -> FetchCount -> SimpleRequest k (Vector a) + Command :: CommandMethod a -> Paths -> LBS.ByteString -> SimpleRequest 'RW a + deriving (Typeable) + +------------------------------------------------------------------------------- +-- Status Map +------------------------------------------------------------------------------- + +-- TODO: Change to 'Map' ? +type StatusMap a = [(Int, a)] + +statusOnlyOk :: StatusMap Bool +statusOnlyOk = + [ (202, True) + , (404, False) + ] + +------------------------------------------------------------------------------- +-- Smart constructors +------------------------------------------------------------------------------- + +query :: FromJSON a => Paths -> QueryString -> Request k a +query ps qs = SimpleQuery (Query ps qs) + +pagedQuery :: FromJSON a => Paths -> QueryString -> FetchCount -> Request k (Vector a) +pagedQuery ps qs fc = SimpleQuery (PagedQuery ps qs fc) + +command :: FromJSON a => CommandMethod a -> Paths -> LBS.ByteString -> Request 'RW a +command m ps body = SimpleQuery (Command m ps body) + +------------------------------------------------------------------------------- +-- Instances +------------------------------------------------------------------------------- + +deriving instance Eq a => Eq (Request k a) +deriving instance Eq a => Eq (SimpleRequest k a) + +instance Show (SimpleRequest k a) where + showsPrec d r = showParen (d > appPrec) $ case r of + Query ps qs -> showString "Query " + . showsPrec (appPrec + 1) ps + . showString " " + . showsPrec (appPrec + 1) qs + PagedQuery ps qs l -> showString "PagedQuery " + . showsPrec (appPrec + 1) ps + . showString " " + . showsPrec (appPrec + 1) qs + . showString " " + . showsPrec (appPrec + 1) l + Command m ps body -> showString "Command " + . showsPrec (appPrec + 1) m + . showString " " + . showsPrec (appPrec + 1) ps + . showString " " + . showsPrec (appPrec + 1) body + where + appPrec = 10 :: Int instance Show (Request k a) where - showsPrec d r = - case r of - Query ps qs -> showParen (d > appPrec) $ - showString "Query " - . showsPrec (appPrec + 1) ps - . showString " " - . showsPrec (appPrec + 1) qs - PagedQuery ps qs l -> showParen (d > appPrec) $ - showString "PagedQuery " - . showsPrec (appPrec + 1) ps - . showString " " - . showsPrec (appPrec + 1) qs - . showString " " - . showsPrec (appPrec + 1) l - Command m ps body -> showParen (d > appPrec) $ - showString "Command " - . showsPrec (appPrec + 1) m - . showString " " - . showsPrec (appPrec + 1) ps - . showString " " - . showsPrec (appPrec + 1) body - StatusQuery m req -> showParen (d > appPrec) $ - showString "Status " - . showsPrec (appPrec + 1) m - . showString " " - . showsPrec (appPrec + 1) req - HeaderQuery m req -> showParen (d > appPrec) $ - showString "Header " - . showsPrec (appPrec + 1) m - . showString " " - . showsPrec (appPrec + 1) req - - where appPrec = 10 :: Int - -instance Hashable (Request k a) where + showsPrec d r = showParen (d > appPrec) $ case r of + SimpleQuery req -> showString "SimpleQuery " + . showsPrec (appPrec + 1) req + StatusQuery m req -> showString "Status " + . showsPrec (appPrec + 1) (map fst m) -- !!! printing only keys + . showString " " + . showsPrec (appPrec + 1) req + HeaderQuery m req -> showString "Header " + . showsPrec (appPrec + 1) m + . showString " " + . showsPrec (appPrec + 1) req + where + appPrec = 10 :: Int + +instance Hashable (SimpleRequest k a) where hashWithSalt salt (Query ps qs) = salt `hashWithSalt` (0 :: Int) `hashWithSalt` ps @@ -211,11 +228,16 @@ instance Hashable (Request k a) where `hashWithSalt` m `hashWithSalt` ps `hashWithSalt` body + +instance Hashable a => Hashable (Request k a) where + hashWithSalt salt (SimpleQuery req) = + salt `hashWithSalt` (0 :: Int) + `hashWithSalt` req hashWithSalt salt (StatusQuery sm req) = - salt `hashWithSalt` (3 :: Int) + salt `hashWithSalt` (1 :: Int) `hashWithSalt` sm `hashWithSalt` req hashWithSalt salt (HeaderQuery h req) = - salt `hashWithSalt` (4 :: Int) + salt `hashWithSalt` (2 :: Int) `hashWithSalt` h `hashWithSalt` req diff --git a/src/GitHub/Endpoints/Activity/Starring.hs b/src/GitHub/Endpoints/Activity/Starring.hs index 5178cbce..7ca84c34 100644 --- a/src/GitHub/Endpoints/Activity/Starring.hs +++ b/src/GitHub/Endpoints/Activity/Starring.hs @@ -34,7 +34,7 @@ stargazersFor auth user repo = -- See stargazersForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector SimpleUser) stargazersForR user repo = - PagedQuery ["repos", toPathPart user, toPathPart repo, "stargazers"] [] + pagedQuery ["repos", toPathPart user, toPathPart repo, "stargazers"] [] -- | All the public repos starred by the specified user. -- @@ -47,7 +47,7 @@ reposStarredBy auth user = -- See reposStarredByR :: Name Owner -> FetchCount -> Request k (Vector Repo) reposStarredByR user = - PagedQuery ["users", toPathPart user, "starred"] [] + pagedQuery ["users", toPathPart user, "starred"] [] -- | All the repos starred by the authenticated user. myStarred :: Auth -> IO (Either Error (Vector Repo)) @@ -57,7 +57,7 @@ myStarred auth = -- | All the repos starred by the authenticated user. -- See myStarredR :: FetchCount -> Request 'RA (Vector Repo) -myStarredR = PagedQuery ["user", "starred"] [] +myStarredR = pagedQuery ["user", "starred"] [] -- | All the repos starred by the authenticated user. diff --git a/src/GitHub/Endpoints/Activity/Watching.hs b/src/GitHub/Endpoints/Activity/Watching.hs index 9e096053..34914e32 100644 --- a/src/GitHub/Endpoints/Activity/Watching.hs +++ b/src/GitHub/Endpoints/Activity/Watching.hs @@ -39,7 +39,7 @@ watchersFor' auth user repo = -- See watchersForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector SimpleUser) watchersForR user repo limit = - PagedQuery ["repos", toPathPart user, toPathPart repo, "watchers"] [] limit + pagedQuery ["repos", toPathPart user, toPathPart repo, "watchers"] [] limit -- | All the public repos watched by the specified user. -- @@ -59,4 +59,4 @@ reposWatchedBy' auth user = -- See reposWatchedByR :: Name Owner -> FetchCount -> Request k (Vector Repo) reposWatchedByR user = - PagedQuery ["users", toPathPart user, "subscriptions"] [] + pagedQuery ["users", toPathPart user, "subscriptions"] [] diff --git a/src/GitHub/Endpoints/Gists.hs b/src/GitHub/Endpoints/Gists.hs index 6804a092..77d7bced 100644 --- a/src/GitHub/Endpoints/Gists.hs +++ b/src/GitHub/Endpoints/Gists.hs @@ -35,7 +35,7 @@ gists = gists' Nothing -- | List gists. -- See gistsR :: Name Owner -> FetchCount -> Request k (Vector Gist) -gistsR user = PagedQuery ["users", toPathPart user, "gists"] [] +gistsR user = pagedQuery ["users", toPathPart user, "gists"] [] -- | A specific gist, given its id, with authentication credentials -- @@ -52,6 +52,6 @@ gist = gist' Nothing -- | Query a single gist. -- See -gistR :: Name Gist ->Request k Gist +gistR :: Name Gist -> Request k Gist gistR gid = - Query ["gists", toPathPart gid] [] + query ["gists", toPathPart gid] [] diff --git a/src/GitHub/Endpoints/Gists/Comments.hs b/src/GitHub/Endpoints/Gists/Comments.hs index 60a27caa..98da18c2 100644 --- a/src/GitHub/Endpoints/Gists/Comments.hs +++ b/src/GitHub/Endpoints/Gists/Comments.hs @@ -29,7 +29,7 @@ commentsOn gid = -- See commentsOnR :: Name Gist -> FetchCount -> Request k (Vector GistComment) commentsOnR gid = - PagedQuery ["gists", toPathPart gid, "comments"] [] + pagedQuery ["gists", toPathPart gid, "comments"] [] -- | A specific comment, by the comment ID. -- @@ -42,4 +42,4 @@ comment cid = -- See gistCommentR :: Id GistComment -> Request k GistComment gistCommentR cid = - Query ["gists", "comments", toPathPart cid] [] + query ["gists", "comments", toPathPart cid] [] diff --git a/src/GitHub/Endpoints/GitData/Blobs.hs b/src/GitHub/Endpoints/GitData/Blobs.hs index 33ab8437..355a6e8a 100644 --- a/src/GitHub/Endpoints/GitData/Blobs.hs +++ b/src/GitHub/Endpoints/GitData/Blobs.hs @@ -34,4 +34,4 @@ blob = blob' Nothing -- See blobR :: Name Owner -> Name Repo -> Name Blob -> Request k Blob blobR user repo sha = - Query ["repos", toPathPart user, toPathPart repo, "git", "blobs", toPathPart sha] [] + query ["repos", toPathPart user, toPathPart repo, "git", "blobs", toPathPart sha] [] diff --git a/src/GitHub/Endpoints/GitData/Commits.hs b/src/GitHub/Endpoints/GitData/Commits.hs index 87bb6fac..1d8ced18 100644 --- a/src/GitHub/Endpoints/GitData/Commits.hs +++ b/src/GitHub/Endpoints/GitData/Commits.hs @@ -27,4 +27,4 @@ commit user repo sha = -- See gitCommitR :: Name Owner -> Name Repo -> Name GitCommit -> Request k GitCommit gitCommitR user repo sha = - Query ["repos", toPathPart user, toPathPart repo, "git", "commits", toPathPart sha] [] + query ["repos", toPathPart user, toPathPart repo, "git", "commits", toPathPart sha] [] diff --git a/src/GitHub/Endpoints/GitData/References.hs b/src/GitHub/Endpoints/GitData/References.hs index a15ddac3..d010e1b7 100644 --- a/src/GitHub/Endpoints/GitData/References.hs +++ b/src/GitHub/Endpoints/GitData/References.hs @@ -41,7 +41,7 @@ reference = reference' Nothing -- See referenceR :: Name Owner -> Name Repo -> Name GitReference -> Request k GitReference referenceR user repo ref = - Query ["repos", toPathPart user, toPathPart repo, "git", "refs", toPathPart ref] [] + query ["repos", toPathPart user, toPathPart repo, "git", "refs", toPathPart ref] [] -- | The history of references for a repo. -- @@ -60,7 +60,7 @@ references = references' Nothing -- See referencesR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector GitReference) referencesR user repo = - PagedQuery ["repos", toPathPart user, toPathPart repo, "git", "refs"] [] + pagedQuery ["repos", toPathPart user, toPathPart repo, "git", "refs"] [] -- | Create a reference. createReference :: Auth -> Name Owner -> Name Repo -> NewGitReference -> IO (Either Error GitReference) @@ -71,7 +71,7 @@ createReference auth user repo newRef = -- See createReferenceR :: Name Owner -> Name Repo -> NewGitReference -> Request 'RW GitReference createReferenceR user repo newRef = - Command Post ["repos", toPathPart user, toPathPart repo , "git", "refs"] (encode newRef) + command Post ["repos", toPathPart user, toPathPart repo , "git", "refs"] (encode newRef) -- | Limited references by a namespace. -- @@ -84,4 +84,4 @@ namespacedReferences user repo namespace = -- See namespacedReferencesR :: Name Owner -> Name Repo -> Text -> Request k [GitReference] namespacedReferencesR user repo namespace = - Query ["repos", toPathPart user, toPathPart repo, "git", "refs", namespace] [] + query ["repos", toPathPart user, toPathPart repo, "git", "refs", namespace] [] diff --git a/src/GitHub/Endpoints/GitData/Trees.hs b/src/GitHub/Endpoints/GitData/Trees.hs index 29f27abe..1806561a 100644 --- a/src/GitHub/Endpoints/GitData/Trees.hs +++ b/src/GitHub/Endpoints/GitData/Trees.hs @@ -37,7 +37,7 @@ tree = tree' Nothing -- See treeR :: Name Owner -> Name Repo -> Name Tree -> Request k Tree treeR user repo sha = - Query ["repos", toPathPart user, toPathPart repo, "git", "trees", toPathPart sha] [] + query ["repos", toPathPart user, toPathPart repo, "git", "trees", toPathPart sha] [] -- | A recursively-nested tree for a SHA1. -- @@ -56,4 +56,4 @@ nestedTree = nestedTree' Nothing -- See nestedTreeR :: Name Owner -> Name Repo -> Name Tree -> Request k Tree nestedTreeR user repo sha = - Query ["repos", toPathPart user, toPathPart repo, "git", "trees", toPathPart sha] [("recursive", Just "1")] + query ["repos", toPathPart user, toPathPart repo, "git", "trees", toPathPart sha] [("recursive", Just "1")] diff --git a/src/GitHub/Endpoints/Issues.hs b/src/GitHub/Endpoints/Issues.hs index dc24db99..431e1c3e 100644 --- a/src/GitHub/Endpoints/Issues.hs +++ b/src/GitHub/Endpoints/Issues.hs @@ -31,12 +31,12 @@ import Prelude () -- | See . currentUserIssuesR :: IssueMod -> FetchCount -> Request 'RA (Vector Issue) currentUserIssuesR opts = - PagedQuery ["user", "issues"] (issueModToQueryString opts) + pagedQuery ["user", "issues"] (issueModToQueryString opts) -- | See . organizationIssuesR :: Name Organization -> IssueMod -> FetchCount -> Request k (Vector Issue) organizationIssuesR org opts = - PagedQuery ["orgs", toPathPart org, "issues"] (issueModToQueryString opts) + pagedQuery ["orgs", toPathPart org, "issues"] (issueModToQueryString opts) -- | Details on a specific issue, given the repo owner and name, and the issue -- number.' @@ -57,7 +57,7 @@ issue = issue' Nothing -- See issueR :: Name Owner -> Name Repo -> Id Issue -> Request k Issue issueR user reqRepoName reqIssueNumber = - Query ["repos", toPathPart user, toPathPart reqRepoName, "issues", toPathPart reqIssueNumber] [] + query ["repos", toPathPart user, toPathPart reqRepoName, "issues", toPathPart reqIssueNumber] [] -- | All issues for a repo (given the repo owner and name), with optional -- restrictions as described in the 'IssueRepoMod' data type. @@ -78,7 +78,7 @@ issuesForRepo = issuesForRepo' Nothing -- See issuesForRepoR :: Name Owner -> Name Repo -> IssueRepoMod -> FetchCount -> Request k (Vector Issue) issuesForRepoR user reqRepoName opts = - PagedQuery ["repos", toPathPart user, toPathPart reqRepoName, "issues"] qs + pagedQuery ["repos", toPathPart user, toPathPart reqRepoName, "issues"] qs where qs = issueRepoModToQueryString opts @@ -101,7 +101,7 @@ createIssue auth user repo ni = -- See createIssueR :: Name Owner -> Name Repo -> NewIssue -> Request 'RW Issue createIssueR user repo = - Command Post ["repos", toPathPart user, toPathPart repo, "issues"] . encode + command Post ["repos", toPathPart user, toPathPart repo, "issues"] . encode -- Editing issues. @@ -121,4 +121,4 @@ editIssue auth user repo iss edit = -- See editIssueR :: Name Owner -> Name Repo -> Id Issue -> EditIssue -> Request 'RW Issue editIssueR user repo iss = - Command Patch ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iss] . encode + command Patch ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iss] . encode diff --git a/src/GitHub/Endpoints/Issues/Comments.hs b/src/GitHub/Endpoints/Issues/Comments.hs index 67bf0d3b..508fc642 100644 --- a/src/GitHub/Endpoints/Issues/Comments.hs +++ b/src/GitHub/Endpoints/Issues/Comments.hs @@ -34,7 +34,7 @@ comment user repo cid = -- See commentR :: Name Owner -> Name Repo -> Id Comment -> Request k IssueComment commentR user repo cid = - Query ["repos", toPathPart user, toPathPart repo, "issues", "comments", toPathPart cid] [] + query ["repos", toPathPart user, toPathPart repo, "issues", "comments", toPathPart cid] [] -- | All comments on an issue, by the issue's number. -- @@ -53,7 +53,7 @@ comments' auth user repo iid = -- See commentsR :: Name Owner -> Name Repo -> Id Issue -> FetchCount -> Request k (Vector IssueComment) commentsR user repo iid = - PagedQuery ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "comments"] [] + pagedQuery ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "comments"] [] -- | Create a new comment. -- @@ -68,7 +68,7 @@ createComment auth user repo iss body = -- See createCommentR :: Name Owner -> Name Repo -> Id Issue -> Text -> Request 'RW Comment createCommentR user repo iss body = - Command Post parts (encode $ NewComment body) + command Post parts (encode $ NewComment body) where parts = ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iss, "comments"] @@ -85,6 +85,6 @@ editComment auth user repo commid body = -- See editCommentR :: Name Owner -> Name Repo -> Id Comment -> Text -> Request 'RW Comment editCommentR user repo commid body = - Command Patch parts (encode $ EditComment body) + command Patch parts (encode $ EditComment body) where parts = ["repos", toPathPart user, toPathPart repo, "issues", "comments", toPathPart commid] diff --git a/src/GitHub/Endpoints/Issues/Events.hs b/src/GitHub/Endpoints/Issues/Events.hs index bf108cee..9bc22a9b 100644 --- a/src/GitHub/Endpoints/Issues/Events.hs +++ b/src/GitHub/Endpoints/Issues/Events.hs @@ -40,7 +40,7 @@ eventsForIssue' auth user repo iid = -- See eventsForIssueR :: Name Owner -> Name Repo -> Id Issue -> FetchCount -> Request k (Vector Event) eventsForIssueR user repo iid = - PagedQuery ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "events"] [] + pagedQuery ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "events"] [] -- | All the events for all issues in a repo. -- @@ -59,7 +59,7 @@ eventsForRepo' auth user repo = -- See eventsForRepoR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Event) eventsForRepoR user repo = - PagedQuery ["repos", toPathPart user, toPathPart repo, "issues", "events"] [] + pagedQuery ["repos", toPathPart user, toPathPart repo, "issues", "events"] [] -- | Details on a specific event, by the event's ID. -- @@ -78,4 +78,4 @@ event' auth user repo eid = -- See eventR :: Name Owner -> Name Repo -> Id Event -> Request k Event eventR user repo eid = - Query ["repos", toPathPart user, toPathPart repo, "issues", "events", toPathPart eid] [] + query ["repos", toPathPart user, toPathPart repo, "issues", "events", toPathPart eid] [] diff --git a/src/GitHub/Endpoints/Issues/Labels.hs b/src/GitHub/Endpoints/Issues/Labels.hs index eab8f4c6..4b4c8628 100644 --- a/src/GitHub/Endpoints/Issues/Labels.hs +++ b/src/GitHub/Endpoints/Issues/Labels.hs @@ -57,7 +57,7 @@ labelsOnRepo' auth user repo = -- See labelsOnRepoR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector IssueLabel) labelsOnRepoR user repo = - PagedQuery ["repos", toPathPart user, toPathPart repo, "labels"] [] + pagedQuery ["repos", toPathPart user, toPathPart repo, "labels"] [] -- | A label by name. -- @@ -76,7 +76,7 @@ label' auth user repo lbl = -- See labelR :: Name Owner -> Name Repo -> Name IssueLabel -> Request k IssueLabel labelR user repo lbl = - Query ["repos", toPathPart user, toPathPart repo, "labels", toPathPart lbl] [] + query ["repos", toPathPart user, toPathPart repo, "labels", toPathPart lbl] [] -- | Create a label -- @@ -89,7 +89,7 @@ createLabel auth user repo lbl color = -- See createLabelR :: Name Owner -> Name Repo -> Name IssueLabel -> String -> Request 'RW IssueLabel createLabelR user repo lbl color = - Command Post paths $ encode body + command Post paths $ encode body where paths = ["repos", toPathPart user, toPathPart repo, "labels"] body = object ["name" .= untagName lbl, "color" .= color] @@ -116,7 +116,7 @@ updateLabelR :: Name Owner -> String -- ^ new color -> Request 'RW IssueLabel updateLabelR user repo oldLbl newLbl color = - Command Patch paths (encode body) + command Patch paths (encode body) where paths = ["repos", toPathPart user, toPathPart repo, "labels", toPathPart oldLbl] body = object ["name" .= untagName newLbl, "color" .= color] @@ -132,7 +132,7 @@ deleteLabel auth user repo lbl = -- See deleteLabelR :: Name Owner -> Name Repo -> Name IssueLabel -> Request 'RW () deleteLabelR user repo lbl = - Command Delete ["repos", toPathPart user, toPathPart repo, "labels", toPathPart lbl] mempty + command Delete ["repos", toPathPart user, toPathPart repo, "labels", toPathPart lbl] mempty -- | The labels on an issue in a repo. -- @@ -151,7 +151,7 @@ labelsOnIssue' auth user repo iid = -- See labelsOnIssueR :: Name Owner -> Name Repo -> Id Issue -> FetchCount -> Request k (Vector IssueLabel) labelsOnIssueR user repo iid = - PagedQuery ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] [] + pagedQuery ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] [] -- | Add labels to an issue. -- @@ -175,7 +175,7 @@ addLabelsToIssueR :: Foldable f -> f (Name IssueLabel) -> Request 'RW (Vector IssueLabel) addLabelsToIssueR user repo iid lbls = - Command Post paths (encode $ toList lbls) + command Post paths (encode $ toList lbls) where paths = ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] @@ -190,7 +190,7 @@ removeLabelFromIssue auth user repo iid lbl = -- See removeLabelFromIssueR :: Name Owner -> Name Repo -> Id Issue -> Name IssueLabel -> Request 'RW () removeLabelFromIssueR user repo iid lbl = - Command Delete ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels", toPathPart lbl] mempty + command Delete ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels", toPathPart lbl] mempty -- | Replace all labels on an issue. Sending an empty list will remove all labels from the issue. -- @@ -216,7 +216,7 @@ replaceAllLabelsForIssueR :: Foldable f -> f (Name IssueLabel) -> Request 'RW (Vector IssueLabel) replaceAllLabelsForIssueR user repo iid lbls = - Command Put paths (encode $ toList lbls) + command Put paths (encode $ toList lbls) where paths = ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] @@ -231,7 +231,7 @@ removeAllLabelsFromIssue auth user repo iid = -- See removeAllLabelsFromIssueR :: Name Owner -> Name Repo -> Id Issue -> Request 'RW () removeAllLabelsFromIssueR user repo iid = - Command Delete ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] mempty + command Delete ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] mempty -- | All the labels on a repo's milestone given the milestone ID. -- @@ -250,4 +250,4 @@ labelsOnMilestone' auth user repo mid = -- See labelsOnMilestoneR :: Name Owner -> Name Repo -> Id Milestone -> FetchCount -> Request k (Vector IssueLabel) labelsOnMilestoneR user repo mid = - PagedQuery ["repos", toPathPart user, toPathPart repo, "milestones", toPathPart mid, "labels"] [] + pagedQuery ["repos", toPathPart user, toPathPart repo, "milestones", toPathPart mid, "labels"] [] diff --git a/src/GitHub/Endpoints/Issues/Milestones.hs b/src/GitHub/Endpoints/Issues/Milestones.hs index 65106975..9f541112 100644 --- a/src/GitHub/Endpoints/Issues/Milestones.hs +++ b/src/GitHub/Endpoints/Issues/Milestones.hs @@ -35,7 +35,8 @@ milestones' auth user repo = -- | List milestones for a repository. -- See milestonesR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Milestone) -milestonesR user repo = PagedQuery ["repos", toPathPart user, toPathPart repo, "milestones"] [] +milestonesR user repo = + pagedQuery ["repos", toPathPart user, toPathPart repo, "milestones"] [] -- | Details on a specific milestone, given it's milestone number. -- @@ -48,4 +49,4 @@ milestone user repo mid = -- See milestoneR :: Name Owner -> Name Repo -> Id Milestone -> Request k Milestone milestoneR user repo mid = - Query ["repos", toPathPart user, toPathPart repo, "milestones", toPathPart mid] [] + query ["repos", toPathPart user, toPathPart repo, "milestones", toPathPart mid] [] diff --git a/src/GitHub/Endpoints/Organizations.hs b/src/GitHub/Endpoints/Organizations.hs index 098d39cc..8bbc9efe 100644 --- a/src/GitHub/Endpoints/Organizations.hs +++ b/src/GitHub/Endpoints/Organizations.hs @@ -35,7 +35,7 @@ publicOrganizationsFor = publicOrganizationsFor' Nothing -- | List user organizations. -- See publicOrganizationsForR :: Name User -> FetchCount -> Request k (Vector SimpleOrganization) -publicOrganizationsForR user = PagedQuery ["users", toPathPart user, "orgs"] [] +publicOrganizationsForR user = pagedQuery ["users", toPathPart user, "orgs"] [] -- | Details on a public organization. Takes the organization's login. -- @@ -52,4 +52,4 @@ publicOrganization = publicOrganization' Nothing -- | Query an organization. -- See publicOrganizationR :: Name Organization -> Request k Organization -publicOrganizationR reqOrganizationName = Query ["orgs", toPathPart reqOrganizationName] [] +publicOrganizationR reqOrganizationName = query ["orgs", toPathPart reqOrganizationName] [] diff --git a/src/GitHub/Endpoints/Organizations/Members.hs b/src/GitHub/Endpoints/Organizations/Members.hs index f3588f56..acb0d366 100644 --- a/src/GitHub/Endpoints/Organizations/Members.hs +++ b/src/GitHub/Endpoints/Organizations/Members.hs @@ -37,13 +37,15 @@ membersOf = membersOf' Nothing -- -- See membersOfR :: Name Organization -> FetchCount -> Request k (Vector SimpleUser) -membersOfR organization = PagedQuery ["orgs", toPathPart organization, "members"] [] +membersOfR organization = + pagedQuery ["orgs", toPathPart organization, "members"] [] -- | 'membersOfR' with filters. -- -- See membersOfWithR :: Name Organization -> OrgMemberFilter -> OrgMemberRole -> FetchCount -> Request k (Vector SimpleUser) -membersOfWithR org f r = PagedQuery ["orgs", toPathPart org, "members"] [("filter", Just f'), ("role", Just r')] +membersOfWithR org f r = + pagedQuery ["orgs", toPathPart org, "members"] [("filter", Just f'), ("role", Just r')] where f' = case f of OrgMemberFilter2faDisabled -> "2fa_disabled" diff --git a/src/GitHub/Endpoints/Organizations/Teams.hs b/src/GitHub/Endpoints/Organizations/Teams.hs index ba06ee6a..0bdcf89c 100644 --- a/src/GitHub/Endpoints/Organizations/Teams.hs +++ b/src/GitHub/Endpoints/Organizations/Teams.hs @@ -57,7 +57,8 @@ teamsOf = teamsOf' Nothing -- | List teams. -- See teamsOfR :: Name Organization -> FetchCount -> Request k (Vector SimpleTeam) -teamsOfR org = PagedQuery ["orgs", toPathPart org, "teams"] [] +teamsOfR org = + pagedQuery ["orgs", toPathPart org, "teams"] [] -- | The information for a single team, by team id. -- With authentication @@ -77,7 +78,7 @@ teamInfoFor = teamInfoFor' Nothing -- See teamInfoForR :: Id Team -> Request k Team teamInfoForR tid = - Query ["teams", toPathPart tid] [] + query ["teams", toPathPart tid] [] -- | Create a team under an Owner -- @@ -93,7 +94,7 @@ createTeamFor' auth org cteam = -- See createTeamForR :: Name Organization -> CreateTeam -> Request 'RW Team createTeamForR org cteam = - Command Post ["orgs", toPathPart org, "teams"] (encode cteam) + command Post ["orgs", toPathPart org, "teams"] (encode cteam) -- | Edit a team, by id. -- @@ -109,7 +110,7 @@ editTeam' auth tid eteam = -- See editTeamR :: Id Team -> EditTeam -> Request 'RW Team editTeamR tid eteam = - Command Patch ["teams", toPathPart tid] (encode eteam) + command Patch ["teams", toPathPart tid] (encode eteam) -- | Delete a team, by id. -- @@ -123,13 +124,14 @@ deleteTeam' auth tid = -- See deleteTeamR :: Id Team -> Request 'RW () deleteTeamR tid = - Command Delete ["teams", toPathPart tid] mempty + command Delete ["teams", toPathPart tid] mempty -- | List team members. -- -- See listTeamMembersR :: Id Team -> TeamMemberRole -> FetchCount -> Request 'RA (Vector SimpleUser) -listTeamMembersR tid r = PagedQuery ["teams", toPathPart tid, "members"] [("role", Just r')] +listTeamMembersR tid r = + pagedQuery ["teams", toPathPart tid, "members"] [("role", Just r')] where r' = case r of TeamMemberRoleAll -> "all" @@ -146,7 +148,8 @@ listTeamRepos' auth tid = executeRequestMaybe auth $ listTeamReposR tid FetchAll -- | Query team repositories. -- See listTeamReposR :: Id Team -> FetchCount -> Request k (Vector Repo) -listTeamReposR tid = PagedQuery ["teams", toPathPart tid, "repos"] [] +listTeamReposR tid = + pagedQuery ["teams", toPathPart tid, "repos"] [] -- | Retrieve repositories for a team. -- @@ -166,7 +169,7 @@ teamMembershipInfoFor' auth tid user = -- See Name Owner -> Request k TeamMembership teamMembershipInfoForR tid user = - Query ["teams", toPathPart tid, "memberships", toPathPart user] [] + query ["teams", toPathPart tid, "memberships", toPathPart user] [] -- | Retrieve team mebership information for a user. -- @@ -185,7 +188,7 @@ addTeamMembershipFor' auth tid user role = -- See addTeamMembershipForR :: Id Team -> Name Owner -> Role -> Request 'RW TeamMembership addTeamMembershipForR tid user role = - Command Put ["teams", toPathPart tid, "memberships", toPathPart user] (encode $ CreateTeamMembership role) + command Put ["teams", toPathPart tid, "memberships", toPathPart user] (encode $ CreateTeamMembership role) -- | Delete a member of a team. -- @@ -198,7 +201,7 @@ deleteTeamMembershipFor' auth tid user = -- See deleteTeamMembershipForR :: Id Team -> Name Owner -> Request 'RW () deleteTeamMembershipForR tid user = - Command Delete ["teams", toPathPart tid, "memberships", toPathPart user] mempty + command Delete ["teams", toPathPart tid, "memberships", toPathPart user] mempty -- | List teams for current authenticated user -- @@ -208,5 +211,6 @@ listTeamsCurrent' auth = executeRequest auth $ listTeamsCurrentR FetchAll -- | List user teams. -- See -listTeamsCurrentR :: FetchCount -> Request 'RW (Vector Team) -listTeamsCurrentR = PagedQuery ["user", "teams"] [] +listTeamsCurrentR :: FetchCount -> Request 'RA (Vector Team) +listTeamsCurrentR = + pagedQuery ["user", "teams"] [] diff --git a/src/GitHub/Endpoints/PullRequests.hs b/src/GitHub/Endpoints/PullRequests.hs index 7c5943e9..edb66509 100644 --- a/src/GitHub/Endpoints/PullRequests.hs +++ b/src/GitHub/Endpoints/PullRequests.hs @@ -48,7 +48,7 @@ pullRequestsForR -> PullRequestMod -> FetchCount -> Request k (Vector SimplePullRequest) -pullRequestsForR user repo opts = PagedQuery +pullRequestsForR user repo opts = pagedQuery ["repos", toPathPart user, toPathPart repo, "pulls"] (prModToQueryString opts) @@ -72,7 +72,7 @@ pullRequest = pullRequest' Nothing -- See pullRequestR :: Name Owner -> Name Repo -> Id PullRequest -> Request k PullRequest pullRequestR user repo prid = - Query ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid] [] + query ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid] [] createPullRequest :: Auth -> Name Owner @@ -89,7 +89,7 @@ createPullRequestR :: Name Owner -> CreatePullRequest -> Request 'RW PullRequest createPullRequestR user repo cpr = - Command Post ["repos", toPathPart user, toPathPart repo, "pulls"] (encode cpr) + command Post ["repos", toPathPart user, toPathPart repo, "pulls"] (encode cpr) -- | Update a pull request updatePullRequest :: Auth -> Name Owner -> Name Repo -> Id PullRequest -> EditPullRequest -> IO (Either Error PullRequest) @@ -104,7 +104,7 @@ updatePullRequestR :: Name Owner -> EditPullRequest -> Request 'RW PullRequest updatePullRequestR user repo prid epr = - Command Patch ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid] (encode epr) + command Patch ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid] (encode epr) -- | All the commits on a pull request, given the repo owner, repo name, and -- the number of the pull request. @@ -126,7 +126,7 @@ pullRequestCommitsIO = pullRequestCommits' Nothing -- See pullRequestCommitsR :: Name Owner -> Name Repo -> Id PullRequest -> FetchCount -> Request k (Vector Commit) pullRequestCommitsR user repo prid = - PagedQuery ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "commits"] [] + pagedQuery ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "commits"] [] -- | The individual files that a pull request patches. Takes the repo owner and -- name, plus the number assigned to the pull request. @@ -148,7 +148,7 @@ pullRequestFiles = pullRequestFiles' Nothing -- See pullRequestFilesR :: Name Owner -> Name Repo -> Id PullRequest -> FetchCount -> Request k (Vector File) pullRequestFilesR user repo prid = - PagedQuery ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "files"] [] + pagedQuery ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "files"] [] -- | Check if pull request has been merged. isPullRequestMerged :: Auth -> Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error Bool) @@ -158,7 +158,7 @@ isPullRequestMerged auth user repo prid = -- | Query if a pull request has been merged. -- See isPullRequestMergedR :: Name Owner -> Name Repo -> Id PullRequest -> Request k Bool -isPullRequestMergedR user repo prid = StatusQuery StatusOnlyOk $ +isPullRequestMergedR user repo prid = StatusQuery statusOnlyOk $ Query ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "merge"] [] -- | Merge a pull request. @@ -169,7 +169,7 @@ mergePullRequest auth user repo prid commitMessage = -- | Merge a pull request (Merge Button). -- https://developer.github.com/v3/pulls/#merge-a-pull-request-merge-button mergePullRequestR :: Name Owner -> Name Repo -> Id PullRequest -> Maybe Text -> Request 'RW MergeResult -mergePullRequestR user repo prid commitMessage = StatusQuery StatusMerge $ +mergePullRequestR user repo prid commitMessage = StatusQuery statusMerge $ Command Put paths (encode $ buildCommitMessageMap commitMessage) where paths = ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "merge"] diff --git a/src/GitHub/Endpoints/PullRequests/ReviewComments.hs b/src/GitHub/Endpoints/PullRequests/ReviewComments.hs index 3fe77333..eee75046 100644 --- a/src/GitHub/Endpoints/PullRequests/ReviewComments.hs +++ b/src/GitHub/Endpoints/PullRequests/ReviewComments.hs @@ -29,7 +29,7 @@ pullRequestReviewCommentsIO user repo prid = -- 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"] [] + pagedQuery ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "comments"] [] -- | One comment on a pull request, by the comment's ID. -- @@ -42,4 +42,4 @@ pullRequestReviewComment user repo cid = -- 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] [] + query ["repos", toPathPart user, toPathPart repo, "pulls", "comments", toPathPart cid] [] diff --git a/src/GitHub/Endpoints/Repos.hs b/src/GitHub/Endpoints/Repos.hs index d6a13587..b16ae23a 100644 --- a/src/GitHub/Endpoints/Repos.hs +++ b/src/GitHub/Endpoints/Repos.hs @@ -78,7 +78,7 @@ currentUserRepos auth publicity = -- See currentUserReposR :: RepoPublicity -> FetchCount -> Request k (Vector Repo) currentUserReposR publicity = - PagedQuery ["user", "repos"] qs + pagedQuery ["user", "repos"] qs where qs = repoPublicityQueryString publicity @@ -105,7 +105,7 @@ userRepos' auth user publicity = -- See userReposR :: Name Owner -> RepoPublicity -> FetchCount -> Request k(Vector Repo) userReposR user publicity = - PagedQuery ["users", toPathPart user, "repos"] qs + pagedQuery ["users", toPathPart user, "repos"] qs where qs = repoPublicityQueryString publicity @@ -135,7 +135,7 @@ organizationReposR -> FetchCount -> Request k (Vector Repo) organizationReposR org publicity = - PagedQuery ["orgs", toPathPart org, "repos"] qs + pagedQuery ["orgs", toPathPart org, "repos"] qs where qs = repoPublicityQueryString publicity @@ -157,7 +157,7 @@ repository' auth user repo = -- See repositoryR :: Name Owner -> Name Repo -> Request k Repo repositoryR user repo = - Query ["repos", toPathPart user, toPathPart repo] [] + query ["repos", toPathPart user, toPathPart repo] [] -- | Create a new repository. -- @@ -170,7 +170,7 @@ createRepo' auth nrepo = -- See createRepoR :: NewRepo -> Request 'RW Repo createRepoR nrepo = - Command Post ["user", "repos"] (encode nrepo) + command Post ["user", "repos"] (encode nrepo) -- | Create a new repository for an organization. -- @@ -183,7 +183,7 @@ createOrganizationRepo' auth org nrepo = -- See createOrganizationRepoR :: Name Organization -> NewRepo -> Request 'RW Repo createOrganizationRepoR org nrepo = - Command Post ["orgs", toPathPart org, "repos"] (encode nrepo) + command Post ["orgs", toPathPart org, "repos"] (encode nrepo) -- | Edit an existing repository. -- @@ -202,7 +202,7 @@ editRepo auth user repo body = -- See editRepoR :: Name Owner -> Name Repo -> EditRepo -> Request 'RW Repo editRepoR user repo body = - Command Patch ["repos", toPathPart user, toPathPart repo] (encode b) + command Patch ["repos", toPathPart user, toPathPart repo] (encode b) where -- if no name is given, use curent name b = body {editName = editName body <|> Just repo} @@ -230,7 +230,7 @@ contributorsR -> FetchCount -> Request k (Vector Contributor) contributorsR user repo anon = - PagedQuery ["repos", toPathPart user, toPathPart repo, "contributors"] qs + pagedQuery ["repos", toPathPart user, toPathPart repo, "contributors"] qs where qs | anon = [("anon", Just "true")] | otherwise = [] @@ -273,7 +273,7 @@ languagesFor' auth user repo = -- See languagesForR :: Name Owner -> Name Repo -> Request k Languages languagesForR user repo = - Query ["repos", toPathPart user, toPathPart repo, "languages"] [] + query ["repos", toPathPart user, toPathPart repo, "languages"] [] -- | The git tags on a repo, given the repo owner and name. -- @@ -293,7 +293,7 @@ tagsFor' auth user repo = -- See tagsForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Tag) tagsForR user repo = - PagedQuery ["repos", toPathPart user, toPathPart repo, "tags"] [] + pagedQuery ["repos", toPathPart user, toPathPart repo, "tags"] [] -- | The git branches on a repo, given the repo owner and name. -- @@ -313,7 +313,7 @@ branchesFor' auth user repo = -- See branchesForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Branch) branchesForR user repo = - PagedQuery ["repos", toPathPart user, toPathPart repo, "branches"] [] + 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 -- @@ -336,7 +336,7 @@ contentsForR -> Maybe Text -- ^ Git commit -> Request k Content contentsForR user repo path ref = - Query ["repos", toPathPart user, toPathPart repo, "contents", path] qs + query ["repos", toPathPart user, toPathPart repo, "contents", path] qs where qs = maybe [] (\r -> [("ref", Just . TE.encodeUtf8 $ r)]) ref @@ -356,7 +356,7 @@ readmeFor' auth user repo = readmeForR :: Name Owner -> Name Repo -> Request k Content readmeForR user repo = - Query ["repos", toPathPart user, toPathPart repo, "readme"] [] + query ["repos", toPathPart user, toPathPart repo, "readme"] [] -- | Delete an existing repository. -- @@ -367,4 +367,4 @@ deleteRepo auth user repo = deleteRepoR :: Name Owner -> Name Repo -> Request 'RW () deleteRepoR user repo = - Command Delete ["repos", toPathPart user, toPathPart repo] mempty + command Delete ["repos", toPathPart user, toPathPart repo] mempty diff --git a/src/GitHub/Endpoints/Repos/Collaborators.hs b/src/GitHub/Endpoints/Repos/Collaborators.hs index 36b47c89..1504ca0f 100644 --- a/src/GitHub/Endpoints/Repos/Collaborators.hs +++ b/src/GitHub/Endpoints/Repos/Collaborators.hs @@ -35,7 +35,7 @@ collaboratorsOn' auth user repo = -- See collaboratorsOnR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector SimpleUser) collaboratorsOnR user repo = - PagedQuery ["repos", toPathPart user, toPathPart repo, "collaborators"] [] + pagedQuery ["repos", toPathPart user, toPathPart repo, "collaborators"] [] -- | Whether the user is collaborating on a repo. Takes the user in question, -- the user who owns the repo, and the repo name. @@ -56,5 +56,5 @@ isCollaboratorOnR :: Name Owner -- ^ Repository owner -> Name Repo -- ^ Repository name -> Name User -- ^ Collaborator? -> Request k Bool -isCollaboratorOnR user repo coll = StatusQuery StatusOnlyOk $ +isCollaboratorOnR user repo coll = StatusQuery statusOnlyOk $ Query ["repos", toPathPart user, toPathPart repo, "collaborators", toPathPart coll] [] diff --git a/src/GitHub/Endpoints/Repos/Comments.hs b/src/GitHub/Endpoints/Repos/Comments.hs index 6fd4dcc7..5adcf814 100644 --- a/src/GitHub/Endpoints/Repos/Comments.hs +++ b/src/GitHub/Endpoints/Repos/Comments.hs @@ -42,7 +42,7 @@ commentsFor' auth user repo = -- See commentsForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Comment) commentsForR user repo = - PagedQuery ["repos", toPathPart user, toPathPart repo, "comments"] [] + pagedQuery ["repos", toPathPart user, toPathPart repo, "comments"] [] -- | Just the comments on a specific SHA for a given Github repo. -- @@ -62,7 +62,7 @@ commitCommentsFor' auth user repo sha = -- See commitCommentsForR :: Name Owner -> Name Repo -> Name Commit -> FetchCount -> Request k (Vector Comment) commitCommentsForR user repo sha = - PagedQuery ["repos", toPathPart user, toPathPart repo, "commits", toPathPart sha, "comments"] [] + pagedQuery ["repos", toPathPart user, toPathPart repo, "commits", toPathPart sha, "comments"] [] -- | A comment, by its ID, relative to the Github repo. -- @@ -81,4 +81,4 @@ commitCommentFor' auth user repo cid = -- See commitCommentForR :: Name Owner -> Name Repo -> Id Comment -> Request k Comment commitCommentForR user repo cid = - Query ["repos", toPathPart user, toPathPart repo, "comments", toPathPart cid] [] + query ["repos", toPathPart user, toPathPart repo, "comments", toPathPart cid] [] diff --git a/src/GitHub/Endpoints/Repos/Commits.hs b/src/GitHub/Endpoints/Repos/Commits.hs index b6ccf5be..ba86ed40 100644 --- a/src/GitHub/Endpoints/Repos/Commits.hs +++ b/src/GitHub/Endpoints/Repos/Commits.hs @@ -74,7 +74,7 @@ commitsWithOptionsFor' auth user repo opts = -- See commitsWithOptionsForR :: Name Owner -> Name Repo -> FetchCount -> [CommitQueryOption] -> Request k (Vector Commit) commitsWithOptionsForR user repo limit opts = - PagedQuery ["repos", toPathPart user, toPathPart repo, "commits"] qs limit + pagedQuery ["repos", toPathPart user, toPathPart repo, "commits"] qs limit where qs = map renderCommitQueryOption opts @@ -97,7 +97,7 @@ commit' auth user repo sha = -- See commitR :: Name Owner -> Name Repo -> Name Commit -> Request k Commit commitR user repo sha = - Query ["repos", toPathPart user, toPathPart repo, "commits", toPathPart sha] [] + query ["repos", toPathPart user, toPathPart repo, "commits", toPathPart sha] [] -- | The diff between two treeishes on a repo. -- @@ -116,4 +116,4 @@ diff' auth user repo base headref = -- See diffR :: Name Owner -> Name Repo -> Name Commit -> Name Commit -> Request k Diff diffR user repo base headref = - Query ["repos", toPathPart user, toPathPart repo, "compare", toPathPart base <> "..." <> toPathPart headref] [] + query ["repos", toPathPart user, toPathPart repo, "compare", toPathPart base <> "..." <> toPathPart headref] [] diff --git a/src/GitHub/Endpoints/Repos/DeployKeys.hs b/src/GitHub/Endpoints/Repos/DeployKeys.hs index 025ee2c8..90b87703 100644 --- a/src/GitHub/Endpoints/Repos/DeployKeys.hs +++ b/src/GitHub/Endpoints/Repos/DeployKeys.hs @@ -35,7 +35,7 @@ deployKeysFor' auth user repo = -- See deployKeysForR :: Name Owner -> Name Repo -> FetchCount -> Request 'RA (Vector RepoDeployKey) deployKeysForR user repo = - PagedQuery ["repos", toPathPart user, toPathPart repo, "keys"] [] + pagedQuery ["repos", toPathPart user, toPathPart repo, "keys"] [] -- | Querying a deploy key deployKeyFor' :: Auth -> Name Owner -> Name Repo -> Id RepoDeployKey -> IO (Either Error RepoDeployKey) @@ -46,7 +46,7 @@ deployKeyFor' auth user repo keyId = -- See deployKeyForR :: Name Owner -> Name Repo -> Id RepoDeployKey -> Request 'RA RepoDeployKey deployKeyForR user repo keyId = - Query ["repos", toPathPart user, toPathPart repo, "keys", toPathPart keyId] [] + query ["repos", toPathPart user, toPathPart repo, "keys", toPathPart keyId] [] -- | Create a deploy key createRepoDeployKey' :: Auth -> Name Owner -> Name Repo -> NewRepoDeployKey -> IO (Either Error RepoDeployKey) @@ -57,7 +57,7 @@ createRepoDeployKey' auth user repo key = -- See . createRepoDeployKeyR :: Name Owner -> Name Repo -> NewRepoDeployKey -> Request 'RW RepoDeployKey createRepoDeployKeyR user repo key = - Command Post ["repos", toPathPart user, toPathPart repo, "keys"] (encode key) + command Post ["repos", toPathPart user, toPathPart repo, "keys"] (encode key) deleteRepoDeployKey' :: Auth -> Name Owner -> Name Repo -> Id RepoDeployKey -> IO (Either Error ()) deleteRepoDeployKey' auth user repo keyId = @@ -67,4 +67,4 @@ deleteRepoDeployKey' auth user repo keyId = -- See deleteRepoDeployKeyR :: Name Owner -> Name Repo -> Id RepoDeployKey -> Request 'RW () deleteRepoDeployKeyR user repo keyId = - Command Delete ["repos", toPathPart user, toPathPart repo, "keys", toPathPart keyId] mempty + command Delete ["repos", toPathPart user, toPathPart repo, "keys", toPathPart keyId] mempty diff --git a/src/GitHub/Endpoints/Repos/Forks.hs b/src/GitHub/Endpoints/Repos/Forks.hs index 8b95c208..b5cad183 100644 --- a/src/GitHub/Endpoints/Repos/Forks.hs +++ b/src/GitHub/Endpoints/Repos/Forks.hs @@ -35,4 +35,4 @@ forksFor' auth user repo = -- See forksForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Repo) forksForR user repo = - PagedQuery ["repos", toPathPart user, toPathPart repo, "forks"] [] + pagedQuery ["repos", toPathPart user, toPathPart repo, "forks"] [] diff --git a/src/GitHub/Endpoints/Repos/Webhooks.hs b/src/GitHub/Endpoints/Repos/Webhooks.hs index 4e6c0bf6..ebb7377d 100644 --- a/src/GitHub/Endpoints/Repos/Webhooks.hs +++ b/src/GitHub/Endpoints/Repos/Webhooks.hs @@ -45,7 +45,7 @@ webhooksFor' auth user repo = -- See webhooksForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector RepoWebhook) webhooksForR user repo = - PagedQuery ["repos", toPathPart user, toPathPart repo, "hooks"] [] + pagedQuery ["repos", toPathPart user, toPathPart repo, "hooks"] [] webhookFor' :: Auth -> Name Owner -> Name Repo -> Id RepoWebhook -> IO (Either Error RepoWebhook) webhookFor' auth user repo hookId = @@ -55,7 +55,7 @@ webhookFor' auth user repo hookId = -- See webhookForR :: Name Owner -> Name Repo -> Id RepoWebhook -> Request k RepoWebhook webhookForR user repo hookId = - Query ["repos", toPathPart user, toPathPart repo, "hooks", toPathPart hookId] [] + query ["repos", toPathPart user, toPathPart repo, "hooks", toPathPart hookId] [] createRepoWebhook' :: Auth -> Name Owner -> Name Repo -> NewRepoWebhook -> IO (Either Error RepoWebhook) createRepoWebhook' auth user repo hook = @@ -65,7 +65,7 @@ createRepoWebhook' auth user repo hook = -- See createRepoWebhookR :: Name Owner -> Name Repo -> NewRepoWebhook -> Request 'RW RepoWebhook createRepoWebhookR user repo hook = - Command Post ["repos", toPathPart user, toPathPart repo, "hooks"] (encode hook) + command Post ["repos", toPathPart user, toPathPart repo, "hooks"] (encode hook) editRepoWebhook' :: Auth -> Name Owner -> Name Repo -> Id RepoWebhook -> EditRepoWebhook -> IO (Either Error RepoWebhook) editRepoWebhook' auth user repo hookId hookEdit = @@ -75,7 +75,7 @@ editRepoWebhook' auth user repo hookId hookEdit = -- See editRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> EditRepoWebhook -> Request 'RW RepoWebhook editRepoWebhookR user repo hookId hookEdit = - Command Patch ["repos", toPathPart user, toPathPart repo, "hooks", toPathPart hookId] (encode hookEdit) + command Patch ["repos", toPathPart user, toPathPart repo, "hooks", toPathPart hookId] (encode hookEdit) testPushRepoWebhook' :: Auth -> Name Owner -> Name Repo -> Id RepoWebhook -> IO (Either Error Bool) testPushRepoWebhook' auth user repo hookId = @@ -84,7 +84,7 @@ testPushRepoWebhook' auth user repo hookId = -- | Test a push hook. -- See testPushRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> Request 'RW Bool -testPushRepoWebhookR user repo hookId = StatusQuery StatusOnlyOk $ +testPushRepoWebhookR user repo hookId = StatusQuery statusOnlyOk $ Command Post (createWebhookOpPath user repo hookId $ Just "tests") (encode ()) pingRepoWebhook' :: Auth -> Name Owner -> Name Repo -> Id RepoWebhook -> IO (Either Error Bool) @@ -94,7 +94,7 @@ pingRepoWebhook' auth user repo hookId = -- | Ping a hook. -- See pingRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> Request 'RW Bool -pingRepoWebhookR user repo hookId = StatusQuery StatusOnlyOk $ +pingRepoWebhookR user repo hookId = StatusQuery statusOnlyOk $ Command Post (createWebhookOpPath user repo hookId $ Just "pings") (encode ()) deleteRepoWebhook' :: Auth -> Name Owner -> Name Repo -> Id RepoWebhook -> IO (Either Error ()) @@ -105,7 +105,7 @@ deleteRepoWebhook' auth user repo hookId = -- See deleteRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> Request 'RW () deleteRepoWebhookR user repo hookId = - Command Delete (createWebhookOpPath user repo hookId Nothing) mempty + command Delete (createWebhookOpPath user repo hookId Nothing) mempty createBaseWebhookPath :: Name Owner -> Name Repo -> Id RepoWebhook -> Paths createBaseWebhookPath user repo hookId = diff --git a/src/GitHub/Endpoints/Search.hs b/src/GitHub/Endpoints/Search.hs index 86f125d3..58a0e4e5 100644 --- a/src/GitHub/Endpoints/Search.hs +++ b/src/GitHub/Endpoints/Search.hs @@ -42,7 +42,8 @@ searchRepos = searchRepos' Nothing -- | Search repositories. -- See searchReposR :: Text -> Request k (SearchResult Repo) -searchReposR searchString = Query ["search", "repositories"] [("q", Just $ TE.encodeUtf8 searchString)] +searchReposR searchString = + query ["search", "repositories"] [("q", Just $ TE.encodeUtf8 searchString)] -- | Perform a code search. -- With authentication. @@ -61,7 +62,8 @@ searchCode = searchCode' Nothing -- | Search code. -- See searchCodeR :: Text -> Request k (SearchResult Code) -searchCodeR searchString = Query ["search", "code"] [("q", Just $ TE.encodeUtf8 searchString)] +searchCodeR searchString = + query ["search", "code"] [("q", Just $ TE.encodeUtf8 searchString)] -- | Perform an issue search. -- With authentication. @@ -80,4 +82,5 @@ searchIssues = searchIssues' Nothing -- | Search issues. -- See searchIssuesR :: Text -> Request k (SearchResult Issue) -searchIssuesR searchString = Query ["search", "issues"] [("q", Just $ TE.encodeUtf8 searchString)] +searchIssuesR searchString = + query ["search", "issues"] [("q", Just $ TE.encodeUtf8 searchString)] diff --git a/src/GitHub/Endpoints/Users.hs b/src/GitHub/Endpoints/Users.hs index 592e6636..f7dfdf07 100644 --- a/src/GitHub/Endpoints/Users.hs +++ b/src/GitHub/Endpoints/Users.hs @@ -36,12 +36,12 @@ userInfoFor = executeRequest' . userInfoForR -- | Query a single user. -- See userInfoForR :: Name User -> Request k User -userInfoForR user = Query ["users", toPathPart user] [] +userInfoForR user = query ["users", toPathPart user] [] -- | Query a single user or an organization. -- See ownerInfoForR :: Name Owner -> Request k Owner -ownerInfoForR owner = Query ["users", toPathPart owner] [] +ownerInfoForR owner = query ["users", toPathPart owner] [] -- | Retrieve information about the user associated with the supplied authentication. -- @@ -53,4 +53,4 @@ userInfoCurrent' auth = -- | Query the authenticated user. -- See userInfoCurrentR :: Request 'RA User -userInfoCurrentR = Query ["user"] [] +userInfoCurrentR = query ["user"] [] diff --git a/src/GitHub/Endpoints/Users/Followers.hs b/src/GitHub/Endpoints/Users/Followers.hs index f112e424..8ab72ce4 100644 --- a/src/GitHub/Endpoints/Users/Followers.hs +++ b/src/GitHub/Endpoints/Users/Followers.hs @@ -28,7 +28,8 @@ usersFollowing user = -- | List followers of a user. -- See usersFollowingR :: Name User -> FetchCount -> Request k (Vector SimpleUser) -usersFollowingR user = PagedQuery ["users", toPathPart user, "followers"] [] +usersFollowingR user = + pagedQuery ["users", toPathPart user, "followers"] [] -- | All the users that the given user follows. -- @@ -40,4 +41,5 @@ usersFollowedBy user = -- | List users followed by another user. -- See usersFollowedByR :: Name User -> FetchCount -> Request k (Vector SimpleUser) -usersFollowedByR user = PagedQuery ["users", toPathPart user, "following"] [] +usersFollowedByR user = + pagedQuery ["users", toPathPart user, "following"] [] diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index 7a02d78f..75ecaf0f 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -43,6 +43,7 @@ module GitHub.Request ( unsafeDropAuthRequirements, -- * Helpers makeHttpRequest, + makeHttpSimpleRequest, parseResponse, parseStatus, getNextUrl, @@ -68,12 +69,11 @@ import Network.HTTP.Client (HttpException (..), Manager, RequestBody (..), Response (..), applyBasicAuth, httpLbs, method, newManager, requestBody, requestHeaders, setQueryString) -import Network.HTTP.Client.TLS (tlsManagerSettings) -import Network.HTTP.Link.Parser (parseLinkHeaderBS) -import Network.HTTP.Link.Types - (Link (..), LinkParam (..), href, linkParams) -import Network.HTTP.Types (Method, RequestHeaders, Status (..)) -import Network.URI (URI) +import Network.HTTP.Client.TLS (tlsManagerSettings) +import Network.HTTP.Link.Parser (parseLinkHeaderBS) +import Network.HTTP.Link.Types (Link (..), LinkParam (..), href, linkParams) +import Network.HTTP.Types (Method, RequestHeaders, Status (..)) +import Network.URI (URI) #if !MIN_VERSION_http_client(0,5,0) import qualified Control.Exception as E @@ -105,41 +105,44 @@ lessFetchCount _ FetchAll = True lessFetchCount i (FetchAtLeast j) = i < fromIntegral j -- | Like 'executeRequest' but with provided 'Manager'. -executeRequestWithMgr :: Manager - -> Auth - -> Request k a - -> IO (Either Error a) -executeRequestWithMgr mgr auth req = runExceptT $ - execute req +executeRequestWithMgr + :: Manager + -> Auth + -> Request k a + -> IO (Either Error a) +executeRequestWithMgr mgr auth req = runExceptT $ do + httpReq <- makeHttpRequest (Just auth) req + performHttpReq httpReq req where - execute :: Request k a -> ExceptT Error IO a - execute req' = case req' of - Query {} -> do - httpReq <- makeHttpRequest (Just auth) req - res <- httpLbs' httpReq - parseResponse res - PagedQuery _ _ l -> do - httpReq <- makeHttpRequest (Just auth) req - performPagedRequest httpLbs' predicate httpReq - where - predicate v = lessFetchCount (V.length v) l - Command m _ _ -> do - httpReq <- makeHttpRequest (Just auth) req - res <- httpLbs' httpReq - case m of - Delete -> pure () - _ -> parseResponse res - StatusQuery sm _ -> do - httpReq <- makeHttpRequest (Just auth) req - res <- httpLbs' httpReq - parseStatus sm . responseStatus $ res - HeaderQuery _ r -> do - execute r httpLbs' :: HTTP.Request -> ExceptT Error IO (Response LBS.ByteString) httpLbs' req' = lift (httpLbs req' mgr) `catch` onHttpException + performHttpReq :: HTTP.Request -> Request k b -> ExceptT Error IO b + performHttpReq httpReq (SimpleQuery sreq) = + performHttpReq' httpReq sreq + performHttpReq httpReq (HeaderQuery _ sreq) = + performHttpReq' httpReq sreq + performHttpReq httpReq (StatusQuery sm _) = do + res <- httpLbs' httpReq + parseStatus sm . responseStatus $ res + + performHttpReq' :: FromJSON b => HTTP.Request -> SimpleRequest k b -> ExceptT Error IO b + performHttpReq' httpReq Query {} = do + res <- httpLbs' httpReq + parseResponse res + performHttpReq' httpReq (PagedQuery _ _ l) = + performPagedRequest httpLbs' predicate httpReq + where + predicate v = lessFetchCount (V.length v) l + performHttpReq' httpReq (Command m _ _) = do + res <- httpLbs' httpReq + case m of + Delete -> pure () + _ -> parseResponse res + + -- | Like 'executeRequest' but without authentication. -executeRequest' :: Request 'RO a -> IO (Either Error a) +executeRequest' ::Request 'RO a -> IO (Either Error a) executeRequest' req = do manager <- newManager tlsManagerSettings x <- executeRequestWithMgr' manager req @@ -153,39 +156,41 @@ executeRequestWithMgr' :: Manager -> Request 'RO a -> IO (Either Error a) -executeRequestWithMgr' mgr req = runExceptT $ - execute req +executeRequestWithMgr' mgr req = runExceptT $ do + httpReq <- makeHttpRequest Nothing req + performHttpReq httpReq req where - execute :: Request 'RO b -> ExceptT Error IO b - execute req' = case req' of - Query {} -> do - httpReq <- makeHttpRequest Nothing req - res <- httpLbs' httpReq - parseResponse res - PagedQuery _ _ l -> do - httpReq <- makeHttpRequest Nothing req - performPagedRequest httpLbs' predicate httpReq - where - predicate v = lessFetchCount (V.length v) l - StatusQuery sm _ -> do - httpReq <- makeHttpRequest Nothing req - res <- httpLbs' httpReq - parseStatus sm . responseStatus $ res - HeaderQuery _ r -> do - execute r httpLbs' :: HTTP.Request -> ExceptT Error IO (Response LBS.ByteString) httpLbs' req' = lift (httpLbs req' mgr) `catch` onHttpException + performHttpReq :: HTTP.Request -> Request 'RO b -> ExceptT Error IO b + performHttpReq httpReq (SimpleQuery sreq) = + performHttpReq' httpReq sreq + performHttpReq httpReq (HeaderQuery _ sreq) = + performHttpReq' httpReq sreq + performHttpReq httpReq (StatusQuery sm _) = do + res <- httpLbs' httpReq + parseStatus sm . responseStatus $ res + + performHttpReq' :: FromJSON b => HTTP.Request -> SimpleRequest 'RO b -> ExceptT Error IO b + performHttpReq' httpReq Query {} = do + res <- httpLbs' httpReq + parseResponse res + performHttpReq' httpReq (PagedQuery _ _ l) = + performPagedRequest httpLbs' predicate httpReq + where + predicate v = lessFetchCount (V.length v) l + -- | Helper for picking between 'executeRequest' and 'executeRequest''. -- -- The use is discouraged. -executeRequestMaybe :: Maybe Auth -> Request 'RO a - -> IO (Either Error a) +executeRequestMaybe :: Maybe Auth -> Request 'RO a -> IO (Either Error a) executeRequestMaybe = maybe executeRequest' executeRequest -- | Partial function to drop authentication need. unsafeDropAuthRequirements :: Request k' a -> Request k a -unsafeDropAuthRequirements (Query ps qs) = Query ps qs +unsafeDropAuthRequirements (SimpleQuery (Query ps qs)) = + SimpleQuery (Query ps qs) unsafeDropAuthRequirements r = error $ "Trying to drop authenatication from" ++ show r @@ -202,39 +207,52 @@ unsafeDropAuthRequirements r = -- @ -- parseResponse :: 'Maybe' 'Auth' -> 'Request' k a -> 'Maybe' 'Request' -- @ -makeHttpRequest :: MonadThrow m - => Maybe Auth - -> Request k a - -> m HTTP.Request +makeHttpRequest + :: MonadThrow m + => Maybe Auth + -> Request k a + -> m HTTP.Request makeHttpRequest auth r = case r of + SimpleQuery req -> + makeHttpSimpleRequest auth req StatusQuery sm req -> do - req' <- makeHttpRequest auth req + req' <- makeHttpSimpleRequest auth req return $ setCheckStatus (Just sm) req' + HeaderQuery h req -> do + req' <- makeHttpSimpleRequest auth req + return $ req' { requestHeaders = h <> requestHeaders req' } + +makeHttpSimpleRequest + :: MonadThrow m + => Maybe Auth + -> SimpleRequest k a + -> m HTTP.Request +makeHttpSimpleRequest auth r = case r of Query paths qs -> do req <- parseUrl' $ url paths - return $ setReqHeaders - . setCheckStatus Nothing - . setAuthRequest auth - . setQueryString qs - $ req + return + $ setReqHeaders + . setCheckStatus Nothing + . setAuthRequest auth + . setQueryString qs + $ req PagedQuery paths qs _ -> do req <- parseUrl' $ url paths - return $ setReqHeaders - . setCheckStatus Nothing - . setAuthRequest auth - . setQueryString qs - $ req + return + $ setReqHeaders + . setCheckStatus Nothing + . setAuthRequest auth + . setQueryString qs + $ req Command m paths body -> do req <- parseUrl' $ url paths - return $ setReqHeaders - . setCheckStatus Nothing - . setAuthRequest auth - . setBody body - . setMethod (toMethod m) - $ req - HeaderQuery h req -> do - req' <- makeHttpRequest auth req - return $ req' { requestHeaders = h <> requestHeaders req' } + return + $ setReqHeaders + . setCheckStatus Nothing + . setAuthRequest auth + . setBody body + . setMethod (toMethod m) + $ req where parseUrl' :: MonadThrow m => Text -> m HTTP.Request #if MIN_VERSION_http_client(0,4,30) @@ -254,13 +272,6 @@ makeHttpRequest auth r = case r of setReqHeaders :: HTTP.Request -> HTTP.Request setReqHeaders req = req { requestHeaders = reqHeaders <> requestHeaders req } - setCheckStatus :: Maybe (StatusMap a) -> HTTP.Request -> HTTP.Request -#if MIN_VERSION_http_client(0,5,0) - setCheckStatus sm req = req { HTTP.checkResponse = successOrMissing sm } -#else - setCheckStatus sm req = req { HTTP.checkStatus = successOrMissing sm } -#endif - setMethod :: Method -> HTTP.Request -> HTTP.Request setMethod m req = req { method = m } @@ -281,8 +292,6 @@ makeHttpRequest auth r = case r of getOAuthHeader (EnterpriseOAuth _ token) = [("Authorization", "token " <> token)] getOAuthHeader _ = [] - - -- | Query @Link@ header with @rel=next@ from the request headers. getNextUrl :: Response a -> Maybe URI getNextUrl req = do @@ -313,15 +322,10 @@ parseResponse res = case eitherDecode (responseBody res) of -- parseStatus :: 'StatusMap' a -> 'Status' -> 'Either' 'Error' a -- @ parseStatus :: MonadError Error m => StatusMap a -> Status -> m a -parseStatus StatusOnlyOk (Status sci _) - | sci == 204 = return True - | sci == 404 = return False - | otherwise = throwError $ JsonError $ "invalid status: " <> T.pack (show sci) -parseStatus StatusMerge (Status sci _) - | sci == 204 = return MergeSuccessful - | sci == 405 = return MergeCannotPerform - | sci == 409 = return MergeConflict - | otherwise = throwError $ JsonError $ "invalid status: " <> T.pack (show sci) +parseStatus m (Status sci _) = + maybe err return $ lookup sci m + where + err = throwError $ JsonError $ "invalid status: " <> T.pack (show sci) -- | Helper for making paginated requests. Responses, @a@ are combined monoidally. -- @@ -332,11 +336,12 @@ parseStatus StatusMerge (Status sci _) -- -> 'HTTP.Request' -- -> 'ExceptT' 'Error' 'IO' a -- @ -performPagedRequest :: forall a m. (FromJSON a, Semigroup a, MonadCatch m, MonadError Error m) - => (HTTP.Request -> m (Response LBS.ByteString)) -- ^ `httpLbs` analogue - -> (a -> Bool) -- ^ predicate to continue iteration - -> HTTP.Request -- ^ initial request - -> m a +performPagedRequest + :: forall a m. (FromJSON a, Semigroup a, MonadCatch m, MonadError Error m) + => (HTTP.Request -> m (Response LBS.ByteString)) -- ^ `httpLbs` analogue + -> (a -> Bool) -- ^ predicate to continue iteration + -> HTTP.Request -- ^ initial request + -> m a performPagedRequest httpLbs' predicate initReq = do res <- httpLbs' initReq m <- parseResponse res @@ -356,6 +361,15 @@ performPagedRequest httpLbs' predicate initReq = do -- Internal ------------------------------------------------------------------------------- + +setCheckStatus :: Maybe (StatusMap a) -> HTTP.Request -> HTTP.Request +#if MIN_VERSION_http_client(0,5,0) +setCheckStatus sm req = req { HTTP.checkResponse = successOrMissing sm } +#else +setCheckStatus sm req = req { HTTP.checkStatus = successOrMissing sm } +#endif + + #if MIN_VERSION_http_client(0,5,0) successOrMissing :: Maybe (StatusMap a) -> HTTP.Request -> HTTP.Response HTTP.BodyReader -> IO () successOrMissing sm _req res @@ -374,9 +388,8 @@ successOrMissing sm s@(Status sci _) hs cookiejar where #endif check = case sm of - Nothing -> 200 <= sci && sci < 300 - Just StatusOnlyOk -> sci == 204 || sci == 404 - Just StatusMerge -> sci `elem` [204, 405, 409] + Nothing -> 200 <= sci && sci < 300 + Just sm' -> sci `elem` map fst sm' onHttpException :: MonadError Error m => HttpException -> m a onHttpException = throwError . HTTPError From c479f07c9ffe903e5d8a5a8f89b1d5e59f3944cd Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Wed, 14 Sep 2016 12:46:22 +0300 Subject: [PATCH 226/510] Fix operational sample --- samples/Operational/Operational.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/samples/Operational/Operational.hs b/samples/Operational/Operational.hs index 7819914e..751cf69d 100644 --- a/samples/Operational/Operational.hs +++ b/samples/Operational/Operational.hs @@ -12,7 +12,7 @@ import Network.HTTP.Client.TLS (tlsManagerSettings) import qualified GitHub as GH -type GithubMonad a = Program (GH.Request 'False) a +type GithubMonad a = Program (GH.Request 'GH.RA) a runMonad :: Manager -> GH.Auth -> GithubMonad a -> ExceptT GH.Error IO a runMonad mgr auth m = case view m of @@ -21,7 +21,7 @@ runMonad mgr auth m = case view m of b <- ExceptT $ GH.executeRequestWithMgr mgr auth req runMonad mgr auth (k b) -githubRequest :: GH.Request 'False a -> GithubMonad a +githubRequest :: GH.Request 'GH.RA a -> GithubMonad a githubRequest = singleton main :: IO () From 70283feaa02644869b91b3153ab33ace3651c4c9 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Wed, 14 Sep 2016 13:48:45 +0300 Subject: [PATCH 227/510] teamName and teamSlug types --- CHANGELOG.md | 2 ++ src/GitHub/Data/Teams.hs | 4 ++-- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 84527b7b..657d186e 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -11,6 +11,8 @@ Changes for 0.15.0 - Add `mkUserId`, `mkUserName`, `fromUserId`, `fromOrganizationId` - Add 'userIssuesR' - Add 'organizationIssuesR' +- Make `teamName :: Text` amnd `teamSlug :: Name Team` in both: `Team` and `SimpleTeam` +- Refactor 'Request' structure Changes for 0.14.1 diff --git a/src/GitHub/Data/Teams.hs b/src/GitHub/Data/Teams.hs index 2ee0b63c..5df040c7 100644 --- a/src/GitHub/Data/Teams.hs +++ b/src/GitHub/Data/Teams.hs @@ -52,8 +52,8 @@ instance Binary SimpleTeam data Team = Team { teamId :: !(Id Team) ,teamUrl :: !URL - ,teamName :: !(Name Team) - ,teamSlug :: !Text + ,teamName :: !Text + ,teamSlug :: !(Name Team) ,teamDescription :: !(Maybe Text) ,teamPrivacy :: !(Maybe Privacy) ,teamPermission :: !Permission From dd149a469cad0fb4ecbb75a76efc633d92870a0c Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Thu, 15 Sep 2016 12:35:40 +0300 Subject: [PATCH 228/510] Make less Hashable (Request) less restrictive --- src/GitHub/Data/Request.hs | 4 ++-- stack-nightly.yaml | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs index 04877130..f6481b60 100644 --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -229,13 +229,13 @@ instance Hashable (SimpleRequest k a) where `hashWithSalt` ps `hashWithSalt` body -instance Hashable a => Hashable (Request k a) where +instance Hashable (Request k a) where hashWithSalt salt (SimpleQuery req) = salt `hashWithSalt` (0 :: Int) `hashWithSalt` req hashWithSalt salt (StatusQuery sm req) = salt `hashWithSalt` (1 :: Int) - `hashWithSalt` sm + `hashWithSalt` map fst sm `hashWithSalt` req hashWithSalt salt (HeaderQuery h req) = salt `hashWithSalt` (2 :: Int) diff --git a/stack-nightly.yaml b/stack-nightly.yaml index 14000e13..0511b9a1 100644 --- a/stack-nightly.yaml +++ b/stack-nightly.yaml @@ -1,4 +1,4 @@ -resolver: nightly-2016-09-12 +resolver: nightly-2016-09-14 packages: - '.' - 'samples/' From 5342a265fab7afa81470461558d8c20bc3cc1593 Mon Sep 17 00:00:00 2001 From: iphydf Date: Sun, 25 Sep 2016 04:07:59 +0100 Subject: [PATCH 229/510] Add mergeable_state and make PR body nullable. Fixes #245. Fixes #246. --- src/GitHub/Data/PullRequests.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/GitHub/Data/PullRequests.hs b/src/GitHub/Data/PullRequests.hs index e2b5cef3..3815aafb 100644 --- a/src/GitHub/Data/PullRequests.hs +++ b/src/GitHub/Data/PullRequests.hs @@ -77,6 +77,7 @@ data PullRequest = PullRequest , pullRequestCommits :: !Count , pullRequestMerged :: !Bool , pullRequestMergeable :: !(Maybe Bool) + , pullRequestMergeableState :: !Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -216,7 +217,7 @@ instance FromJSON PullRequest where <*> o .: "number" <*> o .: "html_url" <*> o .: "updated_at" - <*> o .: "body" + <*> o .:? "body" .!= "" -- TODO: no body is treated as empty <*> o .: "issue_url" <*> o .: "diff_url" <*> o .: "url" @@ -235,6 +236,7 @@ instance FromJSON PullRequest where <*> o .: "commits" <*> o .: "merged" <*> o .:? "mergeable" + <*> o .: "mergeable_state" instance FromJSON PullRequestLinks where parseJSON = withObject "PullRequestLinks" $ \o -> PullRequestLinks From fe50307599377259aac71f187801b3f97a89d827 Mon Sep 17 00:00:00 2001 From: iphydf Date: Sun, 25 Sep 2016 22:01:35 +0100 Subject: [PATCH 230/510] Make body Maybe Text, add enum for mergeable_state. Also, renamed simpleIssueState in SimplePullRequest to simplePullRequestState. --- src/GitHub/Data/Options.hs | 26 ++++++++++++++++++++++++++ src/GitHub/Data/PullRequests.hs | 14 +++++++------- 2 files changed, 33 insertions(+), 7 deletions(-) diff --git a/src/GitHub/Data/Options.hs b/src/GitHub/Data/Options.hs index 285dec0e..d083dd16 100644 --- a/src/GitHub/Data/Options.hs +++ b/src/GitHub/Data/Options.hs @@ -44,6 +44,7 @@ module GitHub.Data.Options ( optionsNoAssignee, -- * Data IssueState (..), + MergeableState (..), -- * Internal HasState, HasDirection, @@ -86,6 +87,31 @@ instance FromJSON IssueState where instance NFData IssueState where rnf = genericRnf instance Binary IssueState +-- | 'GitHub.Data.PullRequests.PullRequest' mergeable_state +data MergeableState + = StateUnknown + | StateClean + | StateDirty + | StateUnstable + deriving + (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) + +instance ToJSON MergeableState where + toJSON StateUnknown = String "unknown" + toJSON StateClean = String "clean" + toJSON StateDirty = String "dirty" + toJSON StateUnstable = String "unstable" + +instance FromJSON MergeableState where + parseJSON (String "unknown") = pure StateUnknown + parseJSON (String "clean") = pure StateClean + parseJSON (String "dirty") = pure StateDirty + parseJSON (String "unstable") = pure StateUnstable + parseJSON v = typeMismatch "MergeableState" v + +instance NFData MergeableState where rnf = genericRnf +instance Binary MergeableState + data SortDirection = SortAscending | SortDescending diff --git a/src/GitHub/Data/PullRequests.hs b/src/GitHub/Data/PullRequests.hs index 3815aafb..9c7c7c78 100644 --- a/src/GitHub/Data/PullRequests.hs +++ b/src/GitHub/Data/PullRequests.hs @@ -19,7 +19,7 @@ module GitHub.Data.PullRequests ( import GitHub.Data.Definitions import GitHub.Data.Id (Id) -import GitHub.Data.Options (IssueState (..)) +import GitHub.Data.Options (IssueState (..), MergeableState (..)) import GitHub.Data.Repos (Repo) import GitHub.Data.Request (StatusMap) import GitHub.Data.URL (URL) @@ -31,11 +31,11 @@ data SimplePullRequest = SimplePullRequest , simplePullRequestCreatedAt :: !UTCTime , simplePullRequestUser :: !SimpleUser , simplePullRequestPatchUrl :: !URL - , simpleIssueState :: !IssueState + , simplePullRequestState :: !IssueState , simplePullRequestNumber :: !Int , simplePullRequestHtmlUrl :: !URL , simplePullRequestUpdatedAt :: !UTCTime - , simplePullRequestBody :: !Text + , simplePullRequestBody :: !(Maybe Text) , simplePullRequestIssueUrl :: !URL , simplePullRequestDiffUrl :: !URL , simplePullRequestUrl :: !URL @@ -58,7 +58,7 @@ data PullRequest = PullRequest , pullRequestNumber :: !Int , pullRequestHtmlUrl :: !URL , pullRequestUpdatedAt :: !UTCTime - , pullRequestBody :: !Text + , pullRequestBody :: !(Maybe Text) , pullRequestIssueUrl :: !URL , pullRequestDiffUrl :: !URL , pullRequestUrl :: !URL @@ -77,7 +77,7 @@ data PullRequest = PullRequest , pullRequestCommits :: !Count , pullRequestMerged :: !Bool , pullRequestMergeable :: !(Maybe Bool) - , pullRequestMergeableState :: !Text + , pullRequestMergeableState :: !MergeableState } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -185,7 +185,7 @@ instance FromJSON SimplePullRequest where <*> o .: "number" <*> o .: "html_url" <*> o .: "updated_at" - <*> o .:? "body" .!= "" -- TODO: no body is treated as empty + <*> o .:? "body" <*> o .: "issue_url" <*> o .: "diff_url" <*> o .: "url" @@ -217,7 +217,7 @@ instance FromJSON PullRequest where <*> o .: "number" <*> o .: "html_url" <*> o .: "updated_at" - <*> o .:? "body" .!= "" -- TODO: no body is treated as empty + <*> o .:? "body" <*> o .: "issue_url" <*> o .: "diff_url" <*> o .: "url" From bf5b6d9a90f6a7fbff47e4e1a9935cb6179898df Mon Sep 17 00:00:00 2001 From: Tristan Bull Date: Thu, 6 Oct 2016 12:10:46 -0500 Subject: [PATCH 231/510] Adding support for the 'Add or update team repository' github API. --- samples/Teams/Repos/AddOrUpdateTeamRepo.hs | 25 +++++++++++++++++++++ src/GitHub/Data/Request.hs | 6 ++++- src/GitHub/Data/Teams.hs | 15 +++++++++++++ src/GitHub/Endpoints/Organizations/Teams.hs | 15 +++++++++++++ src/GitHub/Request.hs | 1 + 5 files changed, 61 insertions(+), 1 deletion(-) create mode 100644 samples/Teams/Repos/AddOrUpdateTeamRepo.hs diff --git a/samples/Teams/Repos/AddOrUpdateTeamRepo.hs b/samples/Teams/Repos/AddOrUpdateTeamRepo.hs new file mode 100644 index 00000000..7e4b6034 --- /dev/null +++ b/samples/Teams/Repos/AddOrUpdateTeamRepo.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +module Main (main) where + +import Common + +import qualified GitHub +import qualified GitHub.Endpoints.Organizations.Teams as GitHub + +main :: IO () +main = do + args <- getArgs + result <- case args of + [token, team_id, org, repo] -> + GitHub.addOrUpdateTeamRepo' + (GitHub.OAuth $ fromString token) + (GitHub.mkTeamId $ read team_id) + (GitHub.mkOrganizationName $ fromString org) + (GitHub.mkRepoName $ fromString repo) + GitHub.PermissionPull + _ -> + error "usage: AddOrUpdateTeamRepo " + case result of + Left err -> putStrLn $ "Error: " <> tshow err + Right team -> putStrLn $ tshow team diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs index f6481b60..5ca7556a 100644 --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -56,6 +56,7 @@ data CommandMethod a where Post :: CommandMethod a Patch :: CommandMethod a Put :: CommandMethod a + Put' :: CommandMethod () Delete :: CommandMethod () deriving (Typeable) @@ -65,18 +66,21 @@ instance Show (CommandMethod a) where showsPrec _ Post = showString "Post" showsPrec _ Patch = showString "Patch" showsPrec _ Put = showString "Put" + showsPrec _ Put' = showString "Put'" showsPrec _ Delete = showString "Delete" instance Hashable (CommandMethod a) where hashWithSalt salt Post = hashWithSalt salt (0 :: Int) hashWithSalt salt Patch = hashWithSalt salt (1 :: Int) hashWithSalt salt Put = hashWithSalt salt (2 :: Int) - hashWithSalt salt Delete = hashWithSalt salt (3 :: Int) + hashWithSalt salt Put' = hashWithSalt salt (3 :: Int) + hashWithSalt salt Delete = hashWithSalt salt (4 :: Int) toMethod :: CommandMethod a -> Method.Method toMethod Post = Method.methodPost toMethod Patch = Method.methodPatch toMethod Put = Method.methodPut +toMethod Put' = Method.methodPut toMethod Delete = Method.methodDelete -- | 'PagedQuery' returns just some results, using this data we can specify how diff --git a/src/GitHub/Data/Teams.hs b/src/GitHub/Data/Teams.hs index 5df040c7..7e30a5fc 100644 --- a/src/GitHub/Data/Teams.hs +++ b/src/GitHub/Data/Teams.hs @@ -34,6 +34,13 @@ data Permission = instance NFData Permission where rnf = genericRnf instance Binary Permission +data AddTeamRepoPermission = AddTeamRepoPermission { + addTeamRepoPermission :: !Permission +} deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData AddTeamRepoPermission where rnf = genericRnf +instance Binary AddTeamRepoPermission + data SimpleTeam = SimpleTeam { simpleTeamId :: !(Id Team) ,simpleTeamUrl :: !URL @@ -178,6 +185,14 @@ instance ToJSON CreateTeamMembership where toJSON (CreateTeamMembership { createTeamMembershipRole = role }) = object [ "role" .= role ] +instance FromJSON AddTeamRepoPermission where + parseJSON = withObject "AddTeamRepoPermission" $ \o -> + AddTeamRepoPermission <$> o .: "permission" + +instance ToJSON AddTeamRepoPermission where + toJSON (AddTeamRepoPermission { addTeamRepoPermission = permission}) = + object [ "permission" .= permission ] + instance FromJSON Role where parseJSON (String attr) = case attr of diff --git a/src/GitHub/Endpoints/Organizations/Teams.hs b/src/GitHub/Endpoints/Organizations/Teams.hs index 0bdcf89c..04af873e 100644 --- a/src/GitHub/Endpoints/Organizations/Teams.hs +++ b/src/GitHub/Endpoints/Organizations/Teams.hs @@ -22,6 +22,8 @@ module GitHub.Endpoints.Organizations.Teams ( listTeamRepos, listTeamRepos', listTeamReposR, + addOrUpdateTeamRepo', + addOrUpdateTeamRepoR, teamMembershipInfoFor, teamMembershipInfoFor', teamMembershipInfoForR, @@ -157,6 +159,19 @@ listTeamReposR tid = listTeamRepos :: Id Team -> IO (Either Error (Vector Repo)) listTeamRepos = listTeamRepos' Nothing +-- | Add a repository to a team or update the permission on the repository. +-- +-- > addOrUpdateTeamRepo' (OAuth "token") 1010101 "mburns" (Just PermissionPull) +addOrUpdateTeamRepo' :: Auth -> Id Team -> Name Organization -> Name Repo -> Permission -> IO (Either Error ()) +addOrUpdateTeamRepo' auth tid org repo permission = + executeRequest auth $ addOrUpdateTeamRepoR tid org repo permission + +-- | Add or update a team repository. +-- See +addOrUpdateTeamRepoR :: Id Team -> Name Organization -> Name Repo -> Permission -> Request 'RW () +addOrUpdateTeamRepoR tid org repo permission = + command Put' ["teams", toPathPart tid, "repos", toPathPart org, toPathPart repo] (encode $ AddTeamRepoPermission permission) + -- | Retrieve team mebership information for a user. -- With authentication -- diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index 75ecaf0f..5629e61c 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -138,6 +138,7 @@ executeRequestWithMgr mgr auth req = runExceptT $ do res <- httpLbs' httpReq case m of Delete -> pure () + Put' -> pure () _ -> parseResponse res From 04e1cf8c3891dd161be65aec1e22bf3b019da649 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Fri, 4 Nov 2016 14:42:03 +0200 Subject: [PATCH 232/510] Make it possible to not specify milestone or assignee --- src/GitHub/Data/Options.hs | 37 ++++++++++++++++++++++++++++--------- 1 file changed, 28 insertions(+), 9 deletions(-) diff --git a/src/GitHub/Data/Options.hs b/src/GitHub/Data/Options.hs index d083dd16..ba27cdda 100644 --- a/src/GitHub/Data/Options.hs +++ b/src/GitHub/Data/Options.hs @@ -38,8 +38,10 @@ module GitHub.Data.Options ( -- * Repo issues IssueRepoMod, issueRepoModToQueryString, + optionsIrrelevantMilestone, optionsAnyMilestone, optionsNoMilestone, + optionsIrrelevantAssignee, optionsAnyAssignee, optionsNoAssignee, -- * Data @@ -161,6 +163,9 @@ data FilterBy a = FilterAny | FilterNone | FilterBy a + | FilterNotSpecified + -- ^ e.g. for milestones "any" means "any milestone". + -- I.e. won't show issues without mileston specified deriving (Eq, Ord, Show, Generic, Typeable, Data) @@ -491,9 +496,9 @@ data IssueRepoOptions = IssueRepoOptions defaultIssueRepoOptions :: IssueRepoOptions defaultIssueRepoOptions = IssueRepoOptions - { issueRepoOptionsMilestone = FilterAny + { issueRepoOptionsMilestone = FilterNotSpecified , issueRepoOptionsState = (Just StateOpen) - , issueRepoOptionsAssignee = FilterAny + , issueRepoOptionsAssignee = FilterNotSpecified , issueRepoOptionsCreator = Nothing , issueRepoOptionsMentioned = Nothing , issueRepoOptionsLabels = [] @@ -520,13 +525,13 @@ issueRepoModToQueryString = issueRepoOptionsToQueryString . toIssueRepoOptions issueRepoOptionsToQueryString :: IssueRepoOptions -> QueryString issueRepoOptionsToQueryString IssueRepoOptions {..} = - [ mk "milestone" milestone' - , mk "assignee" assignee' - , mk "state" state' + [ mk "state" state' , mk "sort" sort' , mk "direction" direction' ] ++ catMaybes - [ mk "labels" <$> labels' + [ mk "milestone" <$> milestone' + , mk "assignee" <$> assignee' + , mk "labels" <$> labels' , mk "since" <$> since' , mk "creator" <$> creator' , mk "mentioned" <$> mentioned' @@ -534,9 +539,10 @@ issueRepoOptionsToQueryString IssueRepoOptions {..} = where mk k v = (k, Just v) filt f x = case x of - FilterAny -> "*" - FilterNone -> "none" - FilterBy x' -> TE.encodeUtf8 (f x') + FilterAny -> Just "*" + FilterNone -> Just "none" + FilterBy x' -> Just $ TE.encodeUtf8 $ f x' + FilterNotSpecified -> Nothing milestone' = filt (T.pack . show . untagId) issueRepoOptionsMilestone assignee' = filt untagName issueRepoOptionsAssignee @@ -562,6 +568,15 @@ issueRepoOptionsToQueryString IssueRepoOptions {..} = -- Issues repo modifiers ------------------------------------------------------------------------------- +-- | Don't care about milestones. +-- +-- 'optionsAnyMilestone' means there should be some milestone, but it can be any. +-- +-- See +optionsIrrelevantMilestone :: IssueRepoMod +optionsIrrelevantMilestone = IssueRepoMod $ \opts -> + opts { issueRepoOptionsMilestone = FilterNotSpecified } + optionsAnyMilestone :: IssueRepoMod optionsAnyMilestone = IssueRepoMod $ \opts -> opts { issueRepoOptionsMilestone = FilterAny } @@ -570,6 +585,10 @@ optionsNoMilestone :: IssueRepoMod optionsNoMilestone = IssueRepoMod $ \opts -> opts { issueRepoOptionsMilestone = FilterNone } +optionsIrrelevantAssignee :: IssueRepoMod +optionsIrrelevantAssignee = IssueRepoMod $ \opts -> + opts { issueRepoOptionsAssignee = FilterNotSpecified } + optionsAnyAssignee :: IssueRepoMod optionsAnyAssignee = IssueRepoMod $ \opts -> opts { issueRepoOptionsAssignee = FilterAny } From 2299cebb0cf812bd3ddef5c69373bdd5f38741d2 Mon Sep 17 00:00:00 2001 From: "Gregory Mullen (grayhatter)" Date: Sun, 25 Sep 2016 17:28:07 -0700 Subject: [PATCH 233/510] Add assiginees to pull requests closes #248 --- src/GitHub/Data/Issues.hs | 3 ++- src/GitHub/Data/PullRequests.hs | 2 ++ 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/src/GitHub/Data/Issues.hs b/src/GitHub/Data/Issues.hs index 7cb8d30f..c032e3c0 100644 --- a/src/GitHub/Data/Issues.hs +++ b/src/GitHub/Data/Issues.hs @@ -23,7 +23,7 @@ data Issue = Issue , issueClosedBy :: !(Maybe SimpleUser) , issueLabels :: (Vector IssueLabel) , issueNumber :: !Int - , issueAssignee :: !(Maybe SimpleUser) + , issueAssignees :: !(Vector SimpleUser) , issueUser :: !SimpleUser , issueTitle :: !Text , issuePullRequest :: !(Maybe PullRequestReference) @@ -169,6 +169,7 @@ instance FromJSON Issue where <*> o .: "labels" <*> o .: "number" <*> o .:? "assignee" + <*> o .: "assignees" <*> o .: "user" <*> o .: "title" <*> o .:? "pull_request" diff --git a/src/GitHub/Data/PullRequests.hs b/src/GitHub/Data/PullRequests.hs index 9c7c7c78..0a68ae0c 100644 --- a/src/GitHub/Data/PullRequests.hs +++ b/src/GitHub/Data/PullRequests.hs @@ -59,6 +59,7 @@ data PullRequest = PullRequest , pullRequestHtmlUrl :: !URL , pullRequestUpdatedAt :: !UTCTime , pullRequestBody :: !(Maybe Text) + , pullRequestAssignees :: (Vector SimpleUser) , pullRequestIssueUrl :: !URL , pullRequestDiffUrl :: !URL , pullRequestUrl :: !URL @@ -218,6 +219,7 @@ instance FromJSON PullRequest where <*> o .: "html_url" <*> o .: "updated_at" <*> o .:? "body" + <*> o .: "assignees" <*> o .: "issue_url" <*> o .: "diff_url" <*> o .: "url" From 1a4afade306a466a22bff699b80757364aacfb39 Mon Sep 17 00:00:00 2001 From: "Gregory Mullen (grayhatter)" Date: Sun, 16 Oct 2016 01:43:54 -0700 Subject: [PATCH 234/510] add assignes to simplePull as well this alse includes the changes from @rob-b as well, thanks mate --- fixtures/issue-search.json | 2 ++ src/GitHub/Data/Issues.hs | 1 - src/GitHub/Data/PullRequests.hs | 2 ++ 3 files changed, 4 insertions(+), 1 deletion(-) diff --git a/fixtures/issue-search.json b/fixtures/issue-search.json index c95cacba..9b3bdfd9 100644 --- a/fixtures/issue-search.json +++ b/fixtures/issue-search.json @@ -36,6 +36,7 @@ "state": "closed", "locked": false, "assignee": null, + "assignees": [], "milestone": null, "comments": 0, "created_at": "2015-12-25T21:37:39Z", @@ -84,6 +85,7 @@ "state": "open", "locked": false, "assignee": null, + "assignees": [], "milestone": null, "comments": 2, "created_at": "2015-12-01T11:09:03Z", diff --git a/src/GitHub/Data/Issues.hs b/src/GitHub/Data/Issues.hs index c032e3c0..6a433c48 100644 --- a/src/GitHub/Data/Issues.hs +++ b/src/GitHub/Data/Issues.hs @@ -168,7 +168,6 @@ instance FromJSON Issue where <*> o .:? "closed_by" <*> o .: "labels" <*> o .: "number" - <*> o .:? "assignee" <*> o .: "assignees" <*> o .: "user" <*> o .: "title" diff --git a/src/GitHub/Data/PullRequests.hs b/src/GitHub/Data/PullRequests.hs index 0a68ae0c..65f50f2f 100644 --- a/src/GitHub/Data/PullRequests.hs +++ b/src/GitHub/Data/PullRequests.hs @@ -36,6 +36,7 @@ data SimplePullRequest = SimplePullRequest , simplePullRequestHtmlUrl :: !URL , simplePullRequestUpdatedAt :: !UTCTime , simplePullRequestBody :: !(Maybe Text) + , simplePullRequestAssignees :: (Vector SimpleUser) , simplePullRequestIssueUrl :: !URL , simplePullRequestDiffUrl :: !URL , simplePullRequestUrl :: !URL @@ -187,6 +188,7 @@ instance FromJSON SimplePullRequest where <*> o .: "html_url" <*> o .: "updated_at" <*> o .:? "body" + <*> o .: "assignees" <*> o .: "issue_url" <*> o .: "diff_url" <*> o .: "url" From f8851bfed62e1f16f9b030d93dc3a62e77502b5f Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Fri, 4 Nov 2016 17:04:41 +0200 Subject: [PATCH 235/510] Add repository events (preliminary) --- github.cabal | 4 ++- src/GitHub.hs | 5 ++++ src/GitHub/Data.hs | 2 ++ src/GitHub/Data/Definitions.hs | 2 -- src/GitHub/Data/Events.hs | 33 +++++++++++++++++++++++++ src/GitHub/Data/Issues.hs | 24 +++++++++--------- src/GitHub/Data/Name.hs | 18 +++++++++++++- src/GitHub/Data/Repos.hs | 2 +- src/GitHub/Endpoints/Activity/Events.hs | 21 ++++++++++++++++ src/GitHub/Endpoints/Issues/Events.hs | 18 +++++++------- 10 files changed, 103 insertions(+), 26 deletions(-) create mode 100644 src/GitHub/Data/Events.hs create mode 100644 src/GitHub/Endpoints/Activity/Events.hs diff --git a/github.cabal b/github.cabal index f5a99047..d83e07a7 100644 --- a/github.cabal +++ b/github.cabal @@ -72,12 +72,13 @@ Library GitHub.Data.Content GitHub.Data.Definitions GitHub.Data.DeployKeys + GitHub.Data.Events GitHub.Data.Gists GitHub.Data.GitData GitHub.Data.Id GitHub.Data.Issues - GitHub.Data.Name GitHub.Data.Milestone + GitHub.Data.Name GitHub.Data.Options GitHub.Data.PullRequests GitHub.Data.Repos @@ -87,6 +88,7 @@ Library GitHub.Data.URL GitHub.Data.Webhooks GitHub.Data.Webhooks.Validate + GitHub.Endpoints.Activity.Events GitHub.Endpoints.Activity.Starring GitHub.Endpoints.Activity.Watching GitHub.Endpoints.Gists diff --git a/src/GitHub.hs b/src/GitHub.hs index ce452a10..4d3187cb 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -15,6 +15,10 @@ module GitHub ( -- * Activity -- | See + -- ** Events + -- | See https://developer.github.com/v3/activity/events/#events + repositoryEventsR, + -- ** Starring -- | See -- @@ -306,6 +310,7 @@ module GitHub ( ) where import GitHub.Data +import GitHub.Endpoints.Activity.Events import GitHub.Endpoints.Activity.Starring import GitHub.Endpoints.Activity.Watching import GitHub.Endpoints.Gists diff --git a/src/GitHub/Data.hs b/src/GitHub/Data.hs index c6cb79b3..f11aa450 100644 --- a/src/GitHub/Data.hs +++ b/src/GitHub/Data.hs @@ -36,6 +36,7 @@ module GitHub.Data ( module GitHub.Data.Content, module GitHub.Data.Definitions, module GitHub.Data.DeployKeys, + module GitHub.Data.Events, module GitHub.Data.Gists, module GitHub.Data.GitData, module GitHub.Data.Issues, @@ -59,6 +60,7 @@ import GitHub.Data.Comments import GitHub.Data.Content import GitHub.Data.Definitions import GitHub.Data.DeployKeys +import GitHub.Data.Events import GitHub.Data.Gists import GitHub.Data.GitData import GitHub.Data.Id diff --git a/src/GitHub/Data/Definitions.hs b/src/GitHub/Data/Definitions.hs index c4a5c95d..c2c172d5 100644 --- a/src/GitHub/Data/Definitions.hs +++ b/src/GitHub/Data/Definitions.hs @@ -43,7 +43,6 @@ data SimpleUser = SimpleUser , simpleUserLogin :: !(Name User) , simpleUserAvatarUrl :: !URL , simpleUserUrl :: !URL - , simpleUserType :: !OwnerType -- ^ Should always be 'OwnerUser' } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -148,7 +147,6 @@ instance FromJSON SimpleUser where <*> obj .: "login" <*> obj .: "avatar_url" <*> obj .: "url" - <*> obj .: "type" instance FromJSON SimpleOrganization where parseJSON = withObject "SimpleOrganization" $ \obj -> diff --git a/src/GitHub/Data/Events.hs b/src/GitHub/Data/Events.hs new file mode 100644 index 00000000..8ec6a22d --- /dev/null +++ b/src/GitHub/Data/Events.hs @@ -0,0 +1,33 @@ +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +module GitHub.Data.Events where + +import GitHub.Data.Definitions +import GitHub.Internal.Prelude +import Prelude () + +-- | Events. +-- +-- /TODO:/ +-- +-- * missing repo, org, payload, id +data Event = Event + -- { eventId :: !(Id Event) -- id can be encoded as string. + { eventActor :: !SimpleUser + , eventCreatedAt :: !UTCTime + , eventPublic :: !Bool + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Event where rnf = genericRnf +instance Binary Event + +instance FromJSON Event where + parseJSON = withObject "Event" $ \obj -> Event + -- <$> obj .: "id" + <$> obj .: "actor" + <*> obj .: "created_at" + <*> obj .: "public" diff --git a/src/GitHub/Data/Issues.hs b/src/GitHub/Data/Issues.hs index 6a433c48..e30a2c03 100644 --- a/src/GitHub/Data/Issues.hs +++ b/src/GitHub/Data/Issues.hs @@ -104,22 +104,22 @@ instance NFData EventType where rnf = genericRnf instance Binary EventType -- | Issue event -data Event = Event - { eventActor :: !SimpleUser - , eventType :: !EventType - , eventCommitId :: !(Maybe Text) - , eventUrl :: !URL - , eventCreatedAt :: !UTCTime - , eventId :: !Int - , eventIssue :: !(Maybe Issue) +data IssueEvent = IssueEvent + { issueEventActor :: !SimpleUser + , issueEventType :: !EventType + , issueEventCommitId :: !(Maybe Text) + , issueEventUrl :: !URL + , issueEventCreatedAt :: !UTCTime + , issueEventId :: !Int + , issueEventIssue :: !(Maybe Issue) } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Event where rnf = genericRnf -instance Binary Event +instance NFData IssueEvent where rnf = genericRnf +instance Binary IssueEvent -instance FromJSON Event where - parseJSON = withObject "Event" $ \o -> Event +instance FromJSON IssueEvent where + parseJSON = withObject "Event" $ \o -> IssueEvent <$> o .: "actor" <*> o .: "event" <*> o .:? "commit_id" diff --git a/src/GitHub/Data/Name.hs b/src/GitHub/Data/Name.hs index 6f9fff53..35c12b0c 100644 --- a/src/GitHub/Data/Name.hs +++ b/src/GitHub/Data/Name.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -9,8 +10,13 @@ module GitHub.Data.Name ( untagName, ) where -import GitHub.Internal.Prelude import Prelude () +import GitHub.Internal.Prelude + +#if MIN_VERSION_aeson(1,0,0) +import Data.Aeson.Types + (FromJSONKey (..), ToJSONKey (..), fromJSONKeyCoerce, toJSONKeyText) +#endif newtype Name entity = N Text deriving (Eq, Ord, Show, Generic, Typeable, Data) @@ -36,3 +42,13 @@ instance ToJSON (Name entity) where instance IsString (Name entity) where fromString = N . fromString + +#if MIN_VERSION_aeson(1,0,0) +-- | @since 0.15.0.0 +instance ToJSONKey (Name entity) where + toJSONKey = toJSONKeyText untagName + +-- | @since 0.15.0.0 +instance FromJSONKey (Name entity) where + fromJSONKey = fromJSONKeyCoerce +#endif diff --git a/src/GitHub/Data/Repos.hs b/src/GitHub/Data/Repos.hs index 8e3c9343..9a079ca8 100644 --- a/src/GitHub/Data/Repos.hs +++ b/src/GitHub/Data/Repos.hs @@ -140,7 +140,7 @@ instance Binary Contributor contributorToSimpleUser :: Contributor -> Maybe SimpleUser contributorToSimpleUser (AnonymousContributor _ _) = Nothing contributorToSimpleUser (KnownContributor _contributions avatarUrl name url uid _gravatarid) = - Just $ SimpleUser uid name avatarUrl url OwnerUser + Just $ SimpleUser uid name avatarUrl url -- JSON instances diff --git a/src/GitHub/Endpoints/Activity/Events.hs b/src/GitHub/Endpoints/Activity/Events.hs new file mode 100644 index 00000000..60d7834a --- /dev/null +++ b/src/GitHub/Endpoints/Activity/Events.hs @@ -0,0 +1,21 @@ +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +-- The events API as described on . +module GitHub.Endpoints.Activity.Events ( + -- * Events + repositoryEventsR, + module GitHub.Data, + ) where + +import GitHub.Data +import GitHub.Internal.Prelude +import Prelude () + +-- | List repository events. +-- See +repositoryEventsR :: Name Owner -> Name Repo -> FetchCount -> Request 'RO (Vector Event) +repositoryEventsR user repo = + pagedQuery ["repos", toPathPart user, toPathPart repo, "events"] [] diff --git a/src/GitHub/Endpoints/Issues/Events.hs b/src/GitHub/Endpoints/Issues/Events.hs index 9bc22a9b..97750eda 100644 --- a/src/GitHub/Endpoints/Issues/Events.hs +++ b/src/GitHub/Endpoints/Issues/Events.hs @@ -26,56 +26,56 @@ import Prelude () -- | All events that have happened on an issue. -- -- > eventsForIssue "thoughtbot" "paperclip" 49 -eventsForIssue :: Name Owner -> Name Repo -> Id Issue -> IO (Either Error (Vector Event)) +eventsForIssue :: Name Owner -> Name Repo -> Id Issue -> IO (Either Error (Vector IssueEvent)) eventsForIssue = eventsForIssue' Nothing -- | All events that have happened on an issue, using authentication. -- -- > eventsForIssue' (User (user, password)) "thoughtbot" "paperclip" 49 -eventsForIssue' :: Maybe Auth -> Name Owner -> Name Repo -> Id Issue -> IO (Either Error (Vector Event)) +eventsForIssue' :: Maybe Auth -> Name Owner -> Name Repo -> Id Issue -> IO (Either Error (Vector IssueEvent)) eventsForIssue' auth user repo iid = executeRequestMaybe auth $ eventsForIssueR user repo iid FetchAll -- | List events for an issue. -- See -eventsForIssueR :: Name Owner -> Name Repo -> Id Issue -> FetchCount -> Request k (Vector Event) +eventsForIssueR :: Name Owner -> Name Repo -> Id Issue -> FetchCount -> Request k (Vector IssueEvent) eventsForIssueR user repo iid = pagedQuery ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "events"] [] -- | All the events for all issues in a repo. -- -- > eventsForRepo "thoughtbot" "paperclip" -eventsForRepo :: Name Owner -> Name Repo -> IO (Either Error (Vector Event)) +eventsForRepo :: Name Owner -> Name Repo -> IO (Either Error (Vector IssueEvent)) eventsForRepo = eventsForRepo' Nothing -- | All the events for all issues in a repo, using authentication. -- -- > eventsForRepo' (User (user, password)) "thoughtbot" "paperclip" -eventsForRepo' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Event)) +eventsForRepo' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector IssueEvent)) eventsForRepo' auth user repo = executeRequestMaybe auth $ eventsForRepoR user repo FetchAll -- | List events for a repository. -- See -eventsForRepoR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Event) +eventsForRepoR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector IssueEvent) eventsForRepoR user repo = pagedQuery ["repos", toPathPart user, toPathPart repo, "issues", "events"] [] -- | Details on a specific event, by the event's ID. -- -- > event "thoughtbot" "paperclip" 5335772 -event :: Name Owner -> Name Repo -> Id Event -> IO (Either Error Event) +event :: Name Owner -> Name Repo -> Id IssueEvent -> IO (Either Error IssueEvent) event = event' Nothing -- | Details on a specific event, by the event's ID, using authentication. -- -- > event' (User (user, password)) "thoughtbot" "paperclip" 5335772 -event' :: Maybe Auth -> Name Owner -> Name Repo -> Id Event -> IO (Either Error Event) +event' :: Maybe Auth -> Name Owner -> Name Repo -> Id IssueEvent -> IO (Either Error IssueEvent) event' auth user repo eid = executeRequestMaybe auth $ eventR user repo eid -- | Query a single event. -- See -eventR :: Name Owner -> Name Repo -> Id Event -> Request k Event +eventR :: Name Owner -> Name Repo -> Id IssueEvent -> Request k IssueEvent eventR user repo eid = query ["repos", toPathPart user, toPathPart repo, "issues", "events", toPathPart eid] [] From 08cc0f0872cdd3238fc33b5f14ad178e2ed530b3 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Fri, 4 Nov 2016 17:09:17 +0200 Subject: [PATCH 236/510] Data.Repo formatting --- src/GitHub/Data/Repos.hs | 201 +++++++++++++++++++-------------------- 1 file changed, 100 insertions(+), 101 deletions(-) diff --git a/src/GitHub/Data/Repos.hs b/src/GitHub/Data/Repos.hs index 9a079ca8..cdd98ce9 100644 --- a/src/GitHub/Data/Repos.hs +++ b/src/GitHub/Data/Repos.hs @@ -27,37 +27,38 @@ import Unsafe.Coerce (unsafeCoerce) #endif #endif -data Repo = Repo { - repoSshUrl :: !(Maybe URL) - ,repoDescription :: !(Maybe Text) - ,repoCreatedAt :: !(Maybe UTCTime) - ,repoHtmlUrl :: !URL - ,repoSvnUrl :: !(Maybe URL) - ,repoForks :: !(Maybe Int) - ,repoHomepage :: !(Maybe Text) - ,repoFork :: !(Maybe Bool) - ,repoGitUrl :: !(Maybe URL) - ,repoPrivate :: !Bool - ,repoCloneUrl :: !(Maybe URL) - ,repoSize :: !(Maybe Int) - ,repoUpdatedAt :: !(Maybe UTCTime) - ,repoWatchers :: !(Maybe Int) - ,repoOwner :: !SimpleOwner - ,repoName :: !(Name Repo) - ,repoLanguage :: !(Maybe Language) - ,repoDefaultBranch :: !(Maybe Text) - ,repoPushedAt :: !(Maybe UTCTime) -- ^ this is Nothing for new repositories - ,repoId :: !(Id Repo) - ,repoUrl :: !URL - ,repoOpenIssues :: !(Maybe Int) - ,repoHasWiki :: !(Maybe Bool) - ,repoHasIssues :: !(Maybe Bool) - ,repoHasDownloads :: !(Maybe Bool) - ,repoParent :: !(Maybe RepoRef) - ,repoSource :: !(Maybe RepoRef) - ,repoHooksUrl :: !URL - ,repoStargazersCount :: !Int -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data Repo = Repo + { repoSshUrl :: !(Maybe URL) + , repoDescription :: !(Maybe Text) + , repoCreatedAt :: !(Maybe UTCTime) + , repoHtmlUrl :: !URL + , repoSvnUrl :: !(Maybe URL) + , repoForks :: !(Maybe Int) + , repoHomepage :: !(Maybe Text) + , repoFork :: !(Maybe Bool) + , repoGitUrl :: !(Maybe URL) + , repoPrivate :: !Bool + , repoCloneUrl :: !(Maybe URL) + , repoSize :: !(Maybe Int) + , repoUpdatedAt :: !(Maybe UTCTime) + , repoWatchers :: !(Maybe Int) + , repoOwner :: !SimpleOwner + , repoName :: !(Name Repo) + , repoLanguage :: !(Maybe Language) + , repoDefaultBranch :: !(Maybe Text) + , repoPushedAt :: !(Maybe UTCTime) -- ^ this is Nothing for new repositories + , repoId :: !(Id Repo) + , repoUrl :: !URL + , repoOpenIssues :: !(Maybe Int) + , repoHasWiki :: !(Maybe Bool) + , repoHasIssues :: !(Maybe Bool) + , repoHasDownloads :: !(Maybe Bool) + , repoParent :: !(Maybe RepoRef) + , repoSource :: !(Maybe RepoRef) + , repoHooksUrl :: !URL + , repoStargazersCount :: !Int + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Repo where rnf = genericRnf instance Binary Repo @@ -71,15 +72,15 @@ data RepoRef = RepoRef instance NFData RepoRef where rnf = genericRnf instance Binary RepoRef -data NewRepo = NewRepo { - newRepoName :: !(Name Repo) -, newRepoDescription :: !(Maybe Text) -, newRepoHomepage :: !(Maybe Text) -, newRepoPrivate :: !(Maybe Bool) -, newRepoHasIssues :: !(Maybe Bool) -, newRepoHasWiki :: !(Maybe Bool) -, newRepoAutoInit :: !(Maybe Bool) -} deriving (Eq, Ord, Show, Data, Typeable, Generic) +data NewRepo = NewRepo + { newRepoName :: !(Name Repo) + , newRepoDescription :: !(Maybe Text) + , newRepoHomepage :: !(Maybe Text) + , newRepoPrivate :: !(Maybe Bool) + , newRepoHasIssues :: !(Maybe Bool) + , newRepoHasWiki :: !(Maybe Bool) + , newRepoAutoInit :: !(Maybe Bool) + } deriving (Eq, Ord, Show, Data, Typeable, Generic) instance NFData NewRepo where rnf = genericRnf instance Binary NewRepo @@ -87,15 +88,16 @@ instance Binary NewRepo newRepo :: Name Repo -> NewRepo newRepo name = NewRepo name Nothing Nothing Nothing Nothing Nothing Nothing -data EditRepo = EditRepo { - editName :: !(Maybe (Name Repo)) -, editDescription :: !(Maybe Text) -, editHomepage :: !(Maybe Text) -, editPublic :: !(Maybe Bool) -, editHasIssues :: !(Maybe Bool) -, editHasWiki :: !(Maybe Bool) -, editHasDownloads :: !(Maybe Bool) -} deriving (Eq, Ord, Show, Data, Typeable, Generic) +data EditRepo = EditRepo + { editName :: !(Maybe (Name Repo)) + , editDescription :: !(Maybe Text) + , editHomepage :: !(Maybe Text) + , editPublic :: !(Maybe Bool) + , editHasIssues :: !(Maybe Bool) + , editHasWiki :: !(Maybe Bool) + , editHasDownloads :: !(Maybe Bool) + } + deriving (Eq, Ord, Show, Data, Typeable, Generic) instance NFData EditRepo where rnf = genericRnf instance Binary EditRepo @@ -127,12 +129,12 @@ instance IsString Language where fromString = Language . fromString data Contributor - -- | An existing Github user, with their number of contributions, avatar - -- URL, login, URL, ID, and Gravatar ID. - = KnownContributor !Int !URL !(Name User) !URL !(Id User) !Text - -- | An unknown Github user with their number of contributions and recorded name. - | AnonymousContributor !Int !Text - deriving (Show, Data, Typeable, Eq, Ord, Generic) + -- | An existing Github user, with their number of contributions, avatar + -- URL, login, URL, ID, and Gravatar ID. + = KnownContributor !Int !URL !(Name User) !URL !(Id User) !Text + -- | An unknown Github user with their number of contributions and recorded name. + | AnonymousContributor !Int !Text + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Contributor where rnf = genericRnf instance Binary Contributor @@ -145,36 +147,35 @@ contributorToSimpleUser (KnownContributor _contributions avatarUrl name url uid -- JSON instances instance FromJSON Repo where - parseJSON = withObject "Repo" $ \o -> - Repo <$> o .:? "ssh_url" - <*> o .: "description" - <*> o .:? "created_at" - <*> o .: "html_url" - <*> o .:? "svn_url" - <*> o .:? "forks" - <*> o .:? "homepage" - <*> o .: "fork" - <*> o .:? "git_url" - <*> o .: "private" - <*> o .:? "clone_url" - <*> o .:? "size" - <*> o .:? "updated_at" - <*> o .:? "watchers" - <*> o .: "owner" - <*> o .: "name" - <*> o .:? "language" - <*> o .:? "default_branch" - <*> o .:? "pushed_at" - <*> o .: "id" - <*> o .: "url" - <*> o .:? "open_issues" - <*> o .:? "has_wiki" - <*> o .:? "has_issues" - <*> o .:? "has_downloads" - <*> o .:? "parent" - <*> o .:? "source" - <*> o .: "hooks_url" - <*> o .: "stargazers_count" + parseJSON = withObject "Repo" $ \o -> Repo <$> o .:? "ssh_url" + <*> o .: "description" + <*> o .:? "created_at" + <*> o .: "html_url" + <*> o .:? "svn_url" + <*> o .:? "forks" + <*> o .:? "homepage" + <*> o .: "fork" + <*> o .:? "git_url" + <*> o .: "private" + <*> o .:? "clone_url" + <*> o .:? "size" + <*> o .:? "updated_at" + <*> o .:? "watchers" + <*> o .: "owner" + <*> o .: "name" + <*> o .:? "language" + <*> o .:? "default_branch" + <*> o .:? "pushed_at" + <*> o .: "id" + <*> o .: "url" + <*> o .:? "open_issues" + <*> o .:? "has_wiki" + <*> o .:? "has_issues" + <*> o .:? "has_downloads" + <*> o .:? "parent" + <*> o .:? "source" + <*> o .: "hooks_url" + <*> o .: "stargazers_count" instance ToJSON NewRepo where toJSON (NewRepo { newRepoName = name @@ -213,26 +214,24 @@ instance ToJSON EditRepo where ] instance FromJSON RepoRef where - parseJSON = withObject "RepoRef" $ \o -> - RepoRef <$> o .: "owner" - <*> o .: "name" + parseJSON = withObject "RepoRef" $ \o -> RepoRef + <$> o .: "owner" + <*> o .: "name" instance FromJSON Contributor where parseJSON = withObject "Contributor" $ \o -> do t <- o .: "type" - case t of - _ | t == ("Anonymous" :: Text) -> - AnonymousContributor - <$> o .: "contributions" - <*> o .: "name" - _ | otherwise -> - KnownContributor - <$> o .: "contributions" - <*> o .: "avatar_url" - <*> o .: "login" - <*> o .: "url" - <*> o .: "id" - <*> o .: "gravatar_id" + case (t :: Text) of + "Anonymous" -> AnonymousContributor + <$> o .: "contributions" + <*> o .: "name" + _ -> KnownContributor + <$> o .: "contributions" + <*> o .: "avatar_url" + <*> o .: "login" + <*> o .: "url" + <*> o .: "id" + <*> o .: "gravatar_id" instance FromJSON Language where parseJSON = withText "Language" (pure . Language) From 543e947ca07db114569508cc92afe6921740745b Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Fri, 4 Nov 2016 17:40:39 +0200 Subject: [PATCH 237/510] Some more re-formatting --- src/GitHub/Data/Teams.hs | 268 ++++++++++---------- src/GitHub/Endpoints/Repos/Collaborators.hs | 20 +- 2 files changed, 141 insertions(+), 147 deletions(-) diff --git a/src/GitHub/Data/Teams.hs b/src/GitHub/Data/Teams.hs index 7e30a5fc..86ddfcfa 100644 --- a/src/GitHub/Data/Teams.hs +++ b/src/GitHub/Data/Teams.hs @@ -17,105 +17,111 @@ import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () -data Privacy = - PrivacyClosed - | PrivacySecret - deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic) +data Privacy + = PrivacyClosed + | PrivacySecret + deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic) instance NFData Privacy where rnf = genericRnf instance Binary Privacy -data Permission = - PermissionPull - | PermissionPush - | PermissionAdmin - deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic) +data Permission + = PermissionPull + | PermissionPush + | PermissionAdmin + deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic) instance NFData Permission where rnf = genericRnf instance Binary Permission -data AddTeamRepoPermission = AddTeamRepoPermission { - addTeamRepoPermission :: !Permission -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data AddTeamRepoPermission = AddTeamRepoPermission + { addTeamRepoPermission :: !Permission + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData AddTeamRepoPermission where rnf = genericRnf instance Binary AddTeamRepoPermission -data SimpleTeam = SimpleTeam { - simpleTeamId :: !(Id Team) - ,simpleTeamUrl :: !URL - ,simpleTeamName :: !Text -- TODO (0.15.0): unify this and 'simpleTeamSlug' as in 'Team'. - ,simpleTeamSlug :: !(Name Team) - ,simpleTeamDescription :: !(Maybe Text) - ,simpleTeamPrivacy :: !(Maybe Privacy) - ,simpleTeamPermission :: !Permission - ,simpleTeamMembersUrl :: !URL - ,simpleTeamRepositoriesUrl :: !URL -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data SimpleTeam = SimpleTeam + { simpleTeamId :: !(Id Team) + , simpleTeamUrl :: !URL + , simpleTeamName :: !Text -- TODO (0.15.0): unify this and 'simpleTeamSlug' as in 'Team'. + , simpleTeamSlug :: !(Name Team) + , simpleTeamDescription :: !(Maybe Text) + , simpleTeamPrivacy :: !(Maybe Privacy) + , simpleTeamPermission :: !Permission + , simpleTeamMembersUrl :: !URL + , simpleTeamRepositoriesUrl :: !URL + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData SimpleTeam where rnf = genericRnf instance Binary SimpleTeam -data Team = Team { - teamId :: !(Id Team) - ,teamUrl :: !URL - ,teamName :: !Text - ,teamSlug :: !(Name Team) - ,teamDescription :: !(Maybe Text) - ,teamPrivacy :: !(Maybe Privacy) - ,teamPermission :: !Permission - ,teamMembersUrl :: !URL - ,teamRepositoriesUrl :: !URL - ,teamMembersCount :: !Int - ,teamReposCount :: !Int - ,teamOrganization :: !SimpleOrganization -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data Team = Team + { teamId :: !(Id Team) + , teamUrl :: !URL + , teamName :: !Text + , teamSlug :: !(Name Team) + , teamDescription :: !(Maybe Text) + , teamPrivacy :: !(Maybe Privacy) + , teamPermission :: !Permission + , teamMembersUrl :: !URL + , teamRepositoriesUrl :: !URL + , teamMembersCount :: !Int + , teamReposCount :: !Int + , teamOrganization :: !SimpleOrganization + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Team where rnf = genericRnf instance Binary Team -data CreateTeam = CreateTeam { - createTeamName :: !(Name Team) - ,createTeamDescription :: !(Maybe Text) - ,createTeamRepoNames :: !(Vector (Name Repo)) - {-,createTeamPrivacy :: Privacy-} - ,createTeamPermission :: Permission -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data CreateTeam = CreateTeam + { createTeamName :: !(Name Team) + , createTeamDescription :: !(Maybe Text) + , createTeamRepoNames :: !(Vector (Name Repo)) + -- , createTeamPrivacy :: Privacy + , createTeamPermission :: Permission + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData CreateTeam where rnf = genericRnf instance Binary CreateTeam -data EditTeam = EditTeam { - editTeamName :: !(Name Team) - ,editTeamDescription :: !(Maybe Text) - {-,editTeamPrivacy :: Privacy-} - ,editTeamPermission :: !Permission -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data EditTeam = EditTeam + { editTeamName :: !(Name Team) + , editTeamDescription :: !(Maybe Text) + -- , editTeamPrivacy :: Privacy + , editTeamPermission :: !Permission + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData EditTeam where rnf = genericRnf instance Binary EditTeam -data Role = - RoleMaintainer - | RoleMember - deriving (Show, Data, Typeable, Eq, Ord, Generic) +data Role + = RoleMaintainer + | RoleMember + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Role instance Binary Role -data ReqState = - StatePending - | StateActive - deriving (Show, Data, Typeable, Eq, Ord, Generic) +data ReqState + = StatePending + | StateActive + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData ReqState where rnf = genericRnf instance Binary ReqState -data TeamMembership = TeamMembership { - teamMembershipUrl :: !URL, - teamMembershipRole :: !Role, - teamMembershipReqState :: !ReqState -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data TeamMembership = TeamMembership + { teamMembershipUrl :: !URL + , teamMembershipRole :: !Role + , teamMembershipReqState :: !ReqState + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData TeamMembership where rnf = genericRnf instance Binary TeamMembership @@ -130,31 +136,31 @@ instance Binary CreateTeamMembership -- JSON Instances instance FromJSON SimpleTeam where - parseJSON = withObject "SimpleTeam" $ \o -> - SimpleTeam <$> o .: "id" - <*> o .: "url" - <*> o .: "name" - <*> o .: "slug" - <*> o .:?"description" .!= Nothing - <*> o .:?"privacy" .!= Nothing - <*> o .: "permission" - <*> o .: "members_url" - <*> o .: "repositories_url" + parseJSON = withObject "SimpleTeam" $ \o -> SimpleTeam + <$> o .: "id" + <*> o .: "url" + <*> o .: "name" + <*> o .: "slug" + <*> o .:?"description" .!= Nothing + <*> o .:?"privacy" .!= Nothing + <*> o .: "permission" + <*> o .: "members_url" + <*> o .: "repositories_url" instance FromJSON Team where - parseJSON = withObject "Team" $ \o -> - Team <$> o .: "id" - <*> o .: "url" - <*> o .: "name" - <*> o .: "slug" - <*> o .:?"description" .!= Nothing - <*> o .:?"privacy" .!= Nothing - <*> o .: "permission" - <*> o .: "members_url" - <*> o .: "repositories_url" - <*> o .: "members_count" - <*> o .: "repos_count" - <*> o .: "organization" + parseJSON = withObject "Team" $ \o -> Team + <$> o .: "id" + <*> o .: "url" + <*> o .: "name" + <*> o .: "slug" + <*> o .:?"description" .!= Nothing + <*> o .:?"privacy" .!= Nothing + <*> o .: "permission" + <*> o .: "members_url" + <*> o .: "repositories_url" + <*> o .: "members_count" + <*> o .: "repos_count" + <*> o .: "organization" instance ToJSON CreateTeam where toJSON (CreateTeam name desc repo_names {-privacy-} permissions) = @@ -172,82 +178,68 @@ instance ToJSON EditTeam where , "permissions" .= permissions ] instance FromJSON TeamMembership where - parseJSON = withObject "TeamMembership" $ \o -> - TeamMembership <$> o .: "url" - <*> o .: "role" - <*> o .: "state" + parseJSON = withObject "TeamMembership" $ \o -> TeamMembership + <$> o .: "url" + <*> o .: "role" + <*> o .: "state" instance FromJSON CreateTeamMembership where - parseJSON = withObject "CreateTeamMembership" $ \o -> - CreateTeamMembership <$> o .: "role" + parseJSON = withObject "CreateTeamMembership" $ \o -> CreateTeamMembership + <$> o .: "role" instance ToJSON CreateTeamMembership where - toJSON (CreateTeamMembership { createTeamMembershipRole = role }) = - object [ "role" .= role ] + toJSON (CreateTeamMembership { createTeamMembershipRole = role }) = + object [ "role" .= role ] instance FromJSON AddTeamRepoPermission where - parseJSON = withObject "AddTeamRepoPermission" $ \o -> - AddTeamRepoPermission <$> o .: "permission" + parseJSON = withObject "AddTeamRepoPermission" $ \o -> AddTeamRepoPermission + <$> o .: "permission" instance ToJSON AddTeamRepoPermission where - toJSON (AddTeamRepoPermission { addTeamRepoPermission = permission}) = - object [ "permission" .= permission ] + toJSON (AddTeamRepoPermission { addTeamRepoPermission = permission}) = + object [ "permission" .= permission ] instance FromJSON Role where - parseJSON (String attr) = - case attr of - "maintainer" -> return RoleMaintainer - "member" -> return RoleMember - _ -> fail "Unknown Role" - parseJSON _ = fail "Could not build Role" + parseJSON = withText "Attribute" $ \attr -> case attr of + "maintainer" -> return RoleMaintainer + "member" -> return RoleMember + _ -> fail $ "Unknown Role: " ++ show attr instance ToJSON Role where - toJSON RoleMaintainer = String "maintainer" - toJSON RoleMember = String "member" + toJSON RoleMaintainer = String "maintainer" + toJSON RoleMember = String "member" instance ToJSON Permission where - toJSON attr = - String $ - case attr of - PermissionPull -> "pull" - PermissionPush -> "push" - PermissionAdmin -> "admin" + toJSON PermissionPull = "pull" + toJSON PermissionPush = "push" + toJSON PermissionAdmin = "admin" instance FromJSON Permission where - parseJSON (String attr) = - case attr of - "pull" -> return PermissionPull - "push" -> return PermissionPush - "admin" -> return PermissionAdmin - _ -> fail "Unknown Permission Attribute" - parseJSON _ = fail "Could not build Permission" + parseJSON = withText "Permission Attribute" $ \attr -> case attr of + "pull" -> return PermissionPull + "push" -> return PermissionPush + "admin" -> return PermissionAdmin + _ -> fail $ "Unknown Permission Attribute: " ++ show attr instance FromJSON Privacy where - parseJSON (String attr) = - case attr of - "secret" -> return PrivacySecret - "closed" -> return PrivacyClosed - _ -> fail "Unknown Privacy Attribute" - parseJSON _ = fail "Could not build Privacy" + parseJSON = withText "Privacy Attribute" $ \attr -> case attr of + "secret" -> return PrivacySecret + "closed" -> return PrivacyClosed + _ -> fail $ "Unknown Privacy Attribute: " ++ show attr instance ToJSON Privacy where - toJSON attr = - String $ - case attr of - PrivacySecret -> "secret" - PrivacyClosed -> "closed" + toJSON PrivacySecret = String "secret" + toJSON PrivacyClosed = String "closed" instance FromJSON ReqState where - parseJSON (String attr) = - case attr of - "active" -> return StateActive - "pending" -> return StatePending - _ -> fail "Unknown ReqState" - parseJSON _ = fail "Could not build ReqState" + parseJSON = withText "ReqState" $ \attr -> case attr of + "active" -> return StateActive + "pending" -> return StatePending + _ -> fail $ "Unknown ReqState: " ++ show attr instance ToJSON ReqState where - toJSON StateActive = String "active" - toJSON StatePending = String "pending" + toJSON StateActive = String "active" + toJSON StatePending = String "pending" -- | Filters members returned by their role in the team. data TeamMemberRole diff --git a/src/GitHub/Endpoints/Repos/Collaborators.hs b/src/GitHub/Endpoints/Repos/Collaborators.hs index 1504ca0f..d3049d7b 100644 --- a/src/GitHub/Endpoints/Repos/Collaborators.hs +++ b/src/GitHub/Endpoints/Repos/Collaborators.hs @@ -42,19 +42,21 @@ collaboratorsOnR user repo = -- -- > isCollaboratorOn Nothing "mike-burns" "thoughtbot" "paperclip" -- > isCollaboratorOn Nothing "johnson" "thoughtbot" "paperclip" -isCollaboratorOn :: Maybe Auth - -> Name Owner -- ^ Repository owner - -> Name Repo -- ^ Repository name - -> Name User -- ^ Collaborator? - -> IO (Either Error Bool) +isCollaboratorOn + :: Maybe Auth + -> Name Owner -- ^ Repository owner + -> Name Repo -- ^ Repository name + -> Name User -- ^ Collaborator? + -> IO (Either Error Bool) isCollaboratorOn auth user repo coll = executeRequestMaybe auth $ isCollaboratorOnR user repo coll -- | Check if a user is a collaborator. -- See -isCollaboratorOnR :: Name Owner -- ^ Repository owner - -> Name Repo -- ^ Repository name - -> Name User -- ^ Collaborator? - -> Request k Bool +isCollaboratorOnR + :: Name Owner -- ^ Repository owner + -> Name Repo -- ^ Repository name + -> Name User -- ^ Collaborator? + -> Request k Bool isCollaboratorOnR user repo coll = StatusQuery statusOnlyOk $ Query ["repos", toPathPart user, toPathPart repo, "collaborators", toPathPart coll] [] From 39dc3780a631459adbaf0d03beab6eef7f0089de Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Fri, 4 Nov 2016 17:40:44 +0200 Subject: [PATCH 238/510] Update changelog --- CHANGELOG.md | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 657d186e..1941a252 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -13,6 +13,12 @@ Changes for 0.15.0 - Add 'organizationIssuesR' - Make `teamName :: Text` amnd `teamSlug :: Name Team` in both: `Team` and `SimpleTeam` - Refactor 'Request' structure +- Added multiple issue assignees +- Preliminary support for repository events: `repositoryEventsR` +- Support for adding repository permissions to the team +- Remove 'simpleUserType', it was always the same. + +See [git commit summary](https://github.com/phadej/github/compare/v0.14.1...v0.15.0) Changes for 0.14.1 From b0e558cb1c504b8f4488e1673b3cf8c5b0334a0b Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Fri, 4 Nov 2016 18:07:58 +0200 Subject: [PATCH 239/510] Update travis jobs --- .travis.yml | 21 +++++++++------------ stack-lts-5.yaml | 3 ++- stack-lts-6.yaml | 6 ++++++ stack-lts-7.yaml | 6 ++++++ stack.yaml | 2 +- 5 files changed, 24 insertions(+), 14 deletions(-) create mode 100644 stack-lts-6.yaml create mode 100644 stack-lts-7.yaml diff --git a/.travis.yml b/.travis.yml index a6c2ed92..17bb8048 100644 --- a/.travis.yml +++ b/.travis.yml @@ -27,18 +27,7 @@ matrix: - env: BUILD=cabal CABALVER=1.24 GHCVER=8.0.1 compiler: ": #GHC 8.0.1" addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.1], sources: [hvr-ghc]}} - - env: BUILD=cabal CABALVER=1.18 GHCVER=7.8.4 STACKAGESNAPSHOT=lts-2.22 - compiler: ": #GHC 7.8.4 lts-2.22" - addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4], sources: [hvr-ghc]}} - - env: BUILD=cabal CABALVER=1.22 GHCVER=7.10.2 STACKAGESNAPSHOT=lts-3.22 - compiler: ": #GHC 7.10.2 lts-3.22" - addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.2], sources: [hvr-ghc]}} - - env: BUILD=cabal CABALVER=1.22 GHCVER=7.10.3 STACKAGESNAPSHOT=lts-4.2 - compiler: ": #GHC 7.10.3 lts-4.2" - addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3], sources: [hvr-ghc]}} - - env: BUILD=cabal CABALVER=1.22 GHCVER=7.10.3 STACKAGESNAPSHOT=lts-5.1 - compiler: ": #GHC 7.10.3 lts-5.1" - addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3], sources: [hvr-ghc]}} + - env: BUILD=stack STACK_YAML=stack-lts-2.yaml GHCVER=7.8.4 compiler: ": #STACK LTS2" addons: {apt: {packages: [ghc-7.8.4], sources: [hvr-ghc]}} @@ -51,12 +40,20 @@ matrix: - env: BUILD=stack STACK_YAML=stack-lts-5.yaml GHCVER=7.10.3 compiler: ": #STACK LTS5" addons: {apt: {packages: [ghc-7.10.3], sources: [hvr-ghc]}} + - env: BUILD=stack STACK_YAML=stack-lts-6.yaml GHCVER=7.10.3 + compiler: ": #STACK LTS6" + addons: {apt: {packages: [ghc-7.10.3], sources: [hvr-ghc]}} + - env: BUILD=stack STACK_YAML=stack-lts-7.yaml GHCVER=7.10.3 + compiler: ": #STACK LTS7" + addons: {apt: {packages: [ghc-8.0.1], sources: [hvr-ghc]}} - env: BUILD=stack STACK_YAML=stack-nightly.yaml GHCVER=7.10.3 compiler: ": #STACK nightly" addons: {apt: {packages: [ghc-7.10.3], sources: [hvr-ghc]}} + - env: BUILD=stack STACK_YAML=stack-lts-4.yaml compiler: ": #stack LTS4 OSX" os: osx + - env: BUILD=stack-space-leak compiler: ": #STACK - space leak" addons: {apt: {packages: [ghc-7.10.3], sources: [hvr-ghc]}} diff --git a/stack-lts-5.yaml b/stack-lts-5.yaml index 591b123f..f09cb78c 100644 --- a/stack-lts-5.yaml +++ b/stack-lts-5.yaml @@ -2,4 +2,5 @@ resolver: lts-5.18 packages: - '.' - samples/ -extra-deps: [] +extra-deps: +- hsc2hs-0.68 diff --git a/stack-lts-6.yaml b/stack-lts-6.yaml new file mode 100644 index 00000000..119a9b1d --- /dev/null +++ b/stack-lts-6.yaml @@ -0,0 +1,6 @@ +resolver: lts-6.23 +packages: +- '.' +- samples/ +extra-deps: +- hsc2hs-0.68 diff --git a/stack-lts-7.yaml b/stack-lts-7.yaml new file mode 100644 index 00000000..48ba555a --- /dev/null +++ b/stack-lts-7.yaml @@ -0,0 +1,6 @@ +resolver: lts-7.7 +packages: +- '.' +- samples/ +extra-deps: +- hsc2hs-0.68 diff --git a/stack.yaml b/stack.yaml index 0db6065a..50e2a08c 120000 --- a/stack.yaml +++ b/stack.yaml @@ -1 +1 @@ -stack-lts-5.yaml \ No newline at end of file +stack-lts-7.yaml \ No newline at end of file From 8d0e12481b79ed8d043b5d109525974f7f2fdd79 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sun, 1 Jan 2017 23:08:26 +0200 Subject: [PATCH 240/510] Allow aeson-1.1 --- github.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/github.cabal b/github.cabal index d83e07a7..b4c6eb2e 100644 --- a/github.cabal +++ b/github.cabal @@ -121,7 +121,7 @@ Library -- Packages needed in order to build this package. build-depends: base >=4.7 && <4.10, - aeson >=0.7.0.6 && <1.1, + aeson >=0.7.0.6 && <1.2, base-compat >=0.9.1 && <0.10, base16-bytestring >=0.1.1.6 && <0.2, binary >=0.7.1.0 && <0.9, From a81266bce4a7644c214ce40afd9c61e5a8324480 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 2 Jan 2017 07:31:17 +0200 Subject: [PATCH 241/510] 0.15.0~1 [ci skip] --- github.cabal | 1 + 1 file changed, 1 insertion(+) diff --git a/github.cabal b/github.cabal index b4c6eb2e..a43caba4 100644 --- a/github.cabal +++ b/github.cabal @@ -1,4 +1,5 @@ name: github +x-revision: 1 version: 0.15.0 synopsis: Access to the GitHub API, v3. description: From 43e765e2cb49e2efeb00dca5ad2366abfedf892a Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 9 Jan 2017 11:32:17 +0200 Subject: [PATCH 242/510] Allow vector-0.12 and vector-instances-3.4 --- github.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/github.cabal b/github.cabal index a43caba4..e94a03fb 100644 --- a/github.cabal +++ b/github.cabal @@ -148,8 +148,8 @@ Library transformers >=0.3.0.0 && <0.6, transformers-compat >=0.4.0.3 && <0.6, unordered-containers >=0.2 && <0.3, - vector >=0.10.12.3 && <0.12, - vector-instances >=3.3.0.1 && <3.4, + vector >=0.10.12.3 && <0.13, + vector-instances >=3.3.0.1 && <3.5, tls >=1.3.5 From 8065c1da2507d5ca62a04dafe2f05987f288e6f8 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 9 Jan 2017 14:52:33 +0200 Subject: [PATCH 243/510] Add dist-newstyle to .gitignore --- .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index e22e77ba..7a8fb579 100644 --- a/.gitignore +++ b/.gitignore @@ -1,4 +1,5 @@ dist +dist-newstyle *swp .cabal-sandbox cabal.sandbox.config From 0cdb50bbb73303d62ed0463281c39edc66a296c9 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 9 Jan 2017 14:53:11 +0200 Subject: [PATCH 244/510] Revision 0.15.0~2 --- github.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/github.cabal b/github.cabal index e94a03fb..5d84cb89 100644 --- a/github.cabal +++ b/github.cabal @@ -1,5 +1,5 @@ name: github -x-revision: 1 +x-revision: 2 version: 0.15.0 synopsis: Access to the GitHub API, v3. description: From 2a3bf846b7429eb14f2055a76d54cde9392d5079 Mon Sep 17 00:00:00 2001 From: Abhinav Gupta Date: Wed, 25 Jan 2017 00:04:41 -0800 Subject: [PATCH 245/510] pulls: Update base and maintainer_can_modify GitHub added support for changing the base branch for a pull request and whether the maintainer can modify its contents or not. This adds the same to the `updatePullRequest` API. --- samples/Pulls/UpdatePull.hs | 8 +++++++- src/GitHub/Data/PullRequests.hs | 14 ++++++++++++-- 2 files changed, 19 insertions(+), 3 deletions(-) diff --git a/samples/Pulls/UpdatePull.hs b/samples/Pulls/UpdatePull.hs index 5900b59a..2c36021a 100644 --- a/samples/Pulls/UpdatePull.hs +++ b/samples/Pulls/UpdatePull.hs @@ -6,7 +6,13 @@ import Github.Data main :: IO () main = do - mergeResult <- Github.updatePullRequest (OAuth "authtoken") "repoOwner" "repoName" 22 (EditPullRequest { editPullRequestTitle = Just "Brand new title", editPullRequestBody = Nothing, editPullRequestState = Just EditPullRequestStateClosed }) + mergeResult <- Github.updatePullRequest (OAuth "authtoken") "repoOwner" "repoName" 22 EditPullRequest + { editPullRequestTitle = Just "Brand new title" + , editPullRequestBody = Nothing + , editPullRequestState = Just EditPullRequestStateClosed + , editPullRequestBase = Nothing + , editPullRequestMaintainerCanModify = Just True + } case mergeResult of (Left err) -> putStrLn $ "Error: " ++ (show err) (Right dpr) -> putStrLn . show $ dpr diff --git a/src/GitHub/Data/PullRequests.hs b/src/GitHub/Data/PullRequests.hs index 65f50f2f..c8ae83d3 100644 --- a/src/GitHub/Data/PullRequests.hs +++ b/src/GitHub/Data/PullRequests.hs @@ -90,6 +90,9 @@ data EditPullRequest = EditPullRequest { editPullRequestTitle :: !(Maybe Text) , editPullRequestBody :: !(Maybe Text) , editPullRequestState :: !(Maybe IssueState) + , editPullRequestBase :: !(Maybe Text) + , editPullRequestMaintainerCanModify + :: !(Maybe Bool) } deriving (Show, Generic) @@ -198,8 +201,15 @@ instance FromJSON SimplePullRequest where <*> o .: "id" instance ToJSON EditPullRequest where - toJSON (EditPullRequest t b s) = - object $ filter notNull [ "title" .= t, "body" .= b, "state" .= s ] + toJSON (EditPullRequest t b s base mcm) = + object $ filter notNull + [ "title" .= t + , "body" .= b + , "state" .= s + , "base" .= base + , "maintainer_can_modify" + .= mcm + ] where notNull (_, Null) = False notNull (_, _) = True From bb5b62363ebbf9baa36373f42f4e2a51e7862e2f Mon Sep 17 00:00:00 2001 From: NooB Date: Fri, 10 Feb 2017 16:49:50 +0900 Subject: [PATCH 246/510] Fix HTTP status code of merge PR --- src/GitHub/Data/PullRequests.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/GitHub/Data/PullRequests.hs b/src/GitHub/Data/PullRequests.hs index c8ae83d3..d5148d87 100644 --- a/src/GitHub/Data/PullRequests.hs +++ b/src/GitHub/Data/PullRequests.hs @@ -309,7 +309,7 @@ data MergeResult statusMerge :: StatusMap MergeResult statusMerge = - [ (204, MergeSuccessful) + [ (200, MergeSuccessful) , (405, MergeCannotPerform) , (409, MergeConflict) ] From 3d3e3c1d7b80d11154bcba7c64e89e118be2e368 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 21 Feb 2017 16:25:22 -0400 Subject: [PATCH 247/510] add back pullRequestsFor' Closes #266 --- src/GitHub/Endpoints/PullRequests.hs | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/src/GitHub/Endpoints/PullRequests.hs b/src/GitHub/Endpoints/PullRequests.hs index edb66509..bfea41c9 100644 --- a/src/GitHub/Endpoints/PullRequests.hs +++ b/src/GitHub/Endpoints/PullRequests.hs @@ -7,6 +7,7 @@ -- . module GitHub.Endpoints.PullRequests ( pullRequestsFor, + pullRequestsFor', pullRequestsForR, pullRequest', pullRequest, @@ -40,6 +41,13 @@ pullRequestsFor :: Name Owner -> Name Repo -> IO (Either Error (Vector SimplePul pullRequestsFor user repo = executeRequest' $ pullRequestsForR user repo mempty FetchAll +-- | All open pull requests for the repo, by owner and repo name. +-- +-- > pullRequestsFor "rails" "rails" +pullRequestsFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector SimplePullRequest)) +pullRequestsFor' auth user repo = + executeRequestMaybe auth $ pullRequestsForR user repo mempty FetchAll + -- | List pull requests. -- See pullRequestsForR From 37a610a93a3f6261ea4de3a827abfb751574cb9c Mon Sep 17 00:00:00 2001 From: iphydf Date: Sat, 25 Mar 2017 15:53:27 +0000 Subject: [PATCH 248/510] Add support for mergeable_state = "blocked". Fixes #269. --- src/GitHub/Data/Options.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/GitHub/Data/Options.hs b/src/GitHub/Data/Options.hs index ba27cdda..274d4b2a 100644 --- a/src/GitHub/Data/Options.hs +++ b/src/GitHub/Data/Options.hs @@ -95,6 +95,7 @@ data MergeableState | StateClean | StateDirty | StateUnstable + | StateBlocked deriving (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) @@ -103,13 +104,15 @@ instance ToJSON MergeableState where toJSON StateClean = String "clean" toJSON StateDirty = String "dirty" toJSON StateUnstable = String "unstable" + toJSON StateBlocked = String "blocked" instance FromJSON MergeableState where parseJSON (String "unknown") = pure StateUnknown parseJSON (String "clean") = pure StateClean parseJSON (String "dirty") = pure StateDirty parseJSON (String "unstable") = pure StateUnstable - parseJSON v = typeMismatch "MergeableState" v + parseJSON (String "blocked") = pure StateBlocked + parseJSON v = typeMismatch "MergeableState" v instance NFData MergeableState where rnf = genericRnf instance Binary MergeableState From e82c6070beb687078f17222e2722ddfb5f79cd4b Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 17 Apr 2017 14:45:39 +0300 Subject: [PATCH 249/510] Allow aeson-1.2 --- github.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/github.cabal b/github.cabal index 5d84cb89..75c11fca 100644 --- a/github.cabal +++ b/github.cabal @@ -122,7 +122,7 @@ Library -- Packages needed in order to build this package. build-depends: base >=4.7 && <4.10, - aeson >=0.7.0.6 && <1.2, + aeson >=0.7.0.6 && <1.3, base-compat >=0.9.1 && <0.10, base16-bytestring >=0.1.1.6 && <0.2, binary >=0.7.1.0 && <0.9, From 1796b736b7135326ef6fd6cc67a2c2aed45e729f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?F=C3=A9lix=20Baylac-Jacqu=C3=A9?= Date: Tue, 25 Apr 2017 13:29:42 +0200 Subject: [PATCH 250/510] Add support for user public events. Fix issue #273 --- github.cabal | 1 + spec/GitHub/EventsSpec.hs | 36 +++++++++++++++++++++++++ src/GitHub.hs | 2 +- src/GitHub/Endpoints/Activity/Events.hs | 7 +++++ 4 files changed, 45 insertions(+), 1 deletion(-) create mode 100644 spec/GitHub/EventsSpec.hs diff --git a/github.cabal b/github.cabal index 75c11fca..11d8b038 100644 --- a/github.cabal +++ b/github.cabal @@ -173,6 +173,7 @@ test-suite github-test GitHub.ReposSpec GitHub.SearchSpec GitHub.UsersSpec + GitHub.EventsSpec main-is: Spec.hs ghc-options: -Wall build-depends: base, diff --git a/spec/GitHub/EventsSpec.hs b/spec/GitHub/EventsSpec.hs new file mode 100644 index 00000000..93f613b1 --- /dev/null +++ b/spec/GitHub/EventsSpec.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE OverloadedStrings #-} +module GitHub.EventsSpec where + +import Data.Either (isRight) +import Data.String (fromString) +import Prelude () +import Prelude.Compat +import System.Environment (lookupEnv) +import Test.Hspec (Spec, describe, it, shouldSatisfy, + pendingWith) + +import qualified GitHub +import GitHub.Data (Auth(..)) + +fromRightS :: Show a => Either a b -> b +fromRightS (Left xs) = error $ "Should be Right" ++ show xs +fromRightS (Right xs) = xs + +withAuth :: (Auth -> IO ()) -> IO () +withAuth action = do + mtoken <- lookupEnv "GITHUB_TOKEN" + case mtoken of + Nothing -> pendingWith "no GITHUB_TOKEN" + Just token -> action (OAuth $ fromString token) + +spec :: Spec +spec = do + describe "repositoryEventsR" $ do + it "returns non empty list of events" $ shouldSucceed $ + GitHub.repositoryEventsR "phadej" "github" 1 + describe "userEventsR" $ do + it "returns non empty list of events" $ shouldSucceed $ GitHub.userEventsR "phadej" 1 + where shouldSucceed f = withAuth $ \auth -> do + cs <- GitHub.executeRequest auth $ f + cs `shouldSatisfy` isRight + length (fromRightS cs) `shouldSatisfy` (> 1) diff --git a/src/GitHub.hs b/src/GitHub.hs index 4d3187cb..f4528018 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -18,7 +18,7 @@ module GitHub ( -- ** Events -- | See https://developer.github.com/v3/activity/events/#events repositoryEventsR, - + userEventsR, -- ** Starring -- | See -- diff --git a/src/GitHub/Endpoints/Activity/Events.hs b/src/GitHub/Endpoints/Activity/Events.hs index 60d7834a..8074ab2a 100644 --- a/src/GitHub/Endpoints/Activity/Events.hs +++ b/src/GitHub/Endpoints/Activity/Events.hs @@ -7,6 +7,7 @@ module GitHub.Endpoints.Activity.Events ( -- * Events repositoryEventsR, + userEventsR, module GitHub.Data, ) where @@ -19,3 +20,9 @@ import Prelude () repositoryEventsR :: Name Owner -> Name Repo -> FetchCount -> Request 'RO (Vector Event) repositoryEventsR user repo = pagedQuery ["repos", toPathPart user, toPathPart repo, "events"] [] + +-- | List user public events. +-- See +userEventsR :: Name User -> FetchCount -> Request 'RO (Vector Event) +userEventsR user = + pagedQuery ["users", toPathPart user, "events", "public"] [] From 4b2c2b556636e792a84579f4c8ae6fb1a33fffa2 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sun, 4 Jun 2017 01:34:40 +0300 Subject: [PATCH 251/510] Prepare for 0.16.0 --- .gitignore | 1 + .travis.yml | 128 ++++++++++++++++++++++++++------------------- CHANGELOG.md | 5 ++ cabal.project | 3 ++ github.cabal | 11 ++-- stack-ghc-8.0.yaml | 101 ----------------------------------- stack-lts-2.yaml | 25 --------- stack-lts-3.yaml | 14 ----- stack-lts-4.yaml | 8 --- stack-lts-5.yaml | 6 --- stack-lts-6.yaml | 6 --- stack-lts-7.yaml | 6 --- stack-nightly.yaml | 11 ---- stack.yaml | 1 - travis-install.sh | 56 -------------------- travis-script.sh | 44 ---------------- 16 files changed, 88 insertions(+), 338 deletions(-) create mode 100644 cabal.project delete mode 100644 stack-ghc-8.0.yaml delete mode 100644 stack-lts-2.yaml delete mode 100644 stack-lts-3.yaml delete mode 100644 stack-lts-4.yaml delete mode 100644 stack-lts-5.yaml delete mode 100644 stack-lts-6.yaml delete mode 100644 stack-lts-7.yaml delete mode 100644 stack-nightly.yaml delete mode 120000 stack.yaml delete mode 100644 travis-install.sh delete mode 100644 travis-script.sh diff --git a/.gitignore b/.gitignore index 7a8fb579..5b3e088e 100644 --- a/.gitignore +++ b/.gitignore @@ -1,5 +1,6 @@ dist dist-newstyle +.ghc.environment.* *swp .cabal-sandbox cabal.sandbox.config diff --git a/.travis.yml b/.travis.yml index 17bb8048..34f8cfd6 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,77 +1,97 @@ -# This file has been generated -- see https://github.com/hvr/multi-ghc-travis +# This Travis job script has been generated by a script via +# +# make_travis_yml_2.hs 'github.cabal' +# +# For more information, see https://github.com/hvr/multi-ghc-travis +# language: c sudo: false +git: + submodules: false # whether to recursively clone submodules + cache: directories: - - $HOME/.cabsnap - $HOME/.cabal/packages - - $HOME/.stack + - $HOME/.cabal/store before_cache: - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log - - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.tar - -env: - global: - secure: "C2YwYhIClWJKjKQ1AfsHn0Py5+6WkA79Ny6bfR9JxQ10aT3sq5FcZt0ZfwutK0+jQ5F6c3+L0yJaNm8dp1+0MGK0ALDE3vx9ftJkXLp/5LwSdfeHHiMLFoQsSs3mGw9DirxiHbWlDzBKNfRi397Vckh0sfEGx/rEBIs5PS86wIU=" + # remove files that are regenerated by 'cabal update' + - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.* + - rm -fv $HOME/.cabal/packages/hackage.haskell.org/*.json + - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.cache + - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar + - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar.idx matrix: include: - - env: BUILD=cabal CABALVER=1.18 GHCVER=7.8.4 - compiler: ": #GHC 7.8.4" - addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4], sources: [hvr-ghc]}} - - env: BUILD=cabal CABALVER=1.22 GHCVER=7.10.3 - compiler: ": #GHC 7.10.3" - addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3], sources: [hvr-ghc]}} - - env: BUILD=cabal CABALVER=1.24 GHCVER=8.0.1 - compiler: ": #GHC 8.0.1" - addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.1], sources: [hvr-ghc]}} - - - env: BUILD=stack STACK_YAML=stack-lts-2.yaml GHCVER=7.8.4 - compiler: ": #STACK LTS2" - addons: {apt: {packages: [ghc-7.8.4], sources: [hvr-ghc]}} - - env: BUILD=stack STACK_YAML=stack-lts-3.yaml GHCVER=7.10.2 - compiler: ": #STACK LTS3" - addons: {apt: {packages: [ghc-7.10.2], sources: [hvr-ghc]}} - - env: BUILD=stack STACK_YAML=stack-lts-4.yaml GHCVER=7.10.3 - compiler: ": #STACK LTS4" - addons: {apt: {packages: [ghc-7.10.3], sources: [hvr-ghc]}} - - env: BUILD=stack STACK_YAML=stack-lts-5.yaml GHCVER=7.10.3 - compiler: ": #STACK LTS5" - addons: {apt: {packages: [ghc-7.10.3], sources: [hvr-ghc]}} - - env: BUILD=stack STACK_YAML=stack-lts-6.yaml GHCVER=7.10.3 - compiler: ": #STACK LTS6" - addons: {apt: {packages: [ghc-7.10.3], sources: [hvr-ghc]}} - - env: BUILD=stack STACK_YAML=stack-lts-7.yaml GHCVER=7.10.3 - compiler: ": #STACK LTS7" - addons: {apt: {packages: [ghc-8.0.1], sources: [hvr-ghc]}} - - env: BUILD=stack STACK_YAML=stack-nightly.yaml GHCVER=7.10.3 - compiler: ": #STACK nightly" - addons: {apt: {packages: [ghc-7.10.3], sources: [hvr-ghc]}} - - - env: BUILD=stack STACK_YAML=stack-lts-4.yaml - compiler: ": #stack LTS4 OSX" - os: osx - - - env: BUILD=stack-space-leak - compiler: ": #STACK - space leak" - addons: {apt: {packages: [ghc-7.10.3], sources: [hvr-ghc]}} + - compiler: "ghc-7.8.4" + # env: TEST=--disable-tests BENCH=--disable-benchmarks + addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.8.4], sources: [hvr-ghc]}} + - compiler: "ghc-7.10.3" + # env: TEST=--disable-tests BENCH=--disable-benchmarks + addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.10.3], sources: [hvr-ghc]}} + - compiler: "ghc-8.0.2" + # env: TEST=--disable-tests BENCH=--disable-benchmarks + addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.0.2], sources: [hvr-ghc]}} + - compiler: "ghc-8.2.1" + # env: TEST=--disable-tests BENCH=--disable-benchmarks + addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.2.1], sources: [hvr-ghc]}} before_install: - - unset CC - - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$HOME/.local/bin:$PATH + - HC=${CC} + - unset CC + - PATH=/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$PATH + - PKGNAME='github' install: - - sh travis-install.sh + - ROOTDIR=$(pwd) + - cabal --version + - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]" + - BENCH=${BENCH---enable-benchmarks} + - TEST=${TEST---enable-tests} + - travis_retry cabal update -v + - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config + - rm -fv cabal.project.local + - "echo 'packages: .' > cabal.project" + - rm -f cabal.project.freeze + - cabal new-build -w ${HC} ${TEST} ${BENCH} --dep -j2 all + - cabal new-build -w ${HC} --disable-tests --disable-benchmarks --dep -j2 all # Here starts the actual work to be performed for the package under test; # any command which exits with a non-zero exit code causes the build to fail. script: - - sh travis-script.sh + - if [ -f configure.ac ]; then autoreconf -i; fi + - rm -rf .ghc.environment.* dist/ + - cabal sdist # test that a source-distribution can be generated + - cd dist/ + - SRCTAR=(${PKGNAME}-*.tar.gz) + - SRC_BASENAME="${SRCTAR/%.tar.gz}" + - tar -xvf "./$SRC_BASENAME.tar.gz" + - cd "$SRC_BASENAME/" +## from here on, CWD is inside the extracted source-tarball + - rm -fv cabal.project.local + - "echo 'packages: . samples' > cabal.project" + - cp -r $ROOTDIR/samples . + # this builds all libraries and executables (without tests/benchmarks) + - rm -f cabal.project.freeze + - cabal new-build -w ${HC} --disable-tests --disable-benchmarks all + # this builds all libraries and executables (including tests/benchmarks) + # - rm -rf ./dist-newstyle -branches: - only: - - master + # build & run tests + - cabal new-build -w ${HC} ${TEST} ${BENCH} all + - if [ "x$TEST" = "x--enable-tests" ]; then cabal new-test -w ${HC} ${TEST} all; fi + + # run samples + - for sample in show-user list-followers list-following operational; do + echo "=== SAMPLE $sample ==="; + $(find dist-newstyle/ -type -f -name github-$sample); + done # EOF + +branches: + only: + - master diff --git a/CHANGELOG.md b/CHANGELOG.md index 1941a252..7acdf273 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,8 @@ +Changes for 0.16.0 +- Add support for `mergeable_state = "blocked".` +- Fix HTTP status code of merge PR +- Supports newest versions of dependencies + Changes for 0.15.0 - Reworked `PullRequest` (notably `pullRequestsFor`) diff --git a/cabal.project b/cabal.project new file mode 100644 index 00000000..7625ac15 --- /dev/null +++ b/cabal.project @@ -0,0 +1,3 @@ +packages: + "." + samples diff --git a/github.cabal b/github.cabal index 11d8b038..600c171c 100644 --- a/github.cabal +++ b/github.cabal @@ -1,6 +1,5 @@ name: github -x-revision: 2 -version: 0.15.0 +version: 0.16.0 synopsis: Access to the GitHub API, v3. description: The GitHub API provides programmatic access to the full @@ -26,7 +25,7 @@ homepage: https://github.com/phadej/github copyright: Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016 Oleg Grenrus category: Network build-type: Simple -tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.1 +tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.1 cabal-version: >=1.10 extra-source-files: README.md, @@ -121,11 +120,11 @@ Library GitHub.Request -- Packages needed in order to build this package. - build-depends: base >=4.7 && <4.10, + build-depends: base >=4.7 && <4.11, aeson >=0.7.0.6 && <1.3, base-compat >=0.9.1 && <0.10, base16-bytestring >=0.1.1.6 && <0.2, - binary >=0.7.1.0 && <0.9, + binary >=0.7.1.0 && <0.10, binary-orphans >=0.1.0.0 && <0.2, byteable >=0.1.1 && <0.2, bytestring >=0.10.4.0 && <0.11, @@ -144,7 +143,7 @@ Library network-uri >=2.6.0.3 && <2.7, semigroups >=0.16.2.2 && <0.19, text >=1.2.0.6 && <1.3, - time >=1.4 && <1.7, + time >=1.4 && <1.9, transformers >=0.3.0.0 && <0.6, transformers-compat >=0.4.0.3 && <0.6, unordered-containers >=0.2 && <0.3, diff --git a/stack-ghc-8.0.yaml b/stack-ghc-8.0.yaml deleted file mode 100644 index 90f9616d..00000000 --- a/stack-ghc-8.0.yaml +++ /dev/null @@ -1,101 +0,0 @@ -resolver: ghc-8.0.1 -packages: -- '.' -extra-deps: -- adjunctions-4.3 -- aeson-0.11.2.0 -- aeson-compat-0.3.3.0 -- ansi-terminal-0.6.2.3 -- asn1-encoding-0.9.3 -- asn1-parse-0.9.4 -- asn1-types-0.3.2 -- async-2.1.0 -- attoparsec-0.13.0.2 -- base-compat-0.9.1 -- base-orphans-0.5.4 -- base16-bytestring-0.1.1.6 -- base64-bytestring-1.0.0.1 -- bifunctors-5.3 -- binary-orphans-0.1.4.0 -- blaze-builder-0.4.0.2 -- byteable-0.1.1 -- bytestring-conversion-0.3.1 -- case-insensitive-1.2.0.6 -- cereal-0.5.1.0 -- comonad-5 -- connection-0.2.5 -- contravariant-1.4 -- cookie-0.4.2 -- cryptohash-0.11.9 -- cryptonite-0.15 -- data-default-class-0.0.1 -- deepseq-generics-0.2.0.0 -- distributive-0.5.0.2 -- dlist-0.7.1.2 -- double-conversion-2.0.1.0 -- errors-2.1.2 -- exceptions-0.8.2.1 -- fail-4.9.0.0 -- file-embed-0.0.10 -- free-4.12.4 -- hashable-1.2.4.0 -- hourglass-0.2.10 -- hspec-2.2.3 -- hspec-core-2.2.3 -- hspec-discover-2.2.3 -- hspec-expectations-0.7.2 -- http-client-0.4.28 -- http-client-tls-0.2.4 -- http-link-header-1.0.1 -- http-types-0.9 -- HUnit-1.3.1.1 -- iso8601-time-0.1.4 -- kan-extensions-5.0.1 -- keys-3.11 -- memory-0.12 -- mime-types-0.1.0.7 -- mtl-2.2.1 -- nats-1.1 -- network-2.6.2.1 -- network-uri-2.6.1.0 -- old-locale-1.0.0.7 -- parsec-3.1.11 -- pem-0.2.2 -- pointed-5 -- prelude-extras-0.4.0.3 -- primitive-0.6.1.0 -- profunctors-5.2 -- QuickCheck-2.8.2 -- quickcheck-io-0.1.2 -- random-1.1 -- safe-0.3.9 -- scientific-0.3.4.6 -- semigroupoids-5.0.1 -- semigroups-0.18.1 -- setenv-0.1.1.3 -- socks-0.5.5 -- StateVar-1.1.0.4 -- stm-2.4.4.1 -- streaming-commons-0.1.15.5 -- syb-0.6 -- tagged-0.8.4 -- text-1.2.2.1 -- text-binary-0.2.1 -- tf-random-0.5 -- time-locale-compat-0.1.1.1 -- tls-1.3.8 -- transformers-compat-0.5.1.4 -- unexceptionalio-0.3.0 -- unordered-containers-0.2.7.0 -- vector-0.11.0.0 -- vector-binary-instances-0.2.3.2 -- vector-instances-3.3.1 -- void-0.7.1 -- x509-1.6.3 -- x509-store-1.6.1 -- x509-system-1.6.3 -- x509-validation-1.6.3 -- zlib-0.6.1.1 -flags: - time-locale-compat: - old-locale: false diff --git a/stack-lts-2.yaml b/stack-lts-2.yaml deleted file mode 100644 index d909cd7e..00000000 --- a/stack-lts-2.yaml +++ /dev/null @@ -1,25 +0,0 @@ -resolver: lts-2.22 -packages: -- '.' -- samples/ -extra-deps: -- aeson-extra-0.2.3.0 -- asn1-parse-0.9.4 -- asn1-types-0.3.2 -- base-compat-0.9.1 -- binary-orphans-0.1.3.0 -- connection-0.2.5 -- cryptonite-0.15 -- http-link-header-1.0.1 -- iso8601-time-0.1.4 -- memory-0.12 -- tls-1.3.8 -- x509-1.6.3 -- x509-store-1.6.1 -- x509-system-1.6.3 -- x509-validation-1.6.3 -flags: - github: - aeson-compat: false - iso8601-time: - new-time: false diff --git a/stack-lts-3.yaml b/stack-lts-3.yaml deleted file mode 100644 index 5162f85f..00000000 --- a/stack-lts-3.yaml +++ /dev/null @@ -1,14 +0,0 @@ -resolver: lts-3.22 -packages: -- '.' -- samples/ -extra-deps: -- base-compat-0.9.1 -- cryptonite-0.15 -- http-link-header-1.0.1 -- iso8601-time-0.1.4 -- memory-0.12 -- tls-1.3.8 -flags: - github: - aeson-compat: false diff --git a/stack-lts-4.yaml b/stack-lts-4.yaml deleted file mode 100644 index ab1937e3..00000000 --- a/stack-lts-4.yaml +++ /dev/null @@ -1,8 +0,0 @@ -resolver: lts-4.2 -packages: -- '.' -- samples/ -extra-deps: -- base-compat-0.9.1 -- cryptonite-0.15 -- tls-1.3.8 diff --git a/stack-lts-5.yaml b/stack-lts-5.yaml deleted file mode 100644 index f09cb78c..00000000 --- a/stack-lts-5.yaml +++ /dev/null @@ -1,6 +0,0 @@ -resolver: lts-5.18 -packages: -- '.' -- samples/ -extra-deps: -- hsc2hs-0.68 diff --git a/stack-lts-6.yaml b/stack-lts-6.yaml deleted file mode 100644 index 119a9b1d..00000000 --- a/stack-lts-6.yaml +++ /dev/null @@ -1,6 +0,0 @@ -resolver: lts-6.23 -packages: -- '.' -- samples/ -extra-deps: -- hsc2hs-0.68 diff --git a/stack-lts-7.yaml b/stack-lts-7.yaml deleted file mode 100644 index 48ba555a..00000000 --- a/stack-lts-7.yaml +++ /dev/null @@ -1,6 +0,0 @@ -resolver: lts-7.7 -packages: -- '.' -- samples/ -extra-deps: -- hsc2hs-0.68 diff --git a/stack-nightly.yaml b/stack-nightly.yaml deleted file mode 100644 index 0511b9a1..00000000 --- a/stack-nightly.yaml +++ /dev/null @@ -1,11 +0,0 @@ -resolver: nightly-2016-09-14 -packages: -- '.' -- 'samples/' -extra-deps: -- aeson-1.0.0.0 -- http-client-0.5.3.1 -- http-client-tls-0.3.1 -flags: - github: - aeson-compat: true diff --git a/stack.yaml b/stack.yaml deleted file mode 120000 index 50e2a08c..00000000 --- a/stack.yaml +++ /dev/null @@ -1 +0,0 @@ -stack-lts-7.yaml \ No newline at end of file diff --git a/travis-install.sh b/travis-install.sh deleted file mode 100644 index 61fc1fd6..00000000 --- a/travis-install.sh +++ /dev/null @@ -1,56 +0,0 @@ -set -ex - -case $BUILD in - stack*) - mkdir -p ~/.local/bin; - if [ `uname` = "Darwin" ]; then - curl -kL https://www.stackage.org/stack/osx-x86_64 | tar xz --strip-components=1 --include '*/stack' -C ~/.local/bin; - else - curl -L https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack'; - fi - - stack --no-terminal setup - - if [ $BUILD == "stack-space-leak" ]; then - stack build --test --fast --library-profiling --ghc-options=-rtsopts --only-dependencies - else - stack --no-terminal test --only-dependencies - fi - ;; - cabal) - if [ -n "$STACKAGESNAPSHOT" ]; then - curl -sL https://www.stackage.org/$STACKAGESNAPSHOT/cabal.config | sed 's/constraints:/preferences:/' | grep -v installed > cabal.config - head cabal.config - fi - cabal --version - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]" - if [ -f $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz ]; then - zcat $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz > $HOME/.cabal/packages/hackage.haskell.org/00-index.tar - fi - cabal update -v - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config - cabal install --constraint="integer-simple installed" --only-dependencies --enable-tests --enable-benchmarks --dry -v > installplan.txt - sed -i -e '1,/^Resolving /d' installplan.txt; cat installplan.txt - - # check whether current requested install-plan matches cached package-db snapshot - if diff -u installplan.txt $HOME/.cabsnap/installplan.txt; then - echo "cabal build-cache HIT"; - rm -rfv .ghc; - cp -a $HOME/.cabsnap/ghc $HOME/.ghc; - cp -a $HOME/.cabsnap/lib $HOME/.cabsnap/share $HOME/.cabsnap/bin $HOME/.cabal/; - else - echo "cabal build-cache MISS"; - rm -rf $HOME/.cabsnap; - mkdir -p $HOME/.ghc $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin; - cabal install --constraint="integer-simple installed" --only-dependencies --enable-tests --enable-benchmarks; - fi - - # snapshot package-db on cache miss - if [ ! -d $HOME/.cabsnap ]; then - echo "snapshotting package-db to build-cache"; - mkdir $HOME/.cabsnap; - cp -a $HOME/.ghc $HOME/.cabsnap/ghc; - cp -a $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin installplan.txt $HOME/.cabsnap/; - fi - ;; -esac diff --git a/travis-script.sh b/travis-script.sh deleted file mode 100644 index ef51e715..00000000 --- a/travis-script.sh +++ /dev/null @@ -1,44 +0,0 @@ -set -ex - -SAMPLE_EXES="show-user list-followers list-following operational" - -case $BUILD in - stack) - stack --no-terminal test github - stack --no-terminal build github-samples - - for testbin in $SAMPLE_EXES; do - echo "Running " $testbin - stack exec github-$testbin - done - ;; - stack-space-leak) - stack --no-terminal test --fast --library-profiling --ghc-options=-rtsopts --test-arguments='+RTS -K1K' github - stack --no-terminal build --fast --library-profiling --ghc-options=-rtsopts --executable-profiling --test-arguments='+RTS -K1K' github-samples - - for testbin in $SAMPLE_EXES; do - echo "Running " $testbin - stack exec github-$testbin - done - ;; - cabal) - if [ -f configure.ac ]; then autoreconf -i; fi - cabal configure --constraint="integer-simple installed" --enable-tests --enable-benchmarks -v2 # -v2 provides useful information for debugging - cabal build # this builds all libraries and executables (including tests/benchmarks) - cabal test --show-details=always - - if [ "$CABALVER" = "1.22" ]; then cabal check; fi - if [ "$CABALVER" = "1.22" ]; then cabal haddock; fi - - cabal sdist # tests that a source-distribution can be generated - - # Check that the resulting source distribution can be built & installed. - # If there are no other `.tar.gz` files in `dist`, this can be even simpler: - # `cabal install --force-reinstalls dist/*-*.tar.gz` - export SRCPKG=$(cabal info . | awk '{print $2;exit}') - cd dist - tar -xzvf $SRCPKG.tar.gz - cd $SRCPKG - cabal configure --enable-tests && cabal build && cabal install --force-reinstalls - ;; -esac From 5a2785c2c51a941d57a8e067cfa8c5cff61bc3d1 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Wed, 28 Jun 2017 13:00:11 +0300 Subject: [PATCH 252/510] Correct github-samples.cabal --- samples/github-samples.cabal | 88 ---------------------------- samples/package.yaml | 108 ----------------------------------- 2 files changed, 196 deletions(-) delete mode 100644 samples/package.yaml diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index 228575c9..826c3e1e 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -1,7 +1,3 @@ --- This file has been generated from package.yaml by hpack version 0.14.1. --- --- see: https://github.com/sol/hpack - name: github-samples version: 0.0.0 build-type: Simple @@ -31,9 +27,6 @@ executable github-add-team-membership-for , github , text , github-samples - other-modules: - DeleteTeamMembershipFor - TeamMembershipInfoFor default-language: Haskell2010 executable github-create-deploy-key @@ -47,10 +40,6 @@ executable github-create-deploy-key , github , text , github-samples - other-modules: - DeleteDeployKey - ListDeployKeys - ShowDeployKey default-language: Haskell2010 executable github-delete-deploy-key @@ -64,10 +53,6 @@ executable github-delete-deploy-key , github , text , github-samples - other-modules: - CreateDeployKey - ListDeployKeys - ShowDeployKey default-language: Haskell2010 executable github-delete-team @@ -81,14 +66,6 @@ executable github-delete-team , github , text , github-samples - other-modules: - EditTeam - ListRepos - ListTeamsCurrent - Memberships.AddTeamMembershipFor - Memberships.DeleteTeamMembershipFor - Memberships.TeamMembershipInfoFor - TeamInfoFor default-language: Haskell2010 executable github-delete-team-membership-for @@ -102,9 +79,6 @@ executable github-delete-team-membership-for , github , text , github-samples - other-modules: - AddTeamMembershipFor - TeamMembershipInfoFor default-language: Haskell2010 executable github-edit-team @@ -118,14 +92,6 @@ executable github-edit-team , github , text , github-samples - other-modules: - DeleteTeam - ListRepos - ListTeamsCurrent - Memberships.AddTeamMembershipFor - Memberships.DeleteTeamMembershipFor - Memberships.TeamMembershipInfoFor - TeamInfoFor default-language: Haskell2010 executable github-list-deploy-keys-for @@ -140,10 +106,6 @@ executable github-list-deploy-keys-for , text , github-samples , vector - other-modules: - CreateDeployKey - DeleteDeployKey - ShowDeployKey default-language: Haskell2010 executable github-list-followers @@ -157,9 +119,6 @@ executable github-list-followers , github , text , github-samples - other-modules: - Example - ListFollowing default-language: Haskell2010 executable github-list-followers-example @@ -172,9 +131,6 @@ executable github-list-followers-example , base-compat , github , text - other-modules: - ListFollowers - ListFollowing default-language: Haskell2010 executable github-list-following @@ -188,9 +144,6 @@ executable github-list-following , github , text , github-samples - other-modules: - Example - ListFollowers default-language: Haskell2010 executable github-list-team-current @@ -204,14 +157,6 @@ executable github-list-team-current , github , text , github-samples - other-modules: - DeleteTeam - EditTeam - ListRepos - Memberships.AddTeamMembershipFor - Memberships.DeleteTeamMembershipFor - Memberships.TeamMembershipInfoFor - TeamInfoFor default-language: Haskell2010 executable github-list-team-repos @@ -225,14 +170,6 @@ executable github-list-team-repos , github , text , github-samples - other-modules: - DeleteTeam - EditTeam - ListTeamsCurrent - Memberships.AddTeamMembershipFor - Memberships.DeleteTeamMembershipFor - Memberships.TeamMembershipInfoFor - TeamInfoFor default-language: Haskell2010 executable github-operational @@ -264,10 +201,6 @@ executable github-show-deploy-key , github , text , github-samples - other-modules: - CreateDeployKey - DeleteDeployKey - ListDeployKeys default-language: Haskell2010 executable github-show-user @@ -281,11 +214,6 @@ executable github-show-user , github , text , github-samples - other-modules: - Followers.Example - Followers.ListFollowers - Followers.ListFollowing - ShowUser2 default-language: Haskell2010 executable github-show-user-2 @@ -299,11 +227,6 @@ executable github-show-user-2 , github , text , github-samples - other-modules: - Followers.Example - Followers.ListFollowers - Followers.ListFollowing - ShowUser default-language: Haskell2010 executable github-team-membership-info-for @@ -317,9 +240,6 @@ executable github-team-membership-info-for , github , text , github-samples - other-modules: - AddTeamMembershipFor - DeleteTeamMembershipFor default-language: Haskell2010 executable github-teaminfo-for @@ -333,12 +253,4 @@ executable github-teaminfo-for , github , text , github-samples - other-modules: - DeleteTeam - EditTeam - ListRepos - ListTeamsCurrent - Memberships.AddTeamMembershipFor - Memberships.DeleteTeamMembershipFor - Memberships.TeamMembershipInfoFor default-language: Haskell2010 diff --git a/samples/package.yaml b/samples/package.yaml deleted file mode 100644 index eae199e7..00000000 --- a/samples/package.yaml +++ /dev/null @@ -1,108 +0,0 @@ -name: github-samples - -ghc-options: -Wall - -dependencies: - - base - - base-compat - - github - - text - -library: - source-dirs: src - -executables: - github-show-user: - main: ShowUser.hs - source-dirs: Users - dependencies: - - github-samples - github-show-user-2: - main: ShowUser2.hs - source-dirs: Users - dependencies: - - github-samples - github-list-followers-example: - main: Example.hs - source-dirs: Users/Followers - github-list-followers: - main: ListFollowers.hs - source-dirs: Users/Followers - dependencies: - - github-samples - github-list-following: - main: ListFollowing.hs - source-dirs: Users/Followers - dependencies: - - github-samples - github-delete-team: - main: DeleteTeam.hs - source-dirs: Teams - dependencies: - - github-samples - github-edit-team: - main: EditTeam.hs - source-dirs: Teams - dependencies: - - github-samples - github-list-team-current: - main: ListTeamsCurrent.hs - source-dirs: Teams - dependencies: - - github-samples - github-list-team-repos: - main: ListRepos.hs - source-dirs: Teams - dependencies: - - github-samples - github-teaminfo-for: - main: TeamInfoFor.hs - source-dirs: Teams - dependencies: - - github-samples - github-add-team-membership-for: - main: AddTeamMembershipFor.hs - source-dirs: Teams/Memberships - dependencies: - - github-samples - github-delete-team-membership-for: - main: DeleteTeamMembershipFor.hs - source-dirs: Teams/Memberships - dependencies: - - github-samples - github-team-membership-info-for: - main: TeamMembershipInfoFor.hs - source-dirs: Teams/Memberships - dependencies: - - github-samples - github-operational: - main: Operational.hs - source-dirs: Operational - dependencies: - - github-samples - - http-client - - http-client-tls - - operational - - transformers - - transformers-compat - github-list-deploy-keys-for: - main: ListDeployKeys.hs - source-dirs: Repos/DeployKeys - dependencies: - - github-samples - - vector - github-show-deploy-key: - main: ShowDeployKey.hs - source-dirs: Repos/DeployKeys - dependencies: - - github-samples - github-create-deploy-key: - main: CreateDeployKey.hs - source-dirs: Repos/DeployKeys - dependencies: - - github-samples - github-delete-deploy-key: - main: DeleteDeployKey.hs - source-dirs: Repos/DeployKeys - dependencies: - - github-samples From 4e745b32fd27d157a880e7d2c073201bd78f6658 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Wed, 28 Jun 2017 16:33:11 +0300 Subject: [PATCH 253/510] Try to install hspec-discover --- .travis.yml | 2 ++ install-hspec-discover.sh | 18 ++++++++++++++++++ 2 files changed, 20 insertions(+) create mode 100644 install-hspec-discover.sh diff --git a/.travis.yml b/.travis.yml index 34f8cfd6..ed58cfcd 100644 --- a/.travis.yml +++ b/.travis.yml @@ -14,6 +14,7 @@ cache: directories: - $HOME/.cabal/packages - $HOME/.cabal/store + - $HOME/.local/bin before_cache: - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log @@ -53,6 +54,7 @@ install: - TEST=${TEST---enable-tests} - travis_retry cabal update -v - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config + - sh install-hspec-discover.sh # TEMP, before we get cabal new-install - rm -fv cabal.project.local - "echo 'packages: .' > cabal.project" - rm -f cabal.project.freeze diff --git a/install-hspec-discover.sh b/install-hspec-discover.sh new file mode 100644 index 00000000..17a3a34a --- /dev/null +++ b/install-hspec-discover.sh @@ -0,0 +1,18 @@ +#!/bin/sh + +set -ex + +if [ ! -e $HOME/.local/bin/hspec-discover ]; then + # Fetch the source + cabal get hspec-discover-2.4.4 + cd hspec-discover-2.4.4 + + # Set-up project + echo 'packages: .' > cabal.project + + # build exe + cabal new-build hspec-discover:exe:hspec-discover + + # copy executable to $HOME/.local/bin + cp $(find dist-newstyle -name hspec-discover -type f) $HOME/.local/bin +fi From f837951a48dee4b98af09084ba1f72e05248c686 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Wed, 28 Jun 2017 23:54:03 +0300 Subject: [PATCH 254/510] -type -f -> -type f --- .travis.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index ed58cfcd..82db014c 100644 --- a/.travis.yml +++ b/.travis.yml @@ -89,7 +89,7 @@ script: # run samples - for sample in show-user list-followers list-following operational; do echo "=== SAMPLE $sample ==="; - $(find dist-newstyle/ -type -f -name github-$sample); + $(find dist-newstyle/ -type f -name github-$sample); done # EOF From b593ddb5ab177e9fd2d4ccad1958c04de14993dd Mon Sep 17 00:00:00 2001 From: Kranium Gikos Mendoza Date: Sun, 18 Jun 2017 22:31:51 +1000 Subject: [PATCH 255/510] implement read-only calls for releases endpoint --- github.cabal | 5 +- spec/GitHub/ReleasesSpec.hs | 54 ++++++++++++ src/GitHub.hs | 7 ++ src/GitHub/Data.hs | 2 + src/GitHub/Data/Releases.hs | 85 +++++++++++++++++++ src/GitHub/Endpoints/Repos/Releases.hs | 110 +++++++++++++++++++++++++ 6 files changed, 262 insertions(+), 1 deletion(-) create mode 100644 spec/GitHub/ReleasesSpec.hs create mode 100644 src/GitHub/Data/Releases.hs create mode 100644 src/GitHub/Endpoints/Repos/Releases.hs diff --git a/github.cabal b/github.cabal index 600c171c..e67d0ab6 100644 --- a/github.cabal +++ b/github.cabal @@ -81,6 +81,7 @@ Library GitHub.Data.Name GitHub.Data.Options GitHub.Data.PullRequests + GitHub.Data.Releases GitHub.Data.Repos GitHub.Data.Request GitHub.Data.Search @@ -111,9 +112,10 @@ Library GitHub.Endpoints.Repos.Collaborators GitHub.Endpoints.Repos.Comments GitHub.Endpoints.Repos.Commits + GitHub.Endpoints.Repos.DeployKeys GitHub.Endpoints.Repos.Forks + GitHub.Endpoints.Repos.Releases GitHub.Endpoints.Repos.Webhooks - GitHub.Endpoints.Repos.DeployKeys GitHub.Endpoints.Search GitHub.Endpoints.Users GitHub.Endpoints.Users.Followers @@ -169,6 +171,7 @@ test-suite github-test GitHub.OrganizationsSpec GitHub.IssuesSpec GitHub.PullRequestsSpec + GitHub.ReleasesSpec GitHub.ReposSpec GitHub.SearchSpec GitHub.UsersSpec diff --git a/spec/GitHub/ReleasesSpec.hs b/spec/GitHub/ReleasesSpec.hs new file mode 100644 index 00000000..db01348f --- /dev/null +++ b/spec/GitHub/ReleasesSpec.hs @@ -0,0 +1,54 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +module GitHub.ReleasesSpec where + +import qualified GitHub + +import GitHub.Auth (Auth (..)) +import GitHub.Endpoints.Repos.Releases + (Release (..), latestReleaseR, releaseByTagNameR, releaseR, releasesR) +import GitHub.Request (executeRequest) + +import Data.Either.Compat (isRight) +import Data.Proxy (Proxy (..)) +import Data.String (fromString) +import System.Environment (lookupEnv) +import Test.Hspec + (Spec, describe, it, pendingWith, shouldBe, shouldSatisfy) + +import qualified Data.Vector as V + +fromRightS :: Show a => Either a b -> b +fromRightS (Right b) = b +fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a + +withAuth :: (Auth -> IO ()) -> IO () +withAuth action = do + mtoken <- lookupEnv "GITHUB_TOKEN" + case mtoken of + Nothing -> pendingWith "no GITHUB_TOKEN" + Just token -> action (OAuth $ fromString token) + +spec :: Spec +spec = do + let v154Id = GitHub.mkId (Proxy :: Proxy Release) 5254449 + v154Text = "v1.5.4" + describe "releasesR" $ do + it "works" $ withAuth $ \auth -> do + rs <- executeRequest auth $ releasesR "calleerlandsson" "pick" GitHub.FetchAll + rs `shouldSatisfy` isRight + V.length (fromRightS rs) `shouldSatisfy` (> 14) + describe "releaseR" $ do + it "works" $ withAuth $ \auth -> do + rs <- executeRequest auth $ releaseR "calleerlandsson" "pick" v154Id + rs `shouldSatisfy` isRight + releaseTagName (fromRightS rs)`shouldBe` v154Text + describe "latestReleaseR" $ do + it "works" $ withAuth $ \auth -> do + rs <- executeRequest auth $ latestReleaseR "calleerlandsson" "pick" + rs `shouldSatisfy` isRight + describe "releaseByTagNameR" $ do + it "works" $ withAuth $ \auth -> do + rs <- executeRequest auth $ releaseByTagNameR "calleerlandsson" "pick" v154Text + rs `shouldSatisfy` isRight + releaseId (fromRightS rs)`shouldBe` v154Id diff --git a/src/GitHub.hs b/src/GitHub.hs index f4528018..e45282e6 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -270,6 +270,12 @@ module GitHub ( pingRepoWebhookR, deleteRepoWebhookR, + -- * Releases + releasesR, + releaseR, + latestReleaseR, + releaseByTagNameR, + -- * Search -- | See -- @@ -334,6 +340,7 @@ import GitHub.Endpoints.Repos.Collaborators import GitHub.Endpoints.Repos.Comments import GitHub.Endpoints.Repos.Commits import GitHub.Endpoints.Repos.Forks +import GitHub.Endpoints.Repos.Releases import GitHub.Endpoints.Repos.Webhooks import GitHub.Endpoints.Search import GitHub.Endpoints.Users diff --git a/src/GitHub/Data.hs b/src/GitHub/Data.hs index f11aa450..e318313f 100644 --- a/src/GitHub/Data.hs +++ b/src/GitHub/Data.hs @@ -43,6 +43,7 @@ module GitHub.Data ( module GitHub.Data.Milestone, module GitHub.Data.Options, module GitHub.Data.PullRequests, + module GitHub.Data.Releases, module GitHub.Data.Repos, module GitHub.Data.Request, module GitHub.Data.Search, @@ -69,6 +70,7 @@ import GitHub.Data.Milestone import GitHub.Data.Name import GitHub.Data.Options import GitHub.Data.PullRequests +import GitHub.Data.Releases import GitHub.Data.Repos import GitHub.Data.Request import GitHub.Data.Search diff --git a/src/GitHub/Data/Releases.hs b/src/GitHub/Data/Releases.hs new file mode 100644 index 00000000..582b524c --- /dev/null +++ b/src/GitHub/Data/Releases.hs @@ -0,0 +1,85 @@ +module GitHub.Data.Releases where + +import GitHub.Data.Definitions +import GitHub.Data.Id (Id) +import GitHub.Data.URL (URL) +import GitHub.Internal.Prelude +import Prelude () + +data Release = Release + { releaseUrl :: !URL + , releaseHtmlUrl :: !URL + , releaseAssetsurl :: !URL + , releaseUploadUrl :: !URL + , releaseTarballUrl :: !URL + , releaseZipballUrl :: !URL + , releaseId :: !(Id Release) + , releaseTagName :: !Text + , releaseTargetCommitish :: !Text + , releaseName :: !Text + , releaseBody :: !Text + , releaseDraft :: !Bool + , releasePrerelease :: !Bool + , releaseCreatedAt :: !UTCTime + , releasePublishedAt :: !(Maybe UTCTime) + , releaseAuthor :: !SimpleUser + , releaseAssets :: !(Vector ReleaseAsset) + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance FromJSON Release where + parseJSON = withObject "Event" $ \o -> Release + <$> o .: "url" + <*> o .: "html_url" + <*> o .: "assets_url" + <*> o .: "upload_url" + <*> o .: "tarball_url" + <*> o .: "zipball_url" + <*> o .: "id" + <*> o .: "tag_name" + <*> o .: "target_commitish" + <*> o .: "name" + <*> o .: "body" + <*> o .: "draft" + <*> o .: "prerelease" + <*> o .: "created_at" + <*> o .:? "published_at" + <*> o .: "author" + <*> o .: "assets" + +instance NFData Release where rnf = genericRnf +instance Binary Release + +data ReleaseAsset = ReleaseAsset + { releaseAssetUrl :: !URL + , releaseAssetBrowserDownloadUrl :: !Text + , releaseAssetId :: !(Id ReleaseAsset) + , releaseAssetName :: !Text + , releaseAssetLabel :: !(Maybe Text) + , releaseAssetState :: !Text + , releaseAssetContentType :: !Text + , releaseAssetSize :: !Int + , releaseAssetDownloadCount :: !Int + , releaseAssetCreatedAt :: !UTCTime + , releaseAssetUpdatedAt :: !UTCTime + , releaseAssetUploader :: !SimpleUser + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance FromJSON ReleaseAsset where + parseJSON = withObject "Event" $ \o -> ReleaseAsset + <$> o .: "url" + <*> o .: "browser_download_url" + <*> o .: "id" + <*> o .: "name" + <*> o .:? "label" + <*> o .: "state" + <*> o .: "content_type" + <*> o .: "size" + <*> o .: "download_count" + <*> o .: "created_at" + <*> o .: "updated_at" + <*> o .: "uploader" + +instance NFData ReleaseAsset where rnf = genericRnf +instance Binary ReleaseAsset diff --git a/src/GitHub/Endpoints/Repos/Releases.hs b/src/GitHub/Endpoints/Repos/Releases.hs new file mode 100644 index 00000000..462060f4 --- /dev/null +++ b/src/GitHub/Endpoints/Repos/Releases.hs @@ -0,0 +1,110 @@ +-- The Release API, as described at +-- . +module GitHub.Endpoints.Repos.Releases ( + releases, + releases', + releasesR, + release, + release', + releaseR, + latestRelease, + latestRelease', + latestReleaseR, + releaseByTagName, + releaseByTagName', + releaseByTagNameR, + module GitHub.Data, + ) where + +import GitHub.Data +import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () + +-- | All releases for the given repo. +-- +-- > releases "calleerlandsson" "pick" +releases :: Name Owner -> Name Repo -> IO (Either Error (Vector Release)) +releases = releases' Nothing + +-- | All releases for the given repo with authentication. +-- +-- > releases' (Just (User (user, password))) "calleerlandsson" "pick" +releases' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Release)) +releases' auth user repo = + executeRequestMaybe auth $ releasesR user repo FetchAll + +-- | List releases for a repository. +-- See +releasesR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Release) +releasesR user repo = + pagedQuery ["repos", toPathPart user, toPathPart repo, "releases"] [] + +-- | Query a single release. +-- +-- > release "calleerlandsson" "pick" +release :: Name Owner -> Name Repo -> Id Release -> IO (Either Error Release) +release = release' Nothing + +-- | Query a single release with authentication. +-- +-- > release' (Just (User (user, password))) "calleerlandsson" "pick" +release' :: Maybe Auth -> Name Owner -> Name Repo -> Id Release -> IO (Either Error Release) +release' auth user repo reqReleaseId = + executeRequestMaybe auth $ releaseR user repo reqReleaseId + +-- | Get a single release. +-- See +releaseR :: Name Owner -> Name Repo -> Id Release -> Request k Release +releaseR user repo reqReleaseId = + query ["repos", toPathPart user, toPathPart repo, "releases", toPathPart reqReleaseId ] [] + +-- | Query latest release. +-- +-- > latestRelease "calleerlandsson" "pick" +latestRelease :: Name Owner -> Name Repo -> IO (Either Error Release) +latestRelease = latestRelease' Nothing + +-- | Query latest release with authentication. +-- +-- > latestRelease' (Just (User (user, password))) "calleerlandsson" "pick" +latestRelease' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error Release) +latestRelease' auth user repo = + executeRequestMaybe auth $ latestReleaseR user repo + +-- | Get the latest release. +-- See +latestReleaseR :: Name Owner -> Name Repo -> Request k Release +latestReleaseR user repo = + query ["repos", toPathPart user, toPathPart repo, "releases", "latest" ] [] + +-- | Query release by tag name. +-- +-- > releaseByTagName "calleerlandsson" "pick" +releaseByTagName :: Name Owner -> Name Repo -> Text -> IO (Either Error Release) +releaseByTagName = releaseByTagName' Nothing + +-- | Query release by tag name with authentication. +-- +-- > releaseByTagName' (Just (User (user, password))) "calleerlandsson" "pick" +releaseByTagName' :: Maybe Auth -> Name Owner -> Name Repo -> Text -> IO (Either Error Release) +releaseByTagName' auth user repo reqTagName = + executeRequestMaybe auth $ releaseByTagNameR user repo reqTagName + +-- | Get a release by tag name +-- See +releaseByTagNameR :: Name Owner -> Name Repo -> Text -> Request k Release +releaseByTagNameR user repo reqTagName = + query ["repos", toPathPart user, toPathPart repo, "releases", "tags" , reqTagName ] [] + +{- +-- TODO: implement the following: + https://developer.github.com/v3/repos/releases/#create-a-release + https://developer.github.com/v3/repos/releases/#edit-a-release + https://developer.github.com/v3/repos/releases/#delete-a-release + https://developer.github.com/v3/repos/releases/#list-assets-for-a-release + https://developer.github.com/v3/repos/releases/#upload-a-release-asset + https://developer.github.com/v3/repos/releases/#get-a-single-release-asset + https://developer.github.com/v3/repos/releases/#edit-a-release-asset + https://developer.github.com/v3/repos/releases/#delete-a-release-asset +-} From 0c3be03a612e6941a745a367256cf476e428edcc Mon Sep 17 00:00:00 2001 From: Erik de Castro Lopo Date: Fri, 14 Jul 2017 19:39:46 +1000 Subject: [PATCH 256/510] Add function forkExistingRepoR Closes: https://github.com/phadej/github/issues/280 --- src/GitHub/Endpoints/Repos.hs | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/src/GitHub/Endpoints/Repos.hs b/src/GitHub/Endpoints/Repos.hs index b16ae23a..7eddfb2e 100644 --- a/src/GitHub/Endpoints/Repos.hs +++ b/src/GitHub/Endpoints/Repos.hs @@ -42,6 +42,7 @@ module GitHub.Endpoints.Repos ( createRepoR, createOrganizationRepo', createOrganizationRepoR, + forkExistingRepoR, -- ** Edit editRepo, @@ -172,6 +173,13 @@ createRepoR :: NewRepo -> Request 'RW Repo createRepoR nrepo = command Post ["user", "repos"] (encode nrepo) +-- | Fork an existing repository. +-- See +-- TODO: The third paramater (an optional Organisation) is not used yet. +forkExistingRepoR :: Name Owner -> Name Repo -> Maybe (Name Owner) -> Request 'RW Repo +forkExistingRepoR owner repo _morg = + command Post ["repos", toPathPart owner, toPathPart repo, "forks" ] mempty + -- | Create a new repository for an organization. -- -- > createOrganizationRepo (BasicAuth (user, password)) "thoughtbot" (newRepo "some_repo") {newRepoHasIssues = Just False} From c4f867ebe2e600176fc3170021e419340ee2cfc6 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 24 Jul 2017 18:00:24 +0300 Subject: [PATCH 257/510] Update changelog --- CHANGELOG.md | 3 +++ 1 file changed, 3 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 7acdf273..42c63088 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,9 @@ Changes for 0.16.0 - Add support for `mergeable_state = "blocked".` - Fix HTTP status code of merge PR - Supports newest versions of dependencies +- user events +- release endpoints +- forkExistingRepo Changes for 0.15.0 From be96fe66a4cfcc3f3318280ae169a86bd1d48da1 Mon Sep 17 00:00:00 2001 From: Scott Fleischman Date: Mon, 10 Jul 2017 17:15:37 -0700 Subject: [PATCH 258/510] Move current repos/contents API endpoints to GitHub.Endpoints.Repos.Contents. --- github.cabal | 1 + src/GitHub/Endpoints/Repos.hs | 49 --------------------- src/GitHub/Endpoints/Repos/Contents.hs | 59 ++++++++++++++++++++++++++ 3 files changed, 60 insertions(+), 49 deletions(-) create mode 100644 src/GitHub/Endpoints/Repos/Contents.hs diff --git a/github.cabal b/github.cabal index e67d0ab6..304cf918 100644 --- a/github.cabal +++ b/github.cabal @@ -112,6 +112,7 @@ Library 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 diff --git a/src/GitHub/Endpoints/Repos.hs b/src/GitHub/Endpoints/Repos.hs index 7eddfb2e..e9261db3 100644 --- a/src/GitHub/Endpoints/Repos.hs +++ b/src/GitHub/Endpoints/Repos.hs @@ -32,10 +32,6 @@ module GitHub.Endpoints.Repos ( branchesFor, branchesFor', branchesForR, - contentsFor, - contentsFor', - readmeFor, - readmeFor', -- ** Create createRepo', @@ -61,8 +57,6 @@ import GitHub.Internal.Prelude 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")] @@ -323,49 +317,6 @@ branchesForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Branc 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. -- -- > deleteRepo (BasicAuth (user, password)) "thoughtbot" "some_repo" diff --git a/src/GitHub/Endpoints/Repos/Contents.hs b/src/GitHub/Endpoints/Repos/Contents.hs new file mode 100644 index 00000000..20ccf8c9 --- /dev/null +++ b/src/GitHub/Endpoints/Repos/Contents.hs @@ -0,0 +1,59 @@ +module GitHub.Endpoints.Repos.Contents ( + -- * Querying repositories + contentsFor, + contentsFor', + contentsForR, + readmeFor, + readmeFor', + readmeForR + ) 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"] [] From fab9d74360f8d73ffc96c78b063d2748d61bd10b Mon Sep 17 00:00:00 2001 From: Scott Fleischman Date: Mon, 10 Jul 2017 18:10:19 -0700 Subject: [PATCH 259/510] Add create/update/delete file endpoints. --- src/GitHub/Data/Content.hs | 107 +++++++++++++++++++++++++ src/GitHub/Endpoints/Repos/Contents.hs | 83 ++++++++++++++++++- 2 files changed, 188 insertions(+), 2 deletions(-) diff --git a/src/GitHub/Data/Content.hs b/src/GitHub/Data/Content.hs index 9c17b81e..819c572b 100644 --- a/src/GitHub/Data/Content.hs +++ b/src/GitHub/Data/Content.hs @@ -55,6 +55,55 @@ data ContentInfo = ContentInfo { instance NFData ContentInfo where rnf = genericRnf instance Binary ContentInfo +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 +136,61 @@ instance FromJSON ContentInfo where <*> o .: "url" <*> o .: "git_url" <*> o .: "html_url" + +instance ToJSON Author where + toJSON (Author { authorName = name + , authorEmail = email + }) = object + [ "name" .= name + , "email" .= email + ] + +instance ToJSON CreateFile where + toJSON (CreateFile { createFilePath = path + , createFileMessage = message + , createFileContent = content + , createFileBranch = branch + , createFileAuthor = author + , createFileCommitter = committer + }) = object + [ "path" .= path + , "message" .= message + , "content" .= content + , "branch" .= branch + , "author" .= author + , "committer" .= committer + ] + +instance ToJSON UpdateFile where + toJSON (UpdateFile { updateFilePath = path + , updateFileMessage = message + , updateFileContent = content + , updateFileSHA = sha + , updateFileBranch = branch + , updateFileAuthor = author + , updateFileCommitter = committer + }) = object + [ "path" .= path + , "message" .= message + , "content" .= content + , "sha" .= sha + , "branch" .= branch + , "author" .= author + , "committer" .= committer + ] + +instance ToJSON DeleteFile where + toJSON (DeleteFile { deleteFilePath = path + , deleteFileMessage = message + , deleteFileSHA = sha + , deleteFileBranch = branch + , deleteFileAuthor = author + , deleteFileCommitter = committer + }) = object + [ "path" .= path + , "message" .= message + , "sha" .= sha + , "branch" .= branch + , "author" .= author + , "committer" .= committer + ] diff --git a/src/GitHub/Endpoints/Repos/Contents.hs b/src/GitHub/Endpoints/Repos/Contents.hs index 20ccf8c9..bb54d8f9 100644 --- a/src/GitHub/Endpoints/Repos/Contents.hs +++ b/src/GitHub/Endpoints/Repos/Contents.hs @@ -1,11 +1,30 @@ +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +-- The Github Repo Contents API, as documented at +-- module GitHub.Endpoints.Repos.Contents ( - -- * Querying repositories + -- * Querying contents contentsFor, contentsFor', contentsForR, readmeFor, readmeFor', - readmeForR + readmeForR, + + -- ** Create + createFile, + createFileR, + + -- ** Update + updateFile, + updateFileR, + + -- ** Delete + deleteFile, + deleteFileR ) where import GitHub.Data @@ -57,3 +76,63 @@ readmeFor' auth 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 Content) +createFile auth user repo body = + executeRequest auth $ createFileR user repo body + +-- | Create a file. +-- See +createFileR + :: Name Owner + -> Name Repo + -> CreateFile + -> Request 'RW Content +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 Content) +updateFile auth user repo body = + executeRequest auth $ updateFileR user repo body + +-- | Update a file. +-- See +updateFileR + :: Name Owner + -> Name Repo + -> UpdateFile + -> Request 'RW Content +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) From 00c5f30c56fd382460e9e77c49823e5768f016a7 Mon Sep 17 00:00:00 2001 From: Scott Fleischman Date: Tue, 11 Jul 2017 07:54:56 -0700 Subject: [PATCH 260/510] Export module GitHub.Data from GitHub.Endpoints.Repos.Contents. --- src/GitHub/Endpoints/Repos/Contents.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/GitHub/Endpoints/Repos/Contents.hs b/src/GitHub/Endpoints/Repos/Contents.hs index bb54d8f9..c5697cb8 100644 --- a/src/GitHub/Endpoints/Repos/Contents.hs +++ b/src/GitHub/Endpoints/Repos/Contents.hs @@ -24,7 +24,9 @@ module GitHub.Endpoints.Repos.Contents ( -- ** Delete deleteFile, - deleteFileR + deleteFileR, + + module GitHub.Data ) where import GitHub.Data From 1cae1e2ac6e63c0eec3e5df53432c650a9e12c9f Mon Sep 17 00:00:00 2001 From: Scott Fleischman Date: Tue, 11 Jul 2017 08:10:40 -0700 Subject: [PATCH 261/510] Fix result type for content file endpoints. --- src/GitHub/Data/Content.hs | 16 ++++++++++++++++ src/GitHub/Endpoints/Repos/Contents.hs | 8 ++++---- 2 files changed, 20 insertions(+), 4 deletions(-) diff --git a/src/GitHub/Data/Content.hs b/src/GitHub/Data/Content.hs index 819c572b..62a68727 100644 --- a/src/GitHub/Data/Content.hs +++ b/src/GitHub/Data/Content.hs @@ -5,6 +5,7 @@ -- module GitHub.Data.Content where +import GitHub.Data.GitData import GitHub.Data.URL import GitHub.Internal.Prelude import Prelude () @@ -55,6 +56,15 @@ data ContentInfo = ContentInfo { instance NFData ContentInfo where rnf = genericRnf instance Binary ContentInfo +data ContentResult = ContentResult + { contentResultInfo :: !ContentInfo + , contentResultSize :: !Int + , contentResultCommit :: !Commit + } deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData ContentResult where rnf = genericRnf +instance Binary ContentResult + data Author = Author { authorName :: !Text , authorEmail :: !Text @@ -137,6 +147,12 @@ instance FromJSON ContentInfo where <*> o .: "git_url" <*> o .: "html_url" +instance FromJSON ContentResult where + parseJSON = withObject "ContentResult" $ \o -> + ContentResult <$> parseJSON (Object o) + <*> o .: "size" + <*> o .: "commit" + instance ToJSON Author where toJSON (Author { authorName = name , authorEmail = email diff --git a/src/GitHub/Endpoints/Repos/Contents.hs b/src/GitHub/Endpoints/Repos/Contents.hs index c5697cb8..98c292a9 100644 --- a/src/GitHub/Endpoints/Repos/Contents.hs +++ b/src/GitHub/Endpoints/Repos/Contents.hs @@ -85,7 +85,7 @@ createFile -> Name Owner -- ^ owner -> Name Repo -- ^ repository name -> CreateFile - -> IO (Either Error Content) + -> IO (Either Error ContentResult) createFile auth user repo body = executeRequest auth $ createFileR user repo body @@ -95,7 +95,7 @@ createFileR :: Name Owner -> Name Repo -> CreateFile - -> Request 'RW Content + -> Request 'RW ContentResult createFileR user repo body = command Put ["repos", toPathPart user, toPathPart repo, "contents", createFilePath body] (encode body) @@ -105,7 +105,7 @@ updateFile -> Name Owner -- ^ owner -> Name Repo -- ^ repository name -> UpdateFile - -> IO (Either Error Content) + -> IO (Either Error ContentResult) updateFile auth user repo body = executeRequest auth $ updateFileR user repo body @@ -115,7 +115,7 @@ updateFileR :: Name Owner -> Name Repo -> UpdateFile - -> Request 'RW Content + -> Request 'RW ContentResult updateFileR user repo body = command Put ["repos", toPathPart user, toPathPart repo, "contents", updateFilePath body] (encode body) From bf73c80cccfd220f6888b201b4a290a7a02e2d54 Mon Sep 17 00:00:00 2001 From: Scott Fleischman Date: Tue, 11 Jul 2017 10:40:30 -0700 Subject: [PATCH 262/510] Fix repo content endpoint result types. --- src/GitHub/Data/Content.hs | 21 ++++++++++++++++----- 1 file changed, 16 insertions(+), 5 deletions(-) diff --git a/src/GitHub/Data/Content.hs b/src/GitHub/Data/Content.hs index 62a68727..89a8c1ba 100644 --- a/src/GitHub/Data/Content.hs +++ b/src/GitHub/Data/Content.hs @@ -56,10 +56,17 @@ data ContentInfo = ContentInfo { 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 - { contentResultInfo :: !ContentInfo - , contentResultSize :: !Int - , contentResultCommit :: !Commit + { contentResultContent :: !ContentResultInfo + , contentResultCommit :: !GitCommit } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData ContentResult where rnf = genericRnf @@ -147,10 +154,14 @@ instance FromJSON ContentInfo where <*> 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 <$> parseJSON (Object o) - <*> o .: "size" + ContentResult <$> o .: "content" <*> o .: "commit" instance ToJSON Author where From 330739da9d2b6eef7eb671272a146090afeeb91a Mon Sep 17 00:00:00 2001 From: Scott Fleischman Date: Tue, 11 Jul 2017 11:13:33 -0700 Subject: [PATCH 263/510] Omit Nothing values from resulting JSON. --- src/GitHub/Data/Content.hs | 29 +++++++++++++++++------------ 1 file changed, 17 insertions(+), 12 deletions(-) diff --git a/src/GitHub/Data/Content.hs b/src/GitHub/Data/Content.hs index 89a8c1ba..f4d6a7e5 100644 --- a/src/GitHub/Data/Content.hs +++ b/src/GitHub/Data/Content.hs @@ -5,6 +5,8 @@ -- module GitHub.Data.Content where +import Data.Aeson.Types (KeyValue) +import Data.Maybe (maybe) import GitHub.Data.GitData import GitHub.Data.URL import GitHub.Internal.Prelude @@ -179,14 +181,14 @@ instance ToJSON CreateFile where , createFileBranch = branch , createFileAuthor = author , createFileCommitter = committer - }) = object + }) = object $ [ "path" .= path , "message" .= message , "content" .= content - , "branch" .= branch - , "author" .= author - , "committer" .= committer ] + ++ "branch" .=? branch + ++ "author" .=? author + ++ "committer" .=? committer instance ToJSON UpdateFile where toJSON (UpdateFile { updateFilePath = path @@ -196,15 +198,15 @@ instance ToJSON UpdateFile where , updateFileBranch = branch , updateFileAuthor = author , updateFileCommitter = committer - }) = object + }) = object $ [ "path" .= path , "message" .= message , "content" .= content , "sha" .= sha - , "branch" .= branch - , "author" .= author - , "committer" .= committer ] + ++ "branch" .=? branch + ++ "author" .=? author + ++ "committer" .=? committer instance ToJSON DeleteFile where toJSON (DeleteFile { deleteFilePath = path @@ -213,11 +215,14 @@ instance ToJSON DeleteFile where , deleteFileBranch = branch , deleteFileAuthor = author , deleteFileCommitter = committer - }) = object + }) = object $ [ "path" .= path , "message" .= message , "sha" .= sha - , "branch" .= branch - , "author" .= author - , "committer" .= committer ] + ++ "branch" .=? branch + ++ "author" .=? author + ++ "committer" .=? committer + +(.=?) :: ToJSON v => KeyValue t => Text -> Maybe v -> [t] +name .=? value = maybe [] (pure . (name .=)) value From 779315b3d24968be9c766768523729f45da4cdda Mon Sep 17 00:00:00 2001 From: Scott Fleischman Date: Mon, 24 Jul 2017 09:34:43 -0700 Subject: [PATCH 264/510] Use RecordWildCards and Aeson.Pair. --- src/GitHub/Data/Content.hs | 86 +++++++++++++++----------------------- 1 file changed, 33 insertions(+), 53 deletions(-) diff --git a/src/GitHub/Data/Content.hs b/src/GitHub/Data/Content.hs index f4d6a7e5..81b44177 100644 --- a/src/GitHub/Data/Content.hs +++ b/src/GitHub/Data/Content.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE RecordWildCards #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -5,7 +6,7 @@ -- module GitHub.Data.Content where -import Data.Aeson.Types (KeyValue) +import Data.Aeson.Types (Pair) import Data.Maybe (maybe) import GitHub.Data.GitData import GitHub.Data.URL @@ -167,62 +168,41 @@ instance FromJSON ContentResult where <*> o .: "commit" instance ToJSON Author where - toJSON (Author { authorName = name - , authorEmail = email - }) = object - [ "name" .= name - , "email" .= email - ] + toJSON Author {..} = object + [ "name" .= authorName + , "email" .= authorEmail + ] instance ToJSON CreateFile where - toJSON (CreateFile { createFilePath = path - , createFileMessage = message - , createFileContent = content - , createFileBranch = branch - , createFileAuthor = author - , createFileCommitter = committer - }) = object $ - [ "path" .= path - , "message" .= message - , "content" .= content - ] - ++ "branch" .=? branch - ++ "author" .=? author - ++ "committer" .=? committer + toJSON CreateFile {..} = object $ + [ "path" .= createFilePath + , "message" .= createFileMessage + , "content" .= createFileContent + ] + ++ "branch" .=? createFileBranch + ++ "author" .=? createFileAuthor + ++ "committer" .=? createFileCommitter instance ToJSON UpdateFile where - toJSON (UpdateFile { updateFilePath = path - , updateFileMessage = message - , updateFileContent = content - , updateFileSHA = sha - , updateFileBranch = branch - , updateFileAuthor = author - , updateFileCommitter = committer - }) = object $ - [ "path" .= path - , "message" .= message - , "content" .= content - , "sha" .= sha - ] - ++ "branch" .=? branch - ++ "author" .=? author - ++ "committer" .=? committer + toJSON UpdateFile {..} = object $ + [ "path" .= updateFilePath + , "message" .= updateFileMessage + , "content" .= updateFileContent + , "sha" .= updateFileSHA + ] + ++ "branch" .=? updateFileBranch + ++ "author" .=? updateFileAuthor + ++ "committer" .=? updateFileCommitter instance ToJSON DeleteFile where - toJSON (DeleteFile { deleteFilePath = path - , deleteFileMessage = message - , deleteFileSHA = sha - , deleteFileBranch = branch - , deleteFileAuthor = author - , deleteFileCommitter = committer - }) = object $ - [ "path" .= path - , "message" .= message - , "sha" .= sha - ] - ++ "branch" .=? branch - ++ "author" .=? author - ++ "committer" .=? committer - -(.=?) :: ToJSON v => KeyValue t => Text -> Maybe v -> [t] + 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 From 8a851fe960eea3304c6ea042ccf3005cba47a2e4 Mon Sep 17 00:00:00 2001 From: Scott Fleischman Date: Mon, 24 Jul 2017 10:31:16 -0700 Subject: [PATCH 265/510] Add Contents example to cabal file and update code. --- samples/Repos/Contents.hs | 56 ++++++++++++++++++++++-------------- samples/github-samples.cabal | 14 +++++++++ 2 files changed, 48 insertions(+), 22 deletions(-) diff --git a/samples/Repos/Contents.hs b/samples/Repos/Contents.hs index 2b3c1cb6..87b61f5a 100644 --- a/samples/Repos/Contents.hs +++ b/samples/Repos/Contents.hs @@ -1,9 +1,18 @@ -module GetContents where +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} -import qualified Github.Repos as Github -import Data.List -import Prelude hiding (truncate, getContents) +module Main where +import Common hiding + (getContents, intercalate, take, truncate, unlines) +import Data.Text + (Text, intercalate, pack, take, unlines) +import Data.Text.IO (putStrLn) +import qualified Data.Vector as Vector +import qualified GitHub.Data as GitHub +import qualified GitHub.Endpoints.Repos.Contents as GitHub + +main :: IO () main = do putStrLn "Root" putStrLn "====" @@ -13,34 +22,37 @@ main = do putStrLn "=======" getContents "LICENSE" +getContents :: Text -> IO () getContents path = do - contents <- Github.contentsFor "mike-burns" "ohlaunch" path Nothing - putStrLn $ either (("Error: " ++) . show) formatContents contents + contents <- GitHub.contentsFor "mike-burns" "ohlaunch" path Nothing + putStrLn $ either (("Error: " <>) . tshow) formatContents contents -formatContents (Github.ContentFile fileData) = - formatContentInfo (Github.contentFileInfo fileData) ++ +formatContents :: GitHub.Content -> Text +formatContents (GitHub.ContentFile fileData) = + formatContentInfo (GitHub.contentFileInfo fileData) <> unlines - [ show (Github.contentFileSize fileData) ++ " bytes" - , "encoding: " ++ Github.contentFileEncoding fileData - , "data: " ++ truncate (Github.contentFileContent fileData) + [ tshow (GitHub.contentFileSize fileData) <> " bytes" + , "encoding: " <> GitHub.contentFileEncoding fileData + , "data: " <> truncate (GitHub.contentFileContent fileData) ] -formatContents (Github.ContentDirectory items) = - intercalate "\n\n" $ map formatItem items +formatContents (GitHub.ContentDirectory items) = + intercalate "\n\n" . map formatItem . Vector.toList $ items +formatContentInfo :: GitHub.ContentInfo -> Text formatContentInfo contentInfo = unlines - [ "name: " ++ Github.contentName contentInfo - , "path: " ++ Github.contentPath contentInfo - , "sha: " ++ Github.contentSha contentInfo - , "url: " ++ Github.contentUrl contentInfo - , "git url: " ++ Github.contentGitUrl contentInfo - , "html url: " ++ Github.contentHtmlUrl contentInfo + [ "name: " <> GitHub.contentName contentInfo + , "path: " <> GitHub.contentPath contentInfo + , "sha: " <> GitHub.contentSha contentInfo + , "url: " <> (GitHub.getUrl . GitHub.contentUrl) contentInfo + , "git url: " <> (GitHub.getUrl . GitHub.contentGitUrl) contentInfo + , "html url: " <> (GitHub.getUrl . GitHub.contentHtmlUrl) contentInfo ] formatItem item = - "type: " ++ show (Github.contentItemType item) ++ "\n" ++ - formatContentInfo (Github.contentItemInfo item) + "type: " <> tshow (GitHub.contentItemType item) <> "\n" <> + formatContentInfo (GitHub.contentItemInfo item) -truncate str = take 40 str ++ "... (truncated)" +truncate str = take 40 str <> "... (truncated)" diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index 826c3e1e..95d3e073 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -190,6 +190,20 @@ executable github-operational , transformers-compat default-language: Haskell2010 +executable github-repos-contents-example + main-is: Contents.hs + hs-source-dirs: + Repos + ghc-options: -Wall + build-depends: + base + , base-compat + , github + , github-samples + , text + , vector + default-language: Haskell2010 + executable github-show-deploy-key main-is: ShowDeployKey.hs hs-source-dirs: From 80b8e69702dcd0c8f60b1f771ba1b86dbd1f8193 Mon Sep 17 00:00:00 2001 From: Scott Fleischman Date: Mon, 24 Jul 2017 11:29:22 -0700 Subject: [PATCH 266/510] Add create/update/delete example. --- samples/Repos/Contents.hs | 62 ++++++++++++++++++++++++++++++++++-- samples/github-samples.cabal | 1 + 2 files changed, 61 insertions(+), 2 deletions(-) diff --git a/samples/Repos/Contents.hs b/samples/Repos/Contents.hs index 87b61f5a..3132c6f5 100644 --- a/samples/Repos/Contents.hs +++ b/samples/Repos/Contents.hs @@ -5,8 +5,10 @@ module Main where import Common hiding (getContents, intercalate, take, truncate, unlines) +import qualified Data.ByteString.Base64 as Base64 import Data.Text - (Text, intercalate, pack, take, unlines) + (Text, intercalate, take, unlines) +import Data.Text.Encoding (decodeUtf8, encodeUtf8) import Data.Text.IO (putStrLn) import qualified Data.Vector as Vector import qualified GitHub.Data as GitHub @@ -22,6 +24,8 @@ main = do putStrLn "=======" getContents "LICENSE" + createUpdateDeleteSampleFile + getContents :: Text -> IO () getContents path = do contents <- GitHub.contentsFor "mike-burns" "ohlaunch" path Nothing @@ -50,9 +54,63 @@ formatContentInfo contentInfo = , "html url: " <> (GitHub.getUrl . GitHub.contentHtmlUrl) contentInfo ] +formatItem :: GitHub.ContentItem -> Text formatItem item = "type: " <> tshow (GitHub.contentItemType item) <> "\n" <> formatContentInfo (GitHub.contentItemInfo item) - +truncate :: Text -> Text truncate str = take 40 str <> "... (truncated)" + +createUpdateDeleteSampleFile :: IO () +createUpdateDeleteSampleFile = do + let + auth = GitHub.OAuth "oauthtoken" + owner = "repoOwner" + repo = "repoName" + author = GitHub.Author + { GitHub.authorName = "John Doe" + , GitHub.authorEmail = "johndoe@example.com" + } + defaultBranch = Nothing + base64Encode = decodeUtf8 . Base64.encode . encodeUtf8 + createResult <- failOnError $ GitHub.createFile auth owner repo + GitHub.CreateFile + { GitHub.createFilePath = "sample.txt" + , GitHub.createFileMessage = "Add sample.txt" + , GitHub.createFileContent = base64Encode "Hello" + , GitHub.createFileBranch = defaultBranch + , GitHub.createFileAuthor = Just author + , GitHub.createFileCommitter = Just author + } + + let getResultSHA = GitHub.contentSha . GitHub.contentResultInfo . GitHub.contentResultContent + let createFileSHA = getResultSHA createResult + updateResult <- failOnError $ GitHub.updateFile auth owner repo + GitHub.UpdateFile + { GitHub.updateFilePath = "sample.txt" + , GitHub.updateFileMessage = "Update sample.txt" + , GitHub.updateFileContent = base64Encode "Hello world!" + , GitHub.updateFileSHA = createFileSHA + , GitHub.updateFileBranch = defaultBranch + , GitHub.updateFileAuthor = Just author + , GitHub.updateFileCommitter = Just author + } + + let updateFileSHA = getResultSHA updateResult + failOnError $ GitHub.deleteFile auth owner repo + GitHub.DeleteFile + { GitHub.deleteFilePath = "sample.txt" + , GitHub.deleteFileMessage = "Delete sample.txt" + , GitHub.deleteFileSHA = updateFileSHA + , GitHub.deleteFileBranch = defaultBranch + , GitHub.deleteFileAuthor = Just author + , GitHub.deleteFileCommitter = Just author + } + +failOnError :: IO (Either GitHub.Error a) -> IO a +failOnError c = c >>= go + where + go r = case r of + Left err -> fail . show $ err + Right x -> return x diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index 95d3e073..830c1e37 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -198,6 +198,7 @@ executable github-repos-contents-example build-depends: base , base-compat + , base64-bytestring , github , github-samples , text From cd064096ad4c99b5766ff5c6d6912833974f0350 Mon Sep 17 00:00:00 2001 From: Rob Berry Date: Sat, 8 Jul 2017 23:23:29 +0100 Subject: [PATCH 267/510] Add support for pull request reviews https://developer.github.com/v3/pulls/reviews/ --- github.cabal | 3 + spec/GitHub/PullRequestReviewsSpec.hs | 32 ++++ src/GitHub.hs | 20 +++ src/GitHub/Data.hs | 2 + src/GitHub/Data/Reviews.hs | 100 +++++++++++ src/GitHub/Endpoints/PullRequests/Reviews.hs | 172 +++++++++++++++++++ 6 files changed, 329 insertions(+) create mode 100644 spec/GitHub/PullRequestReviewsSpec.hs create mode 100644 src/GitHub/Data/Reviews.hs create mode 100644 src/GitHub/Endpoints/PullRequests/Reviews.hs diff --git a/github.cabal b/github.cabal index 304cf918..574a38ca 100644 --- a/github.cabal +++ b/github.cabal @@ -84,6 +84,7 @@ Library GitHub.Data.Releases GitHub.Data.Repos GitHub.Data.Request + GitHub.Data.Reviews GitHub.Data.Search GitHub.Data.Teams GitHub.Data.URL @@ -107,6 +108,7 @@ Library GitHub.Endpoints.Organizations.Members GitHub.Endpoints.Organizations.Teams GitHub.Endpoints.PullRequests + GitHub.Endpoints.PullRequests.Reviews GitHub.Endpoints.PullRequests.ReviewComments GitHub.Endpoints.Repos GitHub.Endpoints.Repos.Collaborators @@ -172,6 +174,7 @@ test-suite github-test 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 index 00000000..b602af7e --- /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 "reviewsForR" $ do + it "works" $ withAuth $ \auth -> for_ prs $ \(owner, repo, prid) -> do + cs <- GitHub.executeRequest auth $ + GitHub.reviewsForR owner repo prid GitHub.FetchAll + cs `shouldSatisfy` isRight + where + prs = + [("phadej", "github", Id 268)] diff --git a/src/GitHub.hs b/src/GitHub.hs index e45282e6..28588cf2 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -210,6 +210,25 @@ module GitHub ( pullRequestReviewCommentsR, pullRequestReviewCommentR, + -- ** 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 + reviewsForR, + reviewsFor, + reviewsFor', + reviewForR, + reviewFor, + reviewFor', + reviewCommentsForR, + reviewCommentsFor, + reviewCommentsFor', + -- * Repositories -- | See -- @@ -334,6 +353,7 @@ import GitHub.Endpoints.Organizations import GitHub.Endpoints.Organizations.Members import GitHub.Endpoints.Organizations.Teams import GitHub.Endpoints.PullRequests +import GitHub.Endpoints.PullRequests.Reviews import GitHub.Endpoints.PullRequests.ReviewComments import GitHub.Endpoints.Repos import GitHub.Endpoints.Repos.Collaborators diff --git a/src/GitHub/Data.hs b/src/GitHub/Data.hs index e318313f..38d4efab 100644 --- a/src/GitHub/Data.hs +++ b/src/GitHub/Data.hs @@ -46,6 +46,7 @@ module GitHub.Data ( 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.PullRequests 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/Reviews.hs b/src/GitHub/Data/Reviews.hs new file mode 100644 index 00000000..db3ceba6 --- /dev/null +++ b/src/GitHub/Data/Reviews.hs @@ -0,0 +1,100 @@ +module GitHub.Data.Reviews where + +import Data.Text (Text) +import GitHub.Data.Definitions (SimpleUser) +import GitHub.Data.Id (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 + { 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 + , reviewCommentUser :: !SimpleUser + , reviewCommentId :: !(Id ReviewComment) + } deriving (Show, Generic) + + +instance NFData ReviewComment where rnf = genericRnf +instance Binary ReviewComment + + +instance FromJSON ReviewComment where + parseJSON = withObject "ReviewComment" $ \o -> ReviewComment + <$> 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" + <*> o .: "user" + <*> o .: "id" diff --git a/src/GitHub/Endpoints/PullRequests/Reviews.hs b/src/GitHub/Endpoints/PullRequests/Reviews.hs new file mode 100644 index 00000000..984a53c9 --- /dev/null +++ b/src/GitHub/Endpoints/PullRequests/Reviews.hs @@ -0,0 +1,172 @@ +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +-- The reviews API as described on . +module GitHub.Endpoints.PullRequests.Reviews + ( reviewsForR + , reviewsFor + , reviewsFor' + , reviewForR + , reviewFor + , reviewFor' + , reviewCommentsForR + , reviewCommentsFor + , reviewCommentsFor' + , 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 +reviewsForR + :: Name Owner + -> Name Repo + -> Id PullRequest + -> FetchCount + -> Request k (Vector Review) +reviewsForR 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. +-- +-- > reviewsFor "thoughtbot" "paperclip" (Id 101) +reviewsFor :: Name Owner + -> Name Repo + -> Id PullRequest + -> IO (Either Error (Vector Review)) +reviewsFor owner repo prid = + executeRequest' $ reviewsForR owner repo prid FetchAll + + +-- | All reviews for a pull request given the repo owner, repo name and the pull +-- request id. With authentication. +-- +-- > reviewsFor' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" (Id 101) +reviewsFor' + :: Maybe Auth + -> Name Owner + -> Name Repo + -> Id PullRequest + -> IO (Either Error (Vector Review)) +reviewsFor' auth owner repo pr = + executeRequestMaybe auth $ reviewsForR owner repo pr FetchAll + + +-- | Query a single pull request review. +-- see +reviewForR :: Name Owner + -> Name Repo + -> Id PullRequest + -> Id Review + -> Request k Review +reviewForR 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. +-- +-- > reviewFor "thoughtbot" "factory_girl" (Id 301819) (Id 332) +reviewFor + :: Name Owner + -> Name Repo + -> Id PullRequest + -> Id Review + -> IO (Either Error Review) +reviewFor owner repo prid rid = + executeRequest' $ reviewForR 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. +-- +-- > reviewFor' (Just ("github-username", "github-password")) +-- "thoughtbot" "factory_girl" (Id 301819) (Id 332) +reviewFor' + :: Maybe Auth + -> Name Owner + -> Name Repo + -> Id PullRequest + -> Id Review + -> IO (Either Error Review) +reviewFor' auth owner repo prid rid = + executeRequestMaybe auth $ reviewForR owner repo prid rid + + +-- | Query the comments for a single pull request review. +-- see +reviewCommentsForR + :: Name Owner + -> Name Repo + -> Id PullRequest + -> Id Review + -> Request k [ReviewComment] +reviewCommentsForR 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. +-- +-- > reviewCommentsFor "thoughtbot" "factory_girl" (Id 301819) (Id 332) +reviewCommentsFor + :: Name Owner + -> Name Repo + -> Id PullRequest + -> Id Review + -> IO (Either Error [ReviewComment]) +reviewCommentsFor owner repo prid rid = + executeRequest' $ reviewCommentsForR 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. +-- +-- > reviewCommentsFor' (Just ("github-username", "github-password")) "thoughtbot" "factory_girl" (Id 301819) (Id 332) +reviewCommentsFor' + :: Maybe Auth + -> Name Owner + -> Name Repo + -> Id PullRequest + -> Id Review + -> IO (Either Error [ReviewComment]) +reviewCommentsFor' auth owner repo prid rid = + executeRequestMaybe auth $ reviewCommentsForR owner repo prid rid From ded3b6a270ce6cab54eac4e546a35369e825d8aa Mon Sep 17 00:00:00 2001 From: Rob Berry Date: Thu, 13 Jul 2017 20:40:56 +0100 Subject: [PATCH 268/510] Rename pull request review functions Rename pullRequestReviewComment to pullRequestComment Rename reviewsFor to pullRequestReviewComment --- samples/Pulls/ReviewComments/ListComments.hs | 2 +- samples/Pulls/ReviewComments/ShowComment.hs | 2 +- spec/GitHub/PullRequestReviewsSpec.hs | 4 +- src/GitHub.hs | 22 ++--- .../Endpoints/PullRequests/ReviewComments.hs | 32 +++---- src/GitHub/Endpoints/PullRequests/Reviews.hs | 92 +++++++++---------- 6 files changed, 77 insertions(+), 77 deletions(-) diff --git a/samples/Pulls/ReviewComments/ListComments.hs b/samples/Pulls/ReviewComments/ListComments.hs index f41234f2..d16eb34a 100644 --- a/samples/Pulls/ReviewComments/ListComments.hs +++ b/samples/Pulls/ReviewComments/ListComments.hs @@ -4,7 +4,7 @@ import qualified Github.PullRequests.ReviewComments as Github import Data.List main = do - possiblePullRequestComments <- Github.pullRequestReviewComments "thoughtbot" "factory_girl" 256 + possiblePullRequestComments <- Github.pullRequestComments "thoughtbot" "factory_girl" 256 case possiblePullRequestComments of (Left error) -> putStrLn $ "Error: " ++ (show error) (Right comments) -> putStrLn $ intercalate "\n\n" $ map formatComment comments diff --git a/samples/Pulls/ReviewComments/ShowComment.hs b/samples/Pulls/ReviewComments/ShowComment.hs index 254fa703..95eb48e7 100644 --- a/samples/Pulls/ReviewComments/ShowComment.hs +++ b/samples/Pulls/ReviewComments/ShowComment.hs @@ -4,7 +4,7 @@ import qualified Github.PullRequests.ReviewComments as Github import Data.List main = do - possiblePullRequestComment <- Github.pullRequestReviewComment "thoughtbot" "factory_girl" 301819 + possiblePullRequestComment <- Github.pullRequestComment "thoughtbot" "factory_girl" 301819 case possiblePullRequestComment of (Left error) -> putStrLn $ "Error: " ++ (show error) (Right comment) -> putStrLn $ formatComment comment diff --git a/spec/GitHub/PullRequestReviewsSpec.hs b/spec/GitHub/PullRequestReviewsSpec.hs index b602af7e..c04b134b 100644 --- a/spec/GitHub/PullRequestReviewsSpec.hs +++ b/spec/GitHub/PullRequestReviewsSpec.hs @@ -22,10 +22,10 @@ withAuth action = do spec :: Spec spec = do - describe "reviewsForR" $ do + describe "pullRequestReviewsR" $ do it "works" $ withAuth $ \auth -> for_ prs $ \(owner, repo, prid) -> do cs <- GitHub.executeRequest auth $ - GitHub.reviewsForR owner repo prid GitHub.FetchAll + GitHub.pullRequestReviewsR owner repo prid GitHub.FetchAll cs `shouldSatisfy` isRight where prs = diff --git a/src/GitHub.hs b/src/GitHub.hs index 28588cf2..2aadfdb4 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -207,8 +207,8 @@ module GitHub ( -- * Create a comment -- * Edit a comment -- * Delete a comment - pullRequestReviewCommentsR, - pullRequestReviewCommentR, + pullRequestCommentsR, + pullRequestCommentR, -- ** Pull request reviews -- | See @@ -219,15 +219,15 @@ module GitHub ( -- * Create a pull request review -- * Submit a pull request review -- * Dismiss a pull request review - reviewsForR, - reviewsFor, - reviewsFor', - reviewForR, - reviewFor, - reviewFor', - reviewCommentsForR, - reviewCommentsFor, - reviewCommentsFor', + pullRequestReviewsR, + pullRequestReviews, + pullRequestReviews', + pullRequestReviewR, + pullRequestReview, + pullRequestReview', + pullRequestReviewCommentsR, + pullRequestReviewCommentsIO, + pullRequestReviewCommentsIO', -- * Repositories -- | See diff --git a/src/GitHub/Endpoints/PullRequests/ReviewComments.hs b/src/GitHub/Endpoints/PullRequests/ReviewComments.hs index eee75046..32b84318 100644 --- a/src/GitHub/Endpoints/PullRequests/ReviewComments.hs +++ b/src/GitHub/Endpoints/PullRequests/ReviewComments.hs @@ -6,10 +6,10 @@ -- The pull request review comments API as described at -- . module GitHub.Endpoints.PullRequests.ReviewComments ( - pullRequestReviewCommentsIO, - pullRequestReviewCommentsR, - pullRequestReviewComment, - pullRequestReviewCommentR, + pullRequestCommentsIO, + pullRequestCommentsR, + pullRequestComment, + pullRequestCommentR, module GitHub.Data, ) where @@ -20,26 +20,26 @@ 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 +-- > 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 -pullRequestReviewCommentsR :: Name Owner -> Name Repo -> Id PullRequest -> FetchCount -> Request k (Vector Comment) -pullRequestReviewCommentsR user repo prid = +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. -- --- > 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 +-- > 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 -pullRequestReviewCommentR :: Name Owner -> Name Repo -> Id Comment -> Request k Comment -pullRequestReviewCommentR user repo cid = +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/Reviews.hs b/src/GitHub/Endpoints/PullRequests/Reviews.hs index 984a53c9..9f5d8e66 100644 --- a/src/GitHub/Endpoints/PullRequests/Reviews.hs +++ b/src/GitHub/Endpoints/PullRequests/Reviews.hs @@ -5,15 +5,15 @@ -- -- The reviews API as described on . module GitHub.Endpoints.PullRequests.Reviews - ( reviewsForR - , reviewsFor - , reviewsFor' - , reviewForR - , reviewFor - , reviewFor' - , reviewCommentsForR - , reviewCommentsFor - , reviewCommentsFor' + ( pullRequestReviewsR + , pullRequestReviews + , pullRequestReviews' + , pullRequestReviewR + , pullRequestReview + , pullRequestReview' + , pullRequestReviewCommentsR + , pullRequestReviewCommentsIO + , pullRequestReviewCommentsIO' , module GitHub.Data ) where @@ -27,13 +27,13 @@ import Prelude () -- | List reviews for a pull request. -- See -reviewsForR +pullRequestReviewsR :: Name Owner -> Name Repo -> Id PullRequest -> FetchCount -> Request k (Vector Review) -reviewsForR owner repo prid = +pullRequestReviewsR owner repo prid = pagedQuery [ "repos" , toPathPart owner @@ -48,37 +48,37 @@ reviewsForR owner repo prid = -- | All reviews for a pull request given the repo owner, repo name and the pull -- request id. -- --- > reviewsFor "thoughtbot" "paperclip" (Id 101) -reviewsFor :: Name Owner - -> Name Repo - -> Id PullRequest - -> IO (Either Error (Vector Review)) -reviewsFor owner repo prid = - executeRequest' $ reviewsForR owner repo prid FetchAll +-- > 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. -- --- > reviewsFor' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" (Id 101) -reviewsFor' +-- > pullRequestReviews' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" (Id 101) +pullRequestReviews' :: Maybe Auth -> Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector Review)) -reviewsFor' auth owner repo pr = - executeRequestMaybe auth $ reviewsForR owner repo pr FetchAll +pullRequestReviews' auth owner repo pr = + executeRequestMaybe auth $ pullRequestReviewsR owner repo pr FetchAll -- | Query a single pull request review. -- see -reviewForR :: Name Owner - -> Name Repo - -> Id PullRequest - -> Id Review - -> Request k Review -reviewForR owner repo prid rid = +pullRequestReviewR :: Name Owner + -> Name Repo + -> Id PullRequest + -> Id Review + -> Request k Review +pullRequestReviewR owner repo prid rid = query [ "repos" , toPathPart owner @@ -94,42 +94,42 @@ reviewForR owner repo prid rid = -- | A detailed review on a pull request given the repo owner, repo name, pull -- request id and review id. -- --- > reviewFor "thoughtbot" "factory_girl" (Id 301819) (Id 332) -reviewFor +-- > pullRequestReview "thoughtbot" "factory_girl" (Id 301819) (Id 332) +pullRequestReview :: Name Owner -> Name Repo -> Id PullRequest -> Id Review -> IO (Either Error Review) -reviewFor owner repo prid rid = - executeRequest' $ reviewForR owner repo prid rid +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. -- --- > reviewFor' (Just ("github-username", "github-password")) +-- > pullRequestReview' (Just ("github-username", "github-password")) -- "thoughtbot" "factory_girl" (Id 301819) (Id 332) -reviewFor' +pullRequestReview' :: Maybe Auth -> Name Owner -> Name Repo -> Id PullRequest -> Id Review -> IO (Either Error Review) -reviewFor' auth owner repo prid rid = - executeRequestMaybe auth $ reviewForR owner repo prid rid +pullRequestReview' auth owner repo prid rid = + executeRequestMaybe auth $ pullRequestReviewR owner repo prid rid -- | Query the comments for a single pull request review. -- see -reviewCommentsForR +pullRequestReviewCommentsR :: Name Owner -> Name Repo -> Id PullRequest -> Id Review -> Request k [ReviewComment] -reviewCommentsForR owner repo prid rid = +pullRequestReviewCommentsR owner repo prid rid = query [ "repos" , toPathPart owner @@ -146,27 +146,27 @@ reviewCommentsForR 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. -- --- > reviewCommentsFor "thoughtbot" "factory_girl" (Id 301819) (Id 332) -reviewCommentsFor +-- > pullRequestReviewComments "thoughtbot" "factory_girl" (Id 301819) (Id 332) +pullRequestReviewCommentsIO :: Name Owner -> Name Repo -> Id PullRequest -> Id Review -> IO (Either Error [ReviewComment]) -reviewCommentsFor owner repo prid rid = - executeRequest' $ reviewCommentsForR owner repo prid rid +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. -- --- > reviewCommentsFor' (Just ("github-username", "github-password")) "thoughtbot" "factory_girl" (Id 301819) (Id 332) -reviewCommentsFor' +-- > 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]) -reviewCommentsFor' auth owner repo prid rid = - executeRequestMaybe auth $ reviewCommentsForR owner repo prid rid +pullRequestReviewCommentsIO' auth owner repo prid rid = + executeRequestMaybe auth $ pullRequestReviewCommentsR owner repo prid rid From 747eb42c220af37e0a7af99ba12a24504b41ed67 Mon Sep 17 00:00:00 2001 From: Rob Berry Date: Thu, 13 Jul 2017 21:20:22 +0100 Subject: [PATCH 269/510] Indent with 4 spaces --- src/GitHub/Data/Reviews.hs | 142 +++++++------ src/GitHub/Endpoints/PullRequests/Reviews.hs | 197 +++++++++---------- 2 files changed, 164 insertions(+), 175 deletions(-) diff --git a/src/GitHub/Data/Reviews.hs b/src/GitHub/Data/Reviews.hs index db3ceba6..174457c7 100644 --- a/src/GitHub/Data/Reviews.hs +++ b/src/GitHub/Data/Reviews.hs @@ -7,94 +7,90 @@ 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) + = ReviewStatePending + | ReviewStateApproved + | ReviewStateDismissed + | ReviewStateCommented + | ReviewStateChangesRequested + deriving (Show, Enum, Bounded, Eq, Ord, Generic) +instance NFData ReviewState where + rnf = genericRnf -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" - + 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) - + { 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 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" - + 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 - { 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 - , reviewCommentUser :: !SimpleUser - , reviewCommentId :: !(Id ReviewComment) - } deriving (Show, Generic) + { 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 + , reviewCommentUser :: !SimpleUser + , reviewCommentId :: !(Id ReviewComment) + } deriving (Show, Generic) + +instance NFData ReviewComment where + rnf = genericRnf - -instance NFData ReviewComment where rnf = genericRnf instance Binary ReviewComment - instance FromJSON ReviewComment where - parseJSON = withObject "ReviewComment" $ \o -> ReviewComment - <$> 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" - <*> o .: "user" - <*> o .: "id" + parseJSON = + withObject "ReviewComment" $ \o -> + ReviewComment <$> 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" <*> + o .: "user" <*> + o .: "id" diff --git a/src/GitHub/Endpoints/PullRequests/Reviews.hs b/src/GitHub/Endpoints/PullRequests/Reviews.hs index 9f5d8e66..50b433fd 100644 --- a/src/GitHub/Endpoints/PullRequests/Reviews.hs +++ b/src/GitHub/Endpoints/PullRequests/Reviews.hs @@ -5,17 +5,17 @@ -- -- The reviews API as described on . module GitHub.Endpoints.PullRequests.Reviews - ( pullRequestReviewsR - , pullRequestReviews - , pullRequestReviews' - , pullRequestReviewR - , pullRequestReview - , pullRequestReview' - , pullRequestReviewCommentsR - , pullRequestReviewCommentsIO - , pullRequestReviewCommentsIO' - , module GitHub.Data - ) where + ( pullRequestReviewsR + , pullRequestReviews + , pullRequestReviews' + , pullRequestReviewR + , pullRequestReview + , pullRequestReview' + , pullRequestReviewCommentsR + , pullRequestReviewCommentsIO + , pullRequestReviewCommentsIO' + , module GitHub.Data + ) where import GitHub.Data import GitHub.Data.Id (Id) @@ -24,86 +24,82 @@ 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) + :: 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" - ] - [] - + 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 + :: Name Owner + -> Name Repo + -> Id PullRequest + -> IO (Either Error (Vector Review)) pullRequestReviews owner repo prid = - executeRequest' $ pullRequestReviewsR owner repo prid FetchAll - + 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)) + :: 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 - + 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 + :: 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 - ] - [] - + 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) + :: Name Owner + -> Name Repo + -> Id PullRequest + -> Id Review + -> IO (Either Error Review) pullRequestReview owner repo prid rid = - executeRequest' $ pullRequestReviewR 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. @@ -111,62 +107,59 @@ pullRequestReview owner repo prid rid = -- > 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) + :: 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 - + 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] + :: 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" - ] - [] - + 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]) + :: Name Owner + -> Name Repo + -> Id PullRequest + -> Id Review + -> IO (Either Error [ReviewComment]) pullRequestReviewCommentsIO owner repo prid rid = - executeRequest' $ pullRequestReviewCommentsR 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]) + :: 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 + executeRequestMaybe auth $ pullRequestReviewCommentsR owner repo prid rid From 82090eeea9827e5cd8a5b043f26632967ac3abed Mon Sep 17 00:00:00 2001 From: Rob Berry Date: Thu, 13 Jul 2017 21:26:36 +0100 Subject: [PATCH 270/510] Change ordering of `ReviewComment` fields --- src/GitHub/Data/Reviews.hs | 37 +++++++++++++++++++------------------ 1 file changed, 19 insertions(+), 18 deletions(-) diff --git a/src/GitHub/Data/Reviews.hs b/src/GitHub/Data/Reviews.hs index 174457c7..2cede51a 100644 --- a/src/GitHub/Data/Reviews.hs +++ b/src/GitHub/Data/Reviews.hs @@ -55,7 +55,9 @@ instance FromJSON Review where o .: "id" data ReviewComment = ReviewComment - { reviewCommentBody :: !Text + { reviewCommentId :: !(Id ReviewComment) + , reviewCommentUser :: !SimpleUser + , reviewCommentBody :: !Text , reviewCommentUrl :: !URL , reviewCommentPullRequestReviewId :: !(Id Review) , reviewCommentDiffHunk :: !Text @@ -68,8 +70,6 @@ data ReviewComment = ReviewComment , reviewCommentUpdatedAt :: !UTCTime , reviewCommentHtmlUrl :: !URL , reviewCommentPullRequestUrl :: !URL - , reviewCommentUser :: !SimpleUser - , reviewCommentId :: !(Id ReviewComment) } deriving (Show, Generic) instance NFData ReviewComment where @@ -79,18 +79,19 @@ instance Binary ReviewComment instance FromJSON ReviewComment where parseJSON = - withObject "ReviewComment" $ \o -> - ReviewComment <$> 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" <*> - o .: "user" <*> - o .: "id" + 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" From 45f973934576c3b8d7bcd761e81a9f0cedcc4ab3 Mon Sep 17 00:00:00 2001 From: Rob Berry Date: Fri, 14 Jul 2017 21:59:33 +0100 Subject: [PATCH 271/510] Rename PullRequests.ReviewComments -> PullRequests.Comments --- github.cabal | 2 +- samples/Pulls/{ReviewComments => Comments}/ListComments.hs | 2 +- samples/Pulls/{ReviewComments => Comments}/ShowComment.hs | 2 +- src/GitHub.hs | 2 +- .../Endpoints/PullRequests/{ReviewComments.hs => Comments.hs} | 2 +- 5 files changed, 5 insertions(+), 5 deletions(-) rename samples/Pulls/{ReviewComments => Comments}/ListComments.hs (92%) rename samples/Pulls/{ReviewComments => Comments}/ShowComment.hs (96%) rename src/GitHub/Endpoints/PullRequests/{ReviewComments.hs => Comments.hs} (97%) diff --git a/github.cabal b/github.cabal index 574a38ca..b19d4748 100644 --- a/github.cabal +++ b/github.cabal @@ -109,7 +109,7 @@ Library GitHub.Endpoints.Organizations.Teams GitHub.Endpoints.PullRequests GitHub.Endpoints.PullRequests.Reviews - GitHub.Endpoints.PullRequests.ReviewComments + GitHub.Endpoints.PullRequests.Comments GitHub.Endpoints.Repos GitHub.Endpoints.Repos.Collaborators GitHub.Endpoints.Repos.Comments diff --git a/samples/Pulls/ReviewComments/ListComments.hs b/samples/Pulls/Comments/ListComments.hs similarity index 92% rename from samples/Pulls/ReviewComments/ListComments.hs rename to samples/Pulls/Comments/ListComments.hs index d16eb34a..b555301c 100644 --- a/samples/Pulls/ReviewComments/ListComments.hs +++ b/samples/Pulls/Comments/ListComments.hs @@ -1,6 +1,6 @@ module ListComments where -import qualified Github.PullRequests.ReviewComments as Github +import qualified Github.PullRequests.Comments as Github import Data.List main = do diff --git a/samples/Pulls/ReviewComments/ShowComment.hs b/samples/Pulls/Comments/ShowComment.hs similarity index 96% rename from samples/Pulls/ReviewComments/ShowComment.hs rename to samples/Pulls/Comments/ShowComment.hs index 95eb48e7..5714244e 100644 --- a/samples/Pulls/ReviewComments/ShowComment.hs +++ b/samples/Pulls/Comments/ShowComment.hs @@ -1,4 +1,4 @@ -module ShowComments where +module ShowComment where import qualified Github.PullRequests.ReviewComments as Github import Data.List diff --git a/src/GitHub.hs b/src/GitHub.hs index 2aadfdb4..62dad7ce 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -354,7 +354,7 @@ import GitHub.Endpoints.Organizations.Members import GitHub.Endpoints.Organizations.Teams import GitHub.Endpoints.PullRequests import GitHub.Endpoints.PullRequests.Reviews -import GitHub.Endpoints.PullRequests.ReviewComments +import GitHub.Endpoints.PullRequests.Comments import GitHub.Endpoints.Repos import GitHub.Endpoints.Repos.Collaborators import GitHub.Endpoints.Repos.Comments diff --git a/src/GitHub/Endpoints/PullRequests/ReviewComments.hs b/src/GitHub/Endpoints/PullRequests/Comments.hs similarity index 97% rename from src/GitHub/Endpoints/PullRequests/ReviewComments.hs rename to src/GitHub/Endpoints/PullRequests/Comments.hs index 32b84318..ccbf0d93 100644 --- a/src/GitHub/Endpoints/PullRequests/ReviewComments.hs +++ b/src/GitHub/Endpoints/PullRequests/Comments.hs @@ -5,7 +5,7 @@ -- -- The pull request review comments API as described at -- . -module GitHub.Endpoints.PullRequests.ReviewComments ( +module GitHub.Endpoints.PullRequests.Comments ( pullRequestCommentsIO, pullRequestCommentsR, pullRequestComment, From d2c763e216285dc2a3105c3f2f81c9f3167ae91f Mon Sep 17 00:00:00 2001 From: Rob Berry Date: Sat, 15 Jul 2017 01:22:24 +0100 Subject: [PATCH 272/510] Make the PullRequests.Comments samples work --- samples/Pulls/Comments/ListComments.hs | 32 ++++++++++++++++---------- samples/Pulls/Comments/ShowComment.hs | 31 +++++++++++++++---------- 2 files changed, 39 insertions(+), 24 deletions(-) diff --git a/samples/Pulls/Comments/ListComments.hs b/samples/Pulls/Comments/ListComments.hs index b555301c..60ae4a07 100644 --- a/samples/Pulls/Comments/ListComments.hs +++ b/samples/Pulls/Comments/ListComments.hs @@ -1,21 +1,29 @@ +{-# LANGUAGE OverloadedStrings #-} module ListComments where -import qualified Github.PullRequests.Comments as Github -import Data.List +import qualified GitHub.Endpoints.PullRequests.Comments as GitHub +import GitHub.Data.Id (Id(Id)) +import Data.Monoid ((<>)) +import Data.Text (Text, unpack, pack) +import Data.Time.Format +main :: IO () main = do - possiblePullRequestComments <- Github.pullRequestComments "thoughtbot" "factory_girl" 256 + possiblePullRequestComments <- GitHub.pullRequestCommentsIO "thoughtbot" "factory_girl" (Id 256) case possiblePullRequestComments of - (Left error) -> putStrLn $ "Error: " ++ (show error) - (Right comments) -> putStrLn $ intercalate "\n\n" $ map formatComment comments + (Left err) -> putStrLn $ "Error: " <> show err + (Right comments) -> putStrLn . unpack $ foldr (\a b -> a <> "\n\n" <> b) "" (formatComment <$> comments) -formatComment :: Github.Comment -> String +formatComment :: GitHub.Comment -> Text formatComment comment = - "Author: " ++ (formatAuthor $ Github.commentUser comment) ++ - "\nUpdated: " ++ (show $ Github.commentUpdatedAt comment) ++ - (maybe "" ("\nURL: "++) $ Github.commentHtmlUrl comment) ++ - "\n\n" ++ (Github.commentBody comment) + "Author: " <> formatAuthor (GitHub.commentUser comment) <> + "\nUpdated: " <> pack (formatTime' (GitHub.commentUpdatedAt comment)) <> + (maybe "" (\u -> "\nURL: " <> GitHub.getUrl u) $ GitHub.commentHtmlUrl comment) <> + "\n\n" <> GitHub.commentBody comment -formatAuthor :: Github.Owner -> String +formatAuthor :: GitHub.SimpleUser -> Text formatAuthor user = - (Github.githubOwnerLogin user) ++ " (" ++ (Github.githubOwnerUrl user) ++ ")" + GitHub.untagName (GitHub.simpleUserLogin user) <> " (" <> GitHub.getUrl (GitHub.simpleUserUrl user) <> ")" + +formatTime' :: (FormatTime t) => t -> String +formatTime' = formatTime defaultTimeLocale "%T, %F (%Z)" diff --git a/samples/Pulls/Comments/ShowComment.hs b/samples/Pulls/Comments/ShowComment.hs index 5714244e..a0c2a2ba 100644 --- a/samples/Pulls/Comments/ShowComment.hs +++ b/samples/Pulls/Comments/ShowComment.hs @@ -1,22 +1,29 @@ +{-# LANGUAGE OverloadedStrings #-} module ShowComment where -import qualified Github.PullRequests.ReviewComments as Github -import Data.List +import qualified GitHub.Endpoints.PullRequests.Comments as GitHub +import GitHub.Data.Id (Id(Id)) +import Data.Monoid ((<>)) +import Data.Text (Text, unpack, pack) +import Data.Time.Format +main :: IO () main = do - possiblePullRequestComment <- Github.pullRequestComment "thoughtbot" "factory_girl" 301819 + possiblePullRequestComment <- GitHub.pullRequestComment "thoughtbot" "factory_girl" (Id 301819) case possiblePullRequestComment of - (Left error) -> putStrLn $ "Error: " ++ (show error) - (Right comment) -> putStrLn $ formatComment comment + (Left err) -> putStrLn $ "Error: " <> show err + (Right comment) -> putStrLn . unpack $ formatComment comment -formatComment :: Github.Comment -> String +formatComment :: GitHub.Comment -> Text formatComment comment = - "Author: " ++ (formatAuthor $ Github.commentUser comment) ++ - "\nUpdated: " ++ (show $ Github.commentUpdatedAt comment) ++ - (maybe "" ("\nURL: "++) $ Github.commentHtmlUrl comment) ++ - "\n\n" ++ (Github.commentBody comment) + "Author: " <> formatAuthor (GitHub.commentUser comment) <> + "\nUpdated: " <> pack (formatTime' (GitHub.commentUpdatedAt comment)) <> + (maybe "" (\u -> "\nURL: " <> GitHub.getUrl u) $ GitHub.commentHtmlUrl comment) <> + "\n\n" <> GitHub.commentBody comment -formatAuthor :: Github.Owner -> String +formatAuthor :: GitHub.SimpleUser -> Text formatAuthor user = - (Github.githubOwnerLogin user) ++ " (" ++ (Github.githubOwnerUrl user) ++ ")" + GitHub.untagName (GitHub.simpleUserLogin user) <> " (" <> GitHub.getUrl (GitHub.simpleUserUrl user) <> ")" +formatTime' :: (FormatTime t) => t -> String +formatTime' = formatTime defaultTimeLocale "%T, %F (%Z)" From 1b6db14b7910ffb0e0c54e4a3fd0b0223942875b Mon Sep 17 00:00:00 2001 From: Rob Berry Date: Sat, 15 Jul 2017 00:33:59 +0100 Subject: [PATCH 273/510] Remove redundant import --- src/GitHub/Data/Reviews.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/GitHub/Data/Reviews.hs b/src/GitHub/Data/Reviews.hs index 2cede51a..44405531 100644 --- a/src/GitHub/Data/Reviews.hs +++ b/src/GitHub/Data/Reviews.hs @@ -2,7 +2,7 @@ module GitHub.Data.Reviews where import Data.Text (Text) import GitHub.Data.Definitions (SimpleUser) -import GitHub.Data.Id (Id(Id)) +import GitHub.Data.Id (Id) import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () From ee8d1b924609ed8fcae5cca92017c9fc8dd9bdb1 Mon Sep 17 00:00:00 2001 From: TAKAHASHI Yuto Date: Wed, 30 Aug 2017 23:06:54 +0900 Subject: [PATCH 274/510] Add endpoints for (un)starring repositories --- samples/Activity/Starring/StarRepo.hs | 17 +++++++++++++++ samples/Activity/Starring/UnstarRepo.hs | 17 +++++++++++++++ src/GitHub.hs | 4 ++-- src/GitHub/Endpoints/Activity/Starring.hs | 26 +++++++++++++++++++++++ 4 files changed, 62 insertions(+), 2 deletions(-) create mode 100644 samples/Activity/Starring/StarRepo.hs create mode 100644 samples/Activity/Starring/UnstarRepo.hs diff --git a/samples/Activity/Starring/StarRepo.hs b/samples/Activity/Starring/StarRepo.hs new file mode 100644 index 00000000..452aaf7b --- /dev/null +++ b/samples/Activity/Starring/StarRepo.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE OverloadedStrings #-} +module StarRepo where + +import qualified GitHub.Endpoints.Activity.Starring as GH + +import qualified Data.Text as T +import qualified Data.Text.IO as T + +main :: IO () +main = do + let owner = "phadej" + repo = "github" + result <- GH.starRepo (GH.OAuth "your-token") + (GH.mkOwnerName owner) (GH.mkRepoName repo) + case result of + Left err -> putStrLn $ "Error: " ++ show err + Right () -> T.putStrLn $ T.concat ["Starred: ", owner, "/", repo] diff --git a/samples/Activity/Starring/UnstarRepo.hs b/samples/Activity/Starring/UnstarRepo.hs new file mode 100644 index 00000000..29d68dd1 --- /dev/null +++ b/samples/Activity/Starring/UnstarRepo.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE OverloadedStrings #-} +module UnstarRepo where + +import qualified GitHub.Endpoints.Activity.Starring as GH + +import qualified Data.Text as T +import qualified Data.Text.IO as T + +main :: IO () +main = do + let owner = "phadej" + repo = "github" + result <- GH.unstarRepo (GH.OAuth "your-token") + (GH.mkOwnerName owner) (GH.mkRepoName repo) + case result of + Left err -> putStrLn $ "Error: " ++ show err + Right () -> T.putStrLn $ T.concat ["Unstarred: ", owner, "/", repo] diff --git a/src/GitHub.hs b/src/GitHub.hs index e45282e6..d332d08b 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -25,12 +25,12 @@ module GitHub ( -- Missing endpoints: -- -- * Check if you are starring a repository - -- * Star a repository - -- * Unstar a repository stargazersForR, reposStarredByR, myStarredR, myStarredAcceptStarR, + starRepoR, + unstarRepoR, -- ** Watching -- | See diff --git a/src/GitHub/Endpoints/Activity/Starring.hs b/src/GitHub/Endpoints/Activity/Starring.hs index 7ca84c34..d934185b 100644 --- a/src/GitHub/Endpoints/Activity/Starring.hs +++ b/src/GitHub/Endpoints/Activity/Starring.hs @@ -14,6 +14,10 @@ module GitHub.Endpoints.Activity.Starring ( myStarredR, myStarredAcceptStar, myStarredAcceptStarR, + starRepo, + starRepoR, + unstarRepo, + unstarRepoR, module GitHub.Data, ) where @@ -69,3 +73,25 @@ myStarredAcceptStar auth = -- 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] From 7755fc79a235261a34a3989a8d4435e01dfda8d2 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 25 Sep 2017 16:40:32 +0300 Subject: [PATCH 275/510] Add Ord Request instance --- src/GitHub/Data/Request.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs index 5ca7556a..59e7e08f 100644 --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -61,6 +61,7 @@ data CommandMethod a where deriving (Typeable) deriving instance Eq (CommandMethod a) +deriving instance Ord (CommandMethod a) instance Show (CommandMethod a) where showsPrec _ Post = showString "Post" @@ -181,6 +182,9 @@ command m ps body = SimpleQuery (Command m ps body) 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 Query ps qs -> showString "Query " From 494b9bd8edb056af9e748176d2acff2af4eee63e Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 26 Sep 2017 11:15:28 +0300 Subject: [PATCH 276/510] Review PR events --- src/GitHub/Data/PullRequests.hs | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/src/GitHub/Data/PullRequests.hs b/src/GitHub/Data/PullRequests.hs index d5148d87..725e939b 100644 --- a/src/GitHub/Data/PullRequests.hs +++ b/src/GitHub/Data/PullRequests.hs @@ -160,6 +160,9 @@ data PullRequestEventType | PullRequestUnassigned | PullRequestLabeled | PullRequestUnlabeled + | PullRequestReviewRequested + | PullRequestReviewRequestRemoved + | PullRequestEdited deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData PullRequestEventType where rnf = genericRnf @@ -284,6 +287,10 @@ instance FromJSON PullRequestEventType where 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 From 7eb3d840e35b4319eca6c051eb5971cc3a468ab9 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 26 Sep 2017 11:16:45 +0300 Subject: [PATCH 277/510] Bump version to 0.17.0 --- CHANGELOG.md | 6 ++++++ github.cabal | 2 +- 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 42c63088..14ea611e 100644 --- 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 index b19d4748..d6c2ac2c 100644 --- 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 From 71f5b2ae1bb9fbb47d7540fe8c05cb12cc53e033 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 26 Sep 2017 11:53:21 +0300 Subject: [PATCH 278/510] Fix compilation error --- src/GitHub/Data/PullRequests.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/GitHub/Data/PullRequests.hs b/src/GitHub/Data/PullRequests.hs index 725e939b..ab0d1976 100644 --- a/src/GitHub/Data/PullRequests.hs +++ b/src/GitHub/Data/PullRequests.hs @@ -26,6 +26,8 @@ import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () +import qualified Data.Text as T + data SimplePullRequest = SimplePullRequest { simplePullRequestClosedAt :: !(Maybe UTCTime) , simplePullRequestCreatedAt :: !UTCTime From 2038d037e47771ee60a937f931d5a0c4f5be9908 Mon Sep 17 00:00:00 2001 From: Todd Mohney Date: Tue, 3 Oct 2017 11:07:15 -0400 Subject: [PATCH 279/510] Add requested reviewers field to pull request records --- fixtures/pull-request-opened.json | 311 +++++++++++++++++ fixtures/pull-request-review-requested.json | 351 ++++++++++++++++++++ github.cabal | 3 + spec/GitHub/PullRequestsSpec.hs | 54 ++- src/GitHub/Data/PullRequests.hs | 96 +++--- 5 files changed, 763 insertions(+), 52 deletions(-) create mode 100644 fixtures/pull-request-opened.json create mode 100644 fixtures/pull-request-review-requested.json diff --git a/fixtures/pull-request-opened.json b/fixtures/pull-request-opened.json new file mode 100644 index 00000000..1dfcddf0 --- /dev/null +++ b/fixtures/pull-request-opened.json @@ -0,0 +1,311 @@ +{ + "url": "https://api.github.com/repos/phadej/github/pulls/9", + "id": 144079630, + "html_url": "https://github.com/phadej/github/pull/9", + "diff_url": "https://github.com/phadej/github/pull/9.diff", + "patch_url": "https://github.com/phadej/github/pull/9.patch", + "issue_url": "https://api.github.com/repos/phadej/github/issues/9", + "number": 9, + "state": "open", + "locked": false, + "title": "Fetch my pull requests", + "user": { + "login": "phadej", + "id": 123898390, + "avatar_url": "https://avatars3.githubusercontent.com/u/123898390?v=4", + "gravatar_id": "", + "url": "https://api.github.com/users/phadej", + "html_url": "https://github.com/phadej", + "followers_url": "https://api.github.com/users/phadej/followers", + "following_url": "https://api.github.com/users/phadej/following{/other_user}", + "gists_url": "https://api.github.com/users/phadej/gists{/gist_id}", + "starred_url": "https://api.github.com/users/phadej/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/phadej/subscriptions", + "organizations_url": "https://api.github.com/users/phadej/orgs", + "repos_url": "https://api.github.com/users/phadej/repos", + "events_url": "https://api.github.com/users/phadej/events{/privacy}", + "received_events_url": "https://api.github.com/users/phadej/received_events", + "type": "User", + "site_admin": false + }, + "body": "", + "created_at": "2017-10-01T17:22:12Z", + "updated_at": "2017-10-01T17:22:12Z", + "closed_at": null, + "merged_at": null, + "merge_commit_sha": null, + "assignee": null, + "assignees": [ + ], + "milestone": null, + "commits_url": "https://api.github.com/repos/phadej/github/pulls/9/commits", + "review_comments_url": "https://api.github.com/repos/phadej/github/pulls/9/comments", + "review_comment_url": "https://api.github.com/repos/phadej/github/pulls/comments{/number}", + "comments_url": "https://api.github.com/repos/phadej/github/issues/9/comments", + "statuses_url": "https://api.github.com/repos/phadej/github/statuses/20218048bb9529de09f1fdaa9126f60ffeb07ce5", + "head": { + "label": "phadej:fetch-my-pull-requests", + "ref": "fetch-my-pull-requests", + "sha": "20218048bb9529de09f1fdaa9126f60ffeb07ce5", + "user": { + "login": "phadej", + "id": 123898390, + "avatar_url": "https://avatars3.githubusercontent.com/u/123898390?v=4", + "gravatar_id": "", + "url": "https://api.github.com/users/phadej", + "html_url": "https://github.com/phadej", + "followers_url": "https://api.github.com/users/phadej/followers", + "following_url": "https://api.github.com/users/phadej/following{/other_user}", + "gists_url": "https://api.github.com/users/phadej/gists{/gist_id}", + "starred_url": "https://api.github.com/users/phadej/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/phadej/subscriptions", + "organizations_url": "https://api.github.com/users/phadej/orgs", + "repos_url": "https://api.github.com/users/phadej/repos", + "events_url": "https://api.github.com/users/phadej/events{/privacy}", + "received_events_url": "https://api.github.com/users/phadej/received_events", + "type": "User", + "site_admin": false + }, + "repo": { + "id": 102602684, + "name": "github", + "full_name": "phadej/github", + "owner": { + "login": "phadej", + "id": 123898390, + "avatar_url": "https://avatars3.githubusercontent.com/u/123898390?v=4", + "gravatar_id": "", + "url": "https://api.github.com/users/phadej", + "html_url": "https://github.com/phadej", + "followers_url": "https://api.github.com/users/phadej/followers", + "following_url": "https://api.github.com/users/phadej/following{/other_user}", + "gists_url": "https://api.github.com/users/phadej/gists{/gist_id}", + "starred_url": "https://api.github.com/users/phadej/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/phadej/subscriptions", + "organizations_url": "https://api.github.com/users/phadej/orgs", + "repos_url": "https://api.github.com/users/phadej/repos", + "events_url": "https://api.github.com/users/phadej/events{/privacy}", + "received_events_url": "https://api.github.com/users/phadej/received_events", + "type": "User", + "site_admin": false + }, + "private": true, + "html_url": "https://github.com/phadej/github", + "description": null, + "fork": false, + "url": "https://api.github.com/repos/phadej/github", + "forks_url": "https://api.github.com/repos/phadej/github/forks", + "keys_url": "https://api.github.com/repos/phadej/github/keys{/key_id}", + "collaborators_url": "https://api.github.com/repos/phadej/github/collaborators{/collaborator}", + "teams_url": "https://api.github.com/repos/phadej/github/teams", + "hooks_url": "https://api.github.com/repos/phadej/github/hooks", + "issue_events_url": "https://api.github.com/repos/phadej/github/issues/events{/number}", + "events_url": "https://api.github.com/repos/phadej/github/events", + "assignees_url": "https://api.github.com/repos/phadej/github/assignees{/user}", + "branches_url": "https://api.github.com/repos/phadej/github/branches{/branch}", + "tags_url": "https://api.github.com/repos/phadej/github/tags", + "blobs_url": "https://api.github.com/repos/phadej/github/git/blobs{/sha}", + "git_tags_url": "https://api.github.com/repos/phadej/github/git/tags{/sha}", + "git_refs_url": "https://api.github.com/repos/phadej/github/git/refs{/sha}", + "trees_url": "https://api.github.com/repos/phadej/github/git/trees{/sha}", + "statuses_url": "https://api.github.com/repos/phadej/github/statuses/{sha}", + "languages_url": "https://api.github.com/repos/phadej/github/languages", + "stargazers_url": "https://api.github.com/repos/phadej/github/stargazers", + "contributors_url": "https://api.github.com/repos/phadej/github/contributors", + "subscribers_url": "https://api.github.com/repos/phadej/github/subscribers", + "subscription_url": "https://api.github.com/repos/phadej/github/subscription", + "commits_url": "https://api.github.com/repos/phadej/github/commits{/sha}", + "git_commits_url": "https://api.github.com/repos/phadej/github/git/commits{/sha}", + "comments_url": "https://api.github.com/repos/phadej/github/comments{/number}", + "issue_comment_url": "https://api.github.com/repos/phadej/github/issues/comments{/number}", + "contents_url": "https://api.github.com/repos/phadej/github/contents/{+path}", + "compare_url": "https://api.github.com/repos/phadej/github/compare/{base}...{head}", + "merges_url": "https://api.github.com/repos/phadej/github/merges", + "archive_url": "https://api.github.com/repos/phadej/github/{archive_format}{/ref}", + "downloads_url": "https://api.github.com/repos/phadej/github/downloads", + "issues_url": "https://api.github.com/repos/phadej/github/issues{/number}", + "pulls_url": "https://api.github.com/repos/phadej/github/pulls{/number}", + "milestones_url": "https://api.github.com/repos/phadej/github/milestones{/number}", + "notifications_url": "https://api.github.com/repos/phadej/github/notifications{?since,all,participating}", + "labels_url": "https://api.github.com/repos/phadej/github/labels{/name}", + "releases_url": "https://api.github.com/repos/phadej/github/releases{/id}", + "deployments_url": "https://api.github.com/repos/phadej/github/deployments", + "created_at": "2017-09-06T11:54:37Z", + "updated_at": "2017-09-06T11:55:42Z", + "pushed_at": "2017-10-01T16:58:54Z", + "git_url": "git://github.com/phadej/github.git", + "ssh_url": "git@github.com:phadej/github.git", + "clone_url": "https://github.com/phadej/github.git", + "svn_url": "https://github.com/phadej/github", + "homepage": null, + "size": 335, + "stargazers_count": 0, + "watchers_count": 0, + "language": "Haskell", + "has_issues": true, + "has_projects": true, + "has_downloads": true, + "has_wiki": true, + "has_pages": false, + "forks_count": 0, + "mirror_url": null, + "open_issues_count": 1, + "forks": 0, + "open_issues": 1, + "watchers": 0, + "default_branch": "master" + } + }, + "base": { + "label": "phadej:master", + "ref": "master", + "sha": "cb686149c0d88af16de61488a1ba70a6c71a2b65", + "user": { + "login": "phadej", + "id": 123898390, + "avatar_url": "https://avatars3.githubusercontent.com/u/123898390?v=4", + "gravatar_id": "", + "url": "https://api.github.com/users/phadej", + "html_url": "https://github.com/phadej", + "followers_url": "https://api.github.com/users/phadej/followers", + "following_url": "https://api.github.com/users/phadej/following{/other_user}", + "gists_url": "https://api.github.com/users/phadej/gists{/gist_id}", + "starred_url": "https://api.github.com/users/phadej/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/phadej/subscriptions", + "organizations_url": "https://api.github.com/users/phadej/orgs", + "repos_url": "https://api.github.com/users/phadej/repos", + "events_url": "https://api.github.com/users/phadej/events{/privacy}", + "received_events_url": "https://api.github.com/users/phadej/received_events", + "type": "User", + "site_admin": false + }, + "repo": { + "id": 102602684, + "name": "github", + "full_name": "phadej/github", + "owner": { + "login": "phadej", + "id": 123898390, + "avatar_url": "https://avatars3.githubusercontent.com/u/123898390?v=4", + "gravatar_id": "", + "url": "https://api.github.com/users/phadej", + "html_url": "https://github.com/phadej", + "followers_url": "https://api.github.com/users/phadej/followers", + "following_url": "https://api.github.com/users/phadej/following{/other_user}", + "gists_url": "https://api.github.com/users/phadej/gists{/gist_id}", + "starred_url": "https://api.github.com/users/phadej/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/phadej/subscriptions", + "organizations_url": "https://api.github.com/users/phadej/orgs", + "repos_url": "https://api.github.com/users/phadej/repos", + "events_url": "https://api.github.com/users/phadej/events{/privacy}", + "received_events_url": "https://api.github.com/users/phadej/received_events", + "type": "User", + "site_admin": false + }, + "private": true, + "html_url": "https://github.com/phadej/github", + "description": null, + "fork": false, + "url": "https://api.github.com/repos/phadej/github", + "forks_url": "https://api.github.com/repos/phadej/github/forks", + "keys_url": "https://api.github.com/repos/phadej/github/keys{/key_id}", + "collaborators_url": "https://api.github.com/repos/phadej/github/collaborators{/collaborator}", + "teams_url": "https://api.github.com/repos/phadej/github/teams", + "hooks_url": "https://api.github.com/repos/phadej/github/hooks", + "issue_events_url": "https://api.github.com/repos/phadej/github/issues/events{/number}", + "events_url": "https://api.github.com/repos/phadej/github/events", + "assignees_url": "https://api.github.com/repos/phadej/github/assignees{/user}", + "branches_url": "https://api.github.com/repos/phadej/github/branches{/branch}", + "tags_url": "https://api.github.com/repos/phadej/github/tags", + "blobs_url": "https://api.github.com/repos/phadej/github/git/blobs{/sha}", + "git_tags_url": "https://api.github.com/repos/phadej/github/git/tags{/sha}", + "git_refs_url": "https://api.github.com/repos/phadej/github/git/refs{/sha}", + "trees_url": "https://api.github.com/repos/phadej/github/git/trees{/sha}", + "statuses_url": "https://api.github.com/repos/phadej/github/statuses/{sha}", + "languages_url": "https://api.github.com/repos/phadej/github/languages", + "stargazers_url": "https://api.github.com/repos/phadej/github/stargazers", + "contributors_url": "https://api.github.com/repos/phadej/github/contributors", + "subscribers_url": "https://api.github.com/repos/phadej/github/subscribers", + "subscription_url": "https://api.github.com/repos/phadej/github/subscription", + "commits_url": "https://api.github.com/repos/phadej/github/commits{/sha}", + "git_commits_url": "https://api.github.com/repos/phadej/github/git/commits{/sha}", + "comments_url": "https://api.github.com/repos/phadej/github/comments{/number}", + "issue_comment_url": "https://api.github.com/repos/phadej/github/issues/comments{/number}", + "contents_url": "https://api.github.com/repos/phadej/github/contents/{+path}", + "compare_url": "https://api.github.com/repos/phadej/github/compare/{base}...{head}", + "merges_url": "https://api.github.com/repos/phadej/github/merges", + "archive_url": "https://api.github.com/repos/phadej/github/{archive_format}{/ref}", + "downloads_url": "https://api.github.com/repos/phadej/github/downloads", + "issues_url": "https://api.github.com/repos/phadej/github/issues{/number}", + "pulls_url": "https://api.github.com/repos/phadej/github/pulls{/number}", + "milestones_url": "https://api.github.com/repos/phadej/github/milestones{/number}", + "notifications_url": "https://api.github.com/repos/phadej/github/notifications{?since,all,participating}", + "labels_url": "https://api.github.com/repos/phadej/github/labels{/name}", + "releases_url": "https://api.github.com/repos/phadej/github/releases{/id}", + "deployments_url": "https://api.github.com/repos/phadej/github/deployments", + "created_at": "2017-09-06T11:54:37Z", + "updated_at": "2017-09-06T11:55:42Z", + "pushed_at": "2017-10-01T16:58:54Z", + "git_url": "git://github.com/phadej/github.git", + "ssh_url": "git@github.com:phadej/github.git", + "clone_url": "https://github.com/phadej/github.git", + "svn_url": "https://github.com/phadej/github", + "homepage": null, + "size": 335, + "stargazers_count": 0, + "watchers_count": 0, + "language": "Haskell", + "has_issues": true, + "has_projects": true, + "has_downloads": true, + "has_wiki": true, + "has_pages": false, + "forks_count": 0, + "mirror_url": null, + "open_issues_count": 1, + "forks": 0, + "open_issues": 1, + "watchers": 0, + "default_branch": "master" + } + }, + "_links": { + "self": { + "href": "https://api.github.com/repos/phadej/github/pulls/9" + }, + "html": { + "href": "https://github.com/phadej/github/pull/9" + }, + "issue": { + "href": "https://api.github.com/repos/phadej/github/issues/9" + }, + "comments": { + "href": "https://api.github.com/repos/phadej/github/issues/9/comments" + }, + "review_comments": { + "href": "https://api.github.com/repos/phadej/github/pulls/9/comments" + }, + "review_comment": { + "href": "https://api.github.com/repos/phadej/github/pulls/comments{/number}" + }, + "commits": { + "href": "https://api.github.com/repos/phadej/github/pulls/9/commits" + }, + "statuses": { + "href": "https://api.github.com/repos/phadej/github/statuses/20218048bb9529de09f1fdaa9126f60ffeb07ce5" + } + }, + "author_association": "OWNER", + "merged": false, + "mergeable": null, + "rebaseable": null, + "mergeable_state": "unknown", + "merged_by": null, + "comments": 0, + "review_comments": 0, + "maintainer_can_modify": false, + "commits": 6, + "additions": 363, + "deletions": 48, + "changed_files": 19 +} diff --git a/fixtures/pull-request-review-requested.json b/fixtures/pull-request-review-requested.json new file mode 100644 index 00000000..7a9adca2 --- /dev/null +++ b/fixtures/pull-request-review-requested.json @@ -0,0 +1,351 @@ +{ + "url": "https://api.github.com/repos/phadej/github/pulls/9", + "id": 144079630, + "html_url": "https://github.com/phadej/github/pull/9", + "diff_url": "https://github.com/phadej/github/pull/9.diff", + "patch_url": "https://github.com/phadej/github/pull/9.patch", + "issue_url": "https://api.github.com/repos/phadej/github/issues/9", + "number": 9, + "state": "open", + "locked": false, + "title": "Fetch my pull requests", + "user": { + "login": "phadej", + "id": 123898390, + "avatar_url": "https://avatars3.githubusercontent.com/u/123898390?v=4", + "gravatar_id": "", + "url": "https://api.github.com/users/phadej", + "html_url": "https://github.com/phadej", + "followers_url": "https://api.github.com/users/phadej/followers", + "following_url": "https://api.github.com/users/phadej/following{/other_user}", + "gists_url": "https://api.github.com/users/phadej/gists{/gist_id}", + "starred_url": "https://api.github.com/users/phadej/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/phadej/subscriptions", + "organizations_url": "https://api.github.com/users/phadej/orgs", + "repos_url": "https://api.github.com/users/phadej/repos", + "events_url": "https://api.github.com/users/phadej/events{/privacy}", + "received_events_url": "https://api.github.com/users/phadej/received_events", + "type": "User", + "site_admin": false + }, + "body": "", + "created_at": "2017-10-01T17:22:12Z", + "updated_at": "2017-10-01T17:22:12Z", + "closed_at": null, + "merged_at": null, + "merge_commit_sha": null, + "assignee": null, + "assignees": [ + { + "login": "phadej", + "id": 123898390, + "avatar_url": "https://avatars3.githubusercontent.com/u/123898390?v=4", + "gravatar_id": "", + "url": "https://api.github.com/users/phadej", + "html_url": "https://github.com/phadej", + "followers_url": "https://api.github.com/users/phadej/followers", + "following_url": "https://api.github.com/users/phadej/following{/other_user}", + "gists_url": "https://api.github.com/users/phadej/gists{/gist_id}", + "starred_url": "https://api.github.com/users/phadej/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/phadej/subscriptions", + "organizations_url": "https://api.github.com/users/phadej/orgs", + "repos_url": "https://api.github.com/users/phadej/repos", + "events_url": "https://api.github.com/users/phadej/events{/privacy}", + "received_events_url": "https://api.github.com/users/phadej/received_events", + "type": "User", + "site_admin": false + } + ], + "requested_reviewers": [ + { + "login": "phadej", + "id": 123898390, + "avatar_url": "https://avatars3.githubusercontent.com/u/123898390?v=4", + "gravatar_id": "", + "url": "https://api.github.com/users/phadej", + "html_url": "https://github.com/phadej", + "followers_url": "https://api.github.com/users/phadej/followers", + "following_url": "https://api.github.com/users/phadej/following{/other_user}", + "gists_url": "https://api.github.com/users/phadej/gists{/gist_id}", + "starred_url": "https://api.github.com/users/phadej/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/phadej/subscriptions", + "organizations_url": "https://api.github.com/users/phadej/orgs", + "repos_url": "https://api.github.com/users/phadej/repos", + "events_url": "https://api.github.com/users/phadej/events{/privacy}", + "received_events_url": "https://api.github.com/users/phadej/received_events", + "type": "User", + "site_admin": false + } + ], + "milestone": null, + "commits_url": "https://api.github.com/repos/phadej/github/pulls/9/commits", + "review_comments_url": "https://api.github.com/repos/phadej/github/pulls/9/comments", + "review_comment_url": "https://api.github.com/repos/phadej/github/pulls/comments{/number}", + "comments_url": "https://api.github.com/repos/phadej/github/issues/9/comments", + "statuses_url": "https://api.github.com/repos/phadej/github/statuses/20218048bb9529de09f1fdaa9126f60ffeb07ce5", + "head": { + "label": "phadej:fetch-my-pull-requests", + "ref": "fetch-my-pull-requests", + "sha": "20218048bb9529de09f1fdaa9126f60ffeb07ce5", + "user": { + "login": "phadej", + "id": 123898390, + "avatar_url": "https://avatars3.githubusercontent.com/u/123898390?v=4", + "gravatar_id": "", + "url": "https://api.github.com/users/phadej", + "html_url": "https://github.com/phadej", + "followers_url": "https://api.github.com/users/phadej/followers", + "following_url": "https://api.github.com/users/phadej/following{/other_user}", + "gists_url": "https://api.github.com/users/phadej/gists{/gist_id}", + "starred_url": "https://api.github.com/users/phadej/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/phadej/subscriptions", + "organizations_url": "https://api.github.com/users/phadej/orgs", + "repos_url": "https://api.github.com/users/phadej/repos", + "events_url": "https://api.github.com/users/phadej/events{/privacy}", + "received_events_url": "https://api.github.com/users/phadej/received_events", + "type": "User", + "site_admin": false + }, + "repo": { + "id": 102602684, + "name": "github", + "full_name": "phadej/github", + "owner": { + "login": "phadej", + "id": 123898390, + "avatar_url": "https://avatars3.githubusercontent.com/u/123898390?v=4", + "gravatar_id": "", + "url": "https://api.github.com/users/phadej", + "html_url": "https://github.com/phadej", + "followers_url": "https://api.github.com/users/phadej/followers", + "following_url": "https://api.github.com/users/phadej/following{/other_user}", + "gists_url": "https://api.github.com/users/phadej/gists{/gist_id}", + "starred_url": "https://api.github.com/users/phadej/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/phadej/subscriptions", + "organizations_url": "https://api.github.com/users/phadej/orgs", + "repos_url": "https://api.github.com/users/phadej/repos", + "events_url": "https://api.github.com/users/phadej/events{/privacy}", + "received_events_url": "https://api.github.com/users/phadej/received_events", + "type": "User", + "site_admin": false + }, + "private": true, + "html_url": "https://github.com/phadej/github", + "description": null, + "fork": false, + "url": "https://api.github.com/repos/phadej/github", + "forks_url": "https://api.github.com/repos/phadej/github/forks", + "keys_url": "https://api.github.com/repos/phadej/github/keys{/key_id}", + "collaborators_url": "https://api.github.com/repos/phadej/github/collaborators{/collaborator}", + "teams_url": "https://api.github.com/repos/phadej/github/teams", + "hooks_url": "https://api.github.com/repos/phadej/github/hooks", + "issue_events_url": "https://api.github.com/repos/phadej/github/issues/events{/number}", + "events_url": "https://api.github.com/repos/phadej/github/events", + "assignees_url": "https://api.github.com/repos/phadej/github/assignees{/user}", + "branches_url": "https://api.github.com/repos/phadej/github/branches{/branch}", + "tags_url": "https://api.github.com/repos/phadej/github/tags", + "blobs_url": "https://api.github.com/repos/phadej/github/git/blobs{/sha}", + "git_tags_url": "https://api.github.com/repos/phadej/github/git/tags{/sha}", + "git_refs_url": "https://api.github.com/repos/phadej/github/git/refs{/sha}", + "trees_url": "https://api.github.com/repos/phadej/github/git/trees{/sha}", + "statuses_url": "https://api.github.com/repos/phadej/github/statuses/{sha}", + "languages_url": "https://api.github.com/repos/phadej/github/languages", + "stargazers_url": "https://api.github.com/repos/phadej/github/stargazers", + "contributors_url": "https://api.github.com/repos/phadej/github/contributors", + "subscribers_url": "https://api.github.com/repos/phadej/github/subscribers", + "subscription_url": "https://api.github.com/repos/phadej/github/subscription", + "commits_url": "https://api.github.com/repos/phadej/github/commits{/sha}", + "git_commits_url": "https://api.github.com/repos/phadej/github/git/commits{/sha}", + "comments_url": "https://api.github.com/repos/phadej/github/comments{/number}", + "issue_comment_url": "https://api.github.com/repos/phadej/github/issues/comments{/number}", + "contents_url": "https://api.github.com/repos/phadej/github/contents/{+path}", + "compare_url": "https://api.github.com/repos/phadej/github/compare/{base}...{head}", + "merges_url": "https://api.github.com/repos/phadej/github/merges", + "archive_url": "https://api.github.com/repos/phadej/github/{archive_format}{/ref}", + "downloads_url": "https://api.github.com/repos/phadej/github/downloads", + "issues_url": "https://api.github.com/repos/phadej/github/issues{/number}", + "pulls_url": "https://api.github.com/repos/phadej/github/pulls{/number}", + "milestones_url": "https://api.github.com/repos/phadej/github/milestones{/number}", + "notifications_url": "https://api.github.com/repos/phadej/github/notifications{?since,all,participating}", + "labels_url": "https://api.github.com/repos/phadej/github/labels{/name}", + "releases_url": "https://api.github.com/repos/phadej/github/releases{/id}", + "deployments_url": "https://api.github.com/repos/phadej/github/deployments", + "created_at": "2017-09-06T11:54:37Z", + "updated_at": "2017-09-06T11:55:42Z", + "pushed_at": "2017-10-01T16:58:54Z", + "git_url": "git://github.com/phadej/github.git", + "ssh_url": "git@github.com:phadej/github.git", + "clone_url": "https://github.com/phadej/github.git", + "svn_url": "https://github.com/phadej/github", + "homepage": null, + "size": 335, + "stargazers_count": 0, + "watchers_count": 0, + "language": "Haskell", + "has_issues": true, + "has_projects": true, + "has_downloads": true, + "has_wiki": true, + "has_pages": false, + "forks_count": 0, + "mirror_url": null, + "open_issues_count": 1, + "forks": 0, + "open_issues": 1, + "watchers": 0, + "default_branch": "master" + } + }, + "base": { + "label": "phadej:master", + "ref": "master", + "sha": "cb686149c0d88af16de61488a1ba70a6c71a2b65", + "user": { + "login": "phadej", + "id": 123898390, + "avatar_url": "https://avatars3.githubusercontent.com/u/123898390?v=4", + "gravatar_id": "", + "url": "https://api.github.com/users/phadej", + "html_url": "https://github.com/phadej", + "followers_url": "https://api.github.com/users/phadej/followers", + "following_url": "https://api.github.com/users/phadej/following{/other_user}", + "gists_url": "https://api.github.com/users/phadej/gists{/gist_id}", + "starred_url": "https://api.github.com/users/phadej/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/phadej/subscriptions", + "organizations_url": "https://api.github.com/users/phadej/orgs", + "repos_url": "https://api.github.com/users/phadej/repos", + "events_url": "https://api.github.com/users/phadej/events{/privacy}", + "received_events_url": "https://api.github.com/users/phadej/received_events", + "type": "User", + "site_admin": false + }, + "repo": { + "id": 102602684, + "name": "github", + "full_name": "phadej/github", + "owner": { + "login": "phadej", + "id": 123898390, + "avatar_url": "https://avatars3.githubusercontent.com/u/123898390?v=4", + "gravatar_id": "", + "url": "https://api.github.com/users/phadej", + "html_url": "https://github.com/phadej", + "followers_url": "https://api.github.com/users/phadej/followers", + "following_url": "https://api.github.com/users/phadej/following{/other_user}", + "gists_url": "https://api.github.com/users/phadej/gists{/gist_id}", + "starred_url": "https://api.github.com/users/phadej/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/phadej/subscriptions", + "organizations_url": "https://api.github.com/users/phadej/orgs", + "repos_url": "https://api.github.com/users/phadej/repos", + "events_url": "https://api.github.com/users/phadej/events{/privacy}", + "received_events_url": "https://api.github.com/users/phadej/received_events", + "type": "User", + "site_admin": false + }, + "private": true, + "html_url": "https://github.com/phadej/github", + "description": null, + "fork": false, + "url": "https://api.github.com/repos/phadej/github", + "forks_url": "https://api.github.com/repos/phadej/github/forks", + "keys_url": "https://api.github.com/repos/phadej/github/keys{/key_id}", + "collaborators_url": "https://api.github.com/repos/phadej/github/collaborators{/collaborator}", + "teams_url": "https://api.github.com/repos/phadej/github/teams", + "hooks_url": "https://api.github.com/repos/phadej/github/hooks", + "issue_events_url": "https://api.github.com/repos/phadej/github/issues/events{/number}", + "events_url": "https://api.github.com/repos/phadej/github/events", + "assignees_url": "https://api.github.com/repos/phadej/github/assignees{/user}", + "branches_url": "https://api.github.com/repos/phadej/github/branches{/branch}", + "tags_url": "https://api.github.com/repos/phadej/github/tags", + "blobs_url": "https://api.github.com/repos/phadej/github/git/blobs{/sha}", + "git_tags_url": "https://api.github.com/repos/phadej/github/git/tags{/sha}", + "git_refs_url": "https://api.github.com/repos/phadej/github/git/refs{/sha}", + "trees_url": "https://api.github.com/repos/phadej/github/git/trees{/sha}", + "statuses_url": "https://api.github.com/repos/phadej/github/statuses/{sha}", + "languages_url": "https://api.github.com/repos/phadej/github/languages", + "stargazers_url": "https://api.github.com/repos/phadej/github/stargazers", + "contributors_url": "https://api.github.com/repos/phadej/github/contributors", + "subscribers_url": "https://api.github.com/repos/phadej/github/subscribers", + "subscription_url": "https://api.github.com/repos/phadej/github/subscription", + "commits_url": "https://api.github.com/repos/phadej/github/commits{/sha}", + "git_commits_url": "https://api.github.com/repos/phadej/github/git/commits{/sha}", + "comments_url": "https://api.github.com/repos/phadej/github/comments{/number}", + "issue_comment_url": "https://api.github.com/repos/phadej/github/issues/comments{/number}", + "contents_url": "https://api.github.com/repos/phadej/github/contents/{+path}", + "compare_url": "https://api.github.com/repos/phadej/github/compare/{base}...{head}", + "merges_url": "https://api.github.com/repos/phadej/github/merges", + "archive_url": "https://api.github.com/repos/phadej/github/{archive_format}{/ref}", + "downloads_url": "https://api.github.com/repos/phadej/github/downloads", + "issues_url": "https://api.github.com/repos/phadej/github/issues{/number}", + "pulls_url": "https://api.github.com/repos/phadej/github/pulls{/number}", + "milestones_url": "https://api.github.com/repos/phadej/github/milestones{/number}", + "notifications_url": "https://api.github.com/repos/phadej/github/notifications{?since,all,participating}", + "labels_url": "https://api.github.com/repos/phadej/github/labels{/name}", + "releases_url": "https://api.github.com/repos/phadej/github/releases{/id}", + "deployments_url": "https://api.github.com/repos/phadej/github/deployments", + "created_at": "2017-09-06T11:54:37Z", + "updated_at": "2017-09-06T11:55:42Z", + "pushed_at": "2017-10-01T16:58:54Z", + "git_url": "git://github.com/phadej/github.git", + "ssh_url": "git@github.com:phadej/github.git", + "clone_url": "https://github.com/phadej/github.git", + "svn_url": "https://github.com/phadej/github", + "homepage": null, + "size": 335, + "stargazers_count": 0, + "watchers_count": 0, + "language": "Haskell", + "has_issues": true, + "has_projects": true, + "has_downloads": true, + "has_wiki": true, + "has_pages": false, + "forks_count": 0, + "mirror_url": null, + "open_issues_count": 1, + "forks": 0, + "open_issues": 1, + "watchers": 0, + "default_branch": "master" + } + }, + "_links": { + "self": { + "href": "https://api.github.com/repos/phadej/github/pulls/9" + }, + "html": { + "href": "https://github.com/phadej/github/pull/9" + }, + "issue": { + "href": "https://api.github.com/repos/phadej/github/issues/9" + }, + "comments": { + "href": "https://api.github.com/repos/phadej/github/issues/9/comments" + }, + "review_comments": { + "href": "https://api.github.com/repos/phadej/github/pulls/9/comments" + }, + "review_comment": { + "href": "https://api.github.com/repos/phadej/github/pulls/comments{/number}" + }, + "commits": { + "href": "https://api.github.com/repos/phadej/github/pulls/9/commits" + }, + "statuses": { + "href": "https://api.github.com/repos/phadej/github/statuses/20218048bb9529de09f1fdaa9126f60ffeb07ce5" + } + }, + "author_association": "OWNER", + "merged": false, + "mergeable": null, + "rebaseable": null, + "mergeable_state": "unknown", + "merged_by": null, + "comments": 0, + "review_comments": 0, + "maintainer_can_modify": false, + "commits": 6, + "additions": 363, + "deletions": 48, + "changed_files": 19 +} diff --git a/github.cabal b/github.cabal index d6c2ac2c..d403ac01 100644 --- a/github.cabal +++ b/github.cabal @@ -33,6 +33,8 @@ extra-source-files: fixtures/issue-search.json, fixtures/list-teams.json, fixtures/members-list.json, + fixtures/pull-request-opened.json, + fixtures/pull-request-review-requested.json, fixtures/user-organizations.json, fixtures/user.json @@ -184,6 +186,7 @@ test-suite github-test ghc-options: -Wall build-depends: base, base-compat, + bytestring, github, vector, unordered-containers, diff --git a/spec/GitHub/PullRequestsSpec.hs b/spec/GitHub/PullRequestsSpec.hs index 78d1ab1c..609412eb 100644 --- a/spec/GitHub/PullRequestsSpec.hs +++ b/spec/GitHub/PullRequestsSpec.hs @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} module GitHub.PullRequestsSpec where import qualified GitHub @@ -6,11 +7,15 @@ import qualified GitHub 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) +import Data.Aeson.Compat (eitherDecodeStrict) +import Data.ByteString (ByteString) +import Data.Either.Compat (isRight) +import Data.FileEmbed (embedFile) +import Data.Foldable (for_) +import Data.String (fromString) +import qualified Data.Vector as V +import System.Environment (lookupEnv) +import Test.Hspec (Spec, describe, it, pendingWith, shouldBe, shouldSatisfy) fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b @@ -28,8 +33,23 @@ spec = do describe "pullRequestsForR" $ do it "works" $ withAuth $ \auth -> for_ repos $ \(owner, repo) -> do cs <- GitHub.executeRequest auth $ - GitHub.pullRequestsForR owner repo opts GitHub.FetchAll + GitHub.pullRequestsForR owner repo opts GitHub.FetchAll cs `shouldSatisfy` isRight + + describe "decoding pull request payloads" $ do + it "decodes a pull request 'opened' payload" $ do + V.length (GitHub.simplePullRequestRequestedReviewers simplePullRequestOpened) + `shouldBe` 0 + + V.length (GitHub.pullRequestRequestedReviewers pullRequestOpened) + `shouldBe` 0 + + it "decodes a pull request 'review_requested' payload" $ do + V.length (GitHub.simplePullRequestRequestedReviewers simplePullRequestReviewRequested) + `shouldBe` 1 + + V.length (GitHub.pullRequestRequestedReviewers pullRequestReviewRequested) + `shouldBe` 1 where repos = [ ("thoughtbot", "paperclip") @@ -37,3 +57,25 @@ spec = do , ("haskell", "cabal") ] opts = GitHub.stateClosed + + simplePullRequestOpened :: GitHub.SimplePullRequest + simplePullRequestOpened = + fromRightS (eitherDecodeStrict prOpenedPayload) + + pullRequestOpened :: GitHub.PullRequest + pullRequestOpened = + fromRightS (eitherDecodeStrict prOpenedPayload) + + simplePullRequestReviewRequested :: GitHub.SimplePullRequest + simplePullRequestReviewRequested = + fromRightS (eitherDecodeStrict prReviewRequestedPayload) + + pullRequestReviewRequested :: GitHub.PullRequest + pullRequestReviewRequested = + fromRightS (eitherDecodeStrict prReviewRequestedPayload) + + prOpenedPayload :: ByteString + prOpenedPayload = $(embedFile "fixtures/pull-request-opened.json") + + prReviewRequestedPayload :: ByteString + prReviewRequestedPayload = $(embedFile "fixtures/pull-request-review-requested.json") diff --git a/src/GitHub/Data/PullRequests.hs b/src/GitHub/Data/PullRequests.hs index ab0d1976..0a80ce7f 100644 --- a/src/GitHub/Data/PullRequests.hs +++ b/src/GitHub/Data/PullRequests.hs @@ -29,23 +29,24 @@ import Prelude () import qualified Data.Text as T data SimplePullRequest = SimplePullRequest - { simplePullRequestClosedAt :: !(Maybe UTCTime) - , simplePullRequestCreatedAt :: !UTCTime - , simplePullRequestUser :: !SimpleUser - , simplePullRequestPatchUrl :: !URL - , simplePullRequestState :: !IssueState - , simplePullRequestNumber :: !Int - , simplePullRequestHtmlUrl :: !URL - , simplePullRequestUpdatedAt :: !UTCTime - , simplePullRequestBody :: !(Maybe Text) - , simplePullRequestAssignees :: (Vector SimpleUser) - , simplePullRequestIssueUrl :: !URL - , simplePullRequestDiffUrl :: !URL - , simplePullRequestUrl :: !URL - , simplePullRequestLinks :: !PullRequestLinks - , simplePullRequestMergedAt :: !(Maybe UTCTime) - , simplePullRequestTitle :: !Text - , simplePullRequestId :: !(Id PullRequest) + { simplePullRequestClosedAt :: !(Maybe UTCTime) + , simplePullRequestCreatedAt :: !UTCTime + , simplePullRequestUser :: !SimpleUser + , simplePullRequestPatchUrl :: !URL + , simplePullRequestState :: !IssueState + , simplePullRequestNumber :: !Int + , simplePullRequestHtmlUrl :: !URL + , simplePullRequestUpdatedAt :: !UTCTime + , simplePullRequestBody :: !(Maybe Text) + , simplePullRequestAssignees :: (Vector SimpleUser) + , simplePullRequestRequestedReviewers :: (Vector SimpleUser) + , simplePullRequestIssueUrl :: !URL + , simplePullRequestDiffUrl :: !URL + , simplePullRequestUrl :: !URL + , simplePullRequestLinks :: !PullRequestLinks + , simplePullRequestMergedAt :: !(Maybe UTCTime) + , simplePullRequestTitle :: !Text + , simplePullRequestId :: !(Id PullRequest) } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -53,35 +54,36 @@ instance NFData SimplePullRequest where rnf = genericRnf instance Binary SimplePullRequest data PullRequest = PullRequest - { pullRequestClosedAt :: !(Maybe UTCTime) - , pullRequestCreatedAt :: !UTCTime - , pullRequestUser :: !SimpleUser - , pullRequestPatchUrl :: !URL - , pullRequestState :: !IssueState - , pullRequestNumber :: !Int - , pullRequestHtmlUrl :: !URL - , pullRequestUpdatedAt :: !UTCTime - , pullRequestBody :: !(Maybe Text) - , pullRequestAssignees :: (Vector SimpleUser) - , pullRequestIssueUrl :: !URL - , pullRequestDiffUrl :: !URL - , pullRequestUrl :: !URL - , pullRequestLinks :: !PullRequestLinks - , pullRequestMergedAt :: !(Maybe UTCTime) - , pullRequestTitle :: !Text - , pullRequestId :: !(Id PullRequest) - , pullRequestMergedBy :: !(Maybe SimpleUser) - , pullRequestChangedFiles :: !Int - , pullRequestHead :: !PullRequestCommit - , pullRequestComments :: !Count - , pullRequestDeletions :: !Count - , pullRequestAdditions :: !Count - , pullRequestReviewComments :: !Count - , pullRequestBase :: !PullRequestCommit - , pullRequestCommits :: !Count - , pullRequestMerged :: !Bool - , pullRequestMergeable :: !(Maybe Bool) - , pullRequestMergeableState :: !MergeableState + { pullRequestClosedAt :: !(Maybe UTCTime) + , pullRequestCreatedAt :: !UTCTime + , pullRequestUser :: !SimpleUser + , pullRequestPatchUrl :: !URL + , pullRequestState :: !IssueState + , pullRequestNumber :: !Int + , pullRequestHtmlUrl :: !URL + , pullRequestUpdatedAt :: !UTCTime + , pullRequestBody :: !(Maybe Text) + , pullRequestAssignees :: (Vector SimpleUser) + , pullRequestRequestedReviewers :: (Vector SimpleUser) + , pullRequestIssueUrl :: !URL + , pullRequestDiffUrl :: !URL + , pullRequestUrl :: !URL + , pullRequestLinks :: !PullRequestLinks + , pullRequestMergedAt :: !(Maybe UTCTime) + , pullRequestTitle :: !Text + , pullRequestId :: !(Id PullRequest) + , pullRequestMergedBy :: !(Maybe SimpleUser) + , pullRequestChangedFiles :: !Int + , pullRequestHead :: !PullRequestCommit + , pullRequestComments :: !Count + , pullRequestDeletions :: !Count + , pullRequestAdditions :: !Count + , pullRequestReviewComments :: !Count + , pullRequestBase :: !PullRequestCommit + , pullRequestCommits :: !Count + , pullRequestMerged :: !Bool + , pullRequestMergeable :: !(Maybe Bool) + , pullRequestMergeableState :: !MergeableState } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -197,6 +199,7 @@ instance FromJSON SimplePullRequest where <*> o .: "updated_at" <*> o .:? "body" <*> o .: "assignees" + <*> o .:? "requested_reviewers" .!= mempty <*> o .: "issue_url" <*> o .: "diff_url" <*> o .: "url" @@ -237,6 +240,7 @@ instance FromJSON PullRequest where <*> o .: "updated_at" <*> o .:? "body" <*> o .: "assignees" + <*> o .:? "requested_reviewers" .!= mempty <*> o .: "issue_url" <*> o .: "diff_url" <*> o .: "url" From 7a7221568cf09ad332fa8a82d8a2a335386c2802 Mon Sep 17 00:00:00 2001 From: James Dabbs Date: Sun, 26 Feb 2017 16:47:15 -0500 Subject: [PATCH 280/510] Add create status endpoint --- github.cabal | 2 + spec/GitHub/CommitsSpec.hs | 4 +- src/GitHub/Data.hs | 6 ++ src/GitHub/Data/Statuses.hs | 81 ++++++++++++++++++++++++++ src/GitHub/Endpoints/Repos/Statuses.hs | 23 ++++++++ 5 files changed, 113 insertions(+), 3 deletions(-) create mode 100644 src/GitHub/Data/Statuses.hs create mode 100644 src/GitHub/Endpoints/Repos/Statuses.hs diff --git a/github.cabal b/github.cabal index d6c2ac2c..75c1de42 100644 --- a/github.cabal +++ b/github.cabal @@ -86,6 +86,7 @@ Library GitHub.Data.Request GitHub.Data.Reviews GitHub.Data.Search + GitHub.Data.Statuses GitHub.Data.Teams GitHub.Data.URL GitHub.Data.Webhooks @@ -118,6 +119,7 @@ Library GitHub.Endpoints.Repos.DeployKeys GitHub.Endpoints.Repos.Forks GitHub.Endpoints.Repos.Releases + GitHub.Endpoints.Repos.Statuses GitHub.Endpoints.Repos.Webhooks GitHub.Endpoints.Search GitHub.Endpoints.Users diff --git a/spec/GitHub/CommitsSpec.hs b/spec/GitHub/CommitsSpec.hs index 2ca4f1a4..046fd36d 100644 --- a/spec/GitHub/CommitsSpec.hs +++ b/spec/GitHub/CommitsSpec.hs @@ -6,13 +6,12 @@ import qualified GitHub import GitHub.Auth (Auth (..)) import GitHub.Endpoints.Repos.Commits (Commit, commitSha, commitsFor', - commitsForR, diffR, mkName) + commitsForR, diffR, mkCommitName) import GitHub.Request (executeRequest) import Control.Monad (forM_) import Data.Either.Compat (isRight) import Data.List (nub, sort) -import Data.Proxy (Proxy (..)) import Data.String (fromString) import System.Environment (lookupEnv) import Test.Hspec (Spec, describe, it, pendingWith, shouldBe, @@ -59,6 +58,5 @@ spec = do d `shouldSatisfy` isRight it "issue #155" $ withAuth $ \auth -> do - let mkCommitName = mkName (Proxy :: Proxy Commit) d <- executeRequest auth $ diffR "nomeata" "codespeed" (mkCommitName "ghc") (mkCommitName "tobami:master") d `shouldSatisfy` isRight diff --git a/src/GitHub/Data.hs b/src/GitHub/Data.hs index 38d4efab..67fb6b09 100644 --- a/src/GitHub/Data.hs +++ b/src/GitHub/Data.hs @@ -16,6 +16,7 @@ module GitHub.Data ( mkTeamName, mkOrganizationName, mkRepoName, + mkCommitName, fromUserName, fromOrganizationName, -- ** Id @@ -48,6 +49,7 @@ module GitHub.Data ( module GitHub.Data.Request, module GitHub.Data.Reviews, module GitHub.Data.Search, + module GitHub.Data.Statuses, module GitHub.Data.Teams, module GitHub.Data.URL, module GitHub.Data.Webhooks @@ -76,6 +78,7 @@ import GitHub.Data.Repos import GitHub.Data.Request import GitHub.Data.Reviews import GitHub.Data.Search +import GitHub.Data.Statuses import GitHub.Data.Teams import GitHub.Data.URL import GitHub.Data.Webhooks @@ -110,6 +113,9 @@ mkRepoId = Id mkRepoName :: Text -> Name Repo mkRepoName = N +mkCommitName :: Text -> Name Commit +mkCommitName = N + fromOrganizationName :: Name Organization -> Name Owner fromOrganizationName = N . untagName diff --git a/src/GitHub/Data/Statuses.hs b/src/GitHub/Data/Statuses.hs new file mode 100644 index 00000000..a6aae6ff --- /dev/null +++ b/src/GitHub/Data/Statuses.hs @@ -0,0 +1,81 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +module GitHub.Data.Statuses where + +import GitHub.Data.Definitions +import GitHub.Data.Id (Id) +import GitHub.Data.URL (URL) +import GitHub.Internal.Prelude +import Prelude () + +data StatusState + = StatusPending + | StatusSuccess + | StatusError + | StatusFailure + deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic) + +instance NFData StatusState where rnf = genericRnf +instance Binary StatusState + +instance FromJSON StatusState where + parseJSON (String "pending") = pure StatusPending + parseJSON (String "success") = pure StatusSuccess + parseJSON (String "error") = pure StatusError + parseJSON (String "failure") = pure StatusFailure + parseJSON _ = fail "Could not build a StatusState" + +instance ToJSON StatusState where + toJSON StatusPending = String "pending" + toJSON StatusSuccess = String "success" + toJSON StatusError = String "error" + toJSON StatusFailure = String "failure" + +data Status = Status + { statusCreatedAt :: !UTCTime + , statusUpdatedAt :: !UTCTime + , statusState :: !StatusState + , statusTargetUrl :: !(Maybe URL) + , statusDescription :: !(Maybe Text) + , statusId :: !(Id Status) + , statusUrl :: !URL + , statusContext :: !(Maybe Text) + , statusCreator :: !SimpleUser + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance FromJSON Status where + parseJSON = withObject "Status" $ \o -> Status + <$> o .: "created_at" + <*> o .: "updated_at" + <*> o .: "state" + <*> o .:? "target_url" + <*> o .:? "description" + <*> o .: "id" + <*> o .: "url" + <*> o .:? "context" + <*> o .: "creator" + +data NewStatus = NewStatus + { newStatusState :: !StatusState + , newStatusTargetUrl :: !(Maybe URL) + , newStatusDescription :: !(Maybe Text) + , newStatusContext :: !(Maybe Text) + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData NewStatus where rnf = genericRnf +instance Binary NewStatus + +instance ToJSON NewStatus where + toJSON (NewStatus s t d c) = object $ filter notNull $ + [ "state" .= s + , "target_url" .= t + , "description" .= d + , "context" .= c + ] + where + notNull (_, Null) = False + notNull (_, _) = True diff --git a/src/GitHub/Endpoints/Repos/Statuses.hs b/src/GitHub/Endpoints/Repos/Statuses.hs new file mode 100644 index 00000000..e0858873 --- /dev/null +++ b/src/GitHub/Endpoints/Repos/Statuses.hs @@ -0,0 +1,23 @@ +-- +-- The repo statuses API as described on +-- . +module GitHub.Endpoints.Repos.Statuses ( + createStatus, + createStatusR, + module GitHub.Data + ) where + +import GitHub.Data +import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () + +createStatus :: Auth -> Name Owner -> Name Repo -> Name Commit -> NewStatus -> IO (Either Error Status) +createStatus auth owner repo sha ns = + executeRequest auth $ createStatusR owner repo sha ns + +createStatusR :: Name Owner -> Name Repo -> Name Commit -> NewStatus -> Request 'RW Status +createStatusR owner repo sha = + command Post parts . encode + where + parts = ["repos", toPathPart owner, toPathPart repo, "statuses", toPathPart sha] From e631f83f2574873c9648a25f7ecc65ae15d23bf6 Mon Sep 17 00:00:00 2001 From: James Dabbs Date: Sun, 26 Feb 2017 18:37:16 -0500 Subject: [PATCH 281/510] Add status-reading endpoints --- src/GitHub/Data/Statuses.hs | 33 ++++++++++++++++++++++++-- src/GitHub/Endpoints/Repos/Statuses.hs | 28 ++++++++++++++++++---- 2 files changed, 55 insertions(+), 6 deletions(-) diff --git a/src/GitHub/Data/Statuses.hs b/src/GitHub/Data/Statuses.hs index a6aae6ff..0b5e3b37 100644 --- a/src/GitHub/Data/Statuses.hs +++ b/src/GitHub/Data/Statuses.hs @@ -5,11 +5,16 @@ module GitHub.Data.Statuses where import GitHub.Data.Definitions +import GitHub.Data.Name (Name) import GitHub.Data.Id (Id) import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () +import GitHub.Data.GitData (Commit) +import GitHub.Data.Repos (RepoRef) + + data StatusState = StatusPending | StatusSuccess @@ -33,6 +38,7 @@ instance ToJSON StatusState where toJSON StatusError = String "error" toJSON StatusFailure = String "failure" + data Status = Status { statusCreatedAt :: !UTCTime , statusUpdatedAt :: !UTCTime @@ -42,7 +48,7 @@ data Status = Status , statusId :: !(Id Status) , statusUrl :: !URL , statusContext :: !(Maybe Text) - , statusCreator :: !SimpleUser + , statusCreator :: !(Maybe SimpleUser) } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -56,7 +62,8 @@ instance FromJSON Status where <*> o .: "id" <*> o .: "url" <*> o .:? "context" - <*> o .: "creator" + <*> o .:? "creator" + data NewStatus = NewStatus { newStatusState :: !StatusState @@ -79,3 +86,25 @@ instance ToJSON NewStatus where where notNull (_, Null) = False notNull (_, _) = True + + +data CombinedStatus = CombinedStatus + { combinedStatusState :: !StatusState + , combinedStatusSha :: !(Name Commit) + , combinedStatusTotalCount :: !Int + , combinedStatusStatuses :: !(Vector Status) + , combinedStatusRepository :: !RepoRef + , combinedStatusCommitUrl :: !URL + , combinedStatusUrl :: !URL + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance FromJSON CombinedStatus where + parseJSON = withObject "CombinedStatus" $ \o -> CombinedStatus + <$> o .: "state" + <*> o .: "sha" + <*> o .: "total_count" + <*> o .: "statuses" + <*> o .: "repository" + <*> o .: "commit_url" + <*> o .: "url" diff --git a/src/GitHub/Endpoints/Repos/Statuses.hs b/src/GitHub/Endpoints/Repos/Statuses.hs index e0858873..3bf16423 100644 --- a/src/GitHub/Endpoints/Repos/Statuses.hs +++ b/src/GitHub/Endpoints/Repos/Statuses.hs @@ -4,6 +4,10 @@ module GitHub.Endpoints.Repos.Statuses ( createStatus, createStatusR, + statusesFor, + statusesForR, + statusFor, + statusForR, module GitHub.Data ) where @@ -14,10 +18,26 @@ import Prelude () createStatus :: Auth -> Name Owner -> Name Repo -> Name Commit -> NewStatus -> IO (Either Error Status) createStatus auth owner repo sha ns = - executeRequest auth $ createStatusR owner repo sha ns + executeRequest auth $ createStatusR owner repo sha ns createStatusR :: Name Owner -> Name Repo -> Name Commit -> NewStatus -> Request 'RW Status createStatusR owner repo sha = - command Post parts . encode - where - parts = ["repos", toPathPart owner, toPathPart repo, "statuses", toPathPart sha] + command Post parts . encode + where + parts = ["repos", toPathPart owner, toPathPart repo, "statuses", toPathPart sha] + +statusesFor :: Auth -> Name Owner -> Name Repo -> Name Commit -> IO (Either Error (Vector Status)) +statusesFor auth user repo sha = + executeRequest auth $ statusesForR user repo sha FetchAll + +statusesForR :: Name Owner -> Name Repo -> Name Commit -> FetchCount -> Request 'RW (Vector Status) +statusesForR user repo sha = + pagedQuery ["repos", toPathPart user, toPathPart repo, "commits", toPathPart sha, "statuses"] [] + +statusFor :: Auth -> Name Owner -> Name Repo -> Name Commit -> IO (Either Error CombinedStatus) +statusFor auth user repo sha = + executeRequest auth $ statusForR user repo sha + +statusForR :: Name Owner -> Name Repo -> Name Commit -> Request 'RW CombinedStatus +statusForR user repo sha = + query ["repos", toPathPart user, toPathPart repo, "commits", toPathPart sha, "status"] [] From d7d857270ff61b717e7ca09eac4c4ec5658321bc Mon Sep 17 00:00:00 2001 From: James Dabbs Date: Sun, 8 Oct 2017 11:26:42 -0400 Subject: [PATCH 282/510] Add documentation for status endpoints --- src/GitHub.hs | 7 +++++++ src/GitHub/Endpoints/Repos/Statuses.hs | 23 +++++++++++++++++++++++ 2 files changed, 30 insertions(+) diff --git a/src/GitHub.hs b/src/GitHub.hs index bd29d3da..4e1598db 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -328,6 +328,12 @@ module GitHub ( usersFollowingR, usersFollowedByR, + -- ** Statuses + -- | See + createStatusR, + statusesForR, + statusForR, + -- * Data definitions module GitHub.Data, -- * Request handling @@ -361,6 +367,7 @@ import GitHub.Endpoints.Repos.Comments import GitHub.Endpoints.Repos.Commits import GitHub.Endpoints.Repos.Forks import GitHub.Endpoints.Repos.Releases +import GitHub.Endpoints.Repos.Statuses import GitHub.Endpoints.Repos.Webhooks import GitHub.Endpoints.Search import GitHub.Endpoints.Users diff --git a/src/GitHub/Endpoints/Repos/Statuses.hs b/src/GitHub/Endpoints/Repos/Statuses.hs index 3bf16423..d25186d6 100644 --- a/src/GitHub/Endpoints/Repos/Statuses.hs +++ b/src/GitHub/Endpoints/Repos/Statuses.hs @@ -1,3 +1,7 @@ +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus -- -- The repo statuses API as described on -- . @@ -16,28 +20,47 @@ import GitHub.Internal.Prelude import GitHub.Request import Prelude () +-- | Create a new status +-- +-- > createStatus (BasicAuth user password) "thoughtbot" "paperclip" +-- > "41f685f6e01396936bb8cd98e7cca517e2c7d96b" +-- > (NewStatus StatusSuccess Nothing "Looks good!" Nothing) createStatus :: Auth -> Name Owner -> Name Repo -> Name Commit -> NewStatus -> IO (Either Error Status) createStatus auth owner repo sha ns = executeRequest auth $ createStatusR owner repo sha ns +-- | Create a new status +-- See createStatusR :: Name Owner -> Name Repo -> Name Commit -> NewStatus -> Request 'RW Status createStatusR owner repo sha = command Post parts . encode where parts = ["repos", toPathPart owner, toPathPart repo, "statuses", toPathPart sha] +-- | All statuses for a commit +-- +-- > statusesFor (BasicAuth user password) "thoughtbot" "paperclip" +-- > "41f685f6e01396936bb8cd98e7cca517e2c7d96b" statusesFor :: Auth -> Name Owner -> Name Repo -> Name Commit -> IO (Either Error (Vector Status)) statusesFor auth user repo sha = executeRequest auth $ statusesForR user repo sha FetchAll +-- | All statuses for a commit +-- See statusesForR :: Name Owner -> Name Repo -> Name Commit -> FetchCount -> Request 'RW (Vector Status) statusesForR user repo sha = pagedQuery ["repos", toPathPart user, toPathPart repo, "commits", toPathPart sha, "statuses"] [] +-- | The combined status for a specific commit +-- +-- > statusFor (BasicAuth user password) "thoughtbot" "paperclip" +-- > "41f685f6e01396936bb8cd98e7cca517e2c7d96b" statusFor :: Auth -> Name Owner -> Name Repo -> Name Commit -> IO (Either Error CombinedStatus) statusFor auth user repo sha = executeRequest auth $ statusForR user repo sha +-- | The combined status for a specific commit +-- See statusForR :: Name Owner -> Name Repo -> Name Commit -> Request 'RW CombinedStatus statusForR user repo sha = query ["repos", toPathPart user, toPathPart repo, "commits", toPathPart sha, "status"] [] From d50776cfd72ec533a2c5667b755eba06de3c075f Mon Sep 17 00:00:00 2001 From: Hong Minhee Date: Fri, 13 Oct 2017 03:24:44 +0900 Subject: [PATCH 283/510] Endpoints for deleting issue comments --- src/GitHub/Endpoints/Issues/Comments.hs | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/src/GitHub/Endpoints/Issues/Comments.hs b/src/GitHub/Endpoints/Issues/Comments.hs index 508fc642..2cbd7c5c 100644 --- a/src/GitHub/Endpoints/Issues/Comments.hs +++ b/src/GitHub/Endpoints/Issues/Comments.hs @@ -13,6 +13,8 @@ module GitHub.Endpoints.Issues.Comments ( comments', createComment, createCommentR, + deleteComment, + deleteCommentR, editComment, editCommentR, module GitHub.Data, @@ -88,3 +90,19 @@ editCommentR user repo commid body = command Patch parts (encode $ EditComment body) where parts = ["repos", toPathPart user, toPathPart repo, "issues", "comments", toPathPart commid] + +-- | Delete a comment. +-- +-- > deleteComment (User (user, password)) user repo commentid +deleteComment :: Auth -> Name Owner -> Name Repo -> Id Comment + -> IO (Either Error ()) +deleteComment auth user repo commid = + executeRequest auth $ deleteCommentR user repo commid + +-- | Delete a comment. +-- See +deleteCommentR :: Name Owner -> Name Repo -> Id Comment -> Request 'RW () +deleteCommentR user repo commid = + command Delete parts mempty + where + parts = ["repos", toPathPart user, toPathPart repo, "issues", "comments", toPathPart commid] From f63172e356081238f5e990f5273b8b550ef918d4 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sun, 22 Oct 2017 12:35:05 +0300 Subject: [PATCH 284/510] Allow http-types-0.10 --- github.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/github.cabal b/github.cabal index d6c2ac2c..06d8b7da 100644 --- a/github.cabal +++ b/github.cabal @@ -142,7 +142,7 @@ Library http-client >=0.4.8.1 && <0.6, http-client-tls >=0.2.2 && <0.4, http-link-header >=1.0.1 && <1.1, - http-types >=0.8.6 && <0.10, + http-types >=0.8.6 && <0.11, iso8601-time >=0.1.4 && <0.2, mtl >=2.1.3.1 && <2.3, network-uri >=2.6.0.3 && <2.7, From 422f3994049e08019d47669cfe1beb70a9b2fef3 Mon Sep 17 00:00:00 2001 From: TAKAHASHI Yuto Date: Tue, 31 Oct 2017 23:31:10 +0900 Subject: [PATCH 285/510] Add endpoints for deleting gists --- samples/Gists/DeleteGist.hs | 16 ++++++++++++++++ src/GitHub.hs | 2 +- src/GitHub/Endpoints/Gists.hs | 13 +++++++++++++ 3 files changed, 30 insertions(+), 1 deletion(-) create mode 100644 samples/Gists/DeleteGist.hs diff --git a/samples/Gists/DeleteGist.hs b/samples/Gists/DeleteGist.hs new file mode 100644 index 00000000..e950d939 --- /dev/null +++ b/samples/Gists/DeleteGist.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE OverloadedStrings #-} +module DeleteGist where + +import qualified GitHub.Data.Name as N +import qualified GitHub.Endpoints.Gists as GH + +import qualified Data.Text as T +import qualified Data.Text.IO as T + +main :: IO () +main = do + let gid = "your-gist-id" + result <- GH.deleteGist (GH.OAuth "your-token") gid + case result of + Left err -> putStrLn $ "Error: " ++ show err + Right () -> T.putStrLn $ T.concat ["Deleted: ", N.untagName gid] diff --git a/src/GitHub.hs b/src/GitHub.hs index bd29d3da..b09cc062 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -57,9 +57,9 @@ module GitHub ( -- * Check if a gist is starred -- * Fork a gist -- * List gist forks - -- * Delete a gist gistsR, gistR, + deleteGistR, -- ** Comments -- | See diff --git a/src/GitHub/Endpoints/Gists.hs b/src/GitHub/Endpoints/Gists.hs index 77d7bced..6242f611 100644 --- a/src/GitHub/Endpoints/Gists.hs +++ b/src/GitHub/Endpoints/Gists.hs @@ -11,6 +11,8 @@ module GitHub.Endpoints.Gists ( gist, gist', gistR, + deleteGist, + deleteGistR, module GitHub.Data, ) where @@ -55,3 +57,14 @@ gist = gist' Nothing gistR :: Name Gist -> Request k Gist gistR gid = query ["gists", toPathPart gid] [] + +-- | Delete a gist by the authenticated user. +-- +-- > deleteGist ("github-username", "github-password") "225074" +deleteGist :: Auth -> Name Gist -> IO (Either Error ()) +deleteGist auth gid = executeRequest auth $ deleteGistR gid + +-- | Delete a gist by the authenticated user. +-- See +deleteGistR :: Name Gist -> Request 'RW () +deleteGistR gid = command Delete ["gists", toPathPart gid] mempty From ced200d496f624dc5e26d47e0fe43d625c36579b Mon Sep 17 00:00:00 2001 From: TAKAHASHI Yuto Date: Tue, 31 Oct 2017 23:11:47 +0900 Subject: [PATCH 286/510] Add endpoints for (un)starring gists --- samples/Gists/StarGist.hs | 16 ++++++++++++++++ samples/Gists/UnstarGist.hs | 16 ++++++++++++++++ src/GitHub.hs | 4 ++-- src/GitHub/Endpoints/Gists.hs | 26 ++++++++++++++++++++++++++ 4 files changed, 60 insertions(+), 2 deletions(-) create mode 100644 samples/Gists/StarGist.hs create mode 100644 samples/Gists/UnstarGist.hs diff --git a/samples/Gists/StarGist.hs b/samples/Gists/StarGist.hs new file mode 100644 index 00000000..f4941cd6 --- /dev/null +++ b/samples/Gists/StarGist.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE OverloadedStrings #-} +module StarGist where + +import qualified GitHub.Data.Name as N +import qualified GitHub.Endpoints.Gists as GH + +import qualified Data.Text as T +import qualified Data.Text.IO as T + +main :: IO () +main = do + let gid = "your-gist-id" + result <- GH.starGist (GH.OAuth "your-token") gid + case result of + Left err -> putStrLn $ "Error: " ++ show err + Right () -> T.putStrLn $ T.concat ["Starred: ", N.untagName gid] diff --git a/samples/Gists/UnstarGist.hs b/samples/Gists/UnstarGist.hs new file mode 100644 index 00000000..d1731934 --- /dev/null +++ b/samples/Gists/UnstarGist.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE OverloadedStrings #-} +module UnstarGist where + +import qualified GitHub.Data.Name as N +import qualified GitHub.Endpoints.Gists as GH + +import qualified Data.Text as T +import qualified Data.Text.IO as T + +main :: IO () +main = do + let gid = "your-gist-id" + result <- GH.unstarGist (GH.OAuth "your-token") gid + case result of + Left err -> putStrLn $ "Error: " ++ show err + Right () -> T.putStrLn $ T.concat ["Unstarred: ", N.untagName gid] diff --git a/src/GitHub.hs b/src/GitHub.hs index b09cc062..27ebbe67 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -52,13 +52,13 @@ module GitHub ( -- * Create a gist -- * Edit a gist -- * List gist commits - -- * Star a gist - -- * Unstar a gist -- * Check if a gist is starred -- * Fork a gist -- * List gist forks gistsR, gistR, + starGistR, + unstarGistR, deleteGistR, -- ** Comments diff --git a/src/GitHub/Endpoints/Gists.hs b/src/GitHub/Endpoints/Gists.hs index 6242f611..cc23b2a9 100644 --- a/src/GitHub/Endpoints/Gists.hs +++ b/src/GitHub/Endpoints/Gists.hs @@ -11,6 +11,10 @@ module GitHub.Endpoints.Gists ( gist, gist', gistR, + starGist, + starGistR, + unstarGist, + unstarGistR, deleteGist, deleteGistR, module GitHub.Data, @@ -58,6 +62,28 @@ gistR :: Name Gist -> Request k Gist gistR gid = query ["gists", toPathPart gid] [] +-- | Star a gist by the authenticated user. +-- +-- > starGist ("github-username", "github-password") "225074" +starGist :: Auth -> Name Gist -> IO (Either Error ()) +starGist auth gid = executeRequest auth $ starGistR gid + +-- | Star a gist by the authenticated user. +-- See +starGistR :: Name Gist -> Request 'RW () +starGistR gid = command Put' ["gists", toPathPart gid, "star"] mempty + +-- | Unstar a gist by the authenticated user. +-- +-- > unstarGist ("github-username", "github-password") "225074" +unstarGist :: Auth -> Name Gist -> IO (Either Error ()) +unstarGist auth gid = executeRequest auth $ unstarGistR gid + +-- | Unstar a gist by the authenticated user. +-- See +unstarGistR :: Name Gist -> Request 'RW () +unstarGistR gid = command Delete ["gists", toPathPart gid, "star"] mempty + -- | Delete a gist by the authenticated user. -- -- > deleteGist ("github-username", "github-password") "225074" From 316c66963d9afc50df4e66768abddb95162c4ad3 Mon Sep 17 00:00:00 2001 From: Hong Minhee Date: Wed, 1 Nov 2017 15:10:06 +0900 Subject: [PATCH 287/510] Re-export deleteCommentR from top GitHub module --- src/GitHub.hs | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/src/GitHub.hs b/src/GitHub.hs index bd29d3da..5b5357d9 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -106,12 +106,10 @@ module GitHub ( -- ** Comments -- | See -- - -- Missing endpoints: - -- - -- * Delete comment commentR, commentsR, createCommentR, + deleteCommentR, editCommentR, -- ** Events From 5bb76f2f265342ed639f8727f31bb9b2f795e1f6 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Thu, 9 Nov 2017 13:42:51 +0200 Subject: [PATCH 288/510] Add Repo.archived field --- src/GitHub/Data/Repos.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/GitHub/Data/Repos.hs b/src/GitHub/Data/Repos.hs index cdd98ce9..63d58ea9 100644 --- a/src/GitHub/Data/Repos.hs +++ b/src/GitHub/Data/Repos.hs @@ -38,6 +38,7 @@ data Repo = Repo , repoFork :: !(Maybe Bool) , repoGitUrl :: !(Maybe URL) , repoPrivate :: !Bool + , repoArchived :: !Bool , repoCloneUrl :: !(Maybe URL) , repoSize :: !(Maybe Int) , repoUpdatedAt :: !(Maybe UTCTime) @@ -157,6 +158,7 @@ instance FromJSON Repo where <*> o .: "fork" <*> o .:? "git_url" <*> o .: "private" + <*> o .: "archived" <*> o .:? "clone_url" <*> o .:? "size" <*> o .:? "updated_at" From 72ac073990e5ca48a042152e3dd10c9c1359a282 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Thu, 9 Nov 2017 15:37:18 +0200 Subject: [PATCH 289/510] Add build-tool-depends, regenerate .travis.yml --- .travis.yml | 95 ++++++++++++++++++++++++++-------------------------- github.cabal | 1 + 2 files changed, 48 insertions(+), 48 deletions(-) diff --git a/.travis.yml b/.travis.yml index 82db014c..8a4d5571 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,6 +1,6 @@ # This Travis job script has been generated by a script via # -# make_travis_yml_2.hs 'github.cabal' +# make_travis_yml_2.hs '--branch' 'master' '-o' '.travis.yml' 'github.cabal' # # For more information, see https://github.com/hvr/multi-ghc-travis # @@ -10,11 +10,14 @@ sudo: false git: submodules: false # whether to recursively clone submodules +branches: + only: + - master + cache: directories: - $HOME/.cabal/packages - $HOME/.cabal/store - - $HOME/.local/bin before_cache: - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log @@ -41,59 +44,55 @@ matrix: addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.2.1], sources: [hvr-ghc]}} before_install: - - HC=${CC} - - unset CC - - PATH=/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$PATH - - PKGNAME='github' + - HC=${CC} + - HCPKG=${HC/ghc/ghc-pkg} + - unset CC + - PATH=/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$PATH install: - - ROOTDIR=$(pwd) - - cabal --version - - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]" - - BENCH=${BENCH---enable-benchmarks} - - TEST=${TEST---enable-tests} - - travis_retry cabal update -v - - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config - - sh install-hspec-discover.sh # TEMP, before we get cabal new-install - - rm -fv cabal.project.local - - "echo 'packages: .' > cabal.project" - - rm -f cabal.project.freeze - - cabal new-build -w ${HC} ${TEST} ${BENCH} --dep -j2 all - - cabal new-build -w ${HC} --disable-tests --disable-benchmarks --dep -j2 all + - cabal --version + - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]" + - BENCH=${BENCH---enable-benchmarks} + - TEST=${TEST---enable-tests} + - HADDOCK=${HADDOCK-true} + - INSTALLED=${INSTALLED-true} + - travis_retry cabal update -v + - sed -i.bak 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config + - rm -fv cabal.project.local + - "echo 'packages: .' > cabal.project" + - if [ -f "./configure.ac" ]; then + (cd "."; autoreconf -i); + fi + - rm -f cabal.project.freeze + - cabal new-build -w ${HC} ${TEST} ${BENCH} --project-file="cabal.project" --dep -j2 all + - cabal new-build -w ${HC} --disable-tests --disable-benchmarks --project-file="cabal.project" --dep -j2 all + - rm -rf "."/.ghc.environment.* "."/dist + - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX) # Here starts the actual work to be performed for the package under test; # any command which exits with a non-zero exit code causes the build to fail. script: - - if [ -f configure.ac ]; then autoreconf -i; fi - - rm -rf .ghc.environment.* dist/ - - cabal sdist # test that a source-distribution can be generated - - cd dist/ - - SRCTAR=(${PKGNAME}-*.tar.gz) - - SRC_BASENAME="${SRCTAR/%.tar.gz}" - - tar -xvf "./$SRC_BASENAME.tar.gz" - - cd "$SRC_BASENAME/" -## from here on, CWD is inside the extracted source-tarball - - rm -fv cabal.project.local - - "echo 'packages: . samples' > cabal.project" - - cp -r $ROOTDIR/samples . - # this builds all libraries and executables (without tests/benchmarks) - - rm -f cabal.project.freeze - - cabal new-build -w ${HC} --disable-tests --disable-benchmarks all - # this builds all libraries and executables (including tests/benchmarks) - # - rm -rf ./dist-newstyle + # test that source-distributions can be generated + - (cd "."; cabal sdist) + - mv "."/dist/github-*.tar.gz ${DISTDIR}/ + - cd ${DISTDIR} + - find . -maxdepth 1 -name '*.tar.gz' -exec tar -xvf '{}' \; + - "printf 'packages: github-*/*.cabal\n' > cabal.project" + # this builds all libraries and executables (without tests/benchmarks) + - cabal new-build -w ${HC} --disable-tests --disable-benchmarks all - # build & run tests - - cabal new-build -w ${HC} ${TEST} ${BENCH} all - - if [ "x$TEST" = "x--enable-tests" ]; then cabal new-test -w ${HC} ${TEST} all; fi + # Build with installed constraints for packages in global-db + - if $INSTALLED; then + echo cabal new-build -w ${HC} --disable-tests --disable-benchmarks $(${HCPKG} list --global --simple-output --names-only | sed 's/\([a-zA-Z0-9-]\{1,\}\) */--constraint="\1 installed" /g') all | sh; + else echo "Not building with installed constraints"; fi - # run samples - - for sample in show-user list-followers list-following operational; do - echo "=== SAMPLE $sample ==="; - $(find dist-newstyle/ -type f -name github-$sample); - done + # build & run tests, build benchmarks + - cabal new-build -w ${HC} ${TEST} ${BENCH} all + - if [ "x$TEST" = "x--enable-tests" ]; then cabal new-test -w ${HC} ${TEST} all; fi -# EOF + # haddock + - rm -rf ./dist-newstyle + - if $HADDOCK; then cabal new-haddock -w ${HC} --disable-tests --disable-benchmarks all; else echo "Skipping haddock generation";fi -branches: - only: - - master +# REGENDATA ["--branch","master","-o",".travis.yml","github.cabal"] +# EOF diff --git a/github.cabal b/github.cabal index 06d8b7da..2a3e190e 100644 --- a/github.cabal +++ b/github.cabal @@ -182,6 +182,7 @@ test-suite github-test GitHub.EventsSpec main-is: Spec.hs ghc-options: -Wall + build-tool-depends: hspec-discover:hspec-discover build-depends: base, base-compat, github, From b2778cc3c2ed4da36aa03c35552af3b018ab54b8 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Thu, 9 Nov 2017 17:56:16 +0200 Subject: [PATCH 290/510] Remove install-hspec-discover.sh [ci skip] --- install-hspec-discover.sh | 18 ------------------ 1 file changed, 18 deletions(-) delete mode 100644 install-hspec-discover.sh diff --git a/install-hspec-discover.sh b/install-hspec-discover.sh deleted file mode 100644 index 17a3a34a..00000000 --- a/install-hspec-discover.sh +++ /dev/null @@ -1,18 +0,0 @@ -#!/bin/sh - -set -ex - -if [ ! -e $HOME/.local/bin/hspec-discover ]; then - # Fetch the source - cabal get hspec-discover-2.4.4 - cd hspec-discover-2.4.4 - - # Set-up project - echo 'packages: .' > cabal.project - - # build exe - cabal new-build hspec-discover:exe:hspec-discover - - # copy executable to $HOME/.local/bin - cp $(find dist-newstyle -name hspec-discover -type f) $HOME/.local/bin -fi From be2f210aaa4e669a6929b2885442ba822ece1334 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Thu, 9 Nov 2017 18:52:32 +0200 Subject: [PATCH 291/510] Lenient archived parsing --- src/GitHub/Data/Repos.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/GitHub/Data/Repos.hs b/src/GitHub/Data/Repos.hs index 63d58ea9..34fc81c8 100644 --- a/src/GitHub/Data/Repos.hs +++ b/src/GitHub/Data/Repos.hs @@ -158,7 +158,7 @@ instance FromJSON Repo where <*> o .: "fork" <*> o .:? "git_url" <*> o .: "private" - <*> o .: "archived" + <*> o .:? "archived" .!= False <*> o .:? "clone_url" <*> o .:? "size" <*> o .:? "updated_at" From 0cb267533216bc25e4e5c1d5ecf9a7431465304c Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Thu, 9 Nov 2017 18:00:34 +0200 Subject: [PATCH 292/510] Bump version to 0.18 --- CHANGELOG.md | 14 ++++++++++++++ github.cabal | 2 +- 2 files changed, 15 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 14ea611e..7857c4ee 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,17 @@ +Changes for 0.18 +- Endpoints for deleting issue comments. + [#294](https://github.com/phadej/github/pull/294) +- Endpoints for (un)starring gists. + [#296](https://github.com/phadej/github/pull/296) +- Add `archived` field to `Repo`. + [#298](https://github.com/phadej/github/pull/298) +- Update dependencies. + [#295](https://github.com/phadej/github/pull/295) +- Add Statuses endpoints. + [#268](https://github.com/phadej/github/pull/268) +- Add requested reviewers field to pull request records. + [#292](https://github.com/phadej/github/pull/292) + Changes for 0.17.0 - Add `Ord Request` instance - Repository contents diff --git a/github.cabal b/github.cabal index b4209f3e..1eec1f2d 100644 --- a/github.cabal +++ b/github.cabal @@ -1,5 +1,5 @@ name: github -version: 0.17.0 +version: 0.18 synopsis: Access to the GitHub API, v3. description: The GitHub API provides programmatic access to the full From a93a495b7883a454010fb46d30e4a0003096a9de Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sun, 10 Dec 2017 00:39:53 +0200 Subject: [PATCH 293/510] Allow http-types-0.11 --- github.cabal | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/github.cabal b/github.cabal index 1eec1f2d..c7e156b4 100644 --- a/github.cabal +++ b/github.cabal @@ -1,5 +1,6 @@ name: github version: 0.18 +x-revision: 1 synopsis: Access to the GitHub API, v3. description: The GitHub API provides programmatic access to the full @@ -146,7 +147,7 @@ Library http-client >=0.4.8.1 && <0.6, http-client-tls >=0.2.2 && <0.4, http-link-header >=1.0.1 && <1.1, - http-types >=0.8.6 && <0.11, + http-types >=0.8.6 && <0.12, iso8601-time >=0.1.4 && <0.2, mtl >=2.1.3.1 && <2.3, network-uri >=2.6.0.3 && <2.7, From 3470ed93214435889ba462aadd80cfa263acace3 Mon Sep 17 00:00:00 2001 From: MM Date: Thu, 28 Dec 2017 07:19:42 +0100 Subject: [PATCH 294/510] userRepo should be repository --- samples/Repos/ShowRepo.hs | 2 +- src/GitHub/Endpoints/Repos.hs | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/samples/Repos/ShowRepo.hs b/samples/Repos/ShowRepo.hs index fb63c497..5007cfdc 100644 --- a/samples/Repos/ShowRepo.hs +++ b/samples/Repos/ShowRepo.hs @@ -5,7 +5,7 @@ import Data.List import Data.Maybe main = do - possibleRepo <- Github.userRepo "mike-burns" "trylambda" + possibleRepo <- Github.repository "mike-burns" "trylambda" case possibleRepo of (Left error) -> putStrLn $ "Error: " ++ (show error) (Right repo) -> putStrLn $ formatRepo repo diff --git a/src/GitHub/Endpoints/Repos.hs b/src/GitHub/Endpoints/Repos.hs index e9261db3..d9ad44a1 100644 --- a/src/GitHub/Endpoints/Repos.hs +++ b/src/GitHub/Endpoints/Repos.hs @@ -136,14 +136,14 @@ organizationReposR org publicity = -- | Details on a specific repo, given the owner and repo name. -- --- > userRepo "mike-burns" "github" +-- > repository "mike-burns" "github" repository :: Name Owner -> Name Repo -> IO (Either Error Repo) repository = repository' Nothing -- | Details on a specific repo, given the owner and repo name. -- With authentication. -- --- > userRepo' (Just (BasicAuth (user, password))) "mike-burns" "github" +-- > repository' (Just (BasicAuth (user, password))) "mike-burns" "github" repository' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error Repo) repository' auth user repo = executeRequestMaybe auth $ repositoryR user repo From 8f543cdc07876bfb7b924d3722e3dbc1df4b02ca Mon Sep 17 00:00:00 2001 From: Ryan Trinkle Date: Sat, 30 Dec 2017 19:18:10 -0500 Subject: [PATCH 295/510] Add "Get archive link" API See https://developer.github.com/v3/repos/contents/#get-archive-link --- src/GitHub/Data/Repos.hs | 11 ++++++++ src/GitHub/Data/Request.hs | 7 ++++++ src/GitHub/Endpoints/Repos/Contents.hs | 30 ++++++++++++++++++++++ src/GitHub/Request.hs | 35 +++++++++++++++++++++++--- 4 files changed, 80 insertions(+), 3 deletions(-) diff --git a/src/GitHub/Data/Repos.hs b/src/GitHub/Data/Repos.hs index 34fc81c8..c476fbbb 100644 --- a/src/GitHub/Data/Repos.hs +++ b/src/GitHub/Data/Repos.hs @@ -14,6 +14,7 @@ module GitHub.Data.Repos where import GitHub.Data.Definitions import GitHub.Data.Id (Id) import GitHub.Data.Name (Name) +import GitHub.Data.Request (IsPathPart (..)) import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () @@ -257,3 +258,13 @@ instance FromJSON a => FromJSON (HM.HashMap Language a) where mapKey f = HM.fromList . map (first f) . HM.toList #endif #endif + +data ArchiveFormat + = ArchiveFormatTarball -- ^ ".tar.gz" format + | ArchiveFormatZipball -- ^ ".zip" format + deriving (Show, Eq, Ord, Enum, Bounded, Typeable, Data, Generic) + +instance IsPathPart ArchiveFormat where + toPathPart af = case af of + ArchiveFormatTarball -> "tarball" + ArchiveFormatZipball -> "zipball" diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs index 59e7e08f..d95af9f5 100644 --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -36,6 +36,7 @@ import qualified Data.ByteString.Lazy as LBS import qualified Data.Text as T import qualified Network.HTTP.Types as Types import qualified Network.HTTP.Types.Method as Method +import Network.URI (URI) ------------------------------------------------------------------------------ -- Auxillary types ------------------------------------------------------------------------------ @@ -141,6 +142,7 @@ data Request (k :: RW) a where SimpleQuery :: FromJSON a => SimpleRequest k a -> Request k a StatusQuery :: StatusMap a -> SimpleRequest k () -> Request k a HeaderQuery :: FromJSON a => Types.RequestHeaders -> SimpleRequest k a -> Request k a + RedirectQuery :: SimpleRequest k () -> Request k URI deriving (Typeable) data SimpleRequest (k :: RW) a where @@ -218,6 +220,8 @@ instance Show (Request k a) where . showsPrec (appPrec + 1) m . showString " " . showsPrec (appPrec + 1) req + RedirectQuery req -> showString "Redirect " + . showsPrec (appPrec + 1) req where appPrec = 10 :: Int @@ -249,3 +253,6 @@ instance Hashable (Request k a) where salt `hashWithSalt` (2 :: Int) `hashWithSalt` h `hashWithSalt` req + hashWithSalt salt (RedirectQuery req) = + salt `hashWithSalt` (3 :: Int) + `hashWithSalt` req diff --git a/src/GitHub/Endpoints/Repos/Contents.hs b/src/GitHub/Endpoints/Repos/Contents.hs index 98c292a9..d424b0c3 100644 --- a/src/GitHub/Endpoints/Repos/Contents.hs +++ b/src/GitHub/Endpoints/Repos/Contents.hs @@ -13,6 +13,9 @@ module GitHub.Endpoints.Repos.Contents ( readmeFor, readmeFor', readmeForR, + archiveFor, + archiveFor', + archiveForR, -- ** Create createFile, @@ -34,7 +37,9 @@ import GitHub.Internal.Prelude import GitHub.Request import Prelude () +import Data.Maybe (maybeToList) import qualified Data.Text.Encoding as TE +import Network.URI (URI) -- | The contents of a file or directory in a repo, given the repo owner, name, and path to the file -- @@ -79,6 +84,31 @@ readmeForR :: Name Owner -> Name Repo -> Request k Content readmeForR user repo = query ["repos", toPathPart user, toPathPart repo, "readme"] [] +-- | The archive of a repo, given the repo owner, name, and archive type +-- +-- > archiveFor "thoughtbot" "paperclip" ArchiveFormatTarball Nothing +archiveFor :: Name Owner -> Name Repo -> ArchiveFormat -> Maybe Text -> IO (Either Error URI) +archiveFor = archiveFor' Nothing + +-- | The archive of a repo, given the repo owner, name, and archive type +-- With Authentication +-- +-- > archiveFor' (Just (BasicAuth (user, password))) "thoughtbot" "paperclip" ArchiveFormatTarball Nothing +archiveFor' :: Maybe Auth -> Name Owner -> Name Repo -> ArchiveFormat -> Maybe Text -> IO (Either Error URI) +archiveFor' auth user repo path ref = + executeRequestMaybe auth $ archiveForR user repo path ref + +archiveForR + :: Name Owner + -> Name Repo + -> ArchiveFormat -- ^ The type of archive to retrieve + -> Maybe Text -- ^ Git commit + -> Request k URI +archiveForR user repo format ref = + RedirectQuery $ Query path [] + where + path = ["repos", toPathPart user, toPathPart repo, toPathPart format] <> maybeToList ref + -- | Create a file. createFile :: Auth diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index 5629e61c..e9f9cddd 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -59,6 +59,7 @@ import Control.Monad.Except (MonadError (..)) import Control.Monad.Error (MonadError (..)) #endif +import Control.Monad (when) import Control.Monad.Catch (MonadCatch (..), MonadThrow) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Except (ExceptT (..), runExceptT) @@ -67,13 +68,13 @@ import Data.List (find) import Network.HTTP.Client (HttpException (..), Manager, RequestBody (..), Response (..), - applyBasicAuth, httpLbs, method, newManager, requestBody, - requestHeaders, setQueryString) + applyBasicAuth, getUri, httpLbs, method, newManager, redirectCount, + requestBody, requestHeaders, setQueryString, setRequestIgnoreStatus) import Network.HTTP.Client.TLS (tlsManagerSettings) import Network.HTTP.Link.Parser (parseLinkHeaderBS) import Network.HTTP.Link.Types (Link (..), LinkParam (..), href, linkParams) import Network.HTTP.Types (Method, RequestHeaders, Status (..)) -import Network.URI (URI) +import Network.URI (URI, parseURIReference, relativeTo) #if !MIN_VERSION_http_client(0,5,0) import qualified Control.Exception as E @@ -82,6 +83,7 @@ import Network.HTTP.Types (ResponseHeaders) import qualified Data.ByteString.Lazy as LBS import qualified Data.Text as T +import qualified Data.Text.Encoding as TE import qualified Data.Vector as V import qualified Network.HTTP.Client as HTTP import qualified Network.HTTP.Client.Internal as HTTP @@ -125,6 +127,9 @@ executeRequestWithMgr mgr auth req = runExceptT $ do performHttpReq httpReq (StatusQuery sm _) = do res <- httpLbs' httpReq parseStatus sm . responseStatus $ res + performHttpReq httpReq (RedirectQuery _) = do + res <- httpLbs' httpReq + parseRedirect (getUri httpReq) res performHttpReq' :: FromJSON b => HTTP.Request -> SimpleRequest k b -> ExceptT Error IO b performHttpReq' httpReq Query {} = do @@ -172,6 +177,9 @@ executeRequestWithMgr' mgr req = runExceptT $ do performHttpReq httpReq (StatusQuery sm _) = do res <- httpLbs' httpReq parseStatus sm . responseStatus $ res + performHttpReq httpReq (RedirectQuery _) = do + res <- httpLbs' httpReq + parseRedirect (getUri httpReq) res performHttpReq' :: FromJSON b => HTTP.Request -> SimpleRequest 'RO b -> ExceptT Error IO b performHttpReq' httpReq Query {} = do @@ -222,6 +230,9 @@ makeHttpRequest auth r = case r of HeaderQuery h req -> do req' <- makeHttpSimpleRequest auth req return $ req' { requestHeaders = h <> requestHeaders req' } + RedirectQuery req -> do + req' <- makeHttpSimpleRequest auth req + return $ setRequestIgnoreStatus $ req' { redirectCount = 0 } makeHttpSimpleRequest :: MonadThrow m @@ -328,6 +339,24 @@ parseStatus m (Status sci _) = where err = throwError $ JsonError $ "invalid status: " <> T.pack (show sci) +-- | Helper for handling of 'RequestRedirect'. +-- +-- @ +-- parseRedirect :: 'Response' 'LBS.ByteString' -> 'Either' 'Error' a +-- @ +parseRedirect :: MonadError Error m => URI -> Response LBS.ByteString -> m URI +parseRedirect originalUri rsp = do + let status = responseStatus rsp + when (statusCode status /= 302) $ + throwError $ ParseError $ "invalid status: " <> T.pack (show status) + loc <- maybe noLocation return $ lookup "Location" $ responseHeaders rsp + case parseURIReference $ T.unpack $ TE.decodeUtf8 loc of + Nothing -> throwError $ ParseError $ + "location header does not contain a URI: " <> T.pack (show loc) + Just uri -> return $ uri `relativeTo` originalUri + where + noLocation = throwError $ ParseError "no location header in response" + -- | Helper for making paginated requests. Responses, @a@ are combined monoidally. -- -- @ From ee04b14828f8c6ef5624cf96ae4b6c29154f457c Mon Sep 17 00:00:00 2001 From: iphydf Date: Sun, 7 Jan 2018 18:49:13 +0000 Subject: [PATCH 296/510] Add "behind" mergeable_state. --- src/GitHub/Data/Options.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/GitHub/Data/Options.hs b/src/GitHub/Data/Options.hs index 274d4b2a..84105277 100644 --- a/src/GitHub/Data/Options.hs +++ b/src/GitHub/Data/Options.hs @@ -96,6 +96,7 @@ data MergeableState | StateDirty | StateUnstable | StateBlocked + | StateBehind deriving (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) @@ -105,6 +106,7 @@ instance ToJSON MergeableState where toJSON StateDirty = String "dirty" toJSON StateUnstable = String "unstable" toJSON StateBlocked = String "blocked" + toJSON StateBehind = String "behind" instance FromJSON MergeableState where parseJSON (String "unknown") = pure StateUnknown @@ -112,6 +114,7 @@ instance FromJSON MergeableState where parseJSON (String "dirty") = pure StateDirty parseJSON (String "unstable") = pure StateUnstable parseJSON (String "blocked") = pure StateBlocked + parseJSON (String "behind") = pure StateBehind parseJSON v = typeMismatch "MergeableState" v instance NFData MergeableState where rnf = genericRnf From a6d421df43da2fd998cffc7eef71aed46d70e1cd Mon Sep 17 00:00:00 2001 From: iphydf Date: Thu, 11 Jan 2018 11:49:06 +0000 Subject: [PATCH 297/510] Make "repo" in PullRequestCommit nullable. In rare cases, the repo can become null. Fixes #310. --- src/GitHub/Data/PullRequests.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/GitHub/Data/PullRequests.hs b/src/GitHub/Data/PullRequests.hs index 0a80ce7f..e40199f5 100644 --- a/src/GitHub/Data/PullRequests.hs +++ b/src/GitHub/Data/PullRequests.hs @@ -136,7 +136,7 @@ data PullRequestCommit = PullRequestCommit , pullRequestCommitRef :: !Text , pullRequestCommitSha :: !Text , pullRequestCommitUser :: !SimpleUser - , pullRequestCommitRepo :: !Repo + , pullRequestCommitRepo :: !(Maybe Repo) } deriving (Show, Data, Typeable, Eq, Ord, Generic) From ddf5a0db2d304be1cbd93af91c2d5ba3992eea34 Mon Sep 17 00:00:00 2001 From: Myron Wu Date: Mon, 15 Jan 2018 22:57:08 -0800 Subject: [PATCH 298/510] Fixing isPullRequestMerged and other is* predicates by changing expectation to http 204 instead of 202 --- spec/GitHub/PullRequestsSpec.hs | 8 ++++++++ src/GitHub/Data/Request.hs | 2 +- 2 files changed, 9 insertions(+), 1 deletion(-) diff --git a/spec/GitHub/PullRequestsSpec.hs b/spec/GitHub/PullRequestsSpec.hs index 609412eb..fbea7c7a 100644 --- a/spec/GitHub/PullRequestsSpec.hs +++ b/spec/GitHub/PullRequestsSpec.hs @@ -3,6 +3,7 @@ module GitHub.PullRequestsSpec where import qualified GitHub +import GitHub.Data.Id (Id(Id)) import Prelude () import Prelude.Compat @@ -50,6 +51,13 @@ spec = do V.length (GitHub.pullRequestRequestedReviewers pullRequestReviewRequested) `shouldBe` 1 + + describe "checking if a pull request is merged" $ do + it "works" $ withAuth $ \auth -> do + b <- GitHub.executeRequest auth $ GitHub.isPullRequestMergedR "phadej" "github" (Id 14) + b `shouldSatisfy` isRight + fromRightS b `shouldBe` True + where repos = [ ("thoughtbot", "paperclip") diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs index 59e7e08f..4e693436 100644 --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -158,7 +158,7 @@ type StatusMap a = [(Int, a)] statusOnlyOk :: StatusMap Bool statusOnlyOk = - [ (202, True) + [ (204, True) , (404, False) ] From 2374f383ed7f66493413375b2850f29f7c18ab76 Mon Sep 17 00:00:00 2001 From: Myron Wu Date: Tue, 16 Jan 2018 22:07:43 -0800 Subject: [PATCH 299/510] Adding "Check membership" API --- src/GitHub.hs | 3 ++- src/GitHub/Endpoints/Organizations/Members.hs | 25 +++++++++++++++++++ 2 files changed, 27 insertions(+), 1 deletion(-) diff --git a/src/GitHub.hs b/src/GitHub.hs index a68c6c80..42b4ddcc 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -158,9 +158,10 @@ module GitHub ( -- ** Members -- | See -- - -- Missing endpoints: All except /Members List/ + -- Missing endpoints: All except /Members List/ and /Check Membership/ membersOfR, membersOfWithR, + isMemberOfR, -- ** Teams -- | See diff --git a/src/GitHub/Endpoints/Organizations/Members.hs b/src/GitHub/Endpoints/Organizations/Members.hs index acb0d366..d2ef4a3b 100644 --- a/src/GitHub/Endpoints/Organizations/Members.hs +++ b/src/GitHub/Endpoints/Organizations/Members.hs @@ -10,6 +10,9 @@ module GitHub.Endpoints.Organizations.Members ( membersOf', membersOfR, membersOfWithR, + isMemberOf, + isMemberOf', + isMemberOfR, module GitHub.Data, ) where @@ -54,3 +57,25 @@ membersOfWithR org f r = OrgMemberRoleAll -> "all" OrgMemberRoleAdmin -> "admin" OrgMemberRoleMember -> "member" + +-- | Check if a user is a member of an organization, +-- | with or without authentication. +-- +-- > isMemberOf' (Just $ OAuth "token") "phadej" "haskell-infra" +isMemberOf' :: Maybe Auth -> Name User -> Name Organization -> IO (Either Error Bool) +isMemberOf' auth user org = + executeRequestMaybe auth $ isMemberOfR user org + +-- | Check if a user is a member of an organization, +-- | without authentication. +-- +-- > isMemberOf "phadej" "haskell-infra" +isMemberOf :: Name User -> Name Organization -> IO (Either Error Bool) +isMemberOf = isMemberOf' Nothing + +-- | Check if a user is a member of an organization. +-- +-- See +isMemberOfR :: Name User -> Name Organization -> Request k Bool +isMemberOfR user org = StatusQuery statusOnlyOk $ + Query [ "orgs", toPathPart org, "members", toPathPart user ] [] \ No newline at end of file From bf59f09d3b3f61dba4784baa421a8f67b1094d1b Mon Sep 17 00:00:00 2001 From: Myron Wu Date: Thu, 18 Jan 2018 00:15:01 -0800 Subject: [PATCH 300/510] Adding read-only parts of emails endpoint --- github.cabal | 2 ++ samples/Users/Emails/ListEmails.hs | 17 +++++++++++ src/GitHub.hs | 12 ++++++++ src/GitHub/Data.hs | 2 ++ src/GitHub/Data/Email.hs | 39 ++++++++++++++++++++++++ src/GitHub/Endpoints/Users/Emails.hs | 45 ++++++++++++++++++++++++++++ 6 files changed, 117 insertions(+) create mode 100644 samples/Users/Emails/ListEmails.hs create mode 100644 src/GitHub/Data/Email.hs create mode 100644 src/GitHub/Endpoints/Users/Emails.hs diff --git a/github.cabal b/github.cabal index c7e156b4..74ec11c2 100644 --- a/github.cabal +++ b/github.cabal @@ -75,6 +75,7 @@ Library GitHub.Data.Content GitHub.Data.Definitions GitHub.Data.DeployKeys + GitHub.Data.Email GitHub.Data.Events GitHub.Data.Gists GitHub.Data.GitData @@ -126,6 +127,7 @@ Library GitHub.Endpoints.Repos.Webhooks GitHub.Endpoints.Search GitHub.Endpoints.Users + GitHub.Endpoints.Users.Emails GitHub.Endpoints.Users.Followers GitHub.Request diff --git a/samples/Users/Emails/ListEmails.hs b/samples/Users/Emails/ListEmails.hs new file mode 100644 index 00000000..548b861e --- /dev/null +++ b/samples/Users/Emails/ListEmails.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main (main) where + +import Common +import Prelude () +import qualified GitHub.Endpoints.Users.Emails as GitHub + + +main :: IO () +main = do + emails <- GitHub.currentUserEmails' (GitHub.OAuth "token") + putStrLn $ either (("Error: " <>) . tshow) + (foldMap ((<> "\n") . formatEmail)) + emails + +formatEmail :: GitHub.Email -> Text +formatEmail e = GitHub.emailAddress e <> if GitHub.emailPrimary e then " [primary]" else "" diff --git a/src/GitHub.hs b/src/GitHub.hs index 42b4ddcc..92c37e73 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -315,6 +315,17 @@ module GitHub ( ownerInfoForR, userInfoCurrentR, + -- ** Emails + -- | See + -- + -- Missing endpoints: + -- + -- * Add email address(es) + -- * Delete email address(es) + -- * Toggle primary email visibility + currentUserEmailsR, + currentUserPublicEmailsR, + -- ** Followers -- | See -- @@ -370,5 +381,6 @@ import GitHub.Endpoints.Repos.Statuses import GitHub.Endpoints.Repos.Webhooks import GitHub.Endpoints.Search import GitHub.Endpoints.Users +import GitHub.Endpoints.Users.Emails import GitHub.Endpoints.Users.Followers import GitHub.Request diff --git a/src/GitHub/Data.hs b/src/GitHub/Data.hs index 67fb6b09..2504d841 100644 --- a/src/GitHub/Data.hs +++ b/src/GitHub/Data.hs @@ -37,6 +37,7 @@ module GitHub.Data ( module GitHub.Data.Content, module GitHub.Data.Definitions, module GitHub.Data.DeployKeys, + module GitHub.Data.Email, module GitHub.Data.Events, module GitHub.Data.Gists, module GitHub.Data.GitData, @@ -64,6 +65,7 @@ import GitHub.Data.Comments import GitHub.Data.Content import GitHub.Data.Definitions import GitHub.Data.DeployKeys +import GitHub.Data.Email import GitHub.Data.Events import GitHub.Data.Gists import GitHub.Data.GitData diff --git a/src/GitHub/Data/Email.hs b/src/GitHub/Data/Email.hs new file mode 100644 index 00000000..23f738c6 --- /dev/null +++ b/src/GitHub/Data/Email.hs @@ -0,0 +1,39 @@ +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +module GitHub.Data.Email where + +import GitHub.Internal.Prelude +import Prelude () + +data EmailVisibility + = EmailVisibilityPrivate + | EmailVisibilityPublic + deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic) + +instance NFData EmailVisibility where rnf = genericRnf +instance Binary EmailVisibility + +instance FromJSON EmailVisibility where + parseJSON (String "private") = pure EmailVisibilityPrivate + parseJSON (String "public") = pure EmailVisibilityPublic + parseJSON _ = fail "Could not build an EmailVisibility" + +data Email = Email + { emailAddress :: !Text + , emailVerified :: !Bool + , emailPrimary :: !Bool + , emailVisibility :: !(Maybe EmailVisibility) + } deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Email where rnf = genericRnf +instance Binary Email + +instance FromJSON Email where + parseJSON = withObject "Email" $ \o -> Email + <$> o .: "email" + <*> o .: "verified" + <*> o .: "primary" + <*> o .:? "visibility" diff --git a/src/GitHub/Endpoints/Users/Emails.hs b/src/GitHub/Endpoints/Users/Emails.hs new file mode 100644 index 00000000..c432aae6 --- /dev/null +++ b/src/GitHub/Endpoints/Users/Emails.hs @@ -0,0 +1,45 @@ +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +-- The user emails API as described on +-- . +module GitHub.Endpoints.Users.Emails ( + currentUserEmails', + currentUserEmailsR, + currentUserPublicEmails', + currentUserPublicEmailsR, + module GitHub.Data, + ) where + +import GitHub.Data +import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () + +-- | List email addresses for the authenticated user. +-- +-- > currentUserEmails' (OAuth "token") +currentUserEmails' :: Auth -> IO (Either Error (Vector Email)) +currentUserEmails' auth = + executeRequest auth $ currentUserEmailsR FetchAll + +-- | List email addresses. +-- See +currentUserEmailsR :: FetchCount -> Request 'RA (Vector Email) +currentUserEmailsR = + pagedQuery ["user", "emails"] [] + +-- | List public email addresses for the authenticated user. +-- +-- > currentUserPublicEmails' (OAuth "token") +currentUserPublicEmails' :: Auth -> IO (Either Error (Vector Email)) +currentUserPublicEmails' auth = + executeRequest auth $ currentUserPublicEmailsR FetchAll + +-- | List public email addresses. +-- See +currentUserPublicEmailsR :: FetchCount -> Request 'RA (Vector Email) +currentUserPublicEmailsR = + pagedQuery ["user", "public_emails"] [] From 8af33743cbc4ae3bbc0a63f0f92d7a3de3e1a7ac Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sun, 28 Jan 2018 15:17:04 +0200 Subject: [PATCH 301/510] Prepare for 0.19 release [wip] --- .travis.yml | 43 +++++++++++++++++++++++++++---------------- CHANGELOG.md | 3 +++ github.cabal | 9 ++++----- 3 files changed, 34 insertions(+), 21 deletions(-) diff --git a/.travis.yml b/.travis.yml index 8a4d5571..b277ed12 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,6 +1,6 @@ # This Travis job script has been generated by a script via # -# make_travis_yml_2.hs '--branch' 'master' '-o' '.travis.yml' 'github.cabal' +# runghc make_travis_yml_2.hs '--branch' 'master' '-o' '.travis.yml' 'github.cabal' # # For more information, see https://github.com/hvr/multi-ghc-travis # @@ -28,6 +28,8 @@ before_cache: - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar.idx + - rm -rfv $HOME/.cabal/packages/head.hackage + matrix: include: - compiler: "ghc-7.8.4" @@ -39,15 +41,19 @@ matrix: - compiler: "ghc-8.0.2" # env: TEST=--disable-tests BENCH=--disable-benchmarks addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.0.2], sources: [hvr-ghc]}} - - compiler: "ghc-8.2.1" + - compiler: "ghc-8.2.2" # env: TEST=--disable-tests BENCH=--disable-benchmarks - addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.2.1], sources: [hvr-ghc]}} + addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.2.2], sources: [hvr-ghc]}} before_install: - HC=${CC} - HCPKG=${HC/ghc/ghc-pkg} - unset CC - - PATH=/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$PATH + - ROOTDIR=$(pwd) + - mkdir -p $HOME/.local/bin + - "PATH=/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$HOME/local/bin:$PATH" + - HCNUMVER=$(( $(${HC} --numeric-version|sed -E 's/([0-9]+)\.([0-9]+)\.([0-9]+).*/\1 * 10000 + \2 * 100 + \3/') )) + - echo $HCNUMVER install: - cabal --version @@ -56,12 +62,15 @@ install: - TEST=${TEST---enable-tests} - HADDOCK=${HADDOCK-true} - INSTALLED=${INSTALLED-true} + - GHCHEAD=${GHCHEAD-false} - travis_retry cabal update -v - - sed -i.bak 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config - - rm -fv cabal.project.local - - "echo 'packages: .' > cabal.project" + - "sed -i.bak 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config" + - rm -fv cabal.project cabal.project.local + - grep -Ev -- '^\s*--' ${HOME}/.cabal/config | grep -Ev '^\s*$' + - "printf 'packages: \".\"\\n' > cabal.project" + - cat cabal.project - if [ -f "./configure.ac" ]; then - (cd "."; autoreconf -i); + (cd "." && autoreconf -i); fi - rm -f cabal.project.freeze - cabal new-build -w ${HC} ${TEST} ${BENCH} --project-file="cabal.project" --dep -j2 all @@ -73,26 +82,28 @@ install: # any command which exits with a non-zero exit code causes the build to fail. script: # test that source-distributions can be generated - - (cd "."; cabal sdist) + - (cd "." && cabal sdist) - mv "."/dist/github-*.tar.gz ${DISTDIR}/ - - cd ${DISTDIR} + - cd ${DISTDIR} || false - find . -maxdepth 1 -name '*.tar.gz' -exec tar -xvf '{}' \; - - "printf 'packages: github-*/*.cabal\n' > cabal.project" + - "printf 'packages: github-*/*.cabal\\n' > cabal.project" + - cat cabal.project # this builds all libraries and executables (without tests/benchmarks) - cabal new-build -w ${HC} --disable-tests --disable-benchmarks all # Build with installed constraints for packages in global-db - - if $INSTALLED; then - echo cabal new-build -w ${HC} --disable-tests --disable-benchmarks $(${HCPKG} list --global --simple-output --names-only | sed 's/\([a-zA-Z0-9-]\{1,\}\) */--constraint="\1 installed" /g') all | sh; - else echo "Not building with installed constraints"; fi + - if $INSTALLED; then echo cabal new-build -w ${HC} --disable-tests --disable-benchmarks $(${HCPKG} list --global --simple-output --names-only | sed 's/\([a-zA-Z0-9-]\{1,\}\) */--constraint="\1 installed" /g') all | sh; else echo "Not building with installed constraints"; fi # build & run tests, build benchmarks - cabal new-build -w ${HC} ${TEST} ${BENCH} all - - if [ "x$TEST" = "x--enable-tests" ]; then cabal new-test -w ${HC} ${TEST} all; fi + - if [ "x$TEST" = "x--enable-tests" ]; then cabal new-test -w ${HC} ${TEST} ${BENCH} all; fi + + # cabal check + - (cd github-* && cabal check) # haddock - rm -rf ./dist-newstyle - - if $HADDOCK; then cabal new-haddock -w ${HC} --disable-tests --disable-benchmarks all; else echo "Skipping haddock generation";fi + - if $HADDOCK; then cabal new-haddock -w ${HC} ${TEST} ${BENCH} all; else echo "Skipping haddock generation";fi # REGENDATA ["--branch","master","-o",".travis.yml","github.cabal"] # EOF diff --git a/CHANGELOG.md b/CHANGELOG.md index 7857c4ee..d45dcdc8 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,6 @@ +Changes for 0.19 +- TBW + Changes for 0.18 - Endpoints for deleting issue comments. [#294](https://github.com/phadej/github/pull/294) diff --git a/github.cabal b/github.cabal index 74ec11c2..54e19087 100644 --- a/github.cabal +++ b/github.cabal @@ -1,6 +1,5 @@ name: github -version: 0.18 -x-revision: 1 +version: 0.19 synopsis: Access to the GitHub API, v3. description: The GitHub API provides programmatic access to the full @@ -26,7 +25,7 @@ homepage: https://github.com/phadej/github copyright: Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016 Oleg Grenrus category: Network build-type: Simple -tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.1 +tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2 cabal-version: >=1.10 extra-source-files: README.md, @@ -149,13 +148,13 @@ Library http-client >=0.4.8.1 && <0.6, http-client-tls >=0.2.2 && <0.4, http-link-header >=1.0.1 && <1.1, - http-types >=0.8.6 && <0.12, + http-types >=0.12 && <0.13, iso8601-time >=0.1.4 && <0.2, mtl >=2.1.3.1 && <2.3, network-uri >=2.6.0.3 && <2.7, semigroups >=0.16.2.2 && <0.19, text >=1.2.0.6 && <1.3, - time >=1.4 && <1.9, + time >=1.4 && <1.10, transformers >=0.3.0.0 && <0.6, transformers-compat >=0.4.0.3 && <0.6, unordered-containers >=0.2 && <0.3, From 405f18676b720771db7486b6e43820911bd459d8 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 19 Feb 2018 13:14:47 +0200 Subject: [PATCH 302/510] Fix #301: Update EventType enumeration --- src/GitHub/Data/Issues.hs | 96 +++++++++++++++++++++++---------------- 1 file changed, 58 insertions(+), 38 deletions(-) diff --git a/src/GitHub/Data/Issues.hs b/src/GitHub/Data/Issues.hs index e30a2c03..66a5e0da 100644 --- a/src/GitHub/Data/Issues.hs +++ b/src/GitHub/Data/Issues.hs @@ -79,25 +79,35 @@ data IssueComment = IssueComment instance NFData IssueComment where rnf = genericRnf instance Binary IssueComment +-- | See data EventType - = Mentioned -- ^ The actor was @mentioned in an issue body. - | Subscribed -- ^ The actor subscribed to receive notifications for an issue. - | Unsubscribed -- ^ The issue was unsubscribed from by the actor. - | Referenced -- ^ The issue was referenced from a commit message. The commit_id attribute is the commit SHA1 of where that happened. - | Merged -- ^ The issue was merged by the actor. The commit_id attribute is the SHA1 of the HEAD commit that was merged. - | Assigned -- ^ The issue was assigned to the actor. - | Closed -- ^ The issue was closed by the actor. When the commit_id is present, it identifies the commit that closed the issue using “closes / fixes #NN” syntax. - | Reopened -- ^ The issue was reopened by the actor. - | ActorUnassigned -- ^ The issue was unassigned to the actor - | Labeled -- ^ A label was added to the issue. - | Unlabeled -- ^ A label was removed from the issue. - | Milestoned -- ^ The issue was added to a milestone. - | Demilestoned -- ^ The issue was removed from a milestone. - | Renamed -- ^ The issue title was changed. - | Locked -- ^ The issue was locked by the actor. - | Unlocked -- ^ The issue was unlocked by the actor. - | HeadRefDeleted -- ^ The pull request’s branch was deleted. - | HeadRefRestored -- ^ The pull request’s branch was restored. + = Mentioned -- ^ The actor was @mentioned in an issue body. + | Subscribed -- ^ The actor subscribed to receive notifications for an issue. + | Unsubscribed -- ^ The issue was unsubscribed from by the actor. + | Referenced -- ^ The issue was referenced from a commit message. The commit_id attribute is the commit SHA1 of where that happened. + | Merged -- ^ The issue was merged by the actor. The commit_id attribute is the SHA1 of the HEAD commit that was merged. + | Assigned -- ^ The issue was assigned to the actor. + | Closed -- ^ The issue was closed by the actor. When the commit_id is present, it identifies the commit that closed the issue using “closes / fixes #NN” syntax. + | Reopened -- ^ The issue was reopened by the actor. + | ActorUnassigned -- ^ The issue was unassigned to the actor + | Labeled -- ^ A label was added to the issue. + | Unlabeled -- ^ A label was removed from the issue. + | Milestoned -- ^ The issue was added to a milestone. + | Demilestoned -- ^ The issue was removed from a milestone. + | Renamed -- ^ The issue title was changed. + | Locked -- ^ The issue was locked by the actor. + | Unlocked -- ^ The issue was unlocked by the actor. + | HeadRefDeleted -- ^ The pull request’s branch was deleted. + | HeadRefRestored -- ^ The pull request’s branch was restored. + | ReviewRequested -- ^ The actor requested review from the subject on this pull request. + | ReviewDismissed -- ^ The actor dismissed a review from the pull request. + | ReviewRequestRemoved -- ^ The actor removed the review request for the subject on this pull request. + | MarkedAsDuplicate -- ^ A user with write permissions marked an issue as a duplicate of another issue or a pull request as a duplicate of another pull request. + | UnmarkedAsDuplicate -- ^ An issue that a user had previously marked as a duplicate of another issue is no longer considered a duplicate, or a pull request that a user had previously marked as a duplicate of another pull request is no longer considered a duplicate. + | AddedToProject -- ^ The issue was added to a project board. + | MovedColumnsInProject -- ^ The issue was moved between columns in a project board. + | RemovedFromProject -- ^ The issue was removed from a project board. + | ConvertedNoteToIssue -- ^ The issue was created by converting a note in a project board to an issue. deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic) instance NFData EventType where rnf = genericRnf @@ -116,7 +126,7 @@ data IssueEvent = IssueEvent deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData IssueEvent where rnf = genericRnf -instance Binary IssueEvent +instance Binary IssueEvent instance FromJSON IssueEvent where parseJSON = withObject "Event" $ \o -> IssueEvent @@ -129,25 +139,35 @@ instance FromJSON IssueEvent where <*> o .:? "issue" instance FromJSON EventType where - parseJSON (String "closed") = pure Closed - parseJSON (String "reopened") = pure Reopened - parseJSON (String "subscribed") = pure Subscribed - parseJSON (String "merged") = pure Merged - parseJSON (String "referenced") = pure Referenced - parseJSON (String "mentioned") = pure Mentioned - parseJSON (String "assigned") = pure Assigned - parseJSON (String "unsubscribed") = pure Unsubscribed - parseJSON (String "unassigned") = pure ActorUnassigned - parseJSON (String "labeled") = pure Labeled - parseJSON (String "unlabeled") = pure Unlabeled - parseJSON (String "milestoned") = pure Milestoned - parseJSON (String "demilestoned") = pure Demilestoned - parseJSON (String "renamed") = pure Renamed - parseJSON (String "locked") = pure Locked - parseJSON (String "unlocked") = pure Unlocked - parseJSON (String "head_ref_deleted") = pure HeadRefDeleted - parseJSON (String "head_ref_restored") = pure HeadRefRestored - parseJSON _ = fail "Could not build an EventType" + parseJSON = withText "EventType" $ \t -> case t of + "closed" -> pure Closed + "reopened" -> pure Reopened + "subscribed" -> pure Subscribed + "merged" -> pure Merged + "referenced" -> pure Referenced + "mentioned" -> pure Mentioned + "assigned" -> pure Assigned + "unassigned" -> pure ActorUnassigned + "labeled" -> pure Labeled + "unlabeled" -> pure Unlabeled + "milestoned" -> pure Milestoned + "demilestoned" -> pure Demilestoned + "renamed" -> pure Renamed + "locked" -> pure Locked + "unlocked" -> pure Unlocked + "head_ref_deleted" -> pure HeadRefDeleted + "head_ref_restored" -> pure HeadRefRestored + "review_requested" -> pure ReviewRequested + "review_dismissed" -> pure ReviewDismissed + "review_request_removed" -> pure ReviewRequestRemoved + "marked_as_duplicate" -> pure MarkedAsDuplicate + "unmarked_as_duplicate" -> pure UnmarkedAsDuplicate + "added_to_project" -> pure AddedToProject + "moved_columns_in_project" -> pure MovedColumnsInProject + "removed_from_project" -> pure RemovedFromProject + "converted_note_to_issue" -> pure ConvertedNoteToIssue + "unsubscribed" -> pure Unsubscribed -- not in api docs list + _ -> fail $ "Unknown EventType " ++ show t instance FromJSON IssueComment where parseJSON = withObject "IssueComment" $ \o -> IssueComment From 3085a784a07d54f6eb6fb212c2cae80768e08334 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 19 Feb 2018 13:34:05 +0200 Subject: [PATCH 303/510] Fix #302. Add issueEventLabel --- src/GitHub/Data/Definitions.hs | 4 ++-- src/GitHub/Data/Issues.hs | 4 +++- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/src/GitHub/Data/Definitions.hs b/src/GitHub/Data/Definitions.hs index c2c172d5..ea7ed2ea 100644 --- a/src/GitHub/Data/Definitions.hs +++ b/src/GitHub/Data/Definitions.hs @@ -18,7 +18,7 @@ import qualified Data.Text as T import GitHub.Data.Id (Id) import GitHub.Data.Name (Name) -import GitHub.Data.URL (URL) +import GitHub.Data.URL (URL (..)) -- | Errors have been tagged according to their source, so you can more easily -- dispatch and handle them. @@ -254,5 +254,5 @@ instance Binary IssueLabel instance FromJSON IssueLabel where parseJSON = withObject "IssueLabel" $ \o -> IssueLabel <$> o .: "color" - <*> o .: "url" + <*> o .:? "url" .!= URL "" -- in events there aren't URL <*> o .: "name" diff --git a/src/GitHub/Data/Issues.hs b/src/GitHub/Data/Issues.hs index 66a5e0da..cb3981fb 100644 --- a/src/GitHub/Data/Issues.hs +++ b/src/GitHub/Data/Issues.hs @@ -21,7 +21,7 @@ data Issue = Issue , issueEventsUrl :: !URL , issueHtmlUrl :: !(Maybe URL) , issueClosedBy :: !(Maybe SimpleUser) - , issueLabels :: (Vector IssueLabel) + , issueLabels :: !(Vector IssueLabel) , issueNumber :: !Int , issueAssignees :: !(Vector SimpleUser) , issueUser :: !SimpleUser @@ -122,6 +122,7 @@ data IssueEvent = IssueEvent , issueEventCreatedAt :: !UTCTime , issueEventId :: !Int , issueEventIssue :: !(Maybe Issue) + , issueEventLabel :: !(Maybe IssueLabel) } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -137,6 +138,7 @@ instance FromJSON IssueEvent where <*> o .: "created_at" <*> o .: "id" <*> o .:? "issue" + <*> o .:? "label" instance FromJSON EventType where parseJSON = withText "EventType" $ \t -> case t of From 1c973ffaa67ed1e890fe3e3da826a497c534741a Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 19 Feb 2018 13:36:57 +0200 Subject: [PATCH 304/510] Add list pending organization invitations req --- github.cabal | 1 + src/GitHub.hs | 1 + src/GitHub/Data.hs | 2 + src/GitHub/Data/Invitation.hs | 57 +++++++++++++++++++ src/GitHub/Endpoints/Organizations/Members.hs | 9 ++- 5 files changed, 69 insertions(+), 1 deletion(-) create mode 100644 src/GitHub/Data/Invitation.hs diff --git a/github.cabal b/github.cabal index 54e19087..a4745206 100644 --- a/github.cabal +++ b/github.cabal @@ -79,6 +79,7 @@ Library GitHub.Data.Gists GitHub.Data.GitData GitHub.Data.Id + GitHub.Data.Invitation GitHub.Data.Issues GitHub.Data.Milestone GitHub.Data.Name diff --git a/src/GitHub.hs b/src/GitHub.hs index 92c37e73..8cf6cbdf 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -162,6 +162,7 @@ module GitHub ( membersOfR, membersOfWithR, isMemberOfR, + orgInvitationsR, -- ** Teams -- | See diff --git a/src/GitHub/Data.hs b/src/GitHub/Data.hs index 2504d841..1c935721 100644 --- a/src/GitHub/Data.hs +++ b/src/GitHub/Data.hs @@ -41,6 +41,7 @@ module GitHub.Data ( module GitHub.Data.Events, module GitHub.Data.Gists, module GitHub.Data.GitData, + module GitHub.Data.Invitation, module GitHub.Data.Issues, module GitHub.Data.Milestone, module GitHub.Data.Options, @@ -70,6 +71,7 @@ import GitHub.Data.Events import GitHub.Data.Gists import GitHub.Data.GitData import GitHub.Data.Id +import GitHub.Data.Invitation import GitHub.Data.Issues import GitHub.Data.Milestone import GitHub.Data.Name diff --git a/src/GitHub/Data/Invitation.hs b/src/GitHub/Data/Invitation.hs new file mode 100644 index 00000000..b4126ccc --- /dev/null +++ b/src/GitHub/Data/Invitation.hs @@ -0,0 +1,57 @@ +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +module GitHub.Data.Invitation where + +import GitHub.Data.Definitions +import GitHub.Data.Id (Id) +import GitHub.Data.Name (Name) +import GitHub.Internal.Prelude +import Prelude () + +data Invitation = Invitation + { invitationId :: !(Id Invitation) + -- TODO: technically either one should be, maybe both. use `these` ? + , invitationLogin :: !(Maybe (Name User)) + , invitationEmail :: !(Maybe Text) + , invitationRole :: !InvitationRole + , invitationCreatedAt :: !UTCTime + , inviter :: !SimpleUser + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Invitation where rnf = genericRnf +instance Binary Invitation + +instance FromJSON Invitation where + parseJSON = withObject "Invitation" $ \o -> Invitation + <$> o .: "id" + <*> o .:? "login" + <*> o .:? "email" + <*> o .: "role" + <*> o .: "created_at" + <*> o .: "inviter" + + +data InvitationRole + = InvitationRoleDirectMember + | InvitationRoleAdmin + | InvitationRoleBillingManager + | InvitationRoleHiringManager + | InvitationRoleReinstate + deriving + (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) + +instance NFData InvitationRole where rnf = genericRnf +instance Binary InvitationRole + +instance FromJSON InvitationRole where + parseJSON = withText "InvirationRole" $ \t -> case t of + "direct_member" -> pure InvitationRoleDirectMember + "admin" -> pure InvitationRoleAdmin + "billing_manager" -> pure InvitationRoleBillingManager + "hiring_manager" -> pure InvitationRoleHiringManager + "reinstate" -> pure InvitationRoleReinstate + _ -> fail $ "Invalid role " ++ show t diff --git a/src/GitHub/Endpoints/Organizations/Members.hs b/src/GitHub/Endpoints/Organizations/Members.hs index d2ef4a3b..d5b434c9 100644 --- a/src/GitHub/Endpoints/Organizations/Members.hs +++ b/src/GitHub/Endpoints/Organizations/Members.hs @@ -13,6 +13,7 @@ module GitHub.Endpoints.Organizations.Members ( isMemberOf, isMemberOf', isMemberOfR, + orgInvitationsR, module GitHub.Data, ) where @@ -78,4 +79,10 @@ isMemberOf = isMemberOf' Nothing -- See isMemberOfR :: Name User -> Name Organization -> Request k Bool isMemberOfR user org = StatusQuery statusOnlyOk $ - Query [ "orgs", toPathPart org, "members", toPathPart user ] [] \ No newline at end of file + Query [ "orgs", toPathPart org, "members", toPathPart user ] [] + +-- | List pending organization invitations +-- +-- See +orgInvitationsR :: Name Organization -> FetchCount -> Request 'RA (Vector Invitation) +orgInvitationsR org = pagedQuery ["orgs", toPathPart org, "invitations"] [] From 9d0cc9122624759d43a87e21e207adf86e1841ab Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 19 Feb 2018 13:37:10 +0200 Subject: [PATCH 305/510] Update changelog --- CHANGELOG.md | 50 ++++++++++++++++++++++++++++++++++++-------------- 1 file changed, 36 insertions(+), 14 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index d45dcdc8..ac855161 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,7 +1,27 @@ -Changes for 0.19 -- TBW +## Changes for 0.19 + +- Fix issue event type enumeration + [#301](https://github.com/phadej/github/issues/301) +- Include label info in `IssseEvent` + [#302](https://github.com/phadej/github/issues/302) +- Fix `ShowRepo` example + [#306](https://github.com/phadej/github/pull/306) +- Add "Get archive link" API + [#307](https://github.com/phadej/github/pull/307) +- Make "repo" in PullRequestCommit nullable (repository can be gone) + [#311](https://github.com/phadej/github/pull/311) +- Add read-only emails endpoint + [#313](https://github.com/phadej/github/pull/313) +- Organisation membership API + [#312](https://github.com/phadej/github/pull/312) +- Fix isPullRequestMerged and other boolean responses + [#312](https://github.com/phadej/github/pull/312) +- Add `behind` pull request mergeable state + [#308](https://github.com/phadej/github/pull/308) +- Add list organisation invitations endpoint + +## Changes for 0.18 -Changes for 0.18 - Endpoints for deleting issue comments. [#294](https://github.com/phadej/github/pull/294) - Endpoints for (un)starring gists. @@ -15,13 +35,15 @@ Changes for 0.18 - Add requested reviewers field to pull request records. [#292](https://github.com/phadej/github/pull/292) -Changes for 0.17.0 +## Changes for 0.17.0 + - Add `Ord Request` instance - Repository contents - Repository starring endpoints - Pull Request review endpoints -Changes for 0.16.0 +## Changes for 0.16.0 + - Add support for `mergeable_state = "blocked".` - Fix HTTP status code of merge PR - Supports newest versions of dependencies @@ -29,7 +51,7 @@ Changes for 0.16.0 - release endpoints - forkExistingRepo -Changes for 0.15.0 +## Changes for 0.15.0 - Reworked `PullRequest` (notably `pullRequestsFor`) - Reworked PR and Issue filtering @@ -51,7 +73,7 @@ Changes for 0.15.0 See [git commit summary](https://github.com/phadej/github/compare/v0.14.1...v0.15.0) -Changes for 0.14.1 +## Changes for 0.14.1 - Add `membersOfWithR`, `listTeamMembersR` - Add related enums: `OrgMemberFilter`, `OrgMemberRole`, `TeamMemberRole` @@ -59,7 +81,7 @@ Changes for 0.14.1 `RepoPublicity` - Don't require network access for search tests -Changes for 0.14.0 +## Changes for 0.14.0 Large API changes: @@ -70,7 +92,7 @@ Large API changes: - Add `Binary` instances for all data - `GithubOwner` is a `newtype` of `Either User Organization`. There's still `SimpleOwner`. -Changes for 0.5.0: +## Changes for 0.5.0: * OAuth. * New function: `Github.Repos.organizationRepo`, to get the repo for a specific organization. @@ -78,7 +100,7 @@ Changes for 0.5.0: * Relax the attoparsec version requirements. * The above by [John Wiegley](https://github.com/jwiegley). -Changes for 0.4.1: +## Changes for 0.4.1: * Stop using the uri package. * Use aeson version 0.6.1.0. @@ -86,11 +108,11 @@ Changes for 0.4.1: * Use http-conduit over 1.8. * Use unordered-containers between 0.2 and 0.3. -Changes for 0.4.0: +## Changes for 0.4.0: * Use http-conduit version 1.4.1.10. -Changes for 0.3.0: +## Changes for 0.3.0: * Re-instantiate the Blobs API. * `repoDescription1` and `repoPushedAt` are a `Maybe GithubDate`. @@ -100,11 +122,11 @@ Changes for 0.3.0: ever-changing `http-conduit` package. * Features by [Pavel Ryzhov](https://github.com/paulrzcz) and [Simon Hengel](https://github.com/sol). -Changes for 0.2.1: +## Changes for 0.2.1: * Expand the unordered-containers dependency to anything in 0.1.x . -Changes for 0.2.0: +## Changes for 0.2.0: * `milestoneDueOn` and `repoLanguage` are now `Maybe` types. * Introduce `GithubOwner` as the sum type for a `GithubUser` or `GithubOrganization`. Everything that once produced a `GithubUser` now produces a `GithubOwner`. All record accessors have changed their names From df2e36a5301b4f3209898024a6770165c82c3b20 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 19 Feb 2018 16:51:05 +0200 Subject: [PATCH 306/510] Rearrange build-depends, disallow mtl-2.2 (no Except module) --- github.cabal | 66 ++++++++++++++++++++++++++++------------------------ 1 file changed, 35 insertions(+), 31 deletions(-) diff --git a/github.cabal b/github.cabal index a4745206..eeafcf89 100644 --- a/github.cabal +++ b/github.cabal @@ -131,38 +131,42 @@ Library GitHub.Endpoints.Users.Followers GitHub.Request - -- Packages needed in order to build this package. - build-depends: base >=4.7 && <4.11, - aeson >=0.7.0.6 && <1.3, - base-compat >=0.9.1 && <0.10, - base16-bytestring >=0.1.1.6 && <0.2, - binary >=0.7.1.0 && <0.10, - binary-orphans >=0.1.0.0 && <0.2, - byteable >=0.1.1 && <0.2, - bytestring >=0.10.4.0 && <0.11, - containers >=0.5.5.1 && <0.6, - cryptohash >=0.11 && <0.12, - deepseq >=1.3.0.2 && <1.5, - deepseq-generics >=0.1.1.2 && <0.3, - exceptions >=0.8.0.2 && <0.9, - hashable >=1.2.3.3 && <1.3, - http-client >=0.4.8.1 && <0.6, - http-client-tls >=0.2.2 && <0.4, - http-link-header >=1.0.1 && <1.1, - http-types >=0.12 && <0.13, - iso8601-time >=0.1.4 && <0.2, - mtl >=2.1.3.1 && <2.3, - network-uri >=2.6.0.3 && <2.7, - semigroups >=0.16.2.2 && <0.19, - text >=1.2.0.6 && <1.3, - time >=1.4 && <1.10, - transformers >=0.3.0.0 && <0.6, - transformers-compat >=0.4.0.3 && <0.6, - unordered-containers >=0.2 && <0.3, - vector >=0.10.12.3 && <0.13, - vector-instances >=3.3.0.1 && <3.5, + -- Packages bundles with GHC, mtl and text are also here + build-depends: + base >=4.7 && <4.11, + bytestring >=0.10.4.0 && <0.11, + containers >=0.5.5.1 && <0.6, + deepseq >=1.3.0.2 && <1.5, + mtl (>=2.1.3.1 && <2.2) || (>=2.2.1 && <2.3), + text >=1.2.0.6 && <1.3, + time >=1.4 && <1.10, + transformers >=0.3.0.0 && <0.6 - tls >=1.3.5 + -- other packages + build-depends: + aeson >=0.7.0.6 && <1.3, + base-compat >=0.9.1 && <0.10, + base16-bytestring >=0.1.1.6 && <0.2, + binary >=0.7.1.0 && <0.10, + binary-orphans >=0.1.0.0 && <0.2, + byteable >=0.1.1 && <0.2, + cryptohash >=0.11 && <0.12, + deepseq-generics >=0.1.1.2 && <0.3, + exceptions >=0.8.0.2 && <0.9, + hashable >=1.2.3.3 && <1.3, + http-client >=0.4.8.1 && <0.6, + http-client-tls >=0.2.2 && <0.4, + http-link-header >=1.0.1 && <1.1, + http-types >=0.12.1 && <0.13, + iso8601-time >=0.1.4 && <0.2, + network-uri >=2.6.0.3 && <2.7, + semigroups >=0.16.2.2 && <0.19, + transformers-compat >=0.4.0.3 && <0.6, + unordered-containers >=0.2 && <0.3, + vector >=0.10.12.3 && <0.13, + vector-instances >=3.3.0.1 && <3.5, + + tls >=1.3.5 if flag(aeson-compat) build-depends: aeson-compat >=0.3.0.0 && <0.4 From 8d0f54def8a9ba1720c79ab0b7adce8273e02244 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 12 Mar 2018 20:42:17 +0200 Subject: [PATCH 307/510] Support GHC-8.4.1 --- github.cabal | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/github.cabal b/github.cabal index eeafcf89..4a31324f 100644 --- a/github.cabal +++ b/github.cabal @@ -25,7 +25,7 @@ homepage: https://github.com/phadej/github copyright: Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016 Oleg Grenrus category: Network build-type: Simple -tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2 +tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.1 cabal-version: >=1.10 extra-source-files: README.md, @@ -133,7 +133,7 @@ Library -- Packages bundles with GHC, mtl and text are also here build-depends: - base >=4.7 && <4.11, + base >=4.7 && <4.12, bytestring >=0.10.4.0 && <0.11, containers >=0.5.5.1 && <0.6, deepseq >=1.3.0.2 && <1.5, @@ -144,7 +144,7 @@ Library -- other packages build-depends: - aeson >=0.7.0.6 && <1.3, + aeson >=0.7.0.6 && <1.4, base-compat >=0.9.1 && <0.10, base16-bytestring >=0.1.1.6 && <0.2, binary >=0.7.1.0 && <0.10, @@ -152,7 +152,7 @@ Library byteable >=0.1.1 && <0.2, cryptohash >=0.11 && <0.12, deepseq-generics >=0.1.1.2 && <0.3, - exceptions >=0.8.0.2 && <0.9, + exceptions >=0.8.0.2 && <0.11, hashable >=1.2.3.3 && <1.3, http-client >=0.4.8.1 && <0.6, http-client-tls >=0.2.2 && <0.4, @@ -161,7 +161,7 @@ Library iso8601-time >=0.1.4 && <0.2, network-uri >=2.6.0.3 && <2.7, semigroups >=0.16.2.2 && <0.19, - transformers-compat >=0.4.0.3 && <0.6, + transformers-compat >=0.4.0.3 && <0.7, unordered-containers >=0.2 && <0.3, vector >=0.10.12.3 && <0.13, vector-instances >=3.3.0.1 && <3.5, From c8b9ca34dca780a48179c3c84b87643a3a4aec57 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sun, 8 Apr 2018 20:38:15 +0300 Subject: [PATCH 308/510] Allow base-compat-0.10 --- github.cabal | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/github.cabal b/github.cabal index 4a31324f..e9b632eb 100644 --- a/github.cabal +++ b/github.cabal @@ -1,5 +1,6 @@ name: github version: 0.19 +x-revision: 2 synopsis: Access to the GitHub API, v3. description: The GitHub API provides programmatic access to the full @@ -145,7 +146,7 @@ Library -- other packages build-depends: aeson >=0.7.0.6 && <1.4, - base-compat >=0.9.1 && <0.10, + base-compat >=0.9.1 && <0.11, base16-bytestring >=0.1.1.6 && <0.2, binary >=0.7.1.0 && <0.10, binary-orphans >=0.1.0.0 && <0.2, From 8dfa3d7d930c774fc119b9bc16d60076ba843de8 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 12 Jun 2018 13:36:51 +0300 Subject: [PATCH 309/510] Allow aeson-1.4 --- .travis.yml | 19 +++++++++++-------- github.cabal | 6 +++--- 2 files changed, 14 insertions(+), 11 deletions(-) diff --git a/.travis.yml b/.travis.yml index b277ed12..2a6d5ea8 100644 --- a/.travis.yml +++ b/.travis.yml @@ -32,18 +32,21 @@ before_cache: matrix: include: - - compiler: "ghc-7.8.4" + - compiler: "ghc-8.4.3" # env: TEST=--disable-tests BENCH=--disable-benchmarks - addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.8.4], sources: [hvr-ghc]}} - - compiler: "ghc-7.10.3" + addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-8.4.3], sources: [hvr-ghc]}} + - compiler: "ghc-8.2.2" # env: TEST=--disable-tests BENCH=--disable-benchmarks - addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.10.3], sources: [hvr-ghc]}} + addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-8.2.2], sources: [hvr-ghc]}} - compiler: "ghc-8.0.2" # env: TEST=--disable-tests BENCH=--disable-benchmarks - addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.0.2], sources: [hvr-ghc]}} - - compiler: "ghc-8.2.2" + addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-8.0.2], sources: [hvr-ghc]}} + - compiler: "ghc-7.10.3" + # env: TEST=--disable-tests BENCH=--disable-benchmarks + addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-7.10.3], sources: [hvr-ghc]}} + - compiler: "ghc-7.8.4" # env: TEST=--disable-tests BENCH=--disable-benchmarks - addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.2.2], sources: [hvr-ghc]}} + addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-7.8.4], sources: [hvr-ghc]}} before_install: - HC=${CC} @@ -75,7 +78,7 @@ install: - rm -f cabal.project.freeze - cabal new-build -w ${HC} ${TEST} ${BENCH} --project-file="cabal.project" --dep -j2 all - cabal new-build -w ${HC} --disable-tests --disable-benchmarks --project-file="cabal.project" --dep -j2 all - - rm -rf "."/.ghc.environment.* "."/dist + - rm -rf .ghc.environment.* "."/dist - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX) # Here starts the actual work to be performed for the package under test; diff --git a/github.cabal b/github.cabal index e9b632eb..29b5dc22 100644 --- a/github.cabal +++ b/github.cabal @@ -1,6 +1,6 @@ name: github version: 0.19 -x-revision: 2 +x-revision: 3 synopsis: Access to the GitHub API, v3. description: The GitHub API provides programmatic access to the full @@ -26,7 +26,7 @@ homepage: https://github.com/phadej/github copyright: Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016 Oleg Grenrus category: Network build-type: Simple -tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.1 +tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.3 cabal-version: >=1.10 extra-source-files: README.md, @@ -145,7 +145,7 @@ Library -- other packages build-depends: - aeson >=0.7.0.6 && <1.4, + aeson >=0.7.0.6 && <1.5, base-compat >=0.9.1 && <0.11, base16-bytestring >=0.1.1.6 && <0.2, binary >=0.7.1.0 && <0.10, From 445f297649e1e887d76d637014bf8df32fd64762 Mon Sep 17 00:00:00 2001 From: Artem Ohanjanyan Date: Mon, 9 Jul 2018 20:09:25 +0300 Subject: [PATCH 310/510] Add webhook installation events --- src/GitHub/Data/Webhooks.hs | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/src/GitHub/Data/Webhooks.hs b/src/GitHub/Data/Webhooks.hs index ea0604e5..9e8d1c4b 100644 --- a/src/GitHub/Data/Webhooks.hs +++ b/src/GitHub/Data/Webhooks.hs @@ -38,6 +38,8 @@ data RepoWebhookEvent | WebhookDeploymentStatusEvent | WebhookForkEvent | WebhookGollumEvent + | WebhookInstallationEvent + | WebhookInstallationRepositoriesEvent | WebhookIssueCommentEvent | WebhookIssuesEvent | WebhookMemberEvent @@ -110,6 +112,8 @@ instance FromJSON RepoWebhookEvent where parseJSON (String "deployment_status") = pure WebhookDeploymentStatusEvent parseJSON (String "fork") = pure WebhookForkEvent parseJSON (String "gollum") = pure WebhookGollumEvent + parseJSON (String "installation") = pure WebhookInstallationEvent + parseJSON (String "installation_repositories") = pure WebhookInstallationRepositoriesEvent parseJSON (String "issue_comment") = pure WebhookIssueCommentEvent parseJSON (String "issues") = pure WebhookIssuesEvent parseJSON (String "member") = pure WebhookMemberEvent @@ -134,6 +138,8 @@ instance ToJSON RepoWebhookEvent where toJSON WebhookDeploymentStatusEvent = String "deployment_status" toJSON WebhookForkEvent = String "fork" toJSON WebhookGollumEvent = String "gollum" + toJSON WebhookInstallationEvent = String "installation" + toJSON WebhookInstallationRepositoriesEvent = String "installation_repositories" toJSON WebhookIssueCommentEvent = String "issue_comment" toJSON WebhookIssuesEvent = String "issues" toJSON WebhookMemberEvent = String "member" From 3373cbf04188259bb3979210db83b6183db86905 Mon Sep 17 00:00:00 2001 From: Brendan Hay Date: Tue, 24 Jul 2018 10:47:46 +0200 Subject: [PATCH 311/510] Adding basic deployments and deployment statuses support --- github.cabal | 2 + src/GitHub/Data.hs | 2 + src/GitHub/Data/Deployments.hs | 205 ++++++++++++++++++++++ src/GitHub/Endpoints/Repos/Deployments.hs | 68 +++++++ 4 files changed, 277 insertions(+) create mode 100644 src/GitHub/Data/Deployments.hs create mode 100644 src/GitHub/Endpoints/Repos/Deployments.hs diff --git a/github.cabal b/github.cabal index 29b5dc22..1b07f1ee 100644 --- a/github.cabal +++ b/github.cabal @@ -75,6 +75,7 @@ Library GitHub.Data.Content GitHub.Data.Definitions GitHub.Data.DeployKeys + GitHub.Data.Deployments GitHub.Data.Email GitHub.Data.Events GitHub.Data.Gists @@ -122,6 +123,7 @@ Library GitHub.Endpoints.Repos.Commits GitHub.Endpoints.Repos.Contents GitHub.Endpoints.Repos.DeployKeys + GitHub.Endpoints.Repos.Deployments GitHub.Endpoints.Repos.Forks GitHub.Endpoints.Repos.Releases GitHub.Endpoints.Repos.Statuses diff --git a/src/GitHub/Data.hs b/src/GitHub/Data.hs index 1c935721..b429a99e 100644 --- a/src/GitHub/Data.hs +++ b/src/GitHub/Data.hs @@ -37,6 +37,7 @@ module GitHub.Data ( module GitHub.Data.Content, module GitHub.Data.Definitions, module GitHub.Data.DeployKeys, + module GitHub.Data.Deployments, module GitHub.Data.Email, module GitHub.Data.Events, module GitHub.Data.Gists, @@ -66,6 +67,7 @@ import GitHub.Data.Comments import GitHub.Data.Content import GitHub.Data.Definitions import GitHub.Data.DeployKeys +import GitHub.Data.Deployments import GitHub.Data.Email import GitHub.Data.Events import GitHub.Data.Gists diff --git a/src/GitHub/Data/Deployments.hs b/src/GitHub/Data/Deployments.hs new file mode 100644 index 00000000..8234d998 --- /dev/null +++ b/src/GitHub/Data/Deployments.hs @@ -0,0 +1,205 @@ +{-# LANGUAGE LambdaCase #-} + +module GitHub.Data.Deployments + ( DeploymentQueryOption (..) + , renderDeploymentQueryOption + + , Deployment (..) + , CreateDeployment (..) + + , DeploymentStatus (..) + , DeploymentStatusState (..) + , CreateDeploymentStatus (..) + ) where + +import Control.Arrow (second) + +import Data.ByteString (ByteString) +import Data.Maybe (catMaybes) +import Data.Text (Text) +import Data.Time.Clock (UTCTime) +import Data.Vector (Vector) + +import GitHub.Data.Definitions (SimpleUser) +import GitHub.Data.Id (Id) +import GitHub.Data.Name (Name) +import GitHub.Data.URL (URL) +import GitHub.Internal.Prelude + +import qualified Data.Aeson as JSON +import qualified Data.Text as Text +import qualified Data.Text.Encoding as Text + +data DeploymentQueryOption + = DeploymentQuerySha !Text + | DeploymentQueryRef !Text + | DeploymentQueryTask !Text + | DeploymentQueryEnvironment !Text + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData DeploymentQueryOption where rnf = genericRnf +instance Binary DeploymentQueryOption + +renderDeploymentQueryOption :: DeploymentQueryOption -> (ByteString, ByteString) +renderDeploymentQueryOption = + second Text.encodeUtf8 . \case + DeploymentQuerySha sha -> ("sha", sha) + DeploymentQueryRef ref -> ("ref", ref) + DeploymentQueryTask task -> ("task", task) + DeploymentQueryEnvironment env -> ("environment", env) + +data Deployment a = Deployment + { deploymentUrl :: !URL + , deploymentId :: !(Id (Deployment a)) + , deploymentSha :: !(Name (Deployment a)) + , deploymentRef :: !Text + , deploymentTask :: !Text + , deploymentPayload :: !(Maybe a) + , deploymentEnvironment :: !Text + , deploymentDescription :: !Text + , deploymentCreator :: !SimpleUser + , deploymentCreatedAt :: !UTCTime + , deploymentUpdatedAt :: !UTCTime + , deploymentStatusesUrl :: !URL + , deploymentRepositoryUrl :: !URL + } deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData a => NFData (Deployment a) where rnf = genericRnf +instance Binary a => Binary (Deployment a) + +instance FromJSON a => FromJSON (Deployment a) where + parseJSON = withObject "GitHub Deployment" $ \o -> + Deployment + <$> o .: "url" + <*> o .: "id" + <*> o .: "sha" + <*> o .: "ref" + <*> o .: "task" + <*> o .:? "payload" + <*> o .: "environment" + <*> o .: "description" + <*> o .: "creator" + <*> o .: "created_at" + <*> o .: "updated_at" + <*> o .: "statuses_url" + <*> o .: "repository_url" + +data CreateDeployment a = CreateDeployment + { createDeploymentRef :: !Text + -- ^ Required. The ref to deploy. This can be a branch, tag, or SHA. + , createDeploymentTask :: !(Maybe Text) + -- ^ Specifies a task to execute (e.g., deploy or deploy:migrations). + -- Default: deploy + , createDeploymentAutoMerge :: !(Maybe Bool) + -- ^ Attempts to automatically merge the default branch into the requested + -- ref, if it is behind the default branch. Default: true + , createDeploymentRequiredContexts :: !(Maybe (Vector Text)) + -- ^ The status contexts to verify against commit status checks. If this + -- parameter is omitted, then all unique contexts will be verified before a + -- deployment is created. To bypass checking entirely pass an empty array. + -- Defaults to all unique contexts. + , createDeploymentPayload :: !(Maybe a) + -- ^ JSON payload with extra information about the deployment. Default: "" + , createDeploymentEnvironment :: !(Maybe Text) + -- ^ Name for the target deployment environment (e.g., production, staging, + -- qa). Default: production + , createDeploymentDescription :: !(Maybe Text) + -- ^ Short description of the deployment. Default: "" + } deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData a => NFData (CreateDeployment a) where rnf = genericRnf +instance Binary a => Binary (CreateDeployment a) + +instance ToJSON a => ToJSON (CreateDeployment a) where + toJSON x = + JSON.object $ catMaybes + [ Just ("ref" .= createDeploymentRef x) + , ("task" .=) <$> createDeploymentTask x + , ("auto_merge" .=) <$> createDeploymentAutoMerge x + , ("required_contexts" .=) <$> createDeploymentRequiredContexts x + , ("payload" .=) <$> createDeploymentPayload x + , ("environment" .=) <$> createDeploymentEnvironment x + , ("description" .=) <$> createDeploymentDescription x + ] + +data DeploymentStatus = DeploymentStatus + { deploymentStatusUrl :: !URL + , deploymentStatusId :: !(Id DeploymentStatus) + , deploymentStatusState :: !DeploymentStatusState + , deploymentStatusCreator :: !SimpleUser + , deploymentStatusDescription :: !Text + , deploymentStatusTargetUrl :: !URL + , deploymentStatusCreatedAt :: !UTCTime + , deploymentStatusUpdatedAt :: !UTCTime + , deploymentStatusDeploymentUrl :: !URL + , deploymentStatusRepositoryUrl :: !URL + } deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData DeploymentStatus where rnf = genericRnf +instance Binary DeploymentStatus + +instance FromJSON DeploymentStatus where + parseJSON = withObject "GitHub DeploymentStatus" $ \o -> + DeploymentStatus + <$> o .: "url" + <*> o .: "id" + <*> o .: "state" + <*> o .: "creator" + <*> o .: "description" + <*> o .: "target_url" + <*> o .: "created_at" + <*> o .: "updated_at" + <*> o .: "deployment_url" + <*> o .: "repository_url" + +data DeploymentStatusState + = DeploymentStatusError + | DeploymentStatusFailure + | DeploymentStatusPending + | DeploymentStatusSuccess + | DeploymentStatusInactive + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData DeploymentStatusState where rnf = genericRnf +instance Binary DeploymentStatusState + +instance ToJSON DeploymentStatusState where + toJSON = \case + DeploymentStatusError -> "error" + DeploymentStatusFailure -> "failure" + DeploymentStatusPending -> "pending" + DeploymentStatusSuccess -> "success" + DeploymentStatusInactive -> "inactive" + +instance FromJSON DeploymentStatusState where + parseJSON = withText "GitHub DeploymentStatusState" $ \case + "error" -> pure DeploymentStatusError + "failure" -> pure DeploymentStatusFailure + "pending" -> pure DeploymentStatusPending + "success" -> pure DeploymentStatusSuccess + "inactive" -> pure DeploymentStatusInactive + x -> fail $ "Unknown deployment status: " ++ Text.unpack x + +data CreateDeploymentStatus = CreateDeploymentStatus + { createDeploymentStatusState :: !DeploymentStatusState + -- ^ Required. The state of the status. Can be one of error, failure, + -- pending, or success. + , createDeploymentStatusTargetUrl :: !(Maybe Text) -- TODO: should this be URL? + -- ^ The target URL to associate with this status. This URL should contain + -- output to keep the user updated while the task is running or serve as + -- historical information for what happened in the deployment. Default: "" + , createDeploymentStatusDescription :: !(Maybe Text) + -- ^ A short description of the status. Maximum length of 140 characters. + -- Default: "" + } deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData CreateDeploymentStatus where rnf = genericRnf +instance Binary CreateDeploymentStatus + +instance ToJSON CreateDeploymentStatus where + toJSON x = + JSON.object $ catMaybes + [ Just ("state" .= createDeploymentStatusState x) + , ("target_url" .=) <$> createDeploymentStatusTargetUrl x + , ("description" .=) <$> createDeploymentStatusDescription x + ] diff --git a/src/GitHub/Endpoints/Repos/Deployments.hs b/src/GitHub/Endpoints/Repos/Deployments.hs new file mode 100644 index 00000000..21c29587 --- /dev/null +++ b/src/GitHub/Endpoints/Repos/Deployments.hs @@ -0,0 +1,68 @@ +{-# LANGUAGE LambdaCase #-} + +-- | The deployments API, as described at +module GitHub.Endpoints.Repos.Deployments + ( deploymentsWithOptionsForR + , createDeploymentR + + , deploymentStatusesForR + , createDeploymentStatusR + + , module GitHub.Data + ) where + +import Control.Arrow (second) + +import Data.Vector (Vector) + +import GitHub.Data +import GitHub.Internal.Prelude + +deploymentsWithOptionsForR + :: FromJSON a + => Name Owner + -> Name Repo + -> FetchCount + -> [DeploymentQueryOption] + -> Request 'RA (Vector (Deployment a)) +deploymentsWithOptionsForR owner repo limit opts = + pagedQuery (deployPaths owner repo) + (map (second Just . renderDeploymentQueryOption) opts) + limit + +createDeploymentR + :: ( ToJSON a + , FromJSON a + ) + => Name Owner + -> Name Repo + -> CreateDeployment a + -> Request 'RW (Deployment a) +createDeploymentR owner repo = + command Post (deployPaths owner repo) . encode + +deploymentStatusesForR + :: Name Owner + -> Name Repo + -> Id (Deployment a) + -> FetchCount + -> Request 'RA (Vector DeploymentStatus) +deploymentStatusesForR owner repo deploy = + pagedQuery (statusesPaths owner repo deploy) [] + +createDeploymentStatusR + :: Name Owner + -> Name Repo + -> Id (Deployment a) + -> CreateDeploymentStatus + -> Request 'RW DeploymentStatus +createDeploymentStatusR owner repo deploy = + command Post (statusesPaths owner repo deploy) . encode + +statusesPaths :: Name Owner -> Name Repo -> Id (Deployment a) -> Paths +statusesPaths owner repo deploy = + deployPaths owner repo ++ [toPathPart deploy, "statuses"] + +deployPaths :: Name Owner -> Name Repo -> Paths +deployPaths owner repo = + ["repos", toPathPart owner, toPathPart repo, "deployments"] From 6fc6dc7acc8a666a1b3511567bdadc0fef921ff2 Mon Sep 17 00:00:00 2001 From: Mark Santolucito Date: Thu, 22 Feb 2018 12:39:12 -0500 Subject: [PATCH 312/510] Add support for RateLimit API call --- github.cabal | 3 +++ src/GitHub.hs | 6 +++++ src/GitHub/Data.hs | 2 ++ src/GitHub/Data/RateLimit.hs | 40 +++++++++++++++++++++++++++++++ src/GitHub/Endpoints/RateLimit.hs | 34 ++++++++++++++++++++++++++ 5 files changed, 85 insertions(+) create mode 100644 src/GitHub/Data/RateLimit.hs create mode 100644 src/GitHub/Endpoints/RateLimit.hs diff --git a/github.cabal b/github.cabal index 1b07f1ee..d226410d 100644 --- a/github.cabal +++ b/github.cabal @@ -65,6 +65,7 @@ Library GADTs KindSignatures StandaloneDeriving + RecordWildCards exposed-modules: GitHub GitHub.Internal.Prelude @@ -87,6 +88,7 @@ Library GitHub.Data.Name GitHub.Data.Options GitHub.Data.PullRequests + GitHub.Data.RateLimit GitHub.Data.Releases GitHub.Data.Repos GitHub.Data.Request @@ -117,6 +119,7 @@ Library GitHub.Endpoints.PullRequests GitHub.Endpoints.PullRequests.Reviews GitHub.Endpoints.PullRequests.Comments + GitHub.Endpoints.RateLimit GitHub.Endpoints.Repos GitHub.Endpoints.Repos.Collaborators GitHub.Endpoints.Repos.Comments diff --git a/src/GitHub.hs b/src/GitHub.hs index 8cf6cbdf..054e8c8b 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -344,6 +344,11 @@ module GitHub ( createStatusR, statusesForR, statusForR, + + -- ** Rate Limit + -- | See + rateLimit, + rateLimit', -- * Data definitions module GitHub.Data, @@ -372,6 +377,7 @@ import GitHub.Endpoints.Organizations.Teams import GitHub.Endpoints.PullRequests import GitHub.Endpoints.PullRequests.Reviews import GitHub.Endpoints.PullRequests.Comments +import GitHub.Endpoints.RateLimit 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 index b429a99e..aff42cdc 100644 --- a/src/GitHub/Data.hs +++ b/src/GitHub/Data.hs @@ -47,6 +47,7 @@ module GitHub.Data ( module GitHub.Data.Milestone, module GitHub.Data.Options, module GitHub.Data.PullRequests, + module GitHub.Data.RateLimit, module GitHub.Data.Releases, module GitHub.Data.Repos, module GitHub.Data.Request, @@ -79,6 +80,7 @@ import GitHub.Data.Milestone import GitHub.Data.Name import GitHub.Data.Options import GitHub.Data.PullRequests +import GitHub.Data.RateLimit import GitHub.Data.Releases import GitHub.Data.Repos import GitHub.Data.Request diff --git a/src/GitHub/Data/RateLimit.hs b/src/GitHub/Data/RateLimit.hs new file mode 100644 index 00000000..1d253583 --- /dev/null +++ b/src/GitHub/Data/RateLimit.hs @@ -0,0 +1,40 @@ +{-# LANGUAGE RecordWildCards #-} + +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +module GitHub.Data.RateLimit where + +import GitHub.Internal.Prelude +import Prelude () + + +data RateLimit = RateLimit + { coreLimit :: !Int + , coreRemaining :: !Int + , coreReset :: !Int + , searchLimit :: !Int + , searchRemaining :: !Int + , searchReset :: !Int + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData RateLimit where rnf = genericRnf +instance Binary RateLimit + +instance FromJSON RateLimit where + parseJSON = withObject "RateLimit" $ \o -> do + resources <- o .: "resources" + core <- resources .: "core" + coreLimit <- core .: "limit" + coreRemaining <- core .: "remaining" + coreReset <- core .: "reset" + + search <- resources .: "search" + searchLimit <- search .: "limit" + searchRemaining <- search .: "remaining" + searchReset <- search .: "reset" + + return RateLimit{..} diff --git a/src/GitHub/Endpoints/RateLimit.hs b/src/GitHub/Endpoints/RateLimit.hs new file mode 100644 index 00000000..c4f47b4d --- /dev/null +++ b/src/GitHub/Endpoints/RateLimit.hs @@ -0,0 +1,34 @@ +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +-- The Github RateLimit API, as described at +-- . +module GitHub.Endpoints.RateLimit( + rateLimit', + rateLimit, + module GitHub.Data, + ) where + +import GitHub.Data +import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () + +import qualified Data.Text.Encoding as TE + +-- | Get your current rate limit status (Note: Accessing this endpoint does not count against your rate limit.) +-- With authentication. +rateLimit' :: Maybe Auth -> IO (Either Error RateLimit) +rateLimit' auth = executeRequestMaybe auth rateLimitR + +-- | Get your current rate limit status (Note: Accessing this endpoint does not count against your rate limit.) +-- Without authentication. +-- +-- > searchRepos "q=a in%3Aname language%3Ahaskell created%3A>2013-10-01&per_page=100" +rateLimit :: IO (Either Error RateLimit) +rateLimit = rateLimit' Nothing + +rateLimitR :: Request k RateLimit +rateLimitR = query ["rate_limit"] [] From 855cefecd2e4a07129586a617c7bb3717ba8cf50 Mon Sep 17 00:00:00 2001 From: Mark Santolucito Date: Thu, 22 Feb 2018 12:45:16 -0500 Subject: [PATCH 313/510] add RateLimit sample usage --- samples/RateLimit.hs | 8 ++++++++ 1 file changed, 8 insertions(+) create mode 100644 samples/RateLimit.hs diff --git a/samples/RateLimit.hs b/samples/RateLimit.hs new file mode 100644 index 00000000..c0cabd5f --- /dev/null +++ b/samples/RateLimit.hs @@ -0,0 +1,8 @@ +module RateLimit where + +import qualified Github.RateLimit as Github + +main = do + x <- Github.rateLimit + print x + From dc27d8151dfc510a3f1ab3eeeca4c18b4fab94ab Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sat, 8 Sep 2018 20:33:17 +0300 Subject: [PATCH 314/510] Add deployments to GitHub --- src/GitHub.hs | 19 ++++++++++++++++--- src/GitHub/Endpoints/Repos/Deployments.hs | 10 ++++++++-- 2 files changed, 24 insertions(+), 5 deletions(-) diff --git a/src/GitHub.hs b/src/GitHub.hs index 054e8c8b..fbcf4e8a 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -259,7 +259,7 @@ module GitHub ( -- -- * Create a commit comment -- * Update a commit comment - -- * Delete a commit comment + -- * Delete a commit comment commentsForR, commitCommentsForR, commitCommentForR, @@ -271,6 +271,18 @@ module GitHub ( commitR, diffR, + -- ** Deployments + -- | See + -- + -- Missing endpoints: + -- * Get a single deployment + -- * Update a deployment + -- * Get a single deployment status + deploymentsWithOptionsForR, + createDeploymentR, + deploymentStatusesForR, + createDeploymentStatusR, + -- ** Forks -- | See -- @@ -344,7 +356,7 @@ module GitHub ( createStatusR, statusesForR, statusForR, - + -- ** Rate Limit -- | See rateLimit, @@ -375,13 +387,14 @@ import GitHub.Endpoints.Organizations import GitHub.Endpoints.Organizations.Members import GitHub.Endpoints.Organizations.Teams import GitHub.Endpoints.PullRequests -import GitHub.Endpoints.PullRequests.Reviews import GitHub.Endpoints.PullRequests.Comments +import GitHub.Endpoints.PullRequests.Reviews import GitHub.Endpoints.RateLimit import GitHub.Endpoints.Repos import GitHub.Endpoints.Repos.Collaborators import GitHub.Endpoints.Repos.Comments import GitHub.Endpoints.Repos.Commits +import GitHub.Endpoints.Repos.Deployments import GitHub.Endpoints.Repos.Forks import GitHub.Endpoints.Repos.Releases import GitHub.Endpoints.Repos.Statuses diff --git a/src/GitHub/Endpoints/Repos/Deployments.hs b/src/GitHub/Endpoints/Repos/Deployments.hs index 21c29587..ed94c16a 100644 --- a/src/GitHub/Endpoints/Repos/Deployments.hs +++ b/src/GitHub/Endpoints/Repos/Deployments.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE LambdaCase #-} - -- | The deployments API, as described at module GitHub.Endpoints.Repos.Deployments ( deploymentsWithOptionsForR @@ -18,6 +16,8 @@ import Data.Vector (Vector) import GitHub.Data import GitHub.Internal.Prelude +-- | List deployments. +-- See deploymentsWithOptionsForR :: FromJSON a => Name Owner @@ -30,6 +30,8 @@ deploymentsWithOptionsForR owner repo limit opts = (map (second Just . renderDeploymentQueryOption) opts) limit +-- | Create a deployment. +-- See createDeploymentR :: ( ToJSON a , FromJSON a @@ -41,6 +43,8 @@ createDeploymentR createDeploymentR owner repo = command Post (deployPaths owner repo) . encode +-- | List deployment statuses. +-- See deploymentStatusesForR :: Name Owner -> Name Repo @@ -50,6 +54,8 @@ deploymentStatusesForR deploymentStatusesForR owner repo deploy = pagedQuery (statusesPaths owner repo deploy) [] +-- | Create a deployment status. +-- See createDeploymentStatusR :: Name Owner -> Name Repo From 6ae6af79193dce8b244f6713fc7baf947fd4d809 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sat, 8 Sep 2018 20:48:52 +0300 Subject: [PATCH 315/510] Some cleanups --- CHANGELOG.md | 9 +++++++ CONTRIBUTING.md | 42 ++++++++++++++++------------- src/GitHub.hs | 3 +-- src/GitHub/Data/RateLimit.hs | 45 ++++++++++++++++--------------- src/GitHub/Endpoints/RateLimit.hs | 11 ++++---- 5 files changed, 62 insertions(+), 48 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index ac855161..eb5d788d 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,12 @@ +## Changes for 0.19.1 + +- Add ratelimit endpoint + [#315](https://github.com/phadej/github/pull/315/) +- Add some deployment endoints + [#330](https://github.com/phadej/github/pull/330/) +- Add webhook installation events + [#329](https://github.com/phadej/github/pull/330/) + ## Changes for 0.19 - Fix issue event type enumeration diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index c18ad2b4..8bb941ef 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -1,26 +1,30 @@ Contributing ------------- +============ -When adding a new public function -================================= +When adding a new endpoint +-------------------------- -* Write a test (or sample) in the appropriate place in the samples/ directory. -* Implement the function. -* Submit a pull request. +```haskell +-- | The title, as in the GitHub API docs. +-- +endpointR :: Request k EndpointResult +endpointR = query ["endpoint"] [] +``` -When modifying an existing data structure -========================================= +For example: -* Find all samples that use the data structure and make sure they run. -* Modify the data structure. -* Modify the samples as appropriate. -* Make sure all relevant samples still run. -* Submit a pull request. +```haskell +-- | Get your current rate limit status. +-- +rateLimitR :: Request k RateLimit +rateLimitR = query ["rate_limit"] [] +``` -Submitting a pull request -========================= +Also re-export endpoints from the top `GitHub` module. *Note:* only `R` variants, not `IO`. -* If your code is radically different from existing functionality, give -some explanation for how it fits in this library. -* Create a topic branch on your fork. -* Rebase and squash your commits. +Miscellaneous +------------- + +* **Don't** edit `CHANGELOG.md`, it will only conflict. +* **Don't** edit package version. +* The codebase is not uniform in style, don't make it worse. diff --git a/src/GitHub.hs b/src/GitHub.hs index fbcf4e8a..d507e980 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -359,8 +359,7 @@ module GitHub ( -- ** Rate Limit -- | See - rateLimit, - rateLimit', + rateLimitR, -- * Data definitions module GitHub.Data, diff --git a/src/GitHub/Data/RateLimit.hs b/src/GitHub/Data/RateLimit.hs index 1d253583..3fbd6211 100644 --- a/src/GitHub/Data/RateLimit.hs +++ b/src/GitHub/Data/RateLimit.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE RecordWildCards #-} - ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -10,14 +8,26 @@ module GitHub.Data.RateLimit where import GitHub.Internal.Prelude import Prelude () +data Limits = Limits + { limitsMax :: !Int + , limitsRemaining :: !Int + , limitsReset :: !Int -- TODO: change to proper type + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Limits where rnf = genericRnf +instance Binary Limits + +instance FromJSON Limits where + parseJSON = withObject "Limits" $ \obj -> Limits + <$> obj .: "limit" + <*> obj .: "remaining" + <*> obj .: "reset" data RateLimit = RateLimit - { coreLimit :: !Int - , coreRemaining :: !Int - , coreReset :: !Int - , searchLimit :: !Int - , searchRemaining :: !Int - , searchReset :: !Int + { rateLimitCore :: Limits + , rateLimitSearch :: Limits + , rateLimitGraphQL :: Limits } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -25,16 +35,9 @@ instance NFData RateLimit where rnf = genericRnf instance Binary RateLimit instance FromJSON RateLimit where - parseJSON = withObject "RateLimit" $ \o -> do - resources <- o .: "resources" - core <- resources .: "core" - coreLimit <- core .: "limit" - coreRemaining <- core .: "remaining" - coreReset <- core .: "reset" - - search <- resources .: "search" - searchLimit <- search .: "limit" - searchRemaining <- search .: "remaining" - searchReset <- search .: "reset" - - return RateLimit{..} + parseJSON = withObject "RateLimit" $ \obj -> do + resources <- obj .: "resources" + RateLimit + <$> resources .: "core" + <*> resources .: "search" + <*> resources .: "graphql" diff --git a/src/GitHub/Endpoints/RateLimit.hs b/src/GitHub/Endpoints/RateLimit.hs index c4f47b4d..d357fbe8 100644 --- a/src/GitHub/Endpoints/RateLimit.hs +++ b/src/GitHub/Endpoints/RateLimit.hs @@ -5,9 +5,10 @@ -- -- The Github RateLimit API, as described at -- . -module GitHub.Endpoints.RateLimit( - rateLimit', +module GitHub.Endpoints.RateLimit ( + rateLimitR, rateLimit, + rateLimit', module GitHub.Data, ) where @@ -16,8 +17,6 @@ import GitHub.Internal.Prelude import GitHub.Request import Prelude () -import qualified Data.Text.Encoding as TE - -- | Get your current rate limit status (Note: Accessing this endpoint does not count against your rate limit.) -- With authentication. rateLimit' :: Maybe Auth -> IO (Either Error RateLimit) @@ -25,10 +24,10 @@ rateLimit' auth = executeRequestMaybe auth rateLimitR -- | Get your current rate limit status (Note: Accessing this endpoint does not count against your rate limit.) -- Without authentication. --- --- > searchRepos "q=a in%3Aname language%3Ahaskell created%3A>2013-10-01&per_page=100" rateLimit :: IO (Either Error RateLimit) rateLimit = rateLimit' Nothing +-- | Get your current rate limit status. +-- rateLimitR :: Request k RateLimit rateLimitR = query ["rate_limit"] [] From 2fa617cb04d6b4176113a92b161049da4f0bfc32 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sat, 8 Sep 2018 21:10:59 +0300 Subject: [PATCH 316/510] Tighten lower bounds Also add RateLimitSpec --- CHANGELOG.md | 2 +- github.cabal | 63 ++++++++++++--------------- spec/GitHub/OrganizationsSpec.hs | 11 +++-- spec/GitHub/PullRequestReviewsSpec.hs | 12 ++--- spec/GitHub/PullRequestsSpec.hs | 21 ++++----- spec/GitHub/RateLimitSpec.hs | 30 +++++++++++++ spec/GitHub/SearchSpec.hs | 6 +-- spec/GitHub/UsersSpec.hs | 14 +++--- src/GitHub/Data/Request.hs | 1 + src/GitHub/Internal/Prelude.hs | 2 +- src/GitHub/Request.hs | 44 ++----------------- 11 files changed, 96 insertions(+), 110 deletions(-) create mode 100644 spec/GitHub/RateLimitSpec.hs diff --git a/CHANGELOG.md b/CHANGELOG.md index eb5d788d..b19135d0 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,4 +1,4 @@ -## Changes for 0.19.1 +## Changes for 0.20 - Add ratelimit endpoint [#315](https://github.com/phadej/github/pull/315/) diff --git a/github.cabal b/github.cabal index d226410d..63099e86 100644 --- a/github.cabal +++ b/github.cabal @@ -1,6 +1,5 @@ name: github -version: 0.19 -x-revision: 3 +version: 0.20 synopsis: Access to the GitHub API, v3. description: The GitHub API provides programmatic access to the full @@ -140,6 +139,7 @@ Library -- Packages bundles with GHC, mtl and text are also here build-depends: base >=4.7 && <4.12, + binary >=0.7.1.0 && <0.10, bytestring >=0.10.4.0 && <0.11, containers >=0.5.5.1 && <0.6, deepseq >=1.3.0.2 && <1.5, @@ -150,34 +150,28 @@ Library -- other packages build-depends: - aeson >=0.7.0.6 && <1.5, - base-compat >=0.9.1 && <0.11, + aeson >=1.4.0.0 && <1.5, + base-compat >=0.10.4 && <0.11, base16-bytestring >=0.1.1.6 && <0.2, - binary >=0.7.1.0 && <0.10, - binary-orphans >=0.1.0.0 && <0.2, + binary-orphans >=0.1.8.0 && <0.2, byteable >=0.1.1 && <0.2, - cryptohash >=0.11 && <0.12, - deepseq-generics >=0.1.1.2 && <0.3, - exceptions >=0.8.0.2 && <0.11, - hashable >=1.2.3.3 && <1.3, - http-client >=0.4.8.1 && <0.6, - http-client-tls >=0.2.2 && <0.4, - http-link-header >=1.0.1 && <1.1, + cryptohash >=0.11.9 && <0.12, + deepseq-generics >=0.2.0.0 && <0.3, + exceptions >=0.10.0 && <0.11, + hashable >=1.2.7.0 && <1.3, + http-client >=0.5.12 && <0.6, + http-client-tls >=0.3.5.3 && <0.4, + http-link-header >=1.0.3.1 && <1.1, http-types >=0.12.1 && <0.13, - iso8601-time >=0.1.4 && <0.2, - network-uri >=2.6.0.3 && <2.7, - semigroups >=0.16.2.2 && <0.19, - transformers-compat >=0.4.0.3 && <0.7, - unordered-containers >=0.2 && <0.3, - vector >=0.10.12.3 && <0.13, - vector-instances >=3.3.0.1 && <3.5, - - tls >=1.3.5 + iso8601-time >=0.1.5 && <0.2, + network-uri >=2.6.1.0 && <2.7, + semigroups >=0.18.5 && <0.19, + transformers-compat >=0.6 && <0.7, + unordered-containers >=0.2.9.0 && <0.3, + vector >=0.12.0.1 && <0.13, + vector-instances >=3.4 && <3.5, - if flag(aeson-compat) - build-depends: aeson-compat >=0.3.0.0 && <0.4 - else - build-depends: aeson-extra >=0.2.0.0 && <0.3 + tls >=1.4.1 test-suite github-test default-language: Haskell2010 @@ -188,28 +182,25 @@ test-suite github-test other-modules: GitHub.ActivitySpec GitHub.CommitsSpec - GitHub.OrganizationsSpec + GitHub.EventsSpec GitHub.IssuesSpec - GitHub.PullRequestsSpec + GitHub.OrganizationsSpec GitHub.PullRequestReviewsSpec + GitHub.PullRequestsSpec + GitHub.RateLimitSpec GitHub.ReleasesSpec GitHub.ReposSpec GitHub.SearchSpec GitHub.UsersSpec - GitHub.EventsSpec main-is: Spec.hs ghc-options: -Wall - build-tool-depends: hspec-discover:hspec-discover + build-tool-depends: hspec-discover:hspec-discover >=2.5.6 && <2.6 build-depends: base, base-compat, + aeson, bytestring, github, vector, unordered-containers, file-embed, - hspec - if flag(aeson-compat) - build-depends: aeson-compat - else - build-depends: aeson-extra - + hspec >= 2.5.6 && <2.6 diff --git a/spec/GitHub/OrganizationsSpec.hs b/spec/GitHub/OrganizationsSpec.hs index e53ecb44..171a29ed 100644 --- a/spec/GitHub/OrganizationsSpec.hs +++ b/spec/GitHub/OrganizationsSpec.hs @@ -3,19 +3,18 @@ module GitHub.OrganizationsSpec where import GitHub.Auth (Auth (..)) -import GitHub.Data (SimpleOrganization (..), - SimpleOwner (..), - SimpleTeam (..)) +import GitHub.Data + (SimpleOrganization (..), SimpleOwner (..), SimpleTeam (..)) import GitHub.Endpoints.Organizations (publicOrganizationsFor') import GitHub.Endpoints.Organizations.Members (membersOf') -import Data.Aeson.Compat (eitherDecodeStrict) +import Data.Aeson (eitherDecodeStrict) import Data.Either.Compat (isRight) import Data.FileEmbed (embedFile) import Data.String (fromString) import System.Environment (lookupEnv) -import Test.Hspec (Spec, describe, it, pendingWith, shouldBe, - shouldSatisfy) +import Test.Hspec + (Spec, describe, it, pendingWith, shouldBe, shouldSatisfy) fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b diff --git a/spec/GitHub/PullRequestReviewsSpec.hs b/spec/GitHub/PullRequestReviewsSpec.hs index c04b134b..d79e806f 100644 --- a/spec/GitHub/PullRequestReviewsSpec.hs +++ b/spec/GitHub/PullRequestReviewsSpec.hs @@ -2,16 +2,16 @@ module GitHub.PullRequestReviewsSpec where import qualified GitHub -import GitHub.Data.Id (Id(Id)) +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) +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 diff --git a/spec/GitHub/PullRequestsSpec.hs b/spec/GitHub/PullRequestsSpec.hs index fbea7c7a..921ec186 100644 --- a/spec/GitHub/PullRequestsSpec.hs +++ b/spec/GitHub/PullRequestsSpec.hs @@ -3,20 +3,21 @@ module GitHub.PullRequestsSpec where import qualified GitHub -import GitHub.Data.Id (Id(Id)) +import GitHub.Data.Id (Id (Id)) import Prelude () import Prelude.Compat -import Data.Aeson.Compat (eitherDecodeStrict) -import Data.ByteString (ByteString) -import Data.Either.Compat (isRight) -import Data.FileEmbed (embedFile) -import Data.Foldable (for_) -import Data.String (fromString) -import qualified Data.Vector as V -import System.Environment (lookupEnv) -import Test.Hspec (Spec, describe, it, pendingWith, shouldBe, shouldSatisfy) +import Data.Aeson (eitherDecodeStrict) +import Data.ByteString (ByteString) +import Data.Either.Compat (isRight) +import Data.FileEmbed (embedFile) +import Data.Foldable (for_) +import Data.String (fromString) +import qualified Data.Vector as V +import System.Environment (lookupEnv) +import Test.Hspec + (Spec, describe, it, pendingWith, shouldBe, shouldSatisfy) fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b diff --git a/spec/GitHub/RateLimitSpec.hs b/spec/GitHub/RateLimitSpec.hs new file mode 100644 index 00000000..ea9673ac --- /dev/null +++ b/spec/GitHub/RateLimitSpec.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE OverloadedStrings #-} +module GitHub.RateLimitSpec where + +import qualified GitHub + +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) + +fromRightS :: Show a => Either a b -> b +fromRightS (Right b) = b +fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a + +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 = describe "rateLimitR" $ + it "works" $ withAuth $ \auth -> do + cs <- GitHub.executeRequest auth GitHub.rateLimitR + cs `shouldSatisfy` isRight diff --git a/spec/GitHub/SearchSpec.hs b/spec/GitHub/SearchSpec.hs index 97e311d4..cb8d919a 100644 --- a/spec/GitHub/SearchSpec.hs +++ b/spec/GitHub/SearchSpec.hs @@ -2,10 +2,10 @@ {-# LANGUAGE TemplateHaskell #-} module GitHub.SearchSpec where -import Prelude () +import Prelude () import Prelude.Compat -import Data.Aeson.Compat (eitherDecodeStrict) +import Data.Aeson (eitherDecodeStrict) import Data.FileEmbed (embedFile) import Data.Proxy (Proxy (..)) import Data.String (fromString) @@ -14,7 +14,7 @@ import Test.Hspec (Spec, describe, it, pendingWith, shouldBe) import qualified Data.Vector as V -import GitHub.Data (Auth (..), Issue (..), mkId, IssueState (..)) +import GitHub.Data (Auth (..), Issue (..), IssueState (..), mkId) import GitHub.Endpoints.Search (SearchResult (..), searchIssues') fromRightS :: Show a => Either a b -> b diff --git a/spec/GitHub/UsersSpec.hs b/spec/GitHub/UsersSpec.hs index 5c578c9c..b0b201c2 100644 --- a/spec/GitHub/UsersSpec.hs +++ b/spec/GitHub/UsersSpec.hs @@ -2,20 +2,20 @@ {-# LANGUAGE TemplateHaskell #-} module GitHub.UsersSpec where -import Data.Aeson.Compat (eitherDecodeStrict) +import Data.Aeson (eitherDecodeStrict) import Data.Either.Compat (isLeft, isRight) import Data.FileEmbed (embedFile) import Data.String (fromString) import System.Environment (lookupEnv) -import Test.Hspec (Spec, describe, it, pendingWith, shouldBe, - shouldSatisfy) +import Test.Hspec + (Spec, describe, it, pendingWith, shouldBe, shouldSatisfy) import qualified GitHub -import GitHub.Data (Auth (..), Organization (..), - User (..), fromOwner) -import GitHub.Endpoints.Users (ownerInfoForR, userInfoCurrent', - userInfoFor') +import GitHub.Data + (Auth (..), Organization (..), User (..), fromOwner) +import GitHub.Endpoints.Users + (ownerInfoForR, userInfoCurrent', userInfoFor') import GitHub.Endpoints.Users.Followers (usersFollowedByR, usersFollowingR) import GitHub.Request (executeRequest) diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs index c7d70e84..38df74d8 100644 --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -37,6 +37,7 @@ import qualified Data.Text as T import qualified Network.HTTP.Types as Types import qualified Network.HTTP.Types.Method as Method import Network.URI (URI) + ------------------------------------------------------------------------------ -- Auxillary types ------------------------------------------------------------------------------ diff --git a/src/GitHub/Internal/Prelude.hs b/src/GitHub/Internal/Prelude.hs index 49680f00..70ba2395 100644 --- a/src/GitHub/Internal/Prelude.hs +++ b/src/GitHub/Internal/Prelude.hs @@ -37,7 +37,7 @@ module GitHub.Internal.Prelude ( import Control.Applicative ((<|>)) import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) -import Data.Aeson.Compat +import Data.Aeson (FromJSON (..), Object, ToJSON (..), Value (..), encode, object, withObject, withText, (.!=), (.:), (.:?), (.=)) import Data.Aeson.Types (typeMismatch) diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index e9f9cddd..e723287f 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -1,8 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE StandaloneDeriving #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -53,17 +51,13 @@ module GitHub.Request ( import GitHub.Internal.Prelude import Prelude () -#if MIN_VERSION_mtl(2,2,0) -import Control.Monad.Except (MonadError (..)) -#else -import Control.Monad.Error (MonadError (..)) -#endif +import Control.Monad.Error.Class (MonadError (..)) import Control.Monad (when) import Control.Monad.Catch (MonadCatch (..), MonadThrow) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Except (ExceptT (..), runExceptT) -import Data.Aeson.Compat (eitherDecode) +import Data.Aeson (eitherDecode) import Data.List (find) import Network.HTTP.Client @@ -76,11 +70,6 @@ import Network.HTTP.Link.Types (Link (..), LinkParam (..), href, linkParams) import Network.HTTP.Types (Method, RequestHeaders, Status (..)) import Network.URI (URI, parseURIReference, relativeTo) -#if !MIN_VERSION_http_client(0,5,0) -import qualified Control.Exception as E -import Network.HTTP.Types (ResponseHeaders) -#endif - import qualified Data.ByteString.Lazy as LBS import qualified Data.Text as T import qualified Data.Text.Encoding as TE @@ -96,11 +85,7 @@ import GitHub.Data.Request executeRequest :: Auth -> Request k a -> IO (Either Error a) executeRequest auth req = do manager <- newManager tlsManagerSettings - x <- executeRequestWithMgr manager auth req -#if !MIN_VERSION_http_client(0, 4, 18) - closeManager manager -#endif - pure x + executeRequestWithMgr manager auth req lessFetchCount :: Int -> FetchCount -> Bool lessFetchCount _ FetchAll = True @@ -151,11 +136,7 @@ executeRequestWithMgr mgr auth req = runExceptT $ do executeRequest' ::Request 'RO a -> IO (Either Error a) executeRequest' req = do manager <- newManager tlsManagerSettings - x <- executeRequestWithMgr' manager req -#if !MIN_VERSION_http_client(0, 4, 18) - closeManager manager -#endif - pure x + executeRequestWithMgr' manager req -- | Like 'executeRequestWithMgr' but without authentication. executeRequestWithMgr' @@ -267,11 +248,7 @@ makeHttpSimpleRequest auth r = case r of $ req where parseUrl' :: MonadThrow m => Text -> m HTTP.Request -#if MIN_VERSION_http_client(0,4,30) parseUrl' = HTTP.parseRequest . T.unpack -#else - parseUrl' = HTTP.parseUrl . T.unpack -#endif url :: Paths -> Text url paths = baseUrl <> "/" <> T.intercalate "/" paths @@ -393,14 +370,8 @@ performPagedRequest httpLbs' predicate initReq = do setCheckStatus :: Maybe (StatusMap a) -> HTTP.Request -> HTTP.Request -#if MIN_VERSION_http_client(0,5,0) setCheckStatus sm req = req { HTTP.checkResponse = successOrMissing sm } -#else -setCheckStatus sm req = req { HTTP.checkStatus = successOrMissing sm } -#endif - -#if MIN_VERSION_http_client(0,5,0) successOrMissing :: Maybe (StatusMap a) -> HTTP.Request -> HTTP.Response HTTP.BodyReader -> IO () successOrMissing sm _req res | check = pure () @@ -410,13 +381,6 @@ successOrMissing sm _req res HTTP.throwHttp $ HTTP.StatusCodeException res' (LBS.toStrict chunk) where Status sci _ = HTTP.responseStatus res -#else -successOrMissing :: Maybe (StatusMap a) -> Status -> ResponseHeaders -> HTTP.CookieJar -> Maybe E.SomeException -successOrMissing sm s@(Status sci _) hs cookiejar - | check = Nothing - | otherwise = Just $ E.toException $ StatusCodeException s hs cookiejar - where -#endif check = case sm of Nothing -> 200 <= sci && sci < 300 Just sm' -> sci `elem` map fst sm' From e27ee4c742d4b11aa1233c8a9f701c7aca1646e4 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sat, 8 Sep 2018 21:12:07 +0300 Subject: [PATCH 317/510] Regenerate .travis.yml --- .travis.yml | 21 ++++++++++++++------- 1 file changed, 14 insertions(+), 7 deletions(-) diff --git a/.travis.yml b/.travis.yml index 2a6d5ea8..c89b7203 100644 --- a/.travis.yml +++ b/.travis.yml @@ -2,7 +2,7 @@ # # runghc make_travis_yml_2.hs '--branch' 'master' '-o' '.travis.yml' 'github.cabal' # -# For more information, see https://github.com/hvr/multi-ghc-travis +# For more information, see https://github.com/haskell-CI/haskell-ci # language: c sudo: false @@ -64,14 +64,18 @@ install: - BENCH=${BENCH---enable-benchmarks} - TEST=${TEST---enable-tests} - HADDOCK=${HADDOCK-true} - - INSTALLED=${INSTALLED-true} + - UNCONSTRAINED=${UNCONSTRAINED-true} + - NOINSTALLEDCONSTRAINTS=${NOINSTALLEDCONSTRAINTS-false} - GHCHEAD=${GHCHEAD-false} - travis_retry cabal update -v - "sed -i.bak 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config" - rm -fv cabal.project cabal.project.local - grep -Ev -- '^\s*--' ${HOME}/.cabal/config | grep -Ev '^\s*$' - "printf 'packages: \".\"\\n' > cabal.project" - - cat cabal.project + - touch cabal.project.local + - "if ! $NOINSTALLEDCONSTRAINTS; then for pkg in $($HCPKG list --simple-output); do echo $pkg | grep -vw -- github | sed 's/^/constraints: /' | sed 's/-[^-]*$/ installed/' >> cabal.project.local; done; fi" + - cat cabal.project || true + - cat cabal.project.local || true - if [ -f "./configure.ac" ]; then (cd "." && autoreconf -i); fi @@ -90,13 +94,13 @@ script: - cd ${DISTDIR} || false - find . -maxdepth 1 -name '*.tar.gz' -exec tar -xvf '{}' \; - "printf 'packages: github-*/*.cabal\\n' > cabal.project" - - cat cabal.project + - touch cabal.project.local + - "if ! $NOINSTALLEDCONSTRAINTS; then for pkg in $($HCPKG list --simple-output); do echo $pkg | grep -vw -- github | sed 's/^/constraints: /' | sed 's/-[^-]*$/ installed/' >> cabal.project.local; done; fi" + - cat cabal.project || true + - cat cabal.project.local || true # this builds all libraries and executables (without tests/benchmarks) - cabal new-build -w ${HC} --disable-tests --disable-benchmarks all - # Build with installed constraints for packages in global-db - - if $INSTALLED; then echo cabal new-build -w ${HC} --disable-tests --disable-benchmarks $(${HCPKG} list --global --simple-output --names-only | sed 's/\([a-zA-Z0-9-]\{1,\}\) */--constraint="\1 installed" /g') all | sh; else echo "Not building with installed constraints"; fi - # build & run tests, build benchmarks - cabal new-build -w ${HC} ${TEST} ${BENCH} all - if [ "x$TEST" = "x--enable-tests" ]; then cabal new-test -w ${HC} ${TEST} ${BENCH} all; fi @@ -108,5 +112,8 @@ script: - rm -rf ./dist-newstyle - if $HADDOCK; then cabal new-haddock -w ${HC} ${TEST} ${BENCH} all; else echo "Skipping haddock generation";fi + # Build without installed constraints for packages in global-db + - if $UNCONSTRAINED; then rm -f cabal.project.local; echo cabal new-build -w ${HC} --disable-tests --disable-benchmarks all; else echo "Not building without installed constraints"; fi + # REGENDATA ["--branch","master","-o",".travis.yml","github.cabal"] # EOF From ec9380cfdb89bdf9a69af63b694dc1339d72da93 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sat, 8 Sep 2018 22:15:46 +0300 Subject: [PATCH 318/510] Remove aeson-compat flag --- CHANGELOG.md | 8 +++++--- github.cabal | 5 ----- 2 files changed, 5 insertions(+), 8 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index b19135d0..861783bc 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,11 +1,13 @@ ## Changes for 0.20 - Add ratelimit endpoint - [#315](https://github.com/phadej/github/pull/315/) + [#315](https://github.com/phadej/github/pull/315) - Add some deployment endoints - [#330](https://github.com/phadej/github/pull/330/) + [#330](https://github.com/phadej/github/pull/330) - Add webhook installation events - [#329](https://github.com/phadej/github/pull/330/) + [#329](https://github.com/phadej/github/pull/330) +- Tigthen lower bounds (also remove aeson-compat dep) + [#332](https://github.com/phadej/github/pull/332) ## Changes for 0.19 diff --git a/github.cabal b/github.cabal index 63099e86..9ea59270 100644 --- a/github.cabal +++ b/github.cabal @@ -38,11 +38,6 @@ extra-source-files: fixtures/user-organizations.json, fixtures/user.json -flag aeson-compat - description: Whether to use aeson-compat or aeson-extra - default: True - manual: False - source-repository head type: git location: git://github.com/phadej/github.git From 5ee98e5516461a2875c6abc52f4d296c16674545 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Wed, 26 Sep 2018 13:24:51 +0300 Subject: [PATCH 319/510] Support ghc-8.6 --- .travis.yml | 13 ++++++++----- github.cabal | 8 ++++---- 2 files changed, 12 insertions(+), 9 deletions(-) diff --git a/.travis.yml b/.travis.yml index c89b7203..82f84f1a 100644 --- a/.travis.yml +++ b/.travis.yml @@ -32,21 +32,24 @@ before_cache: matrix: include: + - compiler: "ghc-8.6.1" + # env: TEST=--disable-tests BENCH=--disable-benchmarks + addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-8.6.1], sources: [hvr-ghc]}} - compiler: "ghc-8.4.3" # env: TEST=--disable-tests BENCH=--disable-benchmarks - addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-8.4.3], sources: [hvr-ghc]}} + addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-8.4.3], sources: [hvr-ghc]}} - compiler: "ghc-8.2.2" # env: TEST=--disable-tests BENCH=--disable-benchmarks - addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-8.2.2], sources: [hvr-ghc]}} + addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-8.2.2], sources: [hvr-ghc]}} - compiler: "ghc-8.0.2" # env: TEST=--disable-tests BENCH=--disable-benchmarks - addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-8.0.2], sources: [hvr-ghc]}} + addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-8.0.2], sources: [hvr-ghc]}} - compiler: "ghc-7.10.3" # env: TEST=--disable-tests BENCH=--disable-benchmarks - addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-7.10.3], sources: [hvr-ghc]}} + addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-7.10.3], sources: [hvr-ghc]}} - compiler: "ghc-7.8.4" # env: TEST=--disable-tests BENCH=--disable-benchmarks - addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-7.8.4], sources: [hvr-ghc]}} + addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-7.8.4], sources: [hvr-ghc]}} before_install: - HC=${CC} diff --git a/github.cabal b/github.cabal index 9ea59270..9984267c 100644 --- a/github.cabal +++ b/github.cabal @@ -25,7 +25,7 @@ homepage: https://github.com/phadej/github copyright: Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016 Oleg Grenrus category: Network build-type: Simple -tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.3 +tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.3, GHC==8.6.1 cabal-version: >=1.10 extra-source-files: README.md, @@ -133,10 +133,10 @@ Library -- Packages bundles with GHC, mtl and text are also here build-depends: - base >=4.7 && <4.12, - binary >=0.7.1.0 && <0.10, + base >=4.7 && <4.13, + binary >=0.7.1.0 && <0.11, bytestring >=0.10.4.0 && <0.11, - containers >=0.5.5.1 && <0.6, + containers >=0.5.5.1 && <0.7, deepseq >=1.3.0.2 && <1.5, mtl (>=2.1.3.1 && <2.2) || (>=2.2.1 && <2.3), text >=1.2.0.6 && <1.3, From 2553802cc62a371072cb52f906536b562d20ec5e Mon Sep 17 00:00:00 2001 From: Sajid Ibne Anower Date: Thu, 25 Oct 2018 16:05:36 +1100 Subject: [PATCH 320/510] Tweaks from stylish haskell --- src/GitHub/Data/Milestone.hs | 10 +++++----- src/GitHub/Endpoints/Issues/Milestones.hs | 9 +++++---- 2 files changed, 10 insertions(+), 9 deletions(-) diff --git a/src/GitHub/Data/Milestone.hs b/src/GitHub/Data/Milestone.hs index 26c861de..85171264 100644 --- a/src/GitHub/Data/Milestone.hs +++ b/src/GitHub/Data/Milestone.hs @@ -5,11 +5,11 @@ -- module GitHub.Data.Milestone where -import GitHub.Data.Definitions -import GitHub.Data.Id (Id) -import GitHub.Data.URL (URL) -import GitHub.Internal.Prelude -import Prelude () +import GitHub.Data.Definitions +import GitHub.Data.Id (Id) +import GitHub.Data.URL (URL) +import GitHub.Internal.Prelude +import Prelude () data Milestone = Milestone { milestoneCreator :: !SimpleUser diff --git a/src/GitHub/Endpoints/Issues/Milestones.hs b/src/GitHub/Endpoints/Issues/Milestones.hs index 9f541112..405a6e6a 100644 --- a/src/GitHub/Endpoints/Issues/Milestones.hs +++ b/src/GitHub/Endpoints/Issues/Milestones.hs @@ -11,13 +11,14 @@ module GitHub.Endpoints.Issues.Milestones ( milestonesR, milestone, milestoneR, + createMilestone, module GitHub.Data, ) where -import GitHub.Data -import GitHub.Internal.Prelude -import GitHub.Request -import Prelude () +import GitHub.Data +import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () -- | All milestones in the repo. -- From d3eff41f1a69c59dd17efa68a3b35cb2e970c1e1 Mon Sep 17 00:00:00 2001 From: Sajid Ibne Anower Date: Thu, 25 Oct 2018 16:06:48 +1100 Subject: [PATCH 321/510] Add data type for new milestone --- src/GitHub/Data/Milestone.hs | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) diff --git a/src/GitHub/Data/Milestone.hs b/src/GitHub/Data/Milestone.hs index 85171264..73685c91 100644 --- a/src/GitHub/Data/Milestone.hs +++ b/src/GitHub/Data/Milestone.hs @@ -40,3 +40,26 @@ instance FromJSON Milestone where <*> o .: "url" <*> o .: "created_at" <*> o .: "state" + +data NewMilestone = NewMilestone + { newMilestoneTitle :: !Text + , newMilestoneState :: !Text + , newMilestoneDescription :: !(Maybe Text) + , newMilestoneDueOn :: !(Maybe UTCTime) + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData NewMilestone where rnf = genericRnf +instance Binary NewMilestone + + +instance ToJSON NewMilestone where + toJSON (NewMilestone title state desc due) = object $ filter notNull + [ "title" .= title + , "state" .= state + , "description" .= desc + , "due_on" .= due + ] + where + notNull (_, Null) = False + notNull (_, _) = True From 4200fc7675fd16d79b559984a3b670f3ee7f7033 Mon Sep 17 00:00:00 2001 From: Sajid Ibne Anower Date: Thu, 25 Oct 2018 16:07:23 +1100 Subject: [PATCH 322/510] Add function to post to create milestone --- src/GitHub/Endpoints/Issues/Milestones.hs | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/src/GitHub/Endpoints/Issues/Milestones.hs b/src/GitHub/Endpoints/Issues/Milestones.hs index 405a6e6a..174ab933 100644 --- a/src/GitHub/Endpoints/Issues/Milestones.hs +++ b/src/GitHub/Endpoints/Issues/Milestones.hs @@ -51,3 +51,13 @@ milestone user repo mid = milestoneR :: Name Owner -> Name Repo -> Id Milestone -> Request k Milestone milestoneR user repo mid = query ["repos", toPathPart user, toPathPart repo, "milestones", toPathPart mid] [] + +createMilestone :: Auth -> Name Owner -> Name Repo -> NewMilestone -> IO (Either Error Milestone) +createMilestone auth user repo mst = executeRequest auth $ createMilestoneR user repo mst + +-- | Create a milestone. +-- See +createMilestoneR :: Name Owner -> Name Repo -> NewMilestone -> Request 'RW Milestone +createMilestoneR user repo = + command Post ["repos", toPathPart user, toPathPart repo, "milestones"] . encode + From b07c1d98f54f15cca48d6bd134d4263dbe79b763 Mon Sep 17 00:00:00 2001 From: Sajid Ibne Anower Date: Thu, 25 Oct 2018 16:21:29 +1100 Subject: [PATCH 323/510] Expose create milestone request --- src/GitHub/Endpoints/Issues/Milestones.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/GitHub/Endpoints/Issues/Milestones.hs b/src/GitHub/Endpoints/Issues/Milestones.hs index 174ab933..2af6c119 100644 --- a/src/GitHub/Endpoints/Issues/Milestones.hs +++ b/src/GitHub/Endpoints/Issues/Milestones.hs @@ -12,6 +12,7 @@ module GitHub.Endpoints.Issues.Milestones ( milestone, milestoneR, createMilestone, + createMilestoneR, module GitHub.Data, ) where From 35bb7e2bd7898ac1c3e7e884087bd9c0ac0e5992 Mon Sep 17 00:00:00 2001 From: Sajid Ibne Anower Date: Thu, 25 Oct 2018 16:38:22 +1100 Subject: [PATCH 324/510] Export create milestone functions from Github module --- src/GitHub.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/GitHub.hs b/src/GitHub.hs index d507e980..ef11f52f 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -139,11 +139,12 @@ module GitHub ( -- -- Missing endpoints: -- - -- * Create a milestone -- * Update a milestone -- * Delete a milestone milestonesR, milestoneR, + createMilestone, + createMilestoneR, -- * Organizations -- | See From 8871b43a3300c25413c7219cffaaaf26b0d6b7c8 Mon Sep 17 00:00:00 2001 From: Sajid Ibne Anower Date: Thu, 25 Oct 2018 17:36:11 +1100 Subject: [PATCH 325/510] Restore stylish haskell changes --- src/GitHub/Data/Milestone.hs | 10 +++++----- src/GitHub/Endpoints/Issues/Milestones.hs | 8 ++++---- 2 files changed, 9 insertions(+), 9 deletions(-) diff --git a/src/GitHub/Data/Milestone.hs b/src/GitHub/Data/Milestone.hs index 73685c91..157c0eeb 100644 --- a/src/GitHub/Data/Milestone.hs +++ b/src/GitHub/Data/Milestone.hs @@ -5,11 +5,11 @@ -- module GitHub.Data.Milestone where -import GitHub.Data.Definitions -import GitHub.Data.Id (Id) -import GitHub.Data.URL (URL) -import GitHub.Internal.Prelude -import Prelude () +import GitHub.Data.Definitions +import GitHub.Data.Id (Id) +import GitHub.Data.URL (URL) +import GitHub.Internal.Prelude +import Prelude () data Milestone = Milestone { milestoneCreator :: !SimpleUser diff --git a/src/GitHub/Endpoints/Issues/Milestones.hs b/src/GitHub/Endpoints/Issues/Milestones.hs index 2af6c119..253080c3 100644 --- a/src/GitHub/Endpoints/Issues/Milestones.hs +++ b/src/GitHub/Endpoints/Issues/Milestones.hs @@ -16,10 +16,10 @@ module GitHub.Endpoints.Issues.Milestones ( module GitHub.Data, ) where -import GitHub.Data -import GitHub.Internal.Prelude -import GitHub.Request -import Prelude () +import GitHub.Data +import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () -- | All milestones in the repo. -- From 64fce2697a57b008d8d1aebf22a6fcb2bfd7fb13 Mon Sep 17 00:00:00 2001 From: Sajid Ibne Anower Date: Sat, 27 Oct 2018 14:30:05 +1100 Subject: [PATCH 326/510] Add delete endpoint for milestones --- src/GitHub/Endpoints/Issues/Milestones.hs | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/src/GitHub/Endpoints/Issues/Milestones.hs b/src/GitHub/Endpoints/Issues/Milestones.hs index 253080c3..43e57476 100644 --- a/src/GitHub/Endpoints/Issues/Milestones.hs +++ b/src/GitHub/Endpoints/Issues/Milestones.hs @@ -13,6 +13,8 @@ module GitHub.Endpoints.Issues.Milestones ( milestoneR, createMilestone, createMilestoneR, + deleteMilestone, + deleteMilestoneR, module GitHub.Data, ) where @@ -54,7 +56,7 @@ milestoneR user repo mid = query ["repos", toPathPart user, toPathPart repo, "milestones", toPathPart mid] [] createMilestone :: Auth -> Name Owner -> Name Repo -> NewMilestone -> IO (Either Error Milestone) -createMilestone auth user repo mst = executeRequest auth $ createMilestoneR user repo mst +createMilestone auth user repo mlstn = executeRequest auth $ createMilestoneR user repo mlstn -- | Create a milestone. -- See @@ -62,3 +64,10 @@ createMilestoneR :: Name Owner -> Name Repo -> NewMilestone -> Request 'RW Miles createMilestoneR user repo = command Post ["repos", toPathPart user, toPathPart repo, "milestones"] . encode +deleteMilestone :: Auth -> Name Owner -> Name Repo -> Id Milestone -> IO (Either Error ()) +deleteMilestone auth user repo mid = executeRequest auth $ deleteMilestoneR user repo mid + +deleteMilestoneR :: Name Owner -> Name Repo -> Id Milestone -> Request 'RW () +deleteMilestoneR user repo mid = + command Delete + ["repos", toPathPart user, toPathPart repo, "milestones", toPathPart mid] mempty From 5f7a10a7c59415d8e8b5d821ba10c24cbf4111ef Mon Sep 17 00:00:00 2001 From: Sajid Ibne Anower Date: Sat, 27 Oct 2018 14:30:38 +1100 Subject: [PATCH 327/510] Expose delete endpoint for milestones --- src/GitHub.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/GitHub.hs b/src/GitHub.hs index ef11f52f..53856485 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -140,11 +140,12 @@ module GitHub ( -- Missing endpoints: -- -- * Update a milestone - -- * Delete a milestone milestonesR, milestoneR, createMilestone, createMilestoneR, + deleteMilestone, + deleteMilestoneR, -- * Organizations -- | See From bd574f43a29622f661d40e76fb311c46621604b2 Mon Sep 17 00:00:00 2001 From: Sajid Ibne Anower Date: Sun, 28 Oct 2018 01:51:51 +1100 Subject: [PATCH 328/510] Add link to Github API docs for delete endpoint --- src/GitHub/Endpoints/Issues/Milestones.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/GitHub/Endpoints/Issues/Milestones.hs b/src/GitHub/Endpoints/Issues/Milestones.hs index 43e57476..7ad2cfbf 100644 --- a/src/GitHub/Endpoints/Issues/Milestones.hs +++ b/src/GitHub/Endpoints/Issues/Milestones.hs @@ -67,6 +67,8 @@ createMilestoneR user repo = deleteMilestone :: Auth -> Name Owner -> Name Repo -> Id Milestone -> IO (Either Error ()) deleteMilestone auth user repo mid = executeRequest auth $ deleteMilestoneR user repo mid +-- | Delete a milestone. +-- See deleteMilestoneR :: Name Owner -> Name Repo -> Id Milestone -> Request 'RW () deleteMilestoneR user repo mid = command Delete From 250e5d901d8348bcd4971bf49db27048151b693c Mon Sep 17 00:00:00 2001 From: Sajid Ibne Anower Date: Sun, 28 Oct 2018 01:53:35 +1100 Subject: [PATCH 329/510] Add new data structure for updating milestones --- src/GitHub/Data/Milestone.hs | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) diff --git a/src/GitHub/Data/Milestone.hs b/src/GitHub/Data/Milestone.hs index 157c0eeb..a8db2864 100644 --- a/src/GitHub/Data/Milestone.hs +++ b/src/GitHub/Data/Milestone.hs @@ -63,3 +63,26 @@ instance ToJSON NewMilestone where where notNull (_, Null) = False notNull (_, _) = True + +data UpdateMilestone = UpdateMilestone + { updateMilestoneTitle :: !(Maybe Text) + , updateMilestoneState :: !(Maybe Text) + , updateMilestoneDescription :: !(Maybe Text) + , updateMilestoneDueOn :: !(Maybe UTCTime) + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData UpdateMilestone where rnf = genericRnf +instance Binary UpdateMilestone + + +instance ToJSON UpdateMilestone where + toJSON (UpdateMilestone title state desc due) = object $ filter notNull + [ "title" .= title + , "state" .= state + , "description" .= desc + , "due_on" .= due + ] + where + notNull (_, Null) = False + notNull (_, _) = True From 1f65d13686d004736aa605345f4a783d9edf437d Mon Sep 17 00:00:00 2001 From: Sajid Ibne Anower Date: Sun, 28 Oct 2018 02:01:38 +1100 Subject: [PATCH 330/510] Add request function to update a milestone --- src/GitHub.hs | 5 ++--- src/GitHub/Endpoints/Issues/Milestones.hs | 11 +++++++++++ 2 files changed, 13 insertions(+), 3 deletions(-) diff --git a/src/GitHub.hs b/src/GitHub.hs index 53856485..92fb16c4 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -137,13 +137,12 @@ module GitHub ( -- ** Milestone -- | See -- - -- Missing endpoints: - -- - -- * Update a milestone milestonesR, milestoneR, createMilestone, createMilestoneR, + updateMilestone, + updateMilestoneR, deleteMilestone, deleteMilestoneR, diff --git a/src/GitHub/Endpoints/Issues/Milestones.hs b/src/GitHub/Endpoints/Issues/Milestones.hs index 7ad2cfbf..06039dd2 100644 --- a/src/GitHub/Endpoints/Issues/Milestones.hs +++ b/src/GitHub/Endpoints/Issues/Milestones.hs @@ -13,6 +13,8 @@ module GitHub.Endpoints.Issues.Milestones ( milestoneR, createMilestone, createMilestoneR, + updateMilestone, + updateMilestoneR, deleteMilestone, deleteMilestoneR, module GitHub.Data, @@ -64,6 +66,15 @@ createMilestoneR :: Name Owner -> Name Repo -> NewMilestone -> Request 'RW Miles createMilestoneR user repo = command Post ["repos", toPathPart user, toPathPart repo, "milestones"] . encode +updateMilestone :: Auth -> Name Owner -> Name Repo -> Id Milestone -> UpdateMilestone -> IO (Either Error Milestone) +updateMilestone auth user repo mid mlstn = executeRequest auth $ updateMilestoneR user repo mid mlstn + +-- | Update a milestone. +-- See +updateMilestoneR :: Name Owner -> Name Repo -> Id Milestone -> UpdateMilestone -> Request 'RW Milestone +updateMilestoneR user repo mid = + command Patch ["repos", toPathPart user, toPathPart repo, "milestones", toPathPart mid ] . encode + deleteMilestone :: Auth -> Name Owner -> Name Repo -> Id Milestone -> IO (Either Error ()) deleteMilestone auth user repo mid = executeRequest auth $ deleteMilestoneR user repo mid From 9cf8c49a38f2171b030be4914d1c8fd9238d7759 Mon Sep 17 00:00:00 2001 From: Sajid Ibne Anower Date: Sun, 28 Oct 2018 02:54:31 +1100 Subject: [PATCH 331/510] Make it possible to choose between ignore/delete milestone due date --- src/GitHub/Data/Milestone.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/GitHub/Data/Milestone.hs b/src/GitHub/Data/Milestone.hs index a8db2864..2c947795 100644 --- a/src/GitHub/Data/Milestone.hs +++ b/src/GitHub/Data/Milestone.hs @@ -68,7 +68,7 @@ data UpdateMilestone = UpdateMilestone { updateMilestoneTitle :: !(Maybe Text) , updateMilestoneState :: !(Maybe Text) , updateMilestoneDescription :: !(Maybe Text) - , updateMilestoneDueOn :: !(Maybe UTCTime) + , updateMilestoneDueOn :: !(Maybe (Maybe UTCTime)) } deriving (Show, Data, Typeable, Eq, Ord, Generic) From b6d287e244f362768a104ddfe8cfd68c0d9c3b7a Mon Sep 17 00:00:00 2001 From: Sajid Ibne Anower Date: Sun, 28 Oct 2018 03:04:00 +1100 Subject: [PATCH 332/510] Restore update milestone due on to be Maybe UTCTime --- src/GitHub/Data/Milestone.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/GitHub/Data/Milestone.hs b/src/GitHub/Data/Milestone.hs index 2c947795..a8db2864 100644 --- a/src/GitHub/Data/Milestone.hs +++ b/src/GitHub/Data/Milestone.hs @@ -68,7 +68,7 @@ data UpdateMilestone = UpdateMilestone { updateMilestoneTitle :: !(Maybe Text) , updateMilestoneState :: !(Maybe Text) , updateMilestoneDescription :: !(Maybe Text) - , updateMilestoneDueOn :: !(Maybe (Maybe UTCTime)) + , updateMilestoneDueOn :: !(Maybe UTCTime) } deriving (Show, Data, Typeable, Eq, Ord, Generic) From b56dd7616765dc33ef0520704bc8e149e492527d Mon Sep 17 00:00:00 2001 From: Scott Fleischman Date: Tue, 30 Oct 2018 07:57:04 -0700 Subject: [PATCH 333/510] Make fileBlobUrl and fileRawUrl optional; Fix #339. These fields are null for the diff api when a commit removes a submodule. Add test that uses the repository I created to test this issue. Remove two redundant imports due to fix warnings. --- spec/GitHub/CommitsSpec.hs | 7 ++++++- spec/GitHub/RateLimitSpec.hs | 1 - src/GitHub/Data/GitData.hs | 4 ++-- 3 files changed, 8 insertions(+), 4 deletions(-) diff --git a/spec/GitHub/CommitsSpec.hs b/spec/GitHub/CommitsSpec.hs index 046fd36d..3bf5fc53 100644 --- a/spec/GitHub/CommitsSpec.hs +++ b/spec/GitHub/CommitsSpec.hs @@ -5,7 +5,7 @@ module GitHub.CommitsSpec where import qualified GitHub import GitHub.Auth (Auth (..)) -import GitHub.Endpoints.Repos.Commits (Commit, commitSha, commitsFor', +import GitHub.Endpoints.Repos.Commits (commitSha, commitsFor', commitsForR, diffR, mkCommitName) import GitHub.Request (executeRequest) @@ -60,3 +60,8 @@ spec = do it "issue #155" $ withAuth $ \auth -> do d <- executeRequest auth $ diffR "nomeata" "codespeed" (mkCommitName "ghc") (mkCommitName "tobami:master") d `shouldSatisfy` isRight + + -- diff that includes a commit where a submodule is removed + it "issue #339" $ withAuth $ \auth -> do + d <- executeRequest auth $ diffR "scott-fleischman" "repo-remove-submodule" "d03c152482169d809be9b1eab71dcf64d7405f76" "42cfd732b20cd093534f246e630b309186eb485d" + d `shouldSatisfy` isRight diff --git a/spec/GitHub/RateLimitSpec.hs b/spec/GitHub/RateLimitSpec.hs index ea9673ac..dd649955 100644 --- a/spec/GitHub/RateLimitSpec.hs +++ b/spec/GitHub/RateLimitSpec.hs @@ -7,7 +7,6 @@ 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) diff --git a/src/GitHub/Data/GitData.hs b/src/GitHub/Data/GitData.hs index 5df5b953..fc035231 100644 --- a/src/GitHub/Data/GitData.hs +++ b/src/GitHub/Data/GitData.hs @@ -184,9 +184,9 @@ instance NFData GitUser where rnf = genericRnf instance Binary GitUser data File = File - { fileBlobUrl :: !URL + { fileBlobUrl :: !(Maybe URL) , fileStatus :: !Text - , fileRawUrl :: !URL + , fileRawUrl :: !(Maybe URL) , fileAdditions :: !Int , fileSha :: !Text , fileChanges :: !Int From b4422b019605d6e60e5f4b612413bd0e79fc3a59 Mon Sep 17 00:00:00 2001 From: Scott Fleischman Date: Tue, 30 Oct 2018 08:19:38 -0700 Subject: [PATCH 334/510] Use (.:?) for safer deserialization of File. --- src/GitHub/Data/GitData.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/GitHub/Data/GitData.hs b/src/GitHub/Data/GitData.hs index fc035231..edeef245 100644 --- a/src/GitHub/Data/GitData.hs +++ b/src/GitHub/Data/GitData.hs @@ -251,9 +251,9 @@ instance FromJSON GitUser where instance FromJSON File where parseJSON = withObject "File" $ \o -> File - <$> o .: "blob_url" + <$> o .:? "blob_url" <*> o .: "status" - <*> o .: "raw_url" + <*> o .:? "raw_url" <*> o .: "additions" <*> o .: "sha" <*> o .: "changes" From 9b9cd9f7820073fc0d6a6fc3bd7bd2d8b6a02720 Mon Sep 17 00:00:00 2001 From: Sajid Ibne Anower Date: Thu, 13 Dec 2018 17:45:26 +1100 Subject: [PATCH 335/510] Add initial endpoint to add collaborator --- src/GitHub/Endpoints/Repos/Collaborators.hs | 28 ++++++++++++++++++--- 1 file changed, 24 insertions(+), 4 deletions(-) diff --git a/src/GitHub/Endpoints/Repos/Collaborators.hs b/src/GitHub/Endpoints/Repos/Collaborators.hs index d3049d7b..c7a95ab7 100644 --- a/src/GitHub/Endpoints/Repos/Collaborators.hs +++ b/src/GitHub/Endpoints/Repos/Collaborators.hs @@ -11,13 +11,15 @@ module GitHub.Endpoints.Repos.Collaborators ( collaboratorsOnR, isCollaboratorOn, isCollaboratorOnR, + addCollaborator, + addCollaboratorR, module GitHub.Data, ) where -import GitHub.Data -import GitHub.Internal.Prelude -import GitHub.Request -import Prelude () +import GitHub.Data +import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () -- | All the users who have collaborated on a repo. -- @@ -60,3 +62,21 @@ isCollaboratorOnR -> Request k Bool isCollaboratorOnR user repo coll = StatusQuery statusOnlyOk $ Query ["repos", toPathPart user, toPathPart repo, "collaborators", toPathPart coll] [] + +addCollaborator + :: Auth + -> Name Owner -- ^ Repository owner + -> Name Repo -- ^ Repository name + -> Name User -- ^ Collaborator to add + -> IO (Either Error Invitation) +addCollaborator auth owner repo coll = + executeRequest auth $ addCollaboratorR owner repo coll + +addCollaboratorR + :: Name Owner -- ^ Repository owner + -> Name Repo -- ^ Repository name + -> Name User -- ^ Collaborator to add + -> Request 'RW Invitation +addCollaboratorR owner repo coll = + command Put ["repos", toPathPart owner, toPathPart repo, "collaborators", toPathPart coll] mempty +-- /repos/:owner/:repo/collaborators/:username From 9f229669107c0431cd8b48218d5b0aa5a30b2d59 Mon Sep 17 00:00:00 2001 From: Sajid Ibne Anower Date: Fri, 14 Dec 2018 10:46:31 +1100 Subject: [PATCH 336/510] Ignore output of repository invitation --- src/GitHub/Endpoints/Repos/Collaborators.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/GitHub/Endpoints/Repos/Collaborators.hs b/src/GitHub/Endpoints/Repos/Collaborators.hs index c7a95ab7..9961512a 100644 --- a/src/GitHub/Endpoints/Repos/Collaborators.hs +++ b/src/GitHub/Endpoints/Repos/Collaborators.hs @@ -68,7 +68,7 @@ addCollaborator -> Name Owner -- ^ Repository owner -> Name Repo -- ^ Repository name -> Name User -- ^ Collaborator to add - -> IO (Either Error Invitation) + -> IO (Either Error ()) addCollaborator auth owner repo coll = executeRequest auth $ addCollaboratorR owner repo coll @@ -76,7 +76,7 @@ addCollaboratorR :: Name Owner -- ^ Repository owner -> Name Repo -- ^ Repository name -> Name User -- ^ Collaborator to add - -> Request 'RW Invitation + -> Request 'RW () addCollaboratorR owner repo coll = - command Put ["repos", toPathPart owner, toPathPart repo, "collaborators", toPathPart coll] mempty + command Put' ["repos", toPathPart owner, toPathPart repo, "collaborators", toPathPart coll] mempty -- /repos/:owner/:repo/collaborators/:username From e76e7a34e9f5bfe42e9e38f118ea710754b6cc84 Mon Sep 17 00:00:00 2001 From: Sajid Ibne Anower Date: Fri, 14 Dec 2018 10:58:30 +1100 Subject: [PATCH 337/510] Add link to API description; expose addCollaboratorR --- src/GitHub.hs | 1 + src/GitHub/Endpoints/Repos/Collaborators.hs | 11 ++++++----- 2 files changed, 7 insertions(+), 5 deletions(-) diff --git a/src/GitHub.hs b/src/GitHub.hs index ef11f52f..7a5cba55 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -252,6 +252,7 @@ module GitHub ( -- | See collaboratorsOnR, isCollaboratorOnR, + addCollaboratorR, -- ** Comments -- | See diff --git a/src/GitHub/Endpoints/Repos/Collaborators.hs b/src/GitHub/Endpoints/Repos/Collaborators.hs index 9961512a..a672187b 100644 --- a/src/GitHub/Endpoints/Repos/Collaborators.hs +++ b/src/GitHub/Endpoints/Repos/Collaborators.hs @@ -16,10 +16,10 @@ module GitHub.Endpoints.Repos.Collaborators ( module GitHub.Data, ) where -import GitHub.Data -import GitHub.Internal.Prelude -import GitHub.Request -import Prelude () +import GitHub.Data +import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () -- | All the users who have collaborated on a repo. -- @@ -72,6 +72,8 @@ addCollaborator addCollaborator auth owner repo coll = executeRequest auth $ addCollaboratorR owner repo coll +-- | Invite a user as a collaborator. +-- See addCollaboratorR :: Name Owner -- ^ Repository owner -> Name Repo -- ^ Repository name @@ -79,4 +81,3 @@ addCollaboratorR -> Request 'RW () addCollaboratorR owner repo coll = command Put' ["repos", toPathPart owner, toPathPart repo, "collaborators", toPathPart coll] mempty --- /repos/:owner/:repo/collaborators/:username From a9a5e8524f9a25d19e24fe7d236a72c085e05b83 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Wed, 9 Jan 2019 09:52:23 +0200 Subject: [PATCH 338/510] Allow http-client-0.6; bump hspec versions --- github.cabal | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/github.cabal b/github.cabal index 9984267c..5d0ad70c 100644 --- a/github.cabal +++ b/github.cabal @@ -154,7 +154,7 @@ Library deepseq-generics >=0.2.0.0 && <0.3, exceptions >=0.10.0 && <0.11, hashable >=1.2.7.0 && <1.3, - http-client >=0.5.12 && <0.6, + http-client >=0.5.12 && <0.7, http-client-tls >=0.3.5.3 && <0.4, http-link-header >=1.0.3.1 && <1.1, http-types >=0.12.1 && <0.13, @@ -189,7 +189,7 @@ test-suite github-test GitHub.UsersSpec main-is: Spec.hs ghc-options: -Wall - build-tool-depends: hspec-discover:hspec-discover >=2.5.6 && <2.6 + build-tool-depends: hspec-discover:hspec-discover >=2.6.1 && <2.7 build-depends: base, base-compat, aeson, @@ -198,4 +198,4 @@ test-suite github-test vector, unordered-containers, file-embed, - hspec >= 2.5.6 && <2.6 + hspec >= 2.6.1 && <2.7 From 738e08a100bd10e2a6058d7cd3f98f7e6f56965e Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Wed, 9 Jan 2019 10:09:42 +0200 Subject: [PATCH 339/510] Use cryptohash-sha1 --- CHANGELOG.md | 6 ++++++ github.cabal | 3 +-- src/GitHub/Data/Webhooks/Validate.hs | 12 +++++------- 3 files changed, 12 insertions(+), 9 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 861783bc..c5b23633 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,9 @@ +## Changes for next + +- Allow http-client-0.6 + +- Change to use `cryptohash-sha1` (before `cryptohash`) + ## Changes for 0.20 - Add ratelimit endpoint diff --git a/github.cabal b/github.cabal index 5d0ad70c..d539d4bb 100644 --- a/github.cabal +++ b/github.cabal @@ -149,8 +149,7 @@ Library base-compat >=0.10.4 && <0.11, base16-bytestring >=0.1.1.6 && <0.2, binary-orphans >=0.1.8.0 && <0.2, - byteable >=0.1.1 && <0.2, - cryptohash >=0.11.9 && <0.12, + cryptohash-sha1 >=0.11.100.1 && <0.12, deepseq-generics >=0.2.0.0 && <0.3, exceptions >=0.10.0 && <0.11, hashable >=1.2.7.0 && <1.3, diff --git a/src/GitHub/Data/Webhooks/Validate.hs b/src/GitHub/Data/Webhooks/Validate.hs index 00884a5d..a90d4e23 100644 --- a/src/GitHub/Data/Webhooks/Validate.hs +++ b/src/GitHub/Data/Webhooks/Validate.hs @@ -12,9 +12,8 @@ module GitHub.Data.Webhooks.Validate ( import GitHub.Internal.Prelude import Prelude () -import Crypto.Hash (HMAC, SHA1, hmac, hmacGetDigest) -import Data.Byteable (constEqBytes, toBytes) -import Data.ByteString (ByteString) +import Crypto.Hash.SHA1 (hmac) +import Data.ByteString (ByteString) import qualified Data.ByteString.Base16 as Hex import qualified Data.Text.Encoding as TE @@ -30,10 +29,9 @@ isValidPayload -- including the 'sha1=...' prefix -> ByteString -- ^ the body -> Bool -isValidPayload secret shaOpt payload = maybe False (constEqBytes sign) shaOptBS +isValidPayload secret shaOpt payload = maybe False (sign ==) shaOptBS where shaOptBS = TE.encodeUtf8 <$> shaOpt - hexDigest = Hex.encode . toBytes . hmacGetDigest - - hm = hmac (TE.encodeUtf8 secret) payload :: HMAC SHA1 + hexDigest = Hex.encode + hm = hmac (TE.encodeUtf8 secret) payload sign = "sha1=" <> hexDigest hm From d79ceece8e7e3b7d89371550f718e8d97dbdea00 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Domen=20Ko=C5=BEar?= Date: Wed, 16 Jan 2019 05:00:50 +0700 Subject: [PATCH 340/510] Add organizationsR to request user organizations --- src/GitHub.hs | 1 + src/GitHub/Endpoints/Organizations.hs | 8 +++++++- 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/src/GitHub.hs b/src/GitHub.hs index ef11f52f..7e3a293a 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -156,6 +156,7 @@ module GitHub ( -- * Edit an organization publicOrganizationsForR, publicOrganizationR, + organizationsR, -- ** Members -- | See -- diff --git a/src/GitHub/Endpoints/Organizations.hs b/src/GitHub/Endpoints/Organizations.hs index 8bbc9efe..ada7052b 100644 --- a/src/GitHub/Endpoints/Organizations.hs +++ b/src/GitHub/Endpoints/Organizations.hs @@ -11,6 +11,7 @@ module GitHub.Endpoints.Organizations ( publicOrganization, publicOrganization', publicOrganizationR, + organizationsR, module GitHub.Data, ) where @@ -32,7 +33,12 @@ publicOrganizationsFor' auth org = publicOrganizationsFor :: Name User -> IO (Either Error (Vector SimpleOrganization)) publicOrganizationsFor = publicOrganizationsFor' Nothing --- | List user organizations. +-- | List all user organizations. +-- See +organizationsR :: FetchCount -> Request k (Vector SimpleOrganization) +organizationsR = pagedQuery ["user", "orgs"] [] + +-- | List public user organizations. -- See publicOrganizationsForR :: Name User -> FetchCount -> Request k (Vector SimpleOrganization) publicOrganizationsForR user = pagedQuery ["users", toPathPart user, "orgs"] [] From d6f4ea6813b595cc553bccb1c19eab34955a831e Mon Sep 17 00:00:00 2001 From: Alex Mason Date: Tue, 5 Feb 2019 08:37:50 +1100 Subject: [PATCH 341/510] Allow multiple assignees in NewIssue and EditIssue (#336) * Replace single assignee fields with vectors * Remove null fields NewIssue * Add missing notNull function * Make assignees just a Vector in NewIssue --- src/GitHub/Data/Issues.hs | 17 ++++++++++------- src/GitHub/Endpoints/Issues.hs | 2 +- 2 files changed, 11 insertions(+), 8 deletions(-) diff --git a/src/GitHub/Data/Issues.hs b/src/GitHub/Data/Issues.hs index cb3981fb..82c0324d 100644 --- a/src/GitHub/Data/Issues.hs +++ b/src/GitHub/Data/Issues.hs @@ -13,7 +13,7 @@ import GitHub.Data.Options (IssueState) import GitHub.Data.PullRequests import GitHub.Data.URL (URL) import GitHub.Internal.Prelude -import Prelude () +import Prelude () data Issue = Issue { issueClosedAt :: !(Maybe UTCTime) @@ -43,7 +43,7 @@ instance Binary Issue data NewIssue = NewIssue { newIssueTitle :: !Text , newIssueBody :: !(Maybe Text) - , newIssueAssignee :: !(Maybe Text) + , newIssueAssignees :: !(Vector (Name User)) , newIssueMilestone :: !(Maybe (Id Milestone)) , newIssueLabels :: !(Maybe (Vector (Name IssueLabel))) } @@ -55,7 +55,7 @@ instance Binary NewIssue data EditIssue = EditIssue { editIssueTitle :: !(Maybe Text) , editIssueBody :: !(Maybe Text) - , editIssueAssignee :: !(Maybe (Name User)) + , editIssueAssignees :: !(Maybe (Vector (Name User))) , editIssueState :: !(Maybe IssueState) , editIssueMilestone :: !(Maybe (Id Milestone)) , editIssueLabels :: !(Maybe (Vector (Name IssueLabel))) @@ -203,19 +203,22 @@ instance FromJSON Issue where <*> o .:? "milestone" instance ToJSON NewIssue where - toJSON (NewIssue t b a m ls) = object + toJSON (NewIssue t b a m ls) = object $ filter notNull [ "title" .= t , "body" .= b - , "assignee" .= a + , "assignees" .= a , "milestone" .= m , "labels" .= ls ] + where + notNull (_, Null) = False + notNull (_, _) = True instance ToJSON EditIssue where - toJSON (EditIssue t b a s m ls) = object $ filter notNull $ + toJSON (EditIssue t b a s m ls) = object $ filter notNull [ "title" .= t , "body" .= b - , "assignee" .= a + , "assignees" .= a , "state" .= s , "milestone" .= m , "labels" .= ls diff --git a/src/GitHub/Endpoints/Issues.hs b/src/GitHub/Endpoints/Issues.hs index 431e1c3e..7b2c5c43 100644 --- a/src/GitHub/Endpoints/Issues.hs +++ b/src/GitHub/Endpoints/Issues.hs @@ -85,7 +85,7 @@ issuesForRepoR user reqRepoName opts = -- Creating new issues. newIssue :: Text -> NewIssue -newIssue title = NewIssue title Nothing Nothing Nothing Nothing +newIssue title = NewIssue title Nothing mempty Nothing Nothing -- | Create a new issue. From fbfcdd61c83837e354d108bfdae4082677a65ba0 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sat, 9 Feb 2019 20:02:54 +0200 Subject: [PATCH 342/510] Fix #334: Introduce IssueNumber newtype --- CHANGELOG.md | 5 +- cabal.project | 3 + github.cabal | 159 +++++++++--------- spec/GitHub/IssuesSpec.hs | 15 +- spec/GitHub/PullRequestsSpec.hs | 3 +- spec/GitHub/SearchSpec.hs | 7 +- src/GitHub/Data.hs | 2 + src/GitHub/Data/Definitions.hs | 22 +++ src/GitHub/Data/Issues.hs | 2 +- src/GitHub/Data/Request.hs | 5 +- src/GitHub/Endpoints/Issues/Comments.hs | 10 +- src/GitHub/Endpoints/PullRequests.hs | 8 +- src/GitHub/Endpoints/PullRequests/Comments.hs | 4 +- 13 files changed, 145 insertions(+), 100 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index c5b23633..d73013a0 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,8 +1,9 @@ ## Changes for next -- Allow http-client-0.6 +## Changes for 0.21 -- Change to use `cryptohash-sha1` (before `cryptohash`) +- Allow `http-client-0.6` +- Change to use `cryptohash-sha1` (`cryptohash` was used before) ## Changes for 0.20 diff --git a/cabal.project b/cabal.project index 7625ac15..cf67e0cf 100644 --- a/cabal.project +++ b/cabal.project @@ -1,3 +1,6 @@ packages: "." samples + +optimization: False +tests: True diff --git a/github.cabal b/github.cabal index d539d4bb..5d46680d 100644 --- a/github.cabal +++ b/github.cabal @@ -1,6 +1,8 @@ -name: github -version: 0.20 -synopsis: Access to the GitHub API, v3. +cabal-version: >=1.10 +name: github +version: 0.21 +synopsis: Access to the GitHub API, v3. +category: Network description: The GitHub API provides programmatic access to the full GitHub Web site, from Issues to Gists to repos down to the underlying git data @@ -17,52 +19,56 @@ description: > print possibleUser . For more of an overview please see the README: -license: BSD3 -license-file: LICENSE -author: Mike Burns, John Wiegley, Oleg Grenrus -maintainer: Oleg Grenrus -homepage: https://github.com/phadej/github -copyright: Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016 Oleg Grenrus -category: Network -build-type: Simple -tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.3, GHC==8.6.1 -cabal-version: >=1.10 + +license: BSD3 +license-file: LICENSE +author: Mike Burns, John Wiegley, Oleg Grenrus +maintainer: Oleg Grenrus +homepage: https://github.com/phadej/github +build-type: Simple +copyright: + Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016-2019 Oleg Grenrus + +tested-with: + ghc ==7.8.4 || ==7.10.3 || ==8.0.2 || ==8.2.2 || ==8.4.3 || ==8.6.3 + extra-source-files: - README.md, - CHANGELOG.md, - fixtures/issue-search.json, - fixtures/list-teams.json, - fixtures/members-list.json, - fixtures/pull-request-opened.json, - fixtures/pull-request-review-requested.json, - fixtures/user-organizations.json, + README.md + CHANGELOG.md + fixtures/issue-search.json + fixtures/list-teams.json + fixtures/members-list.json + fixtures/pull-request-opened.json + fixtures/pull-request-review-requested.json + fixtures/user-organizations.json fixtures/user.json source-repository head - type: git + type: git location: git://github.com/phadej/github.git -Library - default-language: Haskell2010 - ghc-options: -Wall - hs-source-dirs: src +library + default-language: Haskell2010 + ghc-options: -Wall + hs-source-dirs: src default-extensions: DataKinds DeriveDataTypeable DeriveGeneric OverloadedStrings ScopedTypeVariables + other-extensions: CPP FlexibleContexts FlexibleInstances GADTs KindSignatures + RecordWildCards StandaloneDeriving - RecordWildCards + exposed-modules: GitHub - GitHub.Internal.Prelude GitHub.Auth GitHub.Data GitHub.Data.Activities @@ -111,8 +117,8 @@ Library GitHub.Endpoints.Organizations.Members GitHub.Endpoints.Organizations.Teams GitHub.Endpoints.PullRequests - GitHub.Endpoints.PullRequests.Reviews GitHub.Endpoints.PullRequests.Comments + GitHub.Endpoints.PullRequests.Reviews GitHub.Endpoints.RateLimit GitHub.Endpoints.Repos GitHub.Endpoints.Repos.Collaborators @@ -129,50 +135,52 @@ Library GitHub.Endpoints.Users GitHub.Endpoints.Users.Emails GitHub.Endpoints.Users.Followers + GitHub.Internal.Prelude GitHub.Request -- Packages bundles with GHC, mtl and text are also here build-depends: - base >=4.7 && <4.13, - binary >=0.7.1.0 && <0.11, - bytestring >=0.10.4.0 && <0.11, - containers >=0.5.5.1 && <0.7, - deepseq >=1.3.0.2 && <1.5, - mtl (>=2.1.3.1 && <2.2) || (>=2.2.1 && <2.3), - text >=1.2.0.6 && <1.3, - time >=1.4 && <1.10, - transformers >=0.3.0.0 && <0.6 + base >=4.7 && <4.13 + , binary >=0.7.1.0 && <0.11 + , bytestring >=0.10.4.0 && <0.11 + , containers >=0.5.5.1 && <0.7 + , deepseq >=1.3.0.2 && <1.5 + , mtl >=2.1.3.1 && <2.2 || >=2.2.1 && <2.3 + , text >=1.2.0.6 && <1.3 + , time >=1.4 && <1.10 + , transformers >=0.3.0.0 && <0.6 -- other packages build-depends: - aeson >=1.4.0.0 && <1.5, - base-compat >=0.10.4 && <0.11, - base16-bytestring >=0.1.1.6 && <0.2, - binary-orphans >=0.1.8.0 && <0.2, - cryptohash-sha1 >=0.11.100.1 && <0.12, - deepseq-generics >=0.2.0.0 && <0.3, - exceptions >=0.10.0 && <0.11, - hashable >=1.2.7.0 && <1.3, - http-client >=0.5.12 && <0.7, - http-client-tls >=0.3.5.3 && <0.4, - http-link-header >=1.0.3.1 && <1.1, - http-types >=0.12.1 && <0.13, - iso8601-time >=0.1.5 && <0.2, - network-uri >=2.6.1.0 && <2.7, - semigroups >=0.18.5 && <0.19, - transformers-compat >=0.6 && <0.7, - unordered-containers >=0.2.9.0 && <0.3, - vector >=0.12.0.1 && <0.13, - vector-instances >=3.4 && <3.5, - - tls >=1.4.1 + aeson >=1.4.0.0 && <1.5 + , base-compat >=0.10.4 && <0.11 + , base16-bytestring >=0.1.1.6 && <0.2 + , binary-orphans >=0.1.8.0 && <0.2 + , cryptohash-sha1 >=0.11.100.1 && <0.12 + , deepseq-generics >=0.2.0.0 && <0.3 + , exceptions >=0.10.0 && <0.11 + , hashable >=1.2.7.0 && <1.3 + , http-client >=0.5.12 && <0.7 + , http-client-tls >=0.3.5.3 && <0.4 + , http-link-header >=1.0.3.1 && <1.1 + , http-types >=0.12.1 && <0.13 + , iso8601-time >=0.1.5 && <0.2 + , network-uri >=2.6.1.0 && <2.7 + , semigroups >=0.18.5 && <0.19 + , tls >=1.4.1 + , transformers-compat >=0.6 && <0.7 + , unordered-containers >=0.2.9.0 && <0.3 + , vector >=0.12.0.1 && <0.13 + , vector-instances >=3.4 && <3.5 test-suite github-test - default-language: Haskell2010 - type: exitcode-stdio-1.0 - hs-source-dirs: spec - other-extensions: - TemplateHaskell + default-language: Haskell2010 + type: exitcode-stdio-1.0 + hs-source-dirs: spec + main-is: Spec.hs + ghc-options: -Wall + build-tool-depends: hspec-discover:hspec-discover >=2.6.1 && <2.8 + other-extensions: TemplateHaskell other-modules: GitHub.ActivitySpec GitHub.CommitsSpec @@ -186,15 +194,14 @@ test-suite github-test GitHub.ReposSpec GitHub.SearchSpec GitHub.UsersSpec - main-is: Spec.hs - ghc-options: -Wall - build-tool-depends: hspec-discover:hspec-discover >=2.6.1 && <2.7 - build-depends: base, - base-compat, - aeson, - bytestring, - github, - vector, - unordered-containers, - file-embed, - hspec >= 2.6.1 && <2.7 + + build-depends: + aeson + , base + , base-compat + , bytestring + , file-embed + , github + , hspec >=2.6.1 && <2.8 + , unordered-containers + , vector diff --git a/spec/GitHub/IssuesSpec.hs b/spec/GitHub/IssuesSpec.hs index 9eb41093..cfad56e3 100644 --- a/spec/GitHub/IssuesSpec.hs +++ b/spec/GitHub/IssuesSpec.hs @@ -10,7 +10,8 @@ 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) +import Test.Hspec + (Spec, describe, expectationFailure, it, pendingWith, shouldSatisfy) fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b @@ -28,11 +29,17 @@ spec = do describe "issuesForRepoR" $ do it "works" $ withAuth $ \auth -> for_ repos $ \(owner, repo) -> do cs <- GitHub.executeRequest auth $ - GitHub.issuesForRepoR owner repo mempty GitHub.FetchAll - cs `shouldSatisfy` isRight + GitHub.issuesForRepoR owner repo mempty GitHub.FetchAll + case cs of + Left e -> + expectationFailure . show $ e + Right cs' -> do + for_ cs' $ \i -> do + cms <- GitHub.executeRequest auth $ + GitHub.commentsR owner repo (GitHub.issueNumber i) 1 + cms `shouldSatisfy` isRight where repos = [ ("thoughtbot", "paperclip") , ("phadej", "github") - , ("haskell", "cabal") ] diff --git a/spec/GitHub/PullRequestsSpec.hs b/spec/GitHub/PullRequestsSpec.hs index 921ec186..cb7a212f 100644 --- a/spec/GitHub/PullRequestsSpec.hs +++ b/spec/GitHub/PullRequestsSpec.hs @@ -3,7 +3,6 @@ module GitHub.PullRequestsSpec where import qualified GitHub -import GitHub.Data.Id (Id (Id)) import Prelude () import Prelude.Compat @@ -55,7 +54,7 @@ spec = do describe "checking if a pull request is merged" $ do it "works" $ withAuth $ \auth -> do - b <- GitHub.executeRequest auth $ GitHub.isPullRequestMergedR "phadej" "github" (Id 14) + b <- GitHub.executeRequest auth $ GitHub.isPullRequestMergedR "phadej" "github" (GitHub.IssueNumber 14) b `shouldSatisfy` isRight fromRightS b `shouldBe` True diff --git a/spec/GitHub/SearchSpec.hs b/spec/GitHub/SearchSpec.hs index cb8d919a..64f1680a 100644 --- a/spec/GitHub/SearchSpec.hs +++ b/spec/GitHub/SearchSpec.hs @@ -14,7 +14,8 @@ import Test.Hspec (Spec, describe, it, pendingWith, shouldBe) import qualified Data.Vector as V -import GitHub.Data (Auth (..), Issue (..), IssueState (..), mkId) +import GitHub.Data + (Auth (..), Issue (..), IssueNumber (..), IssueState (..), mkId) import GitHub.Endpoints.Search (SearchResult (..), searchIssues') fromRightS :: Show a => Either a b -> b @@ -40,13 +41,13 @@ spec = do let issue1 = issues V.! 0 issueId issue1 `shouldBe` mkId (Proxy :: Proxy Issue) 123898390 - issueNumber issue1 `shouldBe` 130 + issueNumber issue1 `shouldBe` IssueNumber 130 issueTitle issue1 `shouldBe` "Make test runner more robust" issueState issue1 `shouldBe` StateClosed let issue2 = issues V.! 1 issueId issue2 `shouldBe` mkId (Proxy :: Proxy Issue) 119694665 - issueNumber issue2 `shouldBe` 127 + issueNumber issue2 `shouldBe` IssueNumber 127 issueTitle issue2 `shouldBe` "Decouple request creation from execution" issueState issue2 `shouldBe` StateOpen diff --git a/src/GitHub/Data.hs b/src/GitHub/Data.hs index aff42cdc..3f031a07 100644 --- a/src/GitHub/Data.hs +++ b/src/GitHub/Data.hs @@ -30,6 +30,8 @@ module GitHub.Data ( mkRepoId, fromUserId, fromOrganizationId, + -- * IssueNumber + IssueNumber (..), -- * Module re-exports module GitHub.Auth, module GitHub.Data.Activities, diff --git a/src/GitHub/Data/Definitions.hs b/src/GitHub/Data/Definitions.hs index ea7ed2ea..f440c48c 100644 --- a/src/GitHub/Data/Definitions.hs +++ b/src/GitHub/Data/Definitions.hs @@ -237,6 +237,28 @@ type QueryString = [(BS.ByteString, Maybe BS.ByteString)] -- | Count of elements type Count = Int +------------------------------------------------------------------------------- +-- IssueNumber +------------------------------------------------------------------------------- + +newtype IssueNumber = IssueNumber Int + deriving (Eq, Ord, Show, Generic, Typeable, Data) + +unIssueNumber :: IssueNumber -> Int +unIssueNumber (IssueNumber i) = i + +instance Hashable IssueNumber +instance Binary IssueNumber + +instance NFData IssueNumber where + rnf (IssueNumber s) = rnf s + +instance FromJSON IssueNumber where + parseJSON = fmap IssueNumber . parseJSON + +instance ToJSON IssueNumber where + toJSON = toJSON . unIssueNumber + ------------------------------------------------------------------------------- -- IssueLabel ------------------------------------------------------------------------------- diff --git a/src/GitHub/Data/Issues.hs b/src/GitHub/Data/Issues.hs index 82c0324d..1775aeec 100644 --- a/src/GitHub/Data/Issues.hs +++ b/src/GitHub/Data/Issues.hs @@ -22,7 +22,7 @@ data Issue = Issue , issueHtmlUrl :: !(Maybe URL) , issueClosedBy :: !(Maybe SimpleUser) , issueLabels :: !(Vector IssueLabel) - , issueNumber :: !Int + , issueNumber :: !IssueNumber , issueAssignees :: !(Vector SimpleUser) , issueUser :: !SimpleUser , issueTitle :: !Text diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs index 38df74d8..054e9e4d 100644 --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -27,7 +27,7 @@ module GitHub.Data.Request ( Count, ) where -import GitHub.Data.Definitions (Count, QueryString) +import GitHub.Data.Definitions (Count, QueryString, IssueNumber, unIssueNumber) import GitHub.Data.Id (Id, untagId) import GitHub.Data.Name (Name, untagName) import GitHub.Internal.Prelude @@ -53,6 +53,9 @@ instance IsPathPart (Name a) where instance IsPathPart (Id a) where toPathPart = T.pack . show . untagId +instance IsPathPart IssueNumber where + toPathPart = T.pack . show . unIssueNumber + -- | Http method of requests with body. data CommandMethod a where Post :: CommandMethod a diff --git a/src/GitHub/Endpoints/Issues/Comments.hs b/src/GitHub/Endpoints/Issues/Comments.hs index 2cbd7c5c..7b46fc0b 100644 --- a/src/GitHub/Endpoints/Issues/Comments.hs +++ b/src/GitHub/Endpoints/Issues/Comments.hs @@ -41,19 +41,19 @@ commentR user repo cid = -- | All comments on an issue, by the issue's number. -- -- > comments "thoughtbot" "paperclip" 635 -comments :: Name Owner -> Name Repo -> Id Issue -> IO (Either Error (Vector IssueComment)) +comments :: Name Owner -> Name Repo -> IssueNumber -> IO (Either Error (Vector IssueComment)) comments = comments' Nothing -- | All comments on an issue, by the issue's number, using authentication. -- -- > comments' (User (user, password)) "thoughtbot" "paperclip" 635 -comments' :: Maybe Auth -> Name Owner -> Name Repo -> Id Issue -> IO (Either Error (Vector IssueComment)) +comments' :: Maybe Auth -> Name Owner -> Name Repo -> IssueNumber -> IO (Either Error (Vector IssueComment)) comments' auth user repo iid = executeRequestMaybe auth $ commentsR user repo iid FetchAll -- | List comments on an issue. -- See -commentsR :: Name Owner -> Name Repo -> Id Issue -> FetchCount -> Request k (Vector IssueComment) +commentsR :: Name Owner -> Name Repo -> IssueNumber -> FetchCount -> Request k (Vector IssueComment) commentsR user repo iid = pagedQuery ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "comments"] [] @@ -61,14 +61,14 @@ commentsR user repo iid = -- -- > createComment (User (user, password)) user repo issue -- > "some words" -createComment :: Auth -> Name Owner -> Name Repo -> Id Issue -> Text +createComment :: Auth -> Name Owner -> Name Repo -> IssueNumber -> Text -> IO (Either Error Comment) createComment auth user repo iss body = executeRequest auth $ createCommentR user repo iss body -- | Create a comment. -- See -createCommentR :: Name Owner -> Name Repo -> Id Issue -> Text -> Request 'RW Comment +createCommentR :: Name Owner -> Name Repo -> IssueNumber -> Text -> Request 'RW Comment createCommentR user repo iss body = command Post parts (encode $ NewComment body) where diff --git a/src/GitHub/Endpoints/PullRequests.hs b/src/GitHub/Endpoints/PullRequests.hs index bfea41c9..3c2a5447 100644 --- a/src/GitHub/Endpoints/PullRequests.hs +++ b/src/GitHub/Endpoints/PullRequests.hs @@ -159,24 +159,24 @@ pullRequestFilesR user repo prid = pagedQuery ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "files"] [] -- | Check if pull request has been merged. -isPullRequestMerged :: Auth -> Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error Bool) +isPullRequestMerged :: Auth -> Name Owner -> Name Repo -> IssueNumber -> IO (Either Error Bool) isPullRequestMerged auth user repo prid = executeRequest auth $ isPullRequestMergedR user repo prid -- | Query if a pull request has been merged. -- See -isPullRequestMergedR :: Name Owner -> Name Repo -> Id PullRequest -> Request k Bool +isPullRequestMergedR :: Name Owner -> Name Repo -> IssueNumber -> Request k Bool isPullRequestMergedR user repo prid = StatusQuery statusOnlyOk $ Query ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "merge"] [] -- | Merge a pull request. -mergePullRequest :: Auth -> Name Owner -> Name Repo -> Id PullRequest -> Maybe Text -> IO (Either Error MergeResult) +mergePullRequest :: Auth -> Name Owner -> Name Repo -> IssueNumber -> Maybe Text -> IO (Either Error MergeResult) 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 Owner -> Name Repo -> Id PullRequest -> Maybe Text -> Request 'RW MergeResult +mergePullRequestR :: Name Owner -> Name Repo -> IssueNumber -> Maybe Text -> Request 'RW MergeResult mergePullRequestR user repo prid commitMessage = StatusQuery statusMerge $ Command Put paths (encode $ buildCommitMessageMap commitMessage) where diff --git a/src/GitHub/Endpoints/PullRequests/Comments.hs b/src/GitHub/Endpoints/PullRequests/Comments.hs index ccbf0d93..98d5d2c8 100644 --- a/src/GitHub/Endpoints/PullRequests/Comments.hs +++ b/src/GitHub/Endpoints/PullRequests/Comments.hs @@ -21,13 +21,13 @@ 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 :: Name Owner -> Name Repo -> IssueNumber -> 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 :: Name Owner -> Name Repo -> IssueNumber -> FetchCount -> Request k (Vector Comment) pullRequestCommentsR user repo prid = pagedQuery ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "comments"] [] From ee6efdc1b48635e0d3c39a23b4b5dd95cb4a6180 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sun, 10 Feb 2019 19:03:48 +0200 Subject: [PATCH 343/510] Document GADT constructors --- src/GitHub/Data/Request.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs index 054e9e4d..a6cd2784 100644 --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -61,6 +61,8 @@ data CommandMethod a where Post :: CommandMethod a Patch :: CommandMethod a Put :: CommandMethod a + + -- | Put requests, where we don't care about response's body Put' :: CommandMethod () Delete :: CommandMethod () deriving (Typeable) @@ -146,6 +148,8 @@ data Request (k :: RW) a where SimpleQuery :: FromJSON a => SimpleRequest k a -> Request k a StatusQuery :: StatusMap a -> SimpleRequest k () -> Request k a HeaderQuery :: FromJSON a => Types.RequestHeaders -> SimpleRequest k a -> Request k a + + -- | Redirect query is /some/ query where we expect status 302 response with @Location@ header. RedirectQuery :: SimpleRequest k () -> Request k URI deriving (Typeable) From c0e4ad33811be82e1f72ee76116345c681703103 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sun, 17 Feb 2019 20:22:32 +0200 Subject: [PATCH 344/510] Refactor Request --- github.cabal | 1 + samples/Operational/Operational.hs | 14 +- src/GitHub/Data/PullRequests.hs | 9 - src/GitHub/Data/Request.hs | 200 ++++------- src/GitHub/Endpoints/Activity/Starring.hs | 8 +- src/GitHub/Endpoints/Gists.hs | 4 +- src/GitHub/Endpoints/Organizations/Members.hs | 4 +- src/GitHub/Endpoints/Organizations/Teams.hs | 4 +- src/GitHub/Endpoints/PullRequests.hs | 8 +- src/GitHub/Endpoints/Repos/Collaborators.hs | 8 +- src/GitHub/Endpoints/Repos/Contents.hs | 7 +- src/GitHub/Endpoints/Repos/Webhooks.hs | 10 +- src/GitHub/Request.hs | 332 ++++++++++-------- 13 files changed, 291 insertions(+), 318 deletions(-) diff --git a/github.cabal b/github.cabal index 5d46680d..36b9dd3b 100644 --- a/github.cabal +++ b/github.cabal @@ -167,6 +167,7 @@ library , iso8601-time >=0.1.5 && <0.2 , network-uri >=2.6.1.0 && <2.7 , semigroups >=0.18.5 && <0.19 + , tagged , tls >=1.4.1 , transformers-compat >=0.6 && <0.7 , unordered-containers >=0.2.9.0 && <0.3 diff --git a/samples/Operational/Operational.hs b/samples/Operational/Operational.hs index 751cf69d..b84f9ab9 100644 --- a/samples/Operational/Operational.hs +++ b/samples/Operational/Operational.hs @@ -1,28 +1,32 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-} module Main (main) where import Common import Prelude () -import Control.Monad.Trans.Except (ExceptT (..), runExceptT) import Control.Monad.Operational +import Control.Monad.Trans.Except (ExceptT (..), runExceptT) import Network.HTTP.Client (Manager, newManager) import Network.HTTP.Client.TLS (tlsManagerSettings) import qualified GitHub as GH -type GithubMonad a = Program (GH.Request 'GH.RA) a +data R a where + R :: FromJSON a => GH.Request 'GH.RA a -> R a + +type GithubMonad a = Program R a runMonad :: Manager -> GH.Auth -> GithubMonad a -> ExceptT GH.Error IO a runMonad mgr auth m = case view m of Return a -> return a - req :>>= k -> do + R req :>>= k -> do b <- ExceptT $ GH.executeRequestWithMgr mgr auth req runMonad mgr auth (k b) -githubRequest :: GH.Request 'GH.RA a -> GithubMonad a -githubRequest = singleton +githubRequest :: FromJSON a => GH.Request 'GH.RA a -> GithubMonad a +githubRequest = singleton . R main :: IO () main = do diff --git a/src/GitHub/Data/PullRequests.hs b/src/GitHub/Data/PullRequests.hs index e40199f5..0c3df02d 100644 --- a/src/GitHub/Data/PullRequests.hs +++ b/src/GitHub/Data/PullRequests.hs @@ -14,14 +14,12 @@ module GitHub.Data.PullRequests ( PullRequestEventType(..), PullRequestReference(..), MergeResult(..), - statusMerge, ) where import GitHub.Data.Definitions import GitHub.Data.Id (Id) import GitHub.Data.Options (IssueState (..), MergeableState (..)) import GitHub.Data.Repos (Repo) -import GitHub.Data.Request (StatusMap) import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () @@ -319,10 +317,3 @@ data MergeResult | MergeCannotPerform | MergeConflict deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable) - -statusMerge :: StatusMap MergeResult -statusMerge = - [ (200, MergeSuccessful) - , (405, MergeCannotPerform) - , (409, MergeConflict) - ] diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs index a6cd2784..8fe08907 100644 --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -10,17 +10,16 @@ -- module GitHub.Data.Request ( -- * Request - Request (..), - SimpleRequest (..), + Request, + GenRequest (..), -- * Smart constructors query, pagedQuery, command, -- * Auxiliary types RW(..), - StatusMap, - statusOnlyOk, CommandMethod(..), toMethod, FetchCount(..), + MediaType (..), Paths, IsPathPart(..), QueryString, @@ -34,12 +33,10 @@ import GitHub.Internal.Prelude import qualified Data.ByteString.Lazy as LBS import qualified Data.Text as T -import qualified Network.HTTP.Types as Types import qualified Network.HTTP.Types.Method as Method -import Network.URI (URI) ------------------------------------------------------------------------------ --- Auxillary types +-- Path parts ------------------------------------------------------------------------------ type Paths = [Text] @@ -56,41 +53,30 @@ instance IsPathPart (Id a) where instance IsPathPart IssueNumber where toPathPart = T.pack . show . unIssueNumber +------------------------------------------------------------------------------- +-- Command Method +------------------------------------------------------------------------------- + -- | Http method of requests with body. -data CommandMethod a where - Post :: CommandMethod a - Patch :: CommandMethod a - Put :: CommandMethod a - - -- | Put requests, where we don't care about response's body - Put' :: CommandMethod () - Delete :: CommandMethod () - deriving (Typeable) - -deriving instance Eq (CommandMethod a) -deriving instance Ord (CommandMethod a) - -instance Show (CommandMethod a) where - showsPrec _ Post = showString "Post" - showsPrec _ Patch = showString "Patch" - showsPrec _ Put = showString "Put" - showsPrec _ Put' = showString "Put'" - showsPrec _ Delete = showString "Delete" - -instance Hashable (CommandMethod a) where - hashWithSalt salt Post = hashWithSalt salt (0 :: Int) - hashWithSalt salt Patch = hashWithSalt salt (1 :: Int) - hashWithSalt salt Put = hashWithSalt salt (2 :: Int) - hashWithSalt salt Put' = hashWithSalt salt (3 :: Int) - hashWithSalt salt Delete = hashWithSalt salt (4 :: Int) - -toMethod :: CommandMethod a -> Method.Method +data CommandMethod + = Post + | Patch + | Put + | Delete + deriving (Eq, Ord, Read, Show, Enum, Bounded, Typeable, Data, Generic) + +instance Hashable CommandMethod + +toMethod :: CommandMethod -> Method.Method toMethod Post = Method.methodPost toMethod Patch = Method.methodPatch toMethod Put = Method.methodPut -toMethod Put' = Method.methodPut toMethod Delete = Method.methodDelete +------------------------------------------------------------------------------- +-- Fetch count +------------------------------------------------------------------------------- + -- | 'PagedQuery' returns just some results, using this data we can specify how -- many pages we want to fetch. data FetchCount = FetchAtLeast !Word | FetchAll @@ -115,15 +101,31 @@ instance Hashable FetchCount instance Binary FetchCount instance NFData FetchCount where rnf = genericRnf +------------------------------------------------------------------------------- +-- MediaType +------------------------------------------------------------------------------- + +data MediaType + = MtJSON -- ^ @application/vnd.github.v3+json@ + | MtRaw -- ^ @application/vnd.github.v3.raw@ + | MtDiff -- ^ @application/vnd.github.v3.diff@ + | MtPatch -- ^ @application/vnd.github.v3.patch@ + | MtSha -- ^ @application/vnd.github.v3.sha@ + | MtStar -- ^ @application/vnd.github.v3.star+json@ + | MtRedirect -- ^ + | MtStatus -- ^ Parse status + | MtUnit -- ^ Always succeeds + deriving (Eq, Ord, Read, Show, Enum, Bounded, Typeable, Data, Generic) + ------------------------------------------------------------------------------ --- Github request +-- RW ------------------------------------------------------------------------------ -- | Type used as with @DataKinds@ to tag whether requests need authentication -- or aren't read-only. data RW = RO -- ^ /Read-only/, doesn't necessarily requires authentication - | RA -- ^ /Read autenticated/ + | RA -- ^ /Read authenticated/ | RW -- ^ /Read-write/, requires authentication deriving (Eq, Ord, Read, Show, Enum, Bounded, Typeable, Data, Generic) @@ -138,102 +140,54 @@ instance IReadOnly 'RO where iro = ROO instance IReadOnly 'RA where iro = ROA -} +------------------------------------------------------------------------------- +-- GitHub Request +------------------------------------------------------------------------------- + -- | Github request data type. -- --- * @k@ describes whether authentication is required. It's required for non-@GET@ requests. +-- * @rw@ describes whether authentication is required. It's required for non-@GET@ requests. +-- * @mt@ describes the media type, i.e. how the response should be interpreted. -- * @a@ is the result type -- -- /Note:/ 'Request' is not 'Functor' on purpose. -data Request (k :: RW) a where - SimpleQuery :: FromJSON a => SimpleRequest k a -> Request k a - StatusQuery :: StatusMap a -> SimpleRequest k () -> Request k a - HeaderQuery :: FromJSON a => Types.RequestHeaders -> SimpleRequest k a -> Request k a - - -- | Redirect query is /some/ query where we expect status 302 response with @Location@ header. - RedirectQuery :: SimpleRequest k () -> Request k URI +data GenRequest (mt :: MediaType) (rw :: RW) a where + Query :: Paths -> QueryString -> GenRequest mt rw a + PagedQuery :: Paths -> QueryString -> FetchCount -> GenRequest mt rw (Vector a) + + -- | Command + Command + :: CommandMethod -- ^ command + -> Paths -- ^ path + -> LBS.ByteString -- ^ body + -> GenRequest mt 'RW a deriving (Typeable) -data SimpleRequest (k :: RW) a where - Query :: Paths -> QueryString -> SimpleRequest k a - PagedQuery :: Paths -> QueryString -> FetchCount -> SimpleRequest k (Vector a) - Command :: CommandMethod a -> Paths -> LBS.ByteString -> SimpleRequest 'RW a - deriving (Typeable) - -------------------------------------------------------------------------------- --- Status Map -------------------------------------------------------------------------------- - --- TODO: Change to 'Map' ? -type StatusMap a = [(Int, a)] - -statusOnlyOk :: StatusMap Bool -statusOnlyOk = - [ (204, True) - , (404, False) - ] +-- | Most requests ask for @JSON@. +type Request = GenRequest 'MtJSON ------------------------------------------------------------------------------- -- Smart constructors ------------------------------------------------------------------------------- -query :: FromJSON a => Paths -> QueryString -> Request k a -query ps qs = SimpleQuery (Query ps qs) +query :: Paths -> QueryString -> Request mt a +query ps qs = Query ps qs -pagedQuery :: FromJSON a => Paths -> QueryString -> FetchCount -> Request k (Vector a) -pagedQuery ps qs fc = SimpleQuery (PagedQuery ps qs fc) +pagedQuery :: FromJSON a => Paths -> QueryString -> FetchCount -> Request mt (Vector a) +pagedQuery ps qs fc = PagedQuery ps qs fc -command :: FromJSON a => CommandMethod a -> Paths -> LBS.ByteString -> Request 'RW a -command m ps body = SimpleQuery (Command m ps body) +command :: CommandMethod -> Paths -> LBS.ByteString -> Request 'RW a +command m ps body = Command m ps body ------------------------------------------------------------------------------- -- Instances ------------------------------------------------------------------------------- -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 - Query ps qs -> showString "Query " - . showsPrec (appPrec + 1) ps - . showString " " - . showsPrec (appPrec + 1) qs - PagedQuery ps qs l -> showString "PagedQuery " - . showsPrec (appPrec + 1) ps - . showString " " - . showsPrec (appPrec + 1) qs - . showString " " - . showsPrec (appPrec + 1) l - Command m ps body -> showString "Command " - . showsPrec (appPrec + 1) m - . showString " " - . showsPrec (appPrec + 1) ps - . showString " " - . showsPrec (appPrec + 1) body - where - appPrec = 10 :: Int - -instance Show (Request k a) where - showsPrec d r = showParen (d > appPrec) $ case r of - SimpleQuery req -> showString "SimpleQuery " - . showsPrec (appPrec + 1) req - StatusQuery m req -> showString "Status " - . showsPrec (appPrec + 1) (map fst m) -- !!! printing only keys - . showString " " - . showsPrec (appPrec + 1) req - HeaderQuery m req -> showString "Header " - . showsPrec (appPrec + 1) m - . showString " " - . showsPrec (appPrec + 1) req - RedirectQuery req -> showString "Redirect " - . showsPrec (appPrec + 1) req - where - appPrec = 10 :: Int - -instance Hashable (SimpleRequest k a) where +deriving instance Eq (GenRequest rw mt a) +deriving instance Ord (GenRequest rw mt a) +deriving instance Show (GenRequest rw mt a) + +instance Hashable (GenRequest rw mt a) where hashWithSalt salt (Query ps qs) = salt `hashWithSalt` (0 :: Int) `hashWithSalt` ps @@ -249,18 +203,4 @@ instance Hashable (SimpleRequest k a) where `hashWithSalt` ps `hashWithSalt` body -instance Hashable (Request k a) where - hashWithSalt salt (SimpleQuery req) = - salt `hashWithSalt` (0 :: Int) - `hashWithSalt` req - hashWithSalt salt (StatusQuery sm req) = - salt `hashWithSalt` (1 :: Int) - `hashWithSalt` map fst sm - `hashWithSalt` req - hashWithSalt salt (HeaderQuery h req) = - salt `hashWithSalt` (2 :: Int) - `hashWithSalt` h - `hashWithSalt` req - hashWithSalt salt (RedirectQuery req) = - salt `hashWithSalt` (3 :: Int) - `hashWithSalt` req +-- TODO: Binary diff --git a/src/GitHub/Endpoints/Activity/Starring.hs b/src/GitHub/Endpoints/Activity/Starring.hs index d934185b..71558324 100644 --- a/src/GitHub/Endpoints/Activity/Starring.hs +++ b/src/GitHub/Endpoints/Activity/Starring.hs @@ -71,8 +71,8 @@ myStarredAcceptStar auth = -- | All the repos starred by the authenticated user. -- See -myStarredAcceptStarR :: FetchCount -> Request 'RA (Vector RepoStarred) -myStarredAcceptStarR = HeaderQuery [("Accept", "application/vnd.github.v3.star+json")] . PagedQuery ["user", "starred"] [] +myStarredAcceptStarR :: FetchCount -> GenRequest 'MtStar 'RA (Vector RepoStarred) +myStarredAcceptStarR = PagedQuery ["user", "starred"] [] -- | Star a repo by the authenticated user. starRepo :: Auth -> Name Owner -> Name Repo -> IO (Either Error ()) @@ -80,8 +80,8 @@ 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 +starRepoR :: Name Owner -> Name Repo -> GenRequest 'MtUnit 'RW () +starRepoR user repo = Command Put paths mempty where paths = ["user", "starred", toPathPart user, toPathPart repo] diff --git a/src/GitHub/Endpoints/Gists.hs b/src/GitHub/Endpoints/Gists.hs index cc23b2a9..13c830a3 100644 --- a/src/GitHub/Endpoints/Gists.hs +++ b/src/GitHub/Endpoints/Gists.hs @@ -70,8 +70,8 @@ starGist auth gid = executeRequest auth $ starGistR gid -- | Star a gist by the authenticated user. -- See -starGistR :: Name Gist -> Request 'RW () -starGistR gid = command Put' ["gists", toPathPart gid, "star"] mempty +starGistR :: Name Gist -> GenRequest 'MtUnit 'RW () +starGistR gid = Command Put ["gists", toPathPart gid, "star"] mempty -- | Unstar a gist by the authenticated user. -- diff --git a/src/GitHub/Endpoints/Organizations/Members.hs b/src/GitHub/Endpoints/Organizations/Members.hs index d5b434c9..db952269 100644 --- a/src/GitHub/Endpoints/Organizations/Members.hs +++ b/src/GitHub/Endpoints/Organizations/Members.hs @@ -77,8 +77,8 @@ isMemberOf = isMemberOf' Nothing -- | Check if a user is a member of an organization. -- -- See -isMemberOfR :: Name User -> Name Organization -> Request k Bool -isMemberOfR user org = StatusQuery statusOnlyOk $ +isMemberOfR :: Name User -> Name Organization -> GenRequest 'MtStatus rw Bool +isMemberOfR user org = Query [ "orgs", toPathPart org, "members", toPathPart user ] [] -- | List pending organization invitations diff --git a/src/GitHub/Endpoints/Organizations/Teams.hs b/src/GitHub/Endpoints/Organizations/Teams.hs index 04af873e..586d1f99 100644 --- a/src/GitHub/Endpoints/Organizations/Teams.hs +++ b/src/GitHub/Endpoints/Organizations/Teams.hs @@ -168,9 +168,9 @@ addOrUpdateTeamRepo' auth tid org repo permission = -- | Add or update a team repository. -- See -addOrUpdateTeamRepoR :: Id Team -> Name Organization -> Name Repo -> Permission -> Request 'RW () +addOrUpdateTeamRepoR :: Id Team -> Name Organization -> Name Repo -> Permission -> GenRequest 'MtUnit 'RW () addOrUpdateTeamRepoR tid org repo permission = - command Put' ["teams", toPathPart tid, "repos", toPathPart org, toPathPart repo] (encode $ AddTeamRepoPermission permission) + Command Put ["teams", toPathPart tid, "repos", toPathPart org, toPathPart repo] (encode $ AddTeamRepoPermission permission) -- | Retrieve team mebership information for a user. -- With authentication diff --git a/src/GitHub/Endpoints/PullRequests.hs b/src/GitHub/Endpoints/PullRequests.hs index 3c2a5447..036ad4d8 100644 --- a/src/GitHub/Endpoints/PullRequests.hs +++ b/src/GitHub/Endpoints/PullRequests.hs @@ -165,8 +165,8 @@ isPullRequestMerged auth user repo prid = -- | Query if a pull request has been merged. -- See -isPullRequestMergedR :: Name Owner -> Name Repo -> IssueNumber -> Request k Bool -isPullRequestMergedR user repo prid = StatusQuery statusOnlyOk $ +isPullRequestMergedR :: Name Owner -> Name Repo -> IssueNumber -> GenRequest 'MtStatus rw Bool +isPullRequestMergedR user repo prid = Query ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "merge"] [] -- | Merge a pull request. @@ -176,8 +176,8 @@ mergePullRequest auth user repo prid commitMessage = -- | Merge a pull request (Merge Button). -- https://developer.github.com/v3/pulls/#merge-a-pull-request-merge-button -mergePullRequestR :: Name Owner -> Name Repo -> IssueNumber -> Maybe Text -> Request 'RW MergeResult -mergePullRequestR user repo prid commitMessage = StatusQuery statusMerge $ +mergePullRequestR :: Name Owner -> Name Repo -> IssueNumber -> Maybe Text -> GenRequest 'MtStatus 'RW MergeResult +mergePullRequestR user repo prid commitMessage = Command Put paths (encode $ buildCommitMessageMap commitMessage) where paths = ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "merge"] diff --git a/src/GitHub/Endpoints/Repos/Collaborators.hs b/src/GitHub/Endpoints/Repos/Collaborators.hs index a672187b..bc441a28 100644 --- a/src/GitHub/Endpoints/Repos/Collaborators.hs +++ b/src/GitHub/Endpoints/Repos/Collaborators.hs @@ -59,8 +59,8 @@ isCollaboratorOnR :: Name Owner -- ^ Repository owner -> Name Repo -- ^ Repository name -> Name User -- ^ Collaborator? - -> Request k Bool -isCollaboratorOnR user repo coll = StatusQuery statusOnlyOk $ + -> GenRequest 'MtStatus rw Bool +isCollaboratorOnR user repo coll = Query ["repos", toPathPart user, toPathPart repo, "collaborators", toPathPart coll] [] addCollaborator @@ -78,6 +78,6 @@ addCollaboratorR :: Name Owner -- ^ Repository owner -> Name Repo -- ^ Repository name -> Name User -- ^ Collaborator to add - -> Request 'RW () + -> GenRequest 'MtUnit 'RW () addCollaboratorR owner repo coll = - command Put' ["repos", toPathPart owner, toPathPart repo, "collaborators", toPathPart coll] mempty + Command Put ["repos", toPathPart owner, toPathPart repo, "collaborators", toPathPart coll] mempty diff --git a/src/GitHub/Endpoints/Repos/Contents.hs b/src/GitHub/Endpoints/Repos/Contents.hs index d424b0c3..39c9a408 100644 --- a/src/GitHub/Endpoints/Repos/Contents.hs +++ b/src/GitHub/Endpoints/Repos/Contents.hs @@ -98,14 +98,15 @@ archiveFor' :: Maybe Auth -> Name Owner -> Name Repo -> ArchiveFormat -> Maybe archiveFor' auth user repo path ref = executeRequestMaybe auth $ archiveForR user repo path ref +-- | Get archive link. +-- See archiveForR :: Name Owner -> Name Repo -> ArchiveFormat -- ^ The type of archive to retrieve -> Maybe Text -- ^ Git commit - -> Request k URI -archiveForR user repo format ref = - RedirectQuery $ Query path [] + -> GenRequest 'MtRedirect rw URI +archiveForR user repo format ref = Query path [] where path = ["repos", toPathPart user, toPathPart repo, toPathPart format] <> maybeToList ref diff --git a/src/GitHub/Endpoints/Repos/Webhooks.hs b/src/GitHub/Endpoints/Repos/Webhooks.hs index ebb7377d..34619c17 100644 --- a/src/GitHub/Endpoints/Repos/Webhooks.hs +++ b/src/GitHub/Endpoints/Repos/Webhooks.hs @@ -1,4 +1,4 @@ ------------------------------------------------------------------------------ + ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus @@ -83,8 +83,8 @@ testPushRepoWebhook' auth user repo hookId = -- | Test a push hook. -- See -testPushRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> Request 'RW Bool -testPushRepoWebhookR user repo hookId = StatusQuery statusOnlyOk $ +testPushRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> GenRequest 'MtStatus 'RW Bool +testPushRepoWebhookR user repo hookId = Command Post (createWebhookOpPath user repo hookId $ Just "tests") (encode ()) pingRepoWebhook' :: Auth -> Name Owner -> Name Repo -> Id RepoWebhook -> IO (Either Error Bool) @@ -93,8 +93,8 @@ pingRepoWebhook' auth user repo hookId = -- | Ping a hook. -- See -pingRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> Request 'RW Bool -pingRepoWebhookR user repo hookId = StatusQuery statusOnlyOk $ +pingRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> GenRequest 'MtStatus 'RW Bool +pingRepoWebhookR user repo hookId = Command Post (createWebhookOpPath user repo hookId $ Just "pings") (encode ()) deleteRepoWebhook' :: Auth -> Name Owner -> Name Repo -> Id RepoWebhook -> IO (Either Error ()) diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index e723287f..424b3e11 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -1,6 +1,9 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE GADTs #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -27,7 +30,8 @@ -- > githubRequest = singleton module GitHub.Request ( -- * Types - Request(..), + Request, + GenRequest (..), CommandMethod(..), toMethod, Paths, @@ -40,10 +44,11 @@ module GitHub.Request ( executeRequestMaybe, unsafeDropAuthRequirements, -- * Helpers + Accept (..), + ParseResponse (..), makeHttpRequest, - makeHttpSimpleRequest, - parseResponse, parseStatus, + StatusMap, getNextUrl, performPagedRequest, ) where @@ -59,6 +64,7 @@ import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Except (ExceptT (..), runExceptT) import Data.Aeson (eitherDecode) import Data.List (find) +import Data.Tagged (Tagged (..)) import Network.HTTP.Client (HttpException (..), Manager, RequestBody (..), Response (..), @@ -70,6 +76,7 @@ import Network.HTTP.Link.Types (Link (..), LinkParam (..), href, linkParams) import Network.HTTP.Types (Method, RequestHeaders, Status (..)) import Network.URI (URI, parseURIReference, relativeTo) +import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS import qualified Data.Text as T import qualified Data.Text.Encoding as TE @@ -77,12 +84,13 @@ import qualified Data.Vector as V import qualified Network.HTTP.Client as HTTP import qualified Network.HTTP.Client.Internal as HTTP -import GitHub.Auth (Auth (..)) -import GitHub.Data (Error (..)) +import GitHub.Auth (Auth (..)) +import GitHub.Data (Error (..)) +import GitHub.Data.PullRequests (MergeResult (..)) import GitHub.Data.Request -- | Execute 'Request' in 'IO' -executeRequest :: Auth -> Request k a -> IO (Either Error a) +executeRequest :: ParseResponse mt a => Auth -> GenRequest mt rw a -> IO (Either Error a) executeRequest auth req = do manager <- newManager tlsManagerSettings executeRequestWithMgr manager auth req @@ -93,9 +101,10 @@ lessFetchCount i (FetchAtLeast j) = i < fromIntegral j -- | Like 'executeRequest' but with provided 'Manager'. executeRequestWithMgr - :: Manager + :: ParseResponse mt a + => Manager -> Auth - -> Request k a + -> GenRequest mt rw a -> IO (Either Error a) executeRequestWithMgr mgr auth req = runExceptT $ do httpReq <- makeHttpRequest (Just auth) req @@ -104,44 +113,31 @@ executeRequestWithMgr mgr auth req = runExceptT $ do httpLbs' :: HTTP.Request -> ExceptT Error IO (Response LBS.ByteString) httpLbs' req' = lift (httpLbs req' mgr) `catch` onHttpException - performHttpReq :: HTTP.Request -> Request k b -> ExceptT Error IO b - performHttpReq httpReq (SimpleQuery sreq) = - performHttpReq' httpReq sreq - performHttpReq httpReq (HeaderQuery _ sreq) = - performHttpReq' httpReq sreq - performHttpReq httpReq (StatusQuery sm _) = do + performHttpReq :: forall rw mt b. ParseResponse mt b => HTTP.Request -> GenRequest mt rw b -> ExceptT Error IO b + performHttpReq httpReq Query {} = do res <- httpLbs' httpReq - parseStatus sm . responseStatus $ res - performHttpReq httpReq (RedirectQuery _) = do - res <- httpLbs' httpReq - parseRedirect (getUri httpReq) res + unTagged (parseResponse httpReq res :: Tagged mt (ExceptT Error IO b)) - performHttpReq' :: FromJSON b => HTTP.Request -> SimpleRequest k b -> ExceptT Error IO b - performHttpReq' httpReq Query {} = do - res <- httpLbs' httpReq - parseResponse res - performHttpReq' httpReq (PagedQuery _ _ l) = - performPagedRequest httpLbs' predicate httpReq + performHttpReq httpReq (PagedQuery _ _ l) = + unTagged (performPagedRequest httpLbs' predicate httpReq :: Tagged mt (ExceptT Error IO b)) where predicate v = lessFetchCount (V.length v) l - performHttpReq' httpReq (Command m _ _) = do - res <- httpLbs' httpReq - case m of - Delete -> pure () - Put' -> pure () - _ -> parseResponse res + performHttpReq httpReq (Command _ _ _) = do + res <- httpLbs' httpReq + unTagged (parseResponse httpReq res :: Tagged mt (ExceptT Error IO b)) -- | Like 'executeRequest' but without authentication. -executeRequest' ::Request 'RO a -> IO (Either Error a) +executeRequest' :: ParseResponse mt a => GenRequest mt 'RO a -> IO (Either Error a) executeRequest' req = do manager <- newManager tlsManagerSettings executeRequestWithMgr' manager req -- | Like 'executeRequestWithMgr' but without authentication. executeRequestWithMgr' - :: Manager - -> Request 'RO a + :: ParseResponse mt a + => Manager + -> GenRequest mt 'RO a -> IO (Either Error a) executeRequestWithMgr' mgr req = runExceptT $ do httpReq <- makeHttpRequest Nothing req @@ -150,40 +146,157 @@ executeRequestWithMgr' mgr req = runExceptT $ do httpLbs' :: HTTP.Request -> ExceptT Error IO (Response LBS.ByteString) httpLbs' req' = lift (httpLbs req' mgr) `catch` onHttpException - performHttpReq :: HTTP.Request -> Request 'RO b -> ExceptT Error IO b - performHttpReq httpReq (SimpleQuery sreq) = - performHttpReq' httpReq sreq - performHttpReq httpReq (HeaderQuery _ sreq) = - performHttpReq' httpReq sreq - performHttpReq httpReq (StatusQuery sm _) = do + performHttpReq :: forall mt b. ParseResponse mt b => HTTP.Request -> GenRequest mt 'RO b -> ExceptT Error IO b + performHttpReq httpReq Query {} = do res <- httpLbs' httpReq - parseStatus sm . responseStatus $ res - performHttpReq httpReq (RedirectQuery _) = do - res <- httpLbs' httpReq - parseRedirect (getUri httpReq) res - - performHttpReq' :: FromJSON b => HTTP.Request -> SimpleRequest 'RO b -> ExceptT Error IO b - performHttpReq' httpReq Query {} = do - res <- httpLbs' httpReq - parseResponse res - performHttpReq' httpReq (PagedQuery _ _ l) = - performPagedRequest httpLbs' predicate httpReq + unTagged (parseResponse httpReq res :: Tagged mt (ExceptT Error IO b)) + performHttpReq httpReq (PagedQuery _ _ l) = + unTagged (performPagedRequest httpLbs' predicate httpReq :: Tagged mt (ExceptT Error IO b)) where predicate v = lessFetchCount (V.length v) l -- | Helper for picking between 'executeRequest' and 'executeRequest''. -- -- The use is discouraged. -executeRequestMaybe :: Maybe Auth -> Request 'RO a -> IO (Either Error a) +executeRequestMaybe :: ParseResponse mt a => Maybe Auth -> GenRequest mt 'RO a -> IO (Either Error a) executeRequestMaybe = maybe executeRequest' executeRequest -- | Partial function to drop authentication need. -unsafeDropAuthRequirements :: Request k' a -> Request k a -unsafeDropAuthRequirements (SimpleQuery (Query ps qs)) = - SimpleQuery (Query ps qs) -unsafeDropAuthRequirements r = +unsafeDropAuthRequirements :: GenRequest mt rw' a -> GenRequest mt rw a +unsafeDropAuthRequirements (Query ps qs) = Query ps qs +unsafeDropAuthRequirements r = error $ "Trying to drop authenatication from" ++ show r +------------------------------------------------------------------------------- +-- Parse response +------------------------------------------------------------------------------- + +class Accept (mt :: MediaType) where + contentType :: Tagged mt BS.ByteString + contentType = Tagged "application/json" -- default is JSON + + modifyRequest :: Tagged mt (HTTP.Request -> HTTP.Request) + modifyRequest = Tagged id + +class Accept mt => ParseResponse (mt :: MediaType) a where + parseResponse :: MonadError Error m => HTTP.Request -> HTTP.Response LBS.ByteString -> Tagged mt (m a) + +------------------------------------------------------------------------------- +-- JSON (+ star) +------------------------------------------------------------------------------- + +-- | Parse API response. +-- +-- @ +-- parseResponse :: 'FromJSON' a => 'Response' 'LBS.ByteString' -> 'Either' 'Error' a +-- @ +parseResponseJSON :: (FromJSON a, MonadError Error m) => Response LBS.ByteString -> m a +parseResponseJSON res = case eitherDecode (responseBody res) of + Right x -> return x + Left err -> throwError . ParseError . T.pack $ err + +instance Accept 'MtJSON where + contentType = Tagged "application/vnd.github.v3+json" + +instance FromJSON a => ParseResponse 'MtJSON a where + parseResponse _ res = Tagged (parseResponseJSON res) + +instance Accept 'MtStar where + contentType = Tagged "application/vnd.github.v3.star+json" + +instance FromJSON a => ParseResponse 'MtStar a where + parseResponse _ res = Tagged (parseResponseJSON res) + +------------------------------------------------------------------------------- +-- Raw / Diff / Patch / Sha +------------------------------------------------------------------------------- + +instance Accept 'MtRaw where contentType = Tagged "application/vnd.github.v3.raw" +instance Accept 'MtDiff where contentType = Tagged "application/vnd.github.v3.diff" +instance Accept 'MtPatch where contentType = Tagged "application/vnd.github.v3.patch" +instance Accept 'MtSha where contentType = Tagged "application/vnd.github.v3.sha" + +instance a ~ LBS.ByteString => ParseResponse 'MtRaw a where parseResponse _ = Tagged . return . responseBody +instance a ~ LBS.ByteString => ParseResponse 'MtDiff a where parseResponse _ = Tagged . return . responseBody +instance a ~ LBS.ByteString => ParseResponse 'MtPatch a where parseResponse _ = Tagged . return . responseBody +instance a ~ LBS.ByteString => ParseResponse 'MtSha a where parseResponse _ = Tagged . return . responseBody + +------------------------------------------------------------------------------- +-- Redirect +------------------------------------------------------------------------------- + +instance Accept 'MtRedirect where + modifyRequest = Tagged $ \req -> + setRequestIgnoreStatus $ req { redirectCount = 0 } + +instance b ~ URI => ParseResponse 'MtRedirect b where + parseResponse req = Tagged . parseRedirect (getUri req) + +-- | Helper for handling of 'RequestRedirect'. +-- +-- @ +-- parseRedirect :: 'Response' 'LBS.ByteString' -> 'Either' 'Error' a +-- @ +parseRedirect :: MonadError Error m => URI -> Response LBS.ByteString -> m URI +parseRedirect originalUri rsp = do + let status = responseStatus rsp + when (statusCode status /= 302) $ + throwError $ ParseError $ "invalid status: " <> T.pack (show status) + loc <- maybe noLocation return $ lookup "Location" $ responseHeaders rsp + case parseURIReference $ T.unpack $ TE.decodeUtf8 loc of + Nothing -> throwError $ ParseError $ + "location header does not contain a URI: " <> T.pack (show loc) + Just uri -> return $ uri `relativeTo` originalUri + where + noLocation = throwError $ ParseError "no location header in response" + +------------------------------------------------------------------------------- +-- Status +------------------------------------------------------------------------------- + +instance Accept 'MtStatus where + modifyRequest = Tagged setRequestIgnoreStatus + +instance HasStatusMap a => ParseResponse 'MtStatus a where + parseResponse _ = Tagged . parseStatus statusMap . responseStatus + +type StatusMap a = [(Int, a)] + +class HasStatusMap a where + statusMap :: StatusMap a + +instance HasStatusMap Bool where + statusMap = + [ (204, True) + , (404, False) + ] + +instance HasStatusMap MergeResult where + statusMap = + [ (200, MergeSuccessful) + , (405, MergeCannotPerform) + , (409, MergeConflict) + ] + +-- | Helper for handling of 'RequestStatus'. +-- +-- @ +-- parseStatus :: 'StatusMap' a -> 'Status' -> 'Either' 'Error' a +-- @ +parseStatus :: MonadError Error m => StatusMap a -> Status -> m a +parseStatus m (Status sci _) = + maybe err return $ lookup sci m + where + err = throwError $ JsonError $ "invalid status: " <> T.pack (show sci) + +------------------------------------------------------------------------------- +-- Unit +------------------------------------------------------------------------------- + +instance Accept 'MtUnit +instance a ~ () => ParseResponse 'MtUnit a where + parseResponse _ _ = Tagged (return ()) + ------------------------------------------------------------------------------ -- Tools ------------------------------------------------------------------------------ @@ -194,38 +307,17 @@ unsafeDropAuthRequirements r = -- * for 'Status', the 'Request' for underlying 'Request' is created, -- status checking is modifying accordingly. -- --- @ --- parseResponse :: 'Maybe' 'Auth' -> 'Request' k a -> 'Maybe' 'Request' --- @ makeHttpRequest - :: MonadThrow m + :: forall mt rw a m. (MonadThrow m, Accept mt) => Maybe Auth - -> Request k a + -> GenRequest mt rw a -> m HTTP.Request makeHttpRequest auth r = case r of - SimpleQuery req -> - makeHttpSimpleRequest auth req - StatusQuery sm req -> do - req' <- makeHttpSimpleRequest auth req - return $ setCheckStatus (Just sm) req' - HeaderQuery h req -> do - req' <- makeHttpSimpleRequest auth req - return $ req' { requestHeaders = h <> requestHeaders req' } - RedirectQuery req -> do - req' <- makeHttpSimpleRequest auth req - return $ setRequestIgnoreStatus $ req' { redirectCount = 0 } - -makeHttpSimpleRequest - :: MonadThrow m - => Maybe Auth - -> SimpleRequest k a - -> m HTTP.Request -makeHttpSimpleRequest auth r = case r of Query paths qs -> do req <- parseUrl' $ url paths return $ setReqHeaders - . setCheckStatus Nothing + . unTagged (modifyRequest :: Tagged mt (HTTP.Request -> HTTP.Request)) . setAuthRequest auth . setQueryString qs $ req @@ -233,7 +325,7 @@ makeHttpSimpleRequest auth r = case r of req <- parseUrl' $ url paths return $ setReqHeaders - . setCheckStatus Nothing + . unTagged (modifyRequest :: Tagged mt (HTTP.Request -> HTTP.Request)) . setAuthRequest auth . setQueryString qs $ req @@ -241,7 +333,7 @@ makeHttpSimpleRequest auth r = case r of req <- parseUrl' $ url paths return $ setReqHeaders - . setCheckStatus Nothing + . unTagged (modifyRequest :: Tagged mt (HTTP.Request -> HTTP.Request)) . setAuthRequest auth . setBody body . setMethod (toMethod m) @@ -266,15 +358,15 @@ makeHttpSimpleRequest auth r = case r of reqHeaders :: RequestHeaders reqHeaders = maybe [] getOAuthHeader auth - <> [("User-Agent", "github.hs/0.7.4")] - <> [("Accept", "application/vnd.github.preview")] + <> [("User-Agent", "github.hs/0.21")] -- Version + <> [("Accept", unTagged (contentType :: Tagged mt BS.ByteString))] setBody :: LBS.ByteString -> HTTP.Request -> HTTP.Request setBody body req = req { requestBody = RequestBodyLBS body } setAuthRequest :: Maybe Auth -> HTTP.Request -> HTTP.Request setAuthRequest (Just (BasicAuth user pass)) = applyBasicAuth user pass - setAuthRequest _ = id + setAuthRequest _ = id getOAuthHeader :: Auth -> RequestHeaders getOAuthHeader (OAuth token) = [("Authorization", "token " <> token)] @@ -295,45 +387,6 @@ getNextUrl req = do relNextLinkParam :: (LinkParam, Text) relNextLinkParam = (Rel, "next") --- | Parse API response. --- --- @ --- parseResponse :: 'FromJSON' a => 'Response' 'LBS.ByteString' -> 'Either' 'Error' a --- @ -parseResponse :: (FromJSON a, MonadError Error m) => Response LBS.ByteString -> m a -parseResponse res = case eitherDecode (responseBody res) of - Right x -> return x - Left err -> throwError . ParseError . T.pack $ err - --- | Helper for handling of 'RequestStatus'. --- --- @ --- parseStatus :: 'StatusMap' a -> 'Status' -> 'Either' 'Error' a --- @ -parseStatus :: MonadError Error m => StatusMap a -> Status -> m a -parseStatus m (Status sci _) = - maybe err return $ lookup sci m - where - err = throwError $ JsonError $ "invalid status: " <> T.pack (show sci) - --- | Helper for handling of 'RequestRedirect'. --- --- @ --- parseRedirect :: 'Response' 'LBS.ByteString' -> 'Either' 'Error' a --- @ -parseRedirect :: MonadError Error m => URI -> Response LBS.ByteString -> m URI -parseRedirect originalUri rsp = do - let status = responseStatus rsp - when (statusCode status /= 302) $ - throwError $ ParseError $ "invalid status: " <> T.pack (show status) - loc <- maybe noLocation return $ lookup "Location" $ responseHeaders rsp - case parseURIReference $ T.unpack $ TE.decodeUtf8 loc of - Nothing -> throwError $ ParseError $ - "location header does not contain a URI: " <> T.pack (show loc) - Just uri -> return $ uri `relativeTo` originalUri - where - noLocation = throwError $ ParseError "no location header in response" - -- | Helper for making paginated requests. Responses, @a@ are combined monoidally. -- -- @ @@ -344,14 +397,14 @@ parseRedirect originalUri rsp = do -- -> 'ExceptT' 'Error' 'IO' a -- @ performPagedRequest - :: forall a m. (FromJSON a, Semigroup a, MonadCatch m, MonadError Error m) + :: forall a m mt. (ParseResponse mt a, Semigroup a, MonadCatch m, MonadError Error m) => (HTTP.Request -> m (Response LBS.ByteString)) -- ^ `httpLbs` analogue -> (a -> Bool) -- ^ predicate to continue iteration -> HTTP.Request -- ^ initial request - -> m a -performPagedRequest httpLbs' predicate initReq = do + -> Tagged mt (m a) +performPagedRequest httpLbs' predicate initReq = Tagged $ do res <- httpLbs' initReq - m <- parseResponse res + m <- unTagged (parseResponse initReq res :: Tagged mt (m a)) go m res initReq where go :: a -> Response LBS.ByteString -> HTTP.Request -> m a @@ -360,7 +413,7 @@ performPagedRequest httpLbs' predicate initReq = do (True, Just uri) -> do req' <- HTTP.setUri req uri res' <- httpLbs' req' - m <- parseResponse res' + m <- unTagged (parseResponse req' res' :: Tagged mt (m a)) go (acc <> m) res' req' (_, _) -> return acc @@ -368,22 +421,5 @@ performPagedRequest httpLbs' predicate initReq = do -- Internal ------------------------------------------------------------------------------- - -setCheckStatus :: Maybe (StatusMap a) -> HTTP.Request -> HTTP.Request -setCheckStatus sm req = req { HTTP.checkResponse = successOrMissing sm } - -successOrMissing :: Maybe (StatusMap a) -> HTTP.Request -> HTTP.Response HTTP.BodyReader -> IO () -successOrMissing sm _req res - | check = pure () - | otherwise = do - chunk <- HTTP.brReadSome (HTTP.responseBody res) 1024 - let res' = fmap (const ()) res - HTTP.throwHttp $ HTTP.StatusCodeException res' (LBS.toStrict chunk) - where - Status sci _ = HTTP.responseStatus res - check = case sm of - Nothing -> 200 <= sci && sci < 300 - Just sm' -> sci `elem` map fst sm' - onHttpException :: MonadError Error m => HttpException -> m a onHttpException = throwError . HTTPError From 1d1d6e0e2f1be595bd2b04f267514ef27c24fc88 Mon Sep 17 00:00:00 2001 From: "Thomas M. DuBuisson" Date: Sun, 8 Apr 2018 12:20:01 -0700 Subject: [PATCH 345/510] Commit posisition change --- CHANGELOG.md | 14 +++++++++++++ src/GitHub.hs | 2 +- src/GitHub/Data/Comments.hs | 19 ++++++++++++++++++ src/GitHub/Endpoints/PullRequests/Comments.hs | 20 +++++++++++++++++++ 4 files changed, 54 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index d73013a0..ab3b5206 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,8 +2,22 @@ ## Changes for 0.21 +- Refactor `Request` type. + [#349](https://github.com/phadej/github/pull/349) - Allow `http-client-0.6` + [#344](https://github.com/phadej/github/pull/344) - Change to use `cryptohash-sha1` (`cryptohash` was used before) +- Add Create milestone endponts + [#337](https://github.com/phadej/github/pull/337) +- Make fileBlobUrl and fileRawUrl are optional + [#339](https://github.com/phadej/github/issues/339) + [#340](https://github.com/phadej/github/pull/340) +- Add organizationsR to request user organizations + [#345](https://github.com/phadej/github/pull/345) +- Add updateMilestoneR, deleteMilestoneR + [#338](https://github.com/phadej/github/pull/338) +- Allow multiple assignees in NewIssue and EditIssue + [#336](https://github.com/phadej/github/pull/336) ## Changes for 0.20 diff --git a/src/GitHub.hs b/src/GitHub.hs index f38f305f..1f7dbe52 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -206,11 +206,11 @@ module GitHub ( -- Missing endpoints: -- -- * List comments in a repository - -- * Create a comment -- * Edit a comment -- * Delete a comment pullRequestCommentsR, pullRequestCommentR, + createPullCommentR, -- ** Pull request reviews -- | See diff --git a/src/GitHub/Data/Comments.hs b/src/GitHub/Data/Comments.hs index 9c966e7a..91c6d4e5 100644 --- a/src/GitHub/Data/Comments.hs +++ b/src/GitHub/Data/Comments.hs @@ -64,3 +64,22 @@ instance Binary EditComment instance ToJSON EditComment where toJSON (EditComment b) = object [ "body" .= b ] + +data NewPullComment = NewPullComment + { newPullCommentCommit :: !Text + , newPullCommentPath :: !Text + , newPullCommentPosition :: !Int + , newPullCommentBody :: !Text + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData NewPullComment where rnf = genericRnf +instance Binary NewPullComment + +instance ToJSON NewPullComment where + toJSON (NewPullComment c path pos b) = + object [ "body" .= b + , "commit_id" .= c + , "path" .= path + , "position" .= pos + ] diff --git a/src/GitHub/Endpoints/PullRequests/Comments.hs b/src/GitHub/Endpoints/PullRequests/Comments.hs index 98d5d2c8..d8d3d487 100644 --- a/src/GitHub/Endpoints/PullRequests/Comments.hs +++ b/src/GitHub/Endpoints/PullRequests/Comments.hs @@ -10,6 +10,8 @@ module GitHub.Endpoints.PullRequests.Comments ( pullRequestCommentsR, pullRequestComment, pullRequestCommentR, + createPullComment, + createPullCommentR, module GitHub.Data, ) where @@ -43,3 +45,21 @@ pullRequestComment user repo cid = pullRequestCommentR :: Name Owner -> Name Repo -> Id Comment -> Request k Comment pullRequestCommentR user repo cid = query ["repos", toPathPart user, toPathPart repo, "pulls", "comments", toPathPart cid] [] + +-- | Create a new comment. +-- +-- > createPullComment (User (user, password)) user repo issue commit path position +-- > "some words" +createPullComment :: Auth -> Name Owner -> Name Repo -> IssueNumber -> Text -> Text -> Int -> Text + -> IO (Either Error Comment) +createPullComment auth user repo iss commit path position body = + executeRequest auth $ createPullCommentR user repo iss commit path position body + +-- | Create a comment. +-- +-- See +createPullCommentR :: Name Owner -> Name Repo -> IssueNumber -> Text -> Text -> Int -> Text -> Request 'RW Comment +createPullCommentR user repo iss commit path position body = + command Post parts (encode $ NewPullComment commit path position body) + where + parts = ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart iss, "comments"] From 3e768ad95048168e9cf12e6460adbd4c11c24d03 Mon Sep 17 00:00:00 2001 From: "Thomas M. DuBuisson" Date: Thu, 10 May 2018 13:27:12 -0700 Subject: [PATCH 346/510] Add pullRequestPatchR --- CHANGELOG.md | 1 + spec/GitHub/PullRequestsSpec.hs | 8 +++- src/GitHub.hs | 2 + src/GitHub/Data/PullRequests.hs | 4 +- src/GitHub/Endpoints/PullRequests.hs | 64 +++++++++++++++++++++++----- 5 files changed, 65 insertions(+), 14 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index ab3b5206..c8ced0de 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -18,6 +18,7 @@ [#338](https://github.com/phadej/github/pull/338) - Allow multiple assignees in NewIssue and EditIssue [#336](https://github.com/phadej/github/pull/336) +- Add `pullRequestPatchR` and `pullRequestDiffR` ## Changes for 0.20 diff --git a/spec/GitHub/PullRequestsSpec.hs b/spec/GitHub/PullRequestsSpec.hs index cb7a212f..0f08ab22 100644 --- a/spec/GitHub/PullRequestsSpec.hs +++ b/spec/GitHub/PullRequestsSpec.hs @@ -14,6 +14,7 @@ import Data.FileEmbed (embedFile) import Data.Foldable (for_) import Data.String (fromString) import qualified Data.Vector as V +import qualified Data.ByteString.Lazy.Char8 as LBS8 import System.Environment (lookupEnv) import Test.Hspec (Spec, describe, it, pendingWith, shouldBe, shouldSatisfy) @@ -37,6 +38,12 @@ spec = do GitHub.pullRequestsForR owner repo opts GitHub.FetchAll cs `shouldSatisfy` isRight + describe "pullRequestPatchR" $ + it "works" $ withAuth $ \auth -> do + Right patch <- GitHub.executeRequest auth $ + GitHub.pullRequestPatchR "phadej" "github" (GitHub.IssueNumber 349) + head (LBS8.lines patch) `shouldBe` "From c0e4ad33811be82e1f72ee76116345c681703103 Mon Sep 17 00:00:00 2001" + describe "decoding pull request payloads" $ do it "decodes a pull request 'opened' payload" $ do V.length (GitHub.simplePullRequestRequestedReviewers simplePullRequestOpened) @@ -62,7 +69,6 @@ spec = do repos = [ ("thoughtbot", "paperclip") , ("phadej", "github") - , ("haskell", "cabal") ] opts = GitHub.stateClosed diff --git a/src/GitHub.hs b/src/GitHub.hs index 1f7dbe52..bbe0d0fa 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -193,6 +193,8 @@ module GitHub ( -- | See pullRequestsForR, pullRequestR, + pullRequestPatchR, + pullRequestDiffR, createPullRequestR, updatePullRequestR, pullRequestCommitsR, diff --git a/src/GitHub/Data/PullRequests.hs b/src/GitHub/Data/PullRequests.hs index 0c3df02d..b91311da 100644 --- a/src/GitHub/Data/PullRequests.hs +++ b/src/GitHub/Data/PullRequests.hs @@ -32,7 +32,7 @@ data SimplePullRequest = SimplePullRequest , simplePullRequestUser :: !SimpleUser , simplePullRequestPatchUrl :: !URL , simplePullRequestState :: !IssueState - , simplePullRequestNumber :: !Int + , simplePullRequestNumber :: !IssueNumber , simplePullRequestHtmlUrl :: !URL , simplePullRequestUpdatedAt :: !UTCTime , simplePullRequestBody :: !(Maybe Text) @@ -57,7 +57,7 @@ data PullRequest = PullRequest , pullRequestUser :: !SimpleUser , pullRequestPatchUrl :: !URL , pullRequestState :: !IssueState - , pullRequestNumber :: !Int + , pullRequestNumber :: !IssueNumber , pullRequestHtmlUrl :: !URL , pullRequestUpdatedAt :: !UTCTime , pullRequestBody :: !(Maybe Text) diff --git a/src/GitHub/Endpoints/PullRequests.hs b/src/GitHub/Endpoints/PullRequests.hs index 036ad4d8..e141e589 100644 --- a/src/GitHub/Endpoints/PullRequests.hs +++ b/src/GitHub/Endpoints/PullRequests.hs @@ -12,6 +12,12 @@ module GitHub.Endpoints.PullRequests ( pullRequest', pullRequest, pullRequestR, + pullRequestDiff', + pullRequestDiff, + pullRequestDiffR, + pullRequestPatch', + pullRequestPatch, + pullRequestPatchR, createPullRequest, createPullRequestR, updatePullRequest, @@ -33,6 +39,7 @@ import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () +import Data.ByteString.Lazy (ByteString) -- | All open pull requests for the repo, by owner and repo name. -- @@ -60,12 +67,47 @@ pullRequestsForR user repo opts = pagedQuery ["repos", toPathPart user, toPathPart repo, "pulls"] (prModToQueryString opts) +-- | Obtain the diff of a pull request +-- See +pullRequestDiff' :: Maybe Auth -> Name Owner -> Name Repo -> IssueNumber -> IO (Either Error ByteString) +pullRequestDiff' auth user repo prid = + executeRequestMaybe auth $ pullRequestDiffR user repo prid + +-- | Obtain the diff of a pull request +-- See +pullRequestDiff :: Name Owner -> Name Repo -> IssueNumber -> IO (Either Error ByteString) +pullRequestDiff = pullRequestDiff' Nothing + +-- | Query a single pull request to obtain the diff +-- See +pullRequestDiffR :: Name Owner -> Name Repo -> IssueNumber -> GenRequest 'MtDiff rw ByteString +pullRequestDiffR user repo prid = + Query ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid] [] + +-- | Obtain the patch of a pull request +-- +-- See +pullRequestPatch' :: Maybe Auth -> Name Owner -> Name Repo -> IssueNumber -> IO (Either Error ByteString) +pullRequestPatch' auth user repo prid = + executeRequestMaybe auth $ pullRequestPatchR user repo prid + +-- | Obtain the patch of a pull request +-- See +pullRequestPatch :: Name Owner -> Name Repo -> IssueNumber -> IO (Either Error ByteString) +pullRequestPatch = pullRequestPatch' Nothing + +-- | Query a single pull request to obtain the patch +-- See +pullRequestPatchR :: Name Owner -> Name Repo -> IssueNumber -> GenRequest 'MtPatch rw ByteString +pullRequestPatchR user repo prid = + Query ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart 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. -- With authentification. -- -- > pullRequest' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" 562 -pullRequest' :: Maybe Auth -> Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error PullRequest) +pullRequest' :: Maybe Auth -> Name Owner -> Name Repo -> IssueNumber -> IO (Either Error PullRequest) pullRequest' auth user repo prid = executeRequestMaybe auth $ pullRequestR user repo prid @@ -73,12 +115,12 @@ pullRequest' auth user repo prid = -- repo owner and name along with the number assigned to the pull request. -- -- > pullRequest "thoughtbot" "paperclip" 562 -pullRequest :: Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error PullRequest) +pullRequest :: Name Owner -> Name Repo -> IssueNumber -> IO (Either Error PullRequest) pullRequest = pullRequest' Nothing -- | Query a single pull request. -- See -pullRequestR :: Name Owner -> Name Repo -> Id PullRequest -> Request k PullRequest +pullRequestR :: Name Owner -> Name Repo -> IssueNumber -> Request k PullRequest pullRequestR user repo prid = query ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid] [] @@ -100,7 +142,7 @@ createPullRequestR user repo cpr = command Post ["repos", toPathPart user, toPathPart repo, "pulls"] (encode cpr) -- | Update a pull request -updatePullRequest :: Auth -> Name Owner -> Name Repo -> Id PullRequest -> EditPullRequest -> IO (Either Error PullRequest) +updatePullRequest :: Auth -> Name Owner -> Name Repo -> IssueNumber -> EditPullRequest -> IO (Either Error PullRequest) updatePullRequest auth user repo prid epr = executeRequest auth $ updatePullRequestR user repo prid epr @@ -108,7 +150,7 @@ updatePullRequest auth user repo prid epr = -- See updatePullRequestR :: Name Owner -> Name Repo - -> Id PullRequest + -> IssueNumber -> EditPullRequest -> Request 'RW PullRequest updatePullRequestR user repo prid epr = @@ -119,7 +161,7 @@ updatePullRequestR user repo prid epr = -- With authentification. -- -- > pullRequestCommits' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" 688 -pullRequestCommits' :: Maybe Auth -> Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector Commit)) +pullRequestCommits' :: Maybe Auth -> Name Owner -> Name Repo -> IssueNumber -> IO (Either Error (Vector Commit)) pullRequestCommits' auth user repo prid = executeRequestMaybe auth $ pullRequestCommitsR user repo prid FetchAll @@ -127,12 +169,12 @@ pullRequestCommits' auth user repo prid = -- the number of the pull request. -- -- > pullRequestCommits "thoughtbot" "paperclip" 688 -pullRequestCommitsIO :: Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector Commit)) +pullRequestCommitsIO :: Name Owner -> Name Repo -> IssueNumber -> IO (Either Error (Vector Commit)) pullRequestCommitsIO = pullRequestCommits' Nothing -- | List commits on a pull request. -- See -pullRequestCommitsR :: Name Owner -> Name Repo -> Id PullRequest -> FetchCount -> Request k (Vector Commit) +pullRequestCommitsR :: Name Owner -> Name Repo -> IssueNumber -> FetchCount -> Request k (Vector Commit) pullRequestCommitsR user repo prid = pagedQuery ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "commits"] [] @@ -141,7 +183,7 @@ pullRequestCommitsR user repo prid = -- With authentification. -- -- > pullRequestFiles' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" 688 -pullRequestFiles' :: Maybe Auth -> Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector File)) +pullRequestFiles' :: Maybe Auth -> Name Owner -> Name Repo -> IssueNumber -> IO (Either Error (Vector File)) pullRequestFiles' auth user repo prid = executeRequestMaybe auth $ pullRequestFilesR user repo prid FetchAll @@ -149,12 +191,12 @@ pullRequestFiles' auth user repo prid = -- name, plus the number assigned to the pull request. -- -- > pullRequestFiles "thoughtbot" "paperclip" 688 -pullRequestFiles :: Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector File)) +pullRequestFiles :: Name Owner -> Name Repo -> IssueNumber -> IO (Either Error (Vector File)) pullRequestFiles = pullRequestFiles' Nothing -- | List pull requests files. -- See -pullRequestFilesR :: Name Owner -> Name Repo -> Id PullRequest -> FetchCount -> Request k (Vector File) +pullRequestFilesR :: Name Owner -> Name Repo -> IssueNumber -> FetchCount -> Request k (Vector File) pullRequestFilesR user repo prid = pagedQuery ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "files"] [] From 91cbb4c97948867d68ba9121af014b1f4a6d0eab Mon Sep 17 00:00:00 2001 From: "Thomas M. DuBuisson" Date: Thu, 10 May 2018 15:26:04 -0700 Subject: [PATCH 347/510] Provide a wrapper for forking outside of the Req monad. --- src/GitHub/Endpoints/Repos.hs | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/src/GitHub/Endpoints/Repos.hs b/src/GitHub/Endpoints/Repos.hs index d9ad44a1..18b883dd 100644 --- a/src/GitHub/Endpoints/Repos.hs +++ b/src/GitHub/Endpoints/Repos.hs @@ -38,6 +38,7 @@ module GitHub.Endpoints.Repos ( createRepoR, createOrganizationRepo', createOrganizationRepoR, + forkExistingRepo', forkExistingRepoR, -- ** Edit @@ -167,6 +168,11 @@ createRepoR :: NewRepo -> Request 'RW Repo createRepoR nrepo = command Post ["user", "repos"] (encode nrepo) +-- | Fork an existing repository. +forkExistingRepo' :: Auth -> Name Owner -> Name Repo -> Maybe (Name Owner) -> IO (Either Error Repo) +forkExistingRepo' auth owner repo morg = + executeRequest auth $ forkExistingRepoR owner repo morg + -- | Fork an existing repository. -- See -- TODO: The third paramater (an optional Organisation) is not used yet. From 1180ebe78b18823317a0c0674d5e92d428ca83be Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sun, 17 Feb 2019 22:13:49 +0200 Subject: [PATCH 348/510] Amend changelog --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index c8ced0de..abc96133 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -19,6 +19,7 @@ - Allow multiple assignees in NewIssue and EditIssue [#336](https://github.com/phadej/github/pull/336) - Add `pullRequestPatchR` and `pullRequestDiffR` + [#325](https://github.com/phadej/github/pull/325) ## Changes for 0.20 From dcb707efba9e754eee1639415da2ada6131805c6 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 1 Apr 2019 10:33:03 +0300 Subject: [PATCH 349/510] Regenerate .travis.yml --- .travis.yml | 199 +++++++++++++++++++++++++++++---------------------- github.cabal | 2 +- 2 files changed, 114 insertions(+), 87 deletions(-) diff --git a/.travis.yml b/.travis.yml index 82f84f1a..4e9eb83d 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,122 +1,149 @@ # This Travis job script has been generated by a script via # -# runghc make_travis_yml_2.hs '--branch' 'master' '-o' '.travis.yml' 'github.cabal' +# haskell-ci '--branches' 'master' '-o' '.travis.yml' 'github.cabal' # # For more information, see https://github.com/haskell-CI/haskell-ci # +# version: 0.3.20190327 +# language: c -sudo: false - +dist: xenial git: - submodules: false # whether to recursively clone submodules - + # whether to recursively clone submodules + submodules: false branches: only: - master - cache: directories: - $HOME/.cabal/packages - $HOME/.cabal/store - before_cache: - - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log + - rm -fv $CABALHOME/packages/hackage.haskell.org/build-reports.log # remove files that are regenerated by 'cabal update' - - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.* - - rm -fv $HOME/.cabal/packages/hackage.haskell.org/*.json - - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.cache - - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar - - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar.idx - - - rm -rfv $HOME/.cabal/packages/head.hackage - + - rm -fv $CABALHOME/packages/hackage.haskell.org/00-index.* + - rm -fv $CABALHOME/packages/hackage.haskell.org/*.json + - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.cache + - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar + - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar.idx + - rm -rfv $CABALHOME/packages/head.hackage matrix: include: - - compiler: "ghc-8.6.1" - # env: TEST=--disable-tests BENCH=--disable-benchmarks - addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-8.6.1], sources: [hvr-ghc]}} - - compiler: "ghc-8.4.3" - # env: TEST=--disable-tests BENCH=--disable-benchmarks - addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-8.4.3], sources: [hvr-ghc]}} - - compiler: "ghc-8.2.2" - # env: TEST=--disable-tests BENCH=--disable-benchmarks - addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-8.2.2], sources: [hvr-ghc]}} - - compiler: "ghc-8.0.2" - # env: TEST=--disable-tests BENCH=--disable-benchmarks - addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-8.0.2], sources: [hvr-ghc]}} - - compiler: "ghc-7.10.3" - # env: TEST=--disable-tests BENCH=--disable-benchmarks - addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-7.10.3], sources: [hvr-ghc]}} - - compiler: "ghc-7.8.4" - # env: TEST=--disable-tests BENCH=--disable-benchmarks - addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-7.8.4], sources: [hvr-ghc]}} - + - compiler: ghc-8.6.3 + addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.6.3","cabal-install-2.4"]}} + - compiler: ghc-8.4.3 + addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.4.3","cabal-install-2.4"]}} + - compiler: ghc-8.2.2 + addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.2.2","cabal-install-2.4"]}} + - compiler: ghc-8.0.2 + addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.0.2","cabal-install-2.4"]}} + - compiler: ghc-7.10.3 + addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.10.3","cabal-install-2.4"]}} + - compiler: ghc-7.8.4 + addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.8.4","cabal-install-2.4"]}} before_install: - - HC=${CC} - - HCPKG=${HC/ghc/ghc-pkg} + - HC=$(echo "/opt/$CC/bin/ghc" | sed 's/-/\//') + - HCPKG="$HC-pkg" - unset CC - - ROOTDIR=$(pwd) - - mkdir -p $HOME/.local/bin - - "PATH=/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$HOME/local/bin:$PATH" + - CABAL=/opt/ghc/bin/cabal + - CABALHOME=$HOME/.cabal + - export PATH="$CABALHOME/bin:$PATH" + - TOP=$(pwd) - HCNUMVER=$(( $(${HC} --numeric-version|sed -E 's/([0-9]+)\.([0-9]+)\.([0-9]+).*/\1 * 10000 + \2 * 100 + \3/') )) - echo $HCNUMVER - + - CABAL="$CABAL -vnormal+nowrap+markoutput" + - set -o pipefail + - | + echo 'function blue(s) { printf "\033[0;34m" s "\033[0m " }' >> .colorful.awk + echo 'BEGIN { state = "output"; }' >> .colorful.awk + echo '/^-----BEGIN CABAL OUTPUT-----$/ { state = "cabal" }' >> .colorful.awk + echo '/^-----END CABAL OUTPUT-----$/ { state = "output" }' >> .colorful.awk + echo '!/^(-----BEGIN CABAL OUTPUT-----|-----END CABAL OUTPUT-----)/ {' >> .colorful.awk + echo ' if (state == "cabal") {' >> .colorful.awk + echo ' print blue($0)' >> .colorful.awk + echo ' } else {' >> .colorful.awk + echo ' print $0' >> .colorful.awk + echo ' }' >> .colorful.awk + echo '}' >> .colorful.awk + - cat .colorful.awk + - | + color_cabal_output () { + awk -f $TOP/.colorful.awk + } + - echo text | color_cabal_output install: - - cabal --version + - ${CABAL} --version - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]" - - BENCH=${BENCH---enable-benchmarks} - - TEST=${TEST---enable-tests} - - HADDOCK=${HADDOCK-true} - - UNCONSTRAINED=${UNCONSTRAINED-true} - - NOINSTALLEDCONSTRAINTS=${NOINSTALLEDCONSTRAINTS-false} + - TEST=--enable-tests + - BENCH=--enable-benchmarks - GHCHEAD=${GHCHEAD-false} - - travis_retry cabal update -v - - "sed -i.bak 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config" - - rm -fv cabal.project cabal.project.local - - grep -Ev -- '^\s*--' ${HOME}/.cabal/config | grep -Ev '^\s*$' - - "printf 'packages: \".\"\\n' > cabal.project" - - touch cabal.project.local - - "if ! $NOINSTALLEDCONSTRAINTS; then for pkg in $($HCPKG list --simple-output); do echo $pkg | grep -vw -- github | sed 's/^/constraints: /' | sed 's/-[^-]*$/ installed/' >> cabal.project.local; done; fi" + - rm -f $CABALHOME/config + - | + echo "verbose: normal +nowrap +markoutput" >> $CABALHOME/config + echo "remote-build-reporting: anonymous" >> $CABALHOME/config + echo "remote-repo-cache: $CABALHOME/packages" >> $CABALHOME/config + echo "logs-dir: $CABALHOME/logs" >> $CABALHOME/config + echo "world-file: $CABALHOME/world" >> $CABALHOME/config + echo "extra-prog-path: $CABALHOME/bin" >> $CABALHOME/config + echo "symlink-bindir: $CABALHOME/bin" >> $CABALHOME/config + echo "build-summary: $CABALHOME/logs/build.log" >> $CABALHOME/config + echo "store-dir: $CABALHOME/store" >> $CABALHOME/config + echo "install-dirs user" >> $CABALHOME/config + echo " prefix: $CABALHOME" >> $CABALHOME/config + echo "repository hackage.haskell.org" >> $CABALHOME/config + echo " url: http://hackage.haskell.org/" >> $CABALHOME/config + - cat $CABALHOME/config + - rm -fv cabal.project cabal.project.local cabal.project.freeze + - travis_retry ${CABAL} v2-update -v + # Generate cabal.project + - rm -rf cabal.project cabal.project.local cabal.project.freeze + - touch cabal.project + - | + echo 'packages: "."' >> cabal.project + - | + echo "write-ghc-environment-files: always" >> cabal.project + - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | grep -vE -- '^(github)$' | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" - cat cabal.project || true - cat cabal.project.local || true - - if [ -f "./configure.ac" ]; then - (cd "." && autoreconf -i); - fi - - rm -f cabal.project.freeze - - cabal new-build -w ${HC} ${TEST} ${BENCH} --project-file="cabal.project" --dep -j2 all - - cabal new-build -w ${HC} --disable-tests --disable-benchmarks --project-file="cabal.project" --dep -j2 all - - rm -rf .ghc.environment.* "."/dist - - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX) - -# Here starts the actual work to be performed for the package under test; -# any command which exits with a non-zero exit code causes the build to fail. + - if [ -f "./configure.ac" ]; then (cd "." && autoreconf -i); fi + - ${CABAL} v2-freeze -w ${HC} ${TEST} ${BENCH} | color_cabal_output + - "cat cabal.project.freeze | sed -E 's/^(constraints: *| *)//' | sed 's/any.//'" + - rm cabal.project.freeze + - ${CABAL} v2-build -w ${HC} ${TEST} ${BENCH} --dep -j2 all | color_cabal_output + - ${CABAL} v2-build -w ${HC} --disable-tests --disable-benchmarks --dep -j2 all | color_cabal_output script: - # test that source-distributions can be generated - - (cd "." && cabal sdist) - - mv "."/dist/github-*.tar.gz ${DISTDIR}/ + - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX) + # Packaging... + - ${CABAL} v2-sdist all | color_cabal_output + # Unpacking... + - mv dist-newstyle/sdist/*.tar.gz ${DISTDIR}/ - cd ${DISTDIR} || false - find . -maxdepth 1 -name '*.tar.gz' -exec tar -xvf '{}' \; - - "printf 'packages: github-*/*.cabal\\n' > cabal.project" - - touch cabal.project.local - - "if ! $NOINSTALLEDCONSTRAINTS; then for pkg in $($HCPKG list --simple-output); do echo $pkg | grep -vw -- github | sed 's/^/constraints: /' | sed 's/-[^-]*$/ installed/' >> cabal.project.local; done; fi" + # Generate cabal.project + - rm -rf cabal.project cabal.project.local cabal.project.freeze + - touch cabal.project + - | + echo 'packages: "github-*/*.cabal"' >> cabal.project + - | + echo "write-ghc-environment-files: always" >> cabal.project + - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | grep -vE -- '^(github)$' | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" - cat cabal.project || true - cat cabal.project.local || true + # Building... # this builds all libraries and executables (without tests/benchmarks) - - cabal new-build -w ${HC} --disable-tests --disable-benchmarks all - + - ${CABAL} v2-build -w ${HC} --disable-tests --disable-benchmarks all | color_cabal_output + # Building with tests and benchmarks... # build & run tests, build benchmarks - - cabal new-build -w ${HC} ${TEST} ${BENCH} all - - if [ "x$TEST" = "x--enable-tests" ]; then cabal new-test -w ${HC} ${TEST} ${BENCH} all; fi - - # cabal check - - (cd github-* && cabal check) - - # haddock - - rm -rf ./dist-newstyle - - if $HADDOCK; then cabal new-haddock -w ${HC} ${TEST} ${BENCH} all; else echo "Skipping haddock generation";fi - - # Build without installed constraints for packages in global-db - - if $UNCONSTRAINED; then rm -f cabal.project.local; echo cabal new-build -w ${HC} --disable-tests --disable-benchmarks all; else echo "Not building without installed constraints"; fi + - ${CABAL} v2-build -w ${HC} ${TEST} ${BENCH} all | color_cabal_output + # Testing... + - ${CABAL} v2-test -w ${HC} ${TEST} ${BENCH} all | color_cabal_output + # cabal check... + - (cd github-* && ${CABAL} -vnormal check) + # haddock... + - ${CABAL} v2-haddock -w ${HC} ${TEST} ${BENCH} all | color_cabal_output + # Building without installed constraints for packages in global-db... + - rm -f cabal.project.local + - ${CABAL} v2-build -w ${HC} --disable-tests --disable-benchmarks all | color_cabal_output -# REGENDATA ["--branch","master","-o",".travis.yml","github.cabal"] +# REGENDATA ["--branches","master","-o",".travis.yml","github.cabal"] # EOF diff --git a/github.cabal b/github.cabal index 36b9dd3b..df12bf1d 100644 --- a/github.cabal +++ b/github.cabal @@ -30,7 +30,7 @@ copyright: Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016-2019 Oleg Grenrus tested-with: - ghc ==7.8.4 || ==7.10.3 || ==8.0.2 || ==8.2.2 || ==8.4.3 || ==8.6.3 + GHC ==7.8.4 || ==7.10.3 || ==8.0.2 || ==8.2.2 || ==8.4.3 || ==8.6.4 extra-source-files: README.md From b4c52584ef6d534f4abe33fd935f60af7537e0fe Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Fri, 5 Apr 2019 08:02:40 +0200 Subject: [PATCH 350/510] Fix examples in documentation --- github.cabal | 2 +- src/GitHub.hs | 2 +- src/GitHub/Data.hs | 2 +- src/GitHub/Endpoints/Activity/Watching.hs | 4 ++-- src/GitHub/Endpoints/Gists.hs | 10 ++++----- src/GitHub/Endpoints/GitData/Blobs.hs | 2 +- src/GitHub/Endpoints/GitData/References.hs | 2 +- src/GitHub/Endpoints/GitData/Trees.hs | 4 ++-- src/GitHub/Endpoints/Issues.hs | 8 +++---- src/GitHub/Endpoints/Issues/Comments.hs | 8 +++---- src/GitHub/Endpoints/Issues/Events.hs | 6 ++--- src/GitHub/Endpoints/Issues/Labels.hs | 22 +++++++++---------- src/GitHub/Endpoints/Issues/Milestones.hs | 2 +- src/GitHub/Endpoints/Organizations.hs | 4 ++-- src/GitHub/Endpoints/PullRequests.hs | 6 ++--- src/GitHub/Endpoints/PullRequests/Comments.hs | 2 +- src/GitHub/Endpoints/PullRequests/Reviews.hs | 8 +++---- src/GitHub/Endpoints/Repos.hs | 16 +++++++------- src/GitHub/Endpoints/Repos/Commits.hs | 6 ++--- src/GitHub/Endpoints/Repos/Contents.hs | 6 ++--- src/GitHub/Endpoints/Repos/Forks.hs | 2 +- src/GitHub/Endpoints/Repos/Releases.hs | 8 +++---- src/GitHub/Endpoints/Users.hs | 2 +- src/GitHub/Internal/Prelude.hs | 2 +- src/GitHub/Request.hs | 2 +- 25 files changed, 69 insertions(+), 69 deletions(-) diff --git a/github.cabal b/github.cabal index df12bf1d..225ac17e 100644 --- a/github.cabal +++ b/github.cabal @@ -15,7 +15,7 @@ description: > > main :: IO () > main = do - > possibleUser <- GH.executeRequest' $ GH.userInfoR "phadej" + > possibleUser <- GH.executeRequest' $ GH.userInfoForR "phadej" > print possibleUser . For more of an overview please see the README: diff --git a/src/GitHub.hs b/src/GitHub.hs index bbe0d0fa..078a62f7 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -7,7 +7,7 @@ -- this package. -- -- See "GitHub.Request" module for executing 'Request', or other modules --- of this package (e.g. "GitHub.Users") for already composed versions. +-- of this package (e.g. "GitHub.Endpoints.Users") for already composed versions. -- -- The missing endpoints lists show which endpoints we know are missing, there -- might be more. diff --git a/src/GitHub/Data.hs b/src/GitHub/Data.hs index 3f031a07..e6fbd4a0 100644 --- a/src/GitHub/Data.hs +++ b/src/GitHub/Data.hs @@ -4,7 +4,7 @@ -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- --- This module re-exports the @GitHub.Data.@ and "Github.Auth" submodules. +-- This module re-exports the @GitHub.Data.@ and "GitHub.Auth" submodules. module GitHub.Data ( -- * Tagged types -- ** Name diff --git a/src/GitHub/Endpoints/Activity/Watching.hs b/src/GitHub/Endpoints/Activity/Watching.hs index 34914e32..d250878e 100644 --- a/src/GitHub/Endpoints/Activity/Watching.hs +++ b/src/GitHub/Endpoints/Activity/Watching.hs @@ -30,7 +30,7 @@ watchersFor = watchersFor' Nothing -- | The list of users that are watching the specified Github repo. -- With authentication -- --- > watchersFor' (Just (User (user, password))) "thoughtbot" "paperclip" +-- > watchersFor' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" watchersFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector SimpleUser)) watchersFor' auth user repo = executeRequestMaybe auth $ watchersForR user repo FetchAll @@ -50,7 +50,7 @@ reposWatchedBy = reposWatchedBy' Nothing -- | All the public repos watched by the specified user. -- With authentication -- --- > reposWatchedBy' (Just (User (user, password))) "croaky" +-- > reposWatchedBy' (Just $ BasicAuth "github-username" "github-password") "croaky" reposWatchedBy' :: Maybe Auth -> Name Owner -> IO (Either Error (Vector Repo)) reposWatchedBy' auth user = executeRequestMaybe auth $ reposWatchedByR user FetchAll diff --git a/src/GitHub/Endpoints/Gists.hs b/src/GitHub/Endpoints/Gists.hs index 13c830a3..c59ba5c5 100644 --- a/src/GitHub/Endpoints/Gists.hs +++ b/src/GitHub/Endpoints/Gists.hs @@ -27,7 +27,7 @@ import Prelude () -- | The list of all gists created by the user -- --- > gists' (Just ("github-username", "github-password")) "mike-burns" +-- > gists' (Just $ BasicAuth "github-username" "github-password") "mike-burns" gists' :: Maybe Auth -> Name Owner -> IO (Either Error (Vector Gist)) gists' auth user = executeRequestMaybe auth $ gistsR user FetchAll @@ -45,7 +45,7 @@ gistsR user = pagedQuery ["users", toPathPart user, "gists"] [] -- | A specific gist, given its id, with authentication credentials -- --- > gist' (Just ("github-username", "github-password")) "225074" +-- > gist' (Just $ BasicAuth "github-username" "github-password") "225074" gist' :: Maybe Auth -> Name Gist -> IO (Either Error Gist) gist' auth gid = executeRequestMaybe auth $ gistR gid @@ -64,7 +64,7 @@ gistR gid = -- | Star a gist by the authenticated user. -- --- > starGist ("github-username", "github-password") "225074" +-- > starGist (BasicAuth "github-username" "github-password") "225074" starGist :: Auth -> Name Gist -> IO (Either Error ()) starGist auth gid = executeRequest auth $ starGistR gid @@ -75,7 +75,7 @@ starGistR gid = Command Put ["gists", toPathPart gid, "star"] mempty -- | Unstar a gist by the authenticated user. -- --- > unstarGist ("github-username", "github-password") "225074" +-- > unstarGist (BasicAuth "github-username" "github-password") "225074" unstarGist :: Auth -> Name Gist -> IO (Either Error ()) unstarGist auth gid = executeRequest auth $ unstarGistR gid @@ -86,7 +86,7 @@ unstarGistR gid = command Delete ["gists", toPathPart gid, "star"] mempty -- | Delete a gist by the authenticated user. -- --- > deleteGist ("github-username", "github-password") "225074" +-- > deleteGist (BasicAuth "github-username" "github-password") "225074" deleteGist :: Auth -> Name Gist -> IO (Either Error ()) deleteGist auth gid = executeRequest auth $ deleteGistR gid diff --git a/src/GitHub/Endpoints/GitData/Blobs.hs b/src/GitHub/Endpoints/GitData/Blobs.hs index 355a6e8a..1de49084 100644 --- a/src/GitHub/Endpoints/GitData/Blobs.hs +++ b/src/GitHub/Endpoints/GitData/Blobs.hs @@ -19,7 +19,7 @@ import Prelude () -- | Query a blob by SHA1. -- --- > blob' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" "bc5c51d1ece1ee45f94b056a0f5a1674d7e8cba9" +-- > blob' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" "bc5c51d1ece1ee45f94b056a0f5a1674d7e8cba9" blob' :: Maybe Auth -> Name Owner -> Name Repo -> Name Blob -> IO (Either Error Blob) blob' auth user repo sha = executeRequestMaybe auth $ blobR user repo sha diff --git a/src/GitHub/Endpoints/GitData/References.hs b/src/GitHub/Endpoints/GitData/References.hs index d010e1b7..ba5e7bc8 100644 --- a/src/GitHub/Endpoints/GitData/References.hs +++ b/src/GitHub/Endpoints/GitData/References.hs @@ -26,7 +26,7 @@ import Prelude () -- | A single reference by the ref name. -- --- > reference' (Just ("github-username", "github-password")) "mike-burns" "github" "heads/master" +-- > reference' (Just $ BasicAuth "github-username" "github-password") "mike-burns" "github" "heads/master" reference' :: Maybe Auth -> Name Owner -> Name Repo -> Name GitReference -> IO (Either Error GitReference) reference' auth user repo ref = executeRequestMaybe auth $ referenceR user repo ref diff --git a/src/GitHub/Endpoints/GitData/Trees.hs b/src/GitHub/Endpoints/GitData/Trees.hs index 1806561a..b6bc550a 100644 --- a/src/GitHub/Endpoints/GitData/Trees.hs +++ b/src/GitHub/Endpoints/GitData/Trees.hs @@ -22,7 +22,7 @@ import Prelude () -- | A tree for a SHA1. -- --- > tree (Just ("github-username", "github-password")) "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844" +-- > tree (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844" tree' :: Maybe Auth -> Name Owner -> Name Repo -> Name Tree -> IO (Either Error Tree) tree' auth user repo sha = executeRequestMaybe auth $ treeR user repo sha @@ -41,7 +41,7 @@ treeR user repo sha = -- | A recursively-nested tree for a SHA1. -- --- > nestedTree' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844" +-- > nestedTree' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844" nestedTree' :: Maybe Auth -> Name Owner -> Name Repo -> Name Tree -> IO (Either Error Tree) nestedTree' auth user repo sha = executeRequestMaybe auth $ nestedTreeR user repo sha diff --git a/src/GitHub/Endpoints/Issues.hs b/src/GitHub/Endpoints/Issues.hs index 7b2c5c43..92e73bbc 100644 --- a/src/GitHub/Endpoints/Issues.hs +++ b/src/GitHub/Endpoints/Issues.hs @@ -41,7 +41,7 @@ organizationIssuesR org opts = -- | Details on a specific issue, given the repo owner and name, and the issue -- number.' -- --- > issue' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" "462" +-- > issue' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" "462" issue' :: Maybe Auth -> Name Owner -> Name Repo -> Id Issue -> IO (Either Error Issue) issue' auth user reqRepoName reqIssueNumber = executeRequestMaybe auth $ issueR user reqRepoName reqIssueNumber @@ -62,7 +62,7 @@ issueR user reqRepoName reqIssueNumber = -- | All issues for a repo (given the repo owner and name), with optional -- restrictions as described in the 'IssueRepoMod' data type. -- --- > issuesForRepo' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" [NoMilestone, OnlyClosed, Mentions "jyurek", Ascending] +-- > issuesForRepo' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" [NoMilestone, OnlyClosed, Mentions "jyurek", Ascending] issuesForRepo' :: Maybe Auth -> Name Owner -> Name Repo -> IssueRepoMod -> IO (Either Error (Vector Issue)) issuesForRepo' auth user reqRepoName opts = executeRequestMaybe auth $ issuesForRepoR user reqRepoName opts FetchAll @@ -90,7 +90,7 @@ newIssue title = NewIssue title Nothing mempty Nothing Nothing -- | Create a new issue. -- --- > createIssue (User (user, password)) user repo +-- > createIssue (BasicAuth "github-username" "github-password") user repo -- > (newIssue "some_repo") {...} createIssue :: Auth -> Name Owner -> Name Repo -> NewIssue -> IO (Either Error Issue) @@ -110,7 +110,7 @@ editOfIssue = EditIssue Nothing Nothing Nothing Nothing Nothing Nothing -- | Edit an issue. -- --- > editIssue (User (user, password)) user repo issue +-- > editIssue (BasicAuth "github-username" "github-password") user repo issue -- > editOfIssue {...} editIssue :: Auth -> Name Owner -> Name Repo -> Id Issue -> EditIssue -> IO (Either Error Issue) diff --git a/src/GitHub/Endpoints/Issues/Comments.hs b/src/GitHub/Endpoints/Issues/Comments.hs index 7b46fc0b..83f67024 100644 --- a/src/GitHub/Endpoints/Issues/Comments.hs +++ b/src/GitHub/Endpoints/Issues/Comments.hs @@ -46,7 +46,7 @@ comments = comments' Nothing -- | All comments on an issue, by the issue's number, using authentication. -- --- > comments' (User (user, password)) "thoughtbot" "paperclip" 635 +-- > comments' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" 635 comments' :: Maybe Auth -> Name Owner -> Name Repo -> IssueNumber -> IO (Either Error (Vector IssueComment)) comments' auth user repo iid = executeRequestMaybe auth $ commentsR user repo iid FetchAll @@ -59,7 +59,7 @@ commentsR user repo iid = -- | Create a new comment. -- --- > createComment (User (user, password)) user repo issue +-- > createComment (BasicAuth "github-username" "github-password") user repo issue -- > "some words" createComment :: Auth -> Name Owner -> Name Repo -> IssueNumber -> Text -> IO (Either Error Comment) @@ -76,7 +76,7 @@ createCommentR user repo iss body = -- | Edit a comment. -- --- > editComment (User (user, password)) user repo commentid +-- > editComment (BasicAuth "github-username" "github-password") user repo commentid -- > "new words" editComment :: Auth -> Name Owner -> Name Repo -> Id Comment -> Text -> IO (Either Error Comment) @@ -93,7 +93,7 @@ editCommentR user repo commid body = -- | Delete a comment. -- --- > deleteComment (User (user, password)) user repo commentid +-- > deleteComment (BasicAuth "github-username" "github-password") user repo commentid deleteComment :: Auth -> Name Owner -> Name Repo -> Id Comment -> IO (Either Error ()) deleteComment auth user repo commid = diff --git a/src/GitHub/Endpoints/Issues/Events.hs b/src/GitHub/Endpoints/Issues/Events.hs index 97750eda..c139f819 100644 --- a/src/GitHub/Endpoints/Issues/Events.hs +++ b/src/GitHub/Endpoints/Issues/Events.hs @@ -31,7 +31,7 @@ eventsForIssue = eventsForIssue' Nothing -- | All events that have happened on an issue, using authentication. -- --- > eventsForIssue' (User (user, password)) "thoughtbot" "paperclip" 49 +-- > eventsForIssue' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" 49 eventsForIssue' :: Maybe Auth -> Name Owner -> Name Repo -> Id Issue -> IO (Either Error (Vector IssueEvent)) eventsForIssue' auth user repo iid = executeRequestMaybe auth $ eventsForIssueR user repo iid FetchAll @@ -50,7 +50,7 @@ eventsForRepo = eventsForRepo' Nothing -- | All the events for all issues in a repo, using authentication. -- --- > eventsForRepo' (User (user, password)) "thoughtbot" "paperclip" +-- > eventsForRepo' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" eventsForRepo' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector IssueEvent)) eventsForRepo' auth user repo = executeRequestMaybe auth $ eventsForRepoR user repo FetchAll @@ -69,7 +69,7 @@ event = event' Nothing -- | Details on a specific event, by the event's ID, using authentication. -- --- > event' (User (user, password)) "thoughtbot" "paperclip" 5335772 +-- > event' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" 5335772 event' :: Maybe Auth -> Name Owner -> Name Repo -> Id IssueEvent -> IO (Either Error IssueEvent) event' auth user repo eid = executeRequestMaybe auth $ eventR user repo eid diff --git a/src/GitHub/Endpoints/Issues/Labels.hs b/src/GitHub/Endpoints/Issues/Labels.hs index 4b4c8628..6fa03ed3 100644 --- a/src/GitHub/Endpoints/Issues/Labels.hs +++ b/src/GitHub/Endpoints/Issues/Labels.hs @@ -48,7 +48,7 @@ labelsOnRepo = labelsOnRepo' Nothing -- | All the labels available to use on any issue in the repo using authentication. -- --- > labelsOnRepo' (Just (User (user password))) "thoughtbot" "paperclip" +-- > labelsOnRepo' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" labelsOnRepo' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector IssueLabel)) labelsOnRepo' auth user repo = executeRequestMaybe auth $ labelsOnRepoR user repo FetchAll @@ -67,7 +67,7 @@ label = label' Nothing -- | A label by name using authentication. -- --- > label' (Just (User (user password))) "thoughtbot" "paperclip" "bug" +-- > label' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" "bug" label' :: Maybe Auth -> Name Owner -> Name Repo -> Name IssueLabel -> IO (Either Error IssueLabel) label' auth user repo lbl = executeRequestMaybe auth $ labelR user repo lbl @@ -80,7 +80,7 @@ labelR user repo lbl = -- | Create a label -- --- > createLabel (User (user password)) "thoughtbot" "paperclip" "bug" "f29513" +-- > createLabel (BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" "bug" "f29513" createLabel :: Auth -> Name Owner -> Name Repo -> Name IssueLabel -> String -> IO (Either Error IssueLabel) createLabel auth user repo lbl color = executeRequest auth $ createLabelR user repo lbl color @@ -96,7 +96,7 @@ createLabelR user repo lbl color = -- | Update a label -- --- > updateLabel (User (user password)) "thoughtbot" "paperclip" "bug" "new-bug" "ff1111" +-- > updateLabel (BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" "bug" "new-bug" "ff1111" updateLabel :: Auth -> Name Owner -> Name Repo @@ -123,7 +123,7 @@ updateLabelR user repo oldLbl newLbl color = -- | Delete a label -- --- > deleteLabel (User (user password)) "thoughtbot" "paperclip" "bug" +-- > deleteLabel (BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" "bug" deleteLabel :: Auth -> Name Owner -> Name Repo -> Name IssueLabel -> IO (Either Error ()) deleteLabel auth user repo lbl = executeRequest auth $ deleteLabelR user repo lbl @@ -142,7 +142,7 @@ labelsOnIssue = labelsOnIssue' Nothing -- | The labels on an issue in a repo using authentication. -- --- > labelsOnIssue' (Just (User (user password))) "thoughtbot" "paperclip" (Id 585) +-- > labelsOnIssue' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" (Id 585) labelsOnIssue' :: Maybe Auth -> Name Owner -> Name Repo -> Id Issue -> IO (Either Error (Vector IssueLabel)) labelsOnIssue' auth user repo iid = executeRequestMaybe auth $ labelsOnIssueR user repo iid FetchAll @@ -155,7 +155,7 @@ labelsOnIssueR user repo iid = -- | Add labels to an issue. -- --- > addLabelsToIssue (User (user password)) "thoughtbot" "paperclip" (Id 585) ["Label1" "Label2"] +-- > addLabelsToIssue (BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" (Id 585) ["Label1" "Label2"] addLabelsToIssue :: Foldable f => Auth -> Name Owner @@ -181,7 +181,7 @@ addLabelsToIssueR user repo iid lbls = -- | Remove a label from an issue. -- --- > removeLabelFromIssue (User (user password)) "thoughtbot" "paperclip" (Id 585) "bug" +-- > removeLabelFromIssue (BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" (Id 585) "bug" removeLabelFromIssue :: Auth -> Name Owner -> Name Repo -> Id Issue -> Name IssueLabel -> IO (Either Error ()) removeLabelFromIssue auth user repo iid lbl = executeRequest auth $ removeLabelFromIssueR user repo iid lbl @@ -194,7 +194,7 @@ removeLabelFromIssueR user repo iid lbl = -- | Replace all labels on an issue. Sending an empty list will remove all labels from the issue. -- --- > replaceAllLabelsForIssue (User (user password)) "thoughtbot" "paperclip" (Id 585) ["Label1" "Label2"] +-- > replaceAllLabelsForIssue (BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" (Id 585) ["Label1" "Label2"] replaceAllLabelsForIssue :: Foldable f => Auth -> Name Owner @@ -222,7 +222,7 @@ replaceAllLabelsForIssueR user repo iid lbls = -- | Remove all labels from an issue. -- --- > removeAllLabelsFromIssue (User (user password)) "thoughtbot" "paperclip" (Id 585) +-- > removeAllLabelsFromIssue (BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" (Id 585) removeAllLabelsFromIssue :: Auth -> Name Owner -> Name Repo -> Id Issue -> IO (Either Error ()) removeAllLabelsFromIssue auth user repo iid = executeRequest auth $ removeAllLabelsFromIssueR user repo iid @@ -241,7 +241,7 @@ labelsOnMilestone = labelsOnMilestone' Nothing -- | All the labels on a repo's milestone given the milestone ID using authentication. -- --- > labelsOnMilestone' (Just (User (user password))) "thoughtbot" "paperclip" (Id 2) +-- > labelsOnMilestone' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" (Id 2) labelsOnMilestone' :: Maybe Auth -> Name Owner -> Name Repo -> Id Milestone -> IO (Either Error (Vector IssueLabel)) labelsOnMilestone' auth user repo mid = executeRequestMaybe auth $ labelsOnMilestoneR user repo mid FetchAll diff --git a/src/GitHub/Endpoints/Issues/Milestones.hs b/src/GitHub/Endpoints/Issues/Milestones.hs index 06039dd2..282de6c9 100644 --- a/src/GitHub/Endpoints/Issues/Milestones.hs +++ b/src/GitHub/Endpoints/Issues/Milestones.hs @@ -33,7 +33,7 @@ milestones = milestones' Nothing -- | All milestones in the repo, using authentication. -- --- > milestones' (User (user, passwordG) "thoughtbot" "paperclip" +-- > milestones' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" milestones' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Milestone)) milestones' auth user repo = executeRequestMaybe auth $ milestonesR user repo FetchAll diff --git a/src/GitHub/Endpoints/Organizations.hs b/src/GitHub/Endpoints/Organizations.hs index ada7052b..ee1f5557 100644 --- a/src/GitHub/Endpoints/Organizations.hs +++ b/src/GitHub/Endpoints/Organizations.hs @@ -22,7 +22,7 @@ import Prelude () -- | The public organizations for a user, given the user's login, with authorization -- --- > publicOrganizationsFor' (Just ("github-username", "github-password")) "mike-burns" +-- > publicOrganizationsFor' (Just $ BasicAuth "github-username" "github-password") "mike-burns" publicOrganizationsFor' :: Maybe Auth -> Name User -> IO (Either Error (Vector SimpleOrganization)) publicOrganizationsFor' auth org = executeRequestMaybe auth $ publicOrganizationsForR org FetchAll @@ -45,7 +45,7 @@ publicOrganizationsForR user = pagedQuery ["users", toPathPart user, "orgs"] [] -- | Details on a public organization. Takes the organization's login. -- --- > publicOrganization' (Just ("github-username", "github-password")) "thoughtbot" +-- > publicOrganization' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" publicOrganization' :: Maybe Auth -> Name Organization -> IO (Either Error Organization) publicOrganization' auth = executeRequestMaybe auth . publicOrganizationR diff --git a/src/GitHub/Endpoints/PullRequests.hs b/src/GitHub/Endpoints/PullRequests.hs index e141e589..88409839 100644 --- a/src/GitHub/Endpoints/PullRequests.hs +++ b/src/GitHub/Endpoints/PullRequests.hs @@ -106,7 +106,7 @@ pullRequestPatchR user repo prid = -- 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' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" 562 pullRequest' :: Maybe Auth -> Name Owner -> Name Repo -> IssueNumber -> IO (Either Error PullRequest) pullRequest' auth user repo prid = executeRequestMaybe auth $ pullRequestR user repo prid @@ -160,7 +160,7 @@ updatePullRequestR user repo prid epr = -- the number of the pull request. -- With authentification. -- --- > pullRequestCommits' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" 688 +-- > pullRequestCommits' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" 688 pullRequestCommits' :: Maybe Auth -> Name Owner -> Name Repo -> IssueNumber -> IO (Either Error (Vector Commit)) pullRequestCommits' auth user repo prid = executeRequestMaybe auth $ pullRequestCommitsR user repo prid FetchAll @@ -182,7 +182,7 @@ pullRequestCommitsR user repo prid = -- name, plus the number assigned to the pull request. -- With authentification. -- --- > pullRequestFiles' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" 688 +-- > pullRequestFiles' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" 688 pullRequestFiles' :: Maybe Auth -> Name Owner -> Name Repo -> IssueNumber -> IO (Either Error (Vector File)) pullRequestFiles' auth user repo prid = executeRequestMaybe auth $ pullRequestFilesR user repo prid FetchAll diff --git a/src/GitHub/Endpoints/PullRequests/Comments.hs b/src/GitHub/Endpoints/PullRequests/Comments.hs index d8d3d487..52103030 100644 --- a/src/GitHub/Endpoints/PullRequests/Comments.hs +++ b/src/GitHub/Endpoints/PullRequests/Comments.hs @@ -48,7 +48,7 @@ pullRequestCommentR user repo cid = -- | Create a new comment. -- --- > createPullComment (User (user, password)) user repo issue commit path position +-- > createPullComment (BasicAuth "github-username" "github-password") user repo issue commit path position -- > "some words" createPullComment :: Auth -> Name Owner -> Name Repo -> IssueNumber -> Text -> Text -> Int -> Text -> IO (Either Error Comment) diff --git a/src/GitHub/Endpoints/PullRequests/Reviews.hs b/src/GitHub/Endpoints/PullRequests/Reviews.hs index 50b433fd..2143dcd5 100644 --- a/src/GitHub/Endpoints/PullRequests/Reviews.hs +++ b/src/GitHub/Endpoints/PullRequests/Reviews.hs @@ -58,7 +58,7 @@ pullRequestReviews owner repo prid = -- | 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' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" (Id 101) pullRequestReviews' :: Maybe Auth -> Name Owner @@ -104,8 +104,8 @@ pullRequestReview 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' (Just $ BasicAuth "github-username" "github-password") +-- > "thoughtbot" "factory_girl" (Id 301819) (Id 332) pullRequestReview' :: Maybe Auth -> Name Owner @@ -153,7 +153,7 @@ pullRequestReviewCommentsIO 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) +-- > pullRequestReviewComments' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "factory_girl" (Id 301819) (Id 332) pullRequestReviewCommentsIO' :: Maybe Auth -> Name Owner diff --git a/src/GitHub/Endpoints/Repos.hs b/src/GitHub/Endpoints/Repos.hs index 18b883dd..0c1cd83f 100644 --- a/src/GitHub/Endpoints/Repos.hs +++ b/src/GitHub/Endpoints/Repos.hs @@ -88,7 +88,7 @@ userRepos = userRepos' Nothing -- | The repos for a user, by their login. -- With authentication. -- --- > userRepos' (Just (BasicAuth (user, password))) "mike-burns" All +-- > userRepos' (Just $ BasicAuth "github-username" "github-password") "mike-burns" All userRepos' :: Maybe Auth -> Name Owner @@ -114,7 +114,7 @@ organizationRepos org = organizationRepos' Nothing org RepoPublicityAll -- | The repos for an organization, by the organization name. -- With authentication. -- --- > organizationRepos (Just (BasicAuth (user, password))) "thoughtbot" All +-- > organizationRepos (Just $ BasicAuth "github-username" "github-password") "thoughtbot" All organizationRepos' :: Maybe Auth -> Name Organization @@ -144,7 +144,7 @@ repository = repository' Nothing -- | Details on a specific repo, given the owner and repo name. -- With authentication. -- --- > repository' (Just (BasicAuth (user, password))) "mike-burns" "github" +-- > repository' (Just $ BasicAuth "github-username" "github-password") "mike-burns" "github" repository' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error Repo) repository' auth user repo = executeRequestMaybe auth $ repositoryR user repo @@ -224,7 +224,7 @@ contributors = contributors' Nothing -- | The contributors to a repo, given the owner and repo name. -- With authentication. -- --- > contributors' (Just (BasicAuth (user, password))) "thoughtbot" "paperclip" +-- > contributors' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" contributors' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Contributor)) contributors' auth user repo = executeRequestMaybe auth $ contributorsR user repo False FetchAll @@ -256,7 +256,7 @@ contributorsWithAnonymous = contributorsWithAnonymous' Nothing -- and repo name. -- With authentication. -- --- > contributorsWithAnonymous' (Just (BasicAuth (user, password))) "thoughtbot" "paperclip" +-- > contributorsWithAnonymous' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" contributorsWithAnonymous' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Contributor)) contributorsWithAnonymous' auth user repo = executeRequestMaybe auth $ contributorsR user repo True FetchAll @@ -272,7 +272,7 @@ languagesFor = languagesFor' Nothing -- characters written in that language. Takes the repo owner and name. -- With authentication. -- --- > languagesFor' (Just (BasicAuth (user, password))) "mike-burns" "ohlaunch" +-- > languagesFor' (Just $ BasicAuth "github-username" "github-password") "mike-burns" "ohlaunch" languagesFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error Languages) languagesFor' auth user repo = executeRequestMaybe auth $ languagesForR user repo @@ -292,7 +292,7 @@ tagsFor = tagsFor' Nothing -- | The git tags on a repo, given the repo owner and name. -- With authentication. -- --- > tagsFor' (Just (BasicAuth (user, password))) "thoughtbot" "paperclip" +-- > tagsFor' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" tagsFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Tag)) tagsFor' auth user repo = executeRequestMaybe auth $ tagsForR user repo FetchAll @@ -312,7 +312,7 @@ branchesFor = branchesFor' Nothing -- | The git branches on a repo, given the repo owner and name. -- With authentication. -- --- > branchesFor' (Just (BasicAuth (user, password))) "thoughtbot" "paperclip" +-- > branchesFor' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" branchesFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Branch)) branchesFor' auth user repo = executeRequestMaybe auth $ branchesForR user repo FetchAll diff --git a/src/GitHub/Endpoints/Repos/Commits.hs b/src/GitHub/Endpoints/Repos/Commits.hs index ba86ed40..affa5044 100644 --- a/src/GitHub/Endpoints/Repos/Commits.hs +++ b/src/GitHub/Endpoints/Repos/Commits.hs @@ -48,7 +48,7 @@ commitsFor = commitsFor' Nothing -- | The commit history for a repo. -- With authentication. -- --- > commitsFor' (Just (BasicAuth (user, password))) "mike-burns" "github" +-- > commitsFor' (Just $ BasicAuth "github-username" "github-password") "mike-burns" "github" commitsFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Commit)) commitsFor' auth user repo = commitsWithOptionsFor' auth user repo [] @@ -65,7 +65,7 @@ commitsWithOptionsFor = commitsWithOptionsFor' Nothing -- query options. -- With authentication. -- --- > commitsWithOptionsFor' (Just (BasicAuth (user, password))) "mike-burns" "github" [CommitQueryAuthor "djeik"] +-- > commitsWithOptionsFor' (Just $ BasicAuth "github-username" "github-password") "mike-burns" "github" [CommitQueryAuthor "djeik"] commitsWithOptionsFor' :: Maybe Auth -> Name Owner -> Name Repo -> [CommitQueryOption] -> IO (Either Error (Vector Commit)) commitsWithOptionsFor' auth user repo opts = executeRequestMaybe auth $ commitsWithOptionsForR user repo FetchAll opts @@ -88,7 +88,7 @@ commit = commit' Nothing -- | Details on a specific SHA1 for a repo. -- With authentication. -- --- > commit (Just $ BasicAuth (username, password)) "mike-burns" "github" "9d1a9a361266c3c890b1108ad2fdf52f824b1b81" +-- > commit (Just $ BasicAuth "github-username" "github-password") "mike-burns" "github" "9d1a9a361266c3c890b1108ad2fdf52f824b1b81" commit' :: Maybe Auth -> Name Owner -> Name Repo -> Name Commit -> IO (Either Error Commit) commit' auth user repo sha = executeRequestMaybe auth $ commitR user repo sha diff --git a/src/GitHub/Endpoints/Repos/Contents.hs b/src/GitHub/Endpoints/Repos/Contents.hs index 39c9a408..b1e05ebe 100644 --- a/src/GitHub/Endpoints/Repos/Contents.hs +++ b/src/GitHub/Endpoints/Repos/Contents.hs @@ -50,7 +50,7 @@ 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' (Just $ BasicAuth "github-username" "github-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 @@ -75,7 +75,7 @@ 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' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" readmeFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error Content) readmeFor' auth user repo = executeRequestMaybe auth $ readmeForR user repo @@ -93,7 +93,7 @@ archiveFor = archiveFor' Nothing -- | The archive of a repo, given the repo owner, name, and archive type -- With Authentication -- --- > archiveFor' (Just (BasicAuth (user, password))) "thoughtbot" "paperclip" ArchiveFormatTarball Nothing +-- > archiveFor' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" ArchiveFormatTarball Nothing archiveFor' :: Maybe Auth -> Name Owner -> Name Repo -> ArchiveFormat -> Maybe Text -> IO (Either Error URI) archiveFor' auth user repo path ref = executeRequestMaybe auth $ archiveForR user repo path ref diff --git a/src/GitHub/Endpoints/Repos/Forks.hs b/src/GitHub/Endpoints/Repos/Forks.hs index b5cad183..5ca6ac14 100644 --- a/src/GitHub/Endpoints/Repos/Forks.hs +++ b/src/GitHub/Endpoints/Repos/Forks.hs @@ -26,7 +26,7 @@ forksFor = forksFor' Nothing -- | All the repos that are forked off the given repo. -- | With authentication -- --- > forksFor' (Just (User (user, password))) "thoughtbot" "paperclip" +-- > forksFor' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" forksFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Repo)) forksFor' auth user repo = executeRequestMaybe auth $ forksForR user repo FetchAll diff --git a/src/GitHub/Endpoints/Repos/Releases.hs b/src/GitHub/Endpoints/Repos/Releases.hs index 462060f4..9c0e4ed4 100644 --- a/src/GitHub/Endpoints/Repos/Releases.hs +++ b/src/GitHub/Endpoints/Repos/Releases.hs @@ -29,7 +29,7 @@ releases = releases' Nothing -- | All releases for the given repo with authentication. -- --- > releases' (Just (User (user, password))) "calleerlandsson" "pick" +-- > releases' (Just $ BasicAuth "github-username" "github-password") "calleerlandsson" "pick" releases' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Release)) releases' auth user repo = executeRequestMaybe auth $ releasesR user repo FetchAll @@ -48,7 +48,7 @@ release = release' Nothing -- | Query a single release with authentication. -- --- > release' (Just (User (user, password))) "calleerlandsson" "pick" +-- > release' (Just $ BasicAuth "github-username" "github-password") "calleerlandsson" "pick" release' :: Maybe Auth -> Name Owner -> Name Repo -> Id Release -> IO (Either Error Release) release' auth user repo reqReleaseId = executeRequestMaybe auth $ releaseR user repo reqReleaseId @@ -67,7 +67,7 @@ latestRelease = latestRelease' Nothing -- | Query latest release with authentication. -- --- > latestRelease' (Just (User (user, password))) "calleerlandsson" "pick" +-- > latestRelease' (Just $ BasicAuth "github-username" "github-password") "calleerlandsson" "pick" latestRelease' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error Release) latestRelease' auth user repo = executeRequestMaybe auth $ latestReleaseR user repo @@ -86,7 +86,7 @@ releaseByTagName = releaseByTagName' Nothing -- | Query release by tag name with authentication. -- --- > releaseByTagName' (Just (User (user, password))) "calleerlandsson" "pick" +-- > releaseByTagName' (Just $ BasicAuth "github-username" "github-password") "calleerlandsson" "pick" releaseByTagName' :: Maybe Auth -> Name Owner -> Name Repo -> Text -> IO (Either Error Release) releaseByTagName' auth user repo reqTagName = executeRequestMaybe auth $ releaseByTagNameR user repo reqTagName diff --git a/src/GitHub/Endpoints/Users.hs b/src/GitHub/Endpoints/Users.hs index f7dfdf07..b3f7621c 100644 --- a/src/GitHub/Endpoints/Users.hs +++ b/src/GitHub/Endpoints/Users.hs @@ -23,7 +23,7 @@ import Prelude () -- | The information for a single user, by login name. -- With authentification -- --- > userInfoFor' (Just ("github-username", "github-password")) "mike-burns" +-- > userInfoFor' (Just $ BasicAuth "github-username" "github-password") "mike-burns" userInfoFor' :: Maybe Auth -> Name User -> IO (Either Error User) userInfoFor' auth = executeRequestMaybe auth . userInfoForR diff --git a/src/GitHub/Internal/Prelude.hs b/src/GitHub/Internal/Prelude.hs index 70ba2395..0a227092 100644 --- a/src/GitHub/Internal/Prelude.hs +++ b/src/GitHub/Internal/Prelude.hs @@ -4,7 +4,7 @@ -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- --- This module may change between minor releases. Do not rely on it contents. +-- This module may change between minor releases. Do not rely on its contents. module GitHub.Internal.Prelude ( module Prelude.Compat, -- * Commonly used types diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index 424b3e11..a93f4351 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -208,7 +208,7 @@ instance FromJSON a => ParseResponse 'MtStar a where parseResponse _ res = Tagged (parseResponseJSON res) ------------------------------------------------------------------------------- --- Raw / Diff / Patch / Sha +-- Raw / Diff / Patch / Sha ------------------------------------------------------------------------------- instance Accept 'MtRaw where contentType = Tagged "application/vnd.github.v3.raw" From 82a223c0afb989622b92056746dd2312f866f972 Mon Sep 17 00:00:00 2001 From: Robbie McMichael <2044464+robbiemcmichael@users.noreply.github.com> Date: Wed, 24 Apr 2019 23:41:31 +1000 Subject: [PATCH 351/510] Add missing webhook event types --- src/GitHub/Data/Webhooks.hs | 84 +++++++++++++++++++++++++++++++++++-- 1 file changed, 81 insertions(+), 3 deletions(-) diff --git a/src/GitHub/Data/Webhooks.hs b/src/GitHub/Data/Webhooks.hs index 9e8d1c4b..6ddcb504 100644 --- a/src/GitHub/Data/Webhooks.hs +++ b/src/GitHub/Data/Webhooks.hs @@ -31,26 +31,52 @@ instance Binary RepoWebhook data RepoWebhookEvent = WebhookWildcardEvent + | WebhookCheckRunEvent + | WebhookCheckSuiteEvent | WebhookCommitCommentEvent + | WebhookContentReferenceEvent | WebhookCreateEvent | WebhookDeleteEvent + | WebhookDeployKeyEvent | WebhookDeploymentEvent | WebhookDeploymentStatusEvent + | WebhookDownloadEvent + | WebhookFollowEvent | WebhookForkEvent + | WebhookForkApplyEvent + | WebhookGitHubAppAuthorizationEvent + | WebhookGistEvent | WebhookGollumEvent | WebhookInstallationEvent | WebhookInstallationRepositoriesEvent | WebhookIssueCommentEvent | WebhookIssuesEvent + | WebhookLabelEvent + | WebhookMarketplacePurchaseEvent | WebhookMemberEvent + | WebhookMembershipEvent + | WebhookMetaEvent + | WebhookMilestoneEvent + | WebhookOrganizationEvent + | WebhookOrgBlockEvent | WebhookPageBuildEvent | WebhookPingEvent + | WebhookProjectCardEvent + | WebhookProjectColumnEvent + | WebhookProjectEvent | WebhookPublicEvent - | WebhookPullRequestReviewCommentEvent | WebhookPullRequestEvent + | WebhookPullRequestReviewEvent + | WebhookPullRequestReviewCommentEvent | WebhookPushEvent | WebhookReleaseEvent + | WebhookRepositoryEvent + | WebhookRepositoryImportEvent + | WebhookRepositoryVulnerabilityAlertEvent + | WebhookSecurityAdvisoryEvent + | WebhookStarEvent | WebhookStatusEvent + | WebhookTeamEvent | WebhookTeamAddEvent | WebhookWatchEvent deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -105,52 +131,104 @@ instance Binary EditRepoWebhook instance FromJSON RepoWebhookEvent where parseJSON (String "*") = pure WebhookWildcardEvent + parseJSON (String "check_run") = pure WebhookCheckRunEvent + parseJSON (String "check_suite") = pure WebhookCheckSuiteEvent parseJSON (String "commit_comment") = pure WebhookCommitCommentEvent + parseJSON (String "content_reference") = pure WebhookContentReferenceEvent parseJSON (String "create") = pure WebhookCreateEvent parseJSON (String "delete") = pure WebhookDeleteEvent + parseJSON (String "deploy_key") = pure WebhookDeployKeyEvent parseJSON (String "deployment") = pure WebhookDeploymentEvent parseJSON (String "deployment_status") = pure WebhookDeploymentStatusEvent + parseJSON (String "download") = pure WebhookDownloadEvent + parseJSON (String "follow") = pure WebhookFollowEvent parseJSON (String "fork") = pure WebhookForkEvent + parseJSON (String "fork_apply") = pure WebhookForkApplyEvent + parseJSON (String "github_app_authorization") = pure WebhookGitHubAppAuthorizationEvent + parseJSON (String "gist") = pure WebhookGistEvent parseJSON (String "gollum") = pure WebhookGollumEvent parseJSON (String "installation") = pure WebhookInstallationEvent parseJSON (String "installation_repositories") = pure WebhookInstallationRepositoriesEvent parseJSON (String "issue_comment") = pure WebhookIssueCommentEvent parseJSON (String "issues") = pure WebhookIssuesEvent + parseJSON (String "label") = pure WebhookLabelEvent + parseJSON (String "marketplace_purchase") = pure WebhookMarketplacePurchaseEvent parseJSON (String "member") = pure WebhookMemberEvent + parseJSON (String "membership") = pure WebhookMembershipEvent + parseJSON (String "meta") = pure WebhookMetaEvent + parseJSON (String "milestone") = pure WebhookMilestoneEvent + parseJSON (String "organization") = pure WebhookOrganizationEvent + parseJSON (String "org_block") = pure WebhookOrgBlockEvent parseJSON (String "page_build") = pure WebhookPageBuildEvent parseJSON (String "ping") = pure WebhookPingEvent + parseJSON (String "project_card") = pure WebhookProjectCardEvent + parseJSON (String "project_column") = pure WebhookProjectColumnEvent + parseJSON (String "project") = pure WebhookProjectEvent parseJSON (String "public") = pure WebhookPublicEvent - parseJSON (String "pull_request_review_comment") = pure WebhookPullRequestReviewCommentEvent parseJSON (String "pull_request") = pure WebhookPullRequestEvent + parseJSON (String "pull_request_review") = pure WebhookPullRequestReviewEvent + parseJSON (String "pull_request_review_comment") = pure WebhookPullRequestReviewCommentEvent parseJSON (String "push") = pure WebhookPushEvent parseJSON (String "release") = pure WebhookReleaseEvent + parseJSON (String "repository") = pure WebhookRepositoryEvent + parseJSON (String "repository_import") = pure WebhookRepositoryImportEvent + parseJSON (String "repository_vulnerability_alert") = pure WebhookRepositoryVulnerabilityAlertEvent + parseJSON (String "security_advisory") = pure WebhookSecurityAdvisoryEvent + parseJSON (String "star") = pure WebhookStarEvent parseJSON (String "status") = pure WebhookStatusEvent + parseJSON (String "team") = pure WebhookTeamEvent parseJSON (String "team_add") = pure WebhookTeamAddEvent parseJSON (String "watch") = pure WebhookWatchEvent parseJSON _ = fail "Could not build a Webhook event" instance ToJSON RepoWebhookEvent where toJSON WebhookWildcardEvent = String "*" + toJSON WebhookCheckRunEvent = String "check_run" + toJSON WebhookCheckSuiteEvent = String "check_suite" toJSON WebhookCommitCommentEvent = String "commit_comment" + toJSON WebhookContentReferenceEvent = String "content_reference" toJSON WebhookCreateEvent = String "create" toJSON WebhookDeleteEvent = String "delete" + toJSON WebhookDeployKeyEvent = String "deploy_key" toJSON WebhookDeploymentEvent = String "deployment" toJSON WebhookDeploymentStatusEvent = String "deployment_status" + toJSON WebhookDownloadEvent = String "download" + toJSON WebhookFollowEvent = String "follow" toJSON WebhookForkEvent = String "fork" + toJSON WebhookForkApplyEvent = String "fork_apply" + toJSON WebhookGitHubAppAuthorizationEvent = String "github_app_authorization" + toJSON WebhookGistEvent = String "gist" toJSON WebhookGollumEvent = String "gollum" toJSON WebhookInstallationEvent = String "installation" toJSON WebhookInstallationRepositoriesEvent = String "installation_repositories" toJSON WebhookIssueCommentEvent = String "issue_comment" toJSON WebhookIssuesEvent = String "issues" + toJSON WebhookLabelEvent = String "label" + toJSON WebhookMarketplacePurchaseEvent = String "marketplace_purchase" toJSON WebhookMemberEvent = String "member" + toJSON WebhookMembershipEvent = String "membership" + toJSON WebhookMetaEvent = String "meta" + toJSON WebhookMilestoneEvent = String "milestone" + toJSON WebhookOrganizationEvent = String "organization" + toJSON WebhookOrgBlockEvent = String "org_block" toJSON WebhookPageBuildEvent = String "page_build" toJSON WebhookPingEvent = String "ping" + toJSON WebhookProjectCardEvent = String "project_card" + toJSON WebhookProjectColumnEvent = String "project_column" + toJSON WebhookProjectEvent = String "project" toJSON WebhookPublicEvent = String "public" - toJSON WebhookPullRequestReviewCommentEvent = String "pull_request_review_comment" toJSON WebhookPullRequestEvent = String "pull_request" + toJSON WebhookPullRequestReviewEvent = String "pull_request_review" + toJSON WebhookPullRequestReviewCommentEvent = String "pull_request_review_comment" toJSON WebhookPushEvent = String "push" toJSON WebhookReleaseEvent = String "release" + toJSON WebhookRepositoryEvent = String "repository" + toJSON WebhookRepositoryImportEvent = String "repository_import" + toJSON WebhookRepositoryVulnerabilityAlertEvent = String "repository_vulnerability_alert" + toJSON WebhookSecurityAdvisoryEvent = String "security_advisory" + toJSON WebhookStarEvent = String "star" toJSON WebhookStatusEvent = String "status" + toJSON WebhookTeamEvent = String "team" toJSON WebhookTeamAddEvent = String "team_add" toJSON WebhookWatchEvent = String "watch" From 90848831f7baef332d9d67d8bfc96662a2586676 Mon Sep 17 00:00:00 2001 From: Robbie McMichael <2044464+robbiemcmichael@users.noreply.github.com> Date: Wed, 24 Apr 2019 23:43:08 +1000 Subject: [PATCH 352/510] Fix RepoWebhookEvent ToJSON instance indentation --- src/GitHub/Data/Webhooks.hs | 96 ++++++++++++++++++------------------- 1 file changed, 48 insertions(+), 48 deletions(-) diff --git a/src/GitHub/Data/Webhooks.hs b/src/GitHub/Data/Webhooks.hs index 6ddcb504..ce28e2d6 100644 --- a/src/GitHub/Data/Webhooks.hs +++ b/src/GitHub/Data/Webhooks.hs @@ -182,55 +182,55 @@ instance FromJSON RepoWebhookEvent where parseJSON _ = fail "Could not build a Webhook event" instance ToJSON RepoWebhookEvent where - toJSON WebhookWildcardEvent = String "*" - toJSON WebhookCheckRunEvent = String "check_run" - toJSON WebhookCheckSuiteEvent = String "check_suite" - toJSON WebhookCommitCommentEvent = String "commit_comment" - toJSON WebhookContentReferenceEvent = String "content_reference" - toJSON WebhookCreateEvent = String "create" - toJSON WebhookDeleteEvent = String "delete" - toJSON WebhookDeployKeyEvent = String "deploy_key" - toJSON WebhookDeploymentEvent = String "deployment" - toJSON WebhookDeploymentStatusEvent = String "deployment_status" - toJSON WebhookDownloadEvent = String "download" - toJSON WebhookFollowEvent = String "follow" - toJSON WebhookForkEvent = String "fork" - toJSON WebhookForkApplyEvent = String "fork_apply" - toJSON WebhookGitHubAppAuthorizationEvent = String "github_app_authorization" - toJSON WebhookGistEvent = String "gist" - toJSON WebhookGollumEvent = String "gollum" - toJSON WebhookInstallationEvent = String "installation" - toJSON WebhookInstallationRepositoriesEvent = String "installation_repositories" - toJSON WebhookIssueCommentEvent = String "issue_comment" - toJSON WebhookIssuesEvent = String "issues" - toJSON WebhookLabelEvent = String "label" - toJSON WebhookMarketplacePurchaseEvent = String "marketplace_purchase" - toJSON WebhookMemberEvent = String "member" - toJSON WebhookMembershipEvent = String "membership" - toJSON WebhookMetaEvent = String "meta" - toJSON WebhookMilestoneEvent = String "milestone" - toJSON WebhookOrganizationEvent = String "organization" - toJSON WebhookOrgBlockEvent = String "org_block" - toJSON WebhookPageBuildEvent = String "page_build" - toJSON WebhookPingEvent = String "ping" - toJSON WebhookProjectCardEvent = String "project_card" - toJSON WebhookProjectColumnEvent = String "project_column" - toJSON WebhookProjectEvent = String "project" - toJSON WebhookPublicEvent = String "public" - toJSON WebhookPullRequestEvent = String "pull_request" - toJSON WebhookPullRequestReviewEvent = String "pull_request_review" - toJSON WebhookPullRequestReviewCommentEvent = String "pull_request_review_comment" - toJSON WebhookPushEvent = String "push" - toJSON WebhookReleaseEvent = String "release" - toJSON WebhookRepositoryEvent = String "repository" - toJSON WebhookRepositoryImportEvent = String "repository_import" + toJSON WebhookWildcardEvent = String "*" + toJSON WebhookCheckRunEvent = String "check_run" + toJSON WebhookCheckSuiteEvent = String "check_suite" + toJSON WebhookCommitCommentEvent = String "commit_comment" + toJSON WebhookContentReferenceEvent = String "content_reference" + toJSON WebhookCreateEvent = String "create" + toJSON WebhookDeleteEvent = String "delete" + toJSON WebhookDeployKeyEvent = String "deploy_key" + toJSON WebhookDeploymentEvent = String "deployment" + toJSON WebhookDeploymentStatusEvent = String "deployment_status" + toJSON WebhookDownloadEvent = String "download" + toJSON WebhookFollowEvent = String "follow" + toJSON WebhookForkEvent = String "fork" + toJSON WebhookForkApplyEvent = String "fork_apply" + toJSON WebhookGitHubAppAuthorizationEvent = String "github_app_authorization" + toJSON WebhookGistEvent = String "gist" + toJSON WebhookGollumEvent = String "gollum" + toJSON WebhookInstallationEvent = String "installation" + toJSON WebhookInstallationRepositoriesEvent = String "installation_repositories" + toJSON WebhookIssueCommentEvent = String "issue_comment" + toJSON WebhookIssuesEvent = String "issues" + toJSON WebhookLabelEvent = String "label" + toJSON WebhookMarketplacePurchaseEvent = String "marketplace_purchase" + toJSON WebhookMemberEvent = String "member" + toJSON WebhookMembershipEvent = String "membership" + toJSON WebhookMetaEvent = String "meta" + toJSON WebhookMilestoneEvent = String "milestone" + toJSON WebhookOrganizationEvent = String "organization" + toJSON WebhookOrgBlockEvent = String "org_block" + toJSON WebhookPageBuildEvent = String "page_build" + toJSON WebhookPingEvent = String "ping" + toJSON WebhookProjectCardEvent = String "project_card" + toJSON WebhookProjectColumnEvent = String "project_column" + toJSON WebhookProjectEvent = String "project" + toJSON WebhookPublicEvent = String "public" + toJSON WebhookPullRequestEvent = String "pull_request" + toJSON WebhookPullRequestReviewEvent = String "pull_request_review" + toJSON WebhookPullRequestReviewCommentEvent = String "pull_request_review_comment" + toJSON WebhookPushEvent = String "push" + toJSON WebhookReleaseEvent = String "release" + toJSON WebhookRepositoryEvent = String "repository" + toJSON WebhookRepositoryImportEvent = String "repository_import" toJSON WebhookRepositoryVulnerabilityAlertEvent = String "repository_vulnerability_alert" - toJSON WebhookSecurityAdvisoryEvent = String "security_advisory" - toJSON WebhookStarEvent = String "star" - toJSON WebhookStatusEvent = String "status" - toJSON WebhookTeamEvent = String "team" - toJSON WebhookTeamAddEvent = String "team_add" - toJSON WebhookWatchEvent = String "watch" + toJSON WebhookSecurityAdvisoryEvent = String "security_advisory" + toJSON WebhookStarEvent = String "star" + toJSON WebhookStatusEvent = String "status" + toJSON WebhookTeamEvent = String "team" + toJSON WebhookTeamAddEvent = String "team_add" + toJSON WebhookWatchEvent = String "watch" instance FromJSON RepoWebhook where parseJSON = withObject "RepoWebhook" $ \o -> RepoWebhook From 9f367d18e12a457831190b287345e2eec4f9d7df Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9s=20Sicard-Ram=C3=ADrez?= Date: Sat, 11 May 2019 09:33:27 -0500 Subject: [PATCH 353/510] Tested with semigroups 0.19. --- github.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/github.cabal b/github.cabal index 225ac17e..4b098b9c 100644 --- a/github.cabal +++ b/github.cabal @@ -166,7 +166,7 @@ library , http-types >=0.12.1 && <0.13 , iso8601-time >=0.1.5 && <0.2 , network-uri >=2.6.1.0 && <2.7 - , semigroups >=0.18.5 && <0.19 + , semigroups >=0.18.5 && <0.20 , tagged , tls >=1.4.1 , transformers-compat >=0.6 && <0.7 From 8b0ddfd8af91f2ace894a30a6879273cc87fba64 Mon Sep 17 00:00:00 2001 From: Robbie McMichael <2044464+robbiemcmichael@users.noreply.github.com> Date: Thu, 16 May 2019 01:42:00 +1000 Subject: [PATCH 354/510] Type class for different auth methods --- src/GitHub/Auth.hs | 38 ++++++++++++++++++++++++++------- src/GitHub/Request.hs | 49 +++++++++++++++++++------------------------ 2 files changed, 52 insertions(+), 35 deletions(-) diff --git a/src/GitHub/Auth.hs b/src/GitHub/Auth.hs index c197fb4a..7918c0af 100644 --- a/src/GitHub/Auth.hs +++ b/src/GitHub/Auth.hs @@ -3,24 +3,48 @@ -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -module GitHub.Auth where +module GitHub.Auth ( + Auth (..), + AuthMethod, + endpoint, + setAuthRequest + ) where import GitHub.Internal.Prelude import Prelude () -import qualified Data.ByteString as BS +import qualified Data.ByteString as BS +import qualified Network.HTTP.Client as HTTP type Token = BS.ByteString -- | The Github auth data type data Auth - = BasicAuth BS.ByteString BS.ByteString - | OAuth Token -- ^ token - | EnterpriseOAuth Text -- custom API endpoint without - -- trailing slash - Token -- token + = BasicAuth BS.ByteString BS.ByteString -- ^ Username and password + | OAuth Token -- ^ OAuth token + | EnterpriseOAuth Text Token -- ^ Custom endpoint and OAuth token deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Auth where rnf = genericRnf instance Binary Auth instance Hashable Auth + +-- | A type class for different authentication methods +class AuthMethod a where + -- | Custom API endpoint without trailing slash + endpoint :: a -> Maybe Text + -- | A function which sets authorisation on an HTTP request + setAuthRequest :: a -> HTTP.Request -> HTTP.Request + +instance AuthMethod Auth where + endpoint (BasicAuth _ _) = Nothing + endpoint (OAuth _) = Nothing + endpoint (EnterpriseOAuth e _) = Just e + + setAuthRequest (BasicAuth u p) = HTTP.applyBasicAuth u p + setAuthRequest (OAuth t) = setAuthHeader $ "token " <> t + setAuthRequest (EnterpriseOAuth _ t) = setAuthHeader $ "token " <> t + +setAuthHeader :: BS.ByteString -> HTTP.Request -> HTTP.Request +setAuthHeader auth req = + req { HTTP.requestHeaders = ("Authorization", auth) : HTTP.requestHeaders req } diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index a93f4351..4eb28fc7 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -84,13 +84,17 @@ import qualified Data.Vector as V import qualified Network.HTTP.Client as HTTP import qualified Network.HTTP.Client.Internal as HTTP -import GitHub.Auth (Auth (..)) +import GitHub.Auth (Auth, AuthMethod, endpoint, setAuthRequest) import GitHub.Data (Error (..)) import GitHub.Data.PullRequests (MergeResult (..)) import GitHub.Data.Request -- | Execute 'Request' in 'IO' -executeRequest :: ParseResponse mt a => Auth -> GenRequest mt rw a -> IO (Either Error a) +executeRequest + :: (AuthMethod am, ParseResponse mt a) + => am + -> GenRequest mt rw a + -> IO (Either Error a) executeRequest auth req = do manager <- newManager tlsManagerSettings executeRequestWithMgr manager auth req @@ -101,9 +105,9 @@ lessFetchCount i (FetchAtLeast j) = i < fromIntegral j -- | Like 'executeRequest' but with provided 'Manager'. executeRequestWithMgr - :: ParseResponse mt a + :: (AuthMethod am, ParseResponse mt a) => Manager - -> Auth + -> am -> GenRequest mt rw a -> IO (Either Error a) executeRequestWithMgr mgr auth req = runExceptT $ do @@ -140,7 +144,7 @@ executeRequestWithMgr' -> GenRequest mt 'RO a -> IO (Either Error a) executeRequestWithMgr' mgr req = runExceptT $ do - httpReq <- makeHttpRequest Nothing req + httpReq <- makeHttpRequest (Nothing :: Maybe Auth) req performHttpReq httpReq req where httpLbs' :: HTTP.Request -> ExceptT Error IO (Response LBS.ByteString) @@ -158,7 +162,11 @@ executeRequestWithMgr' mgr req = runExceptT $ do -- | Helper for picking between 'executeRequest' and 'executeRequest''. -- -- The use is discouraged. -executeRequestMaybe :: ParseResponse mt a => Maybe Auth -> GenRequest mt 'RO a -> IO (Either Error a) +executeRequestMaybe + :: (AuthMethod am, ParseResponse mt a) + => Maybe am + -> GenRequest mt 'RO a + -> IO (Either Error a) executeRequestMaybe = maybe executeRequest' executeRequest -- | Partial function to drop authentication need. @@ -308,8 +316,8 @@ instance a ~ () => ParseResponse 'MtUnit a where -- status checking is modifying accordingly. -- makeHttpRequest - :: forall mt rw a m. (MonadThrow m, Accept mt) - => Maybe Auth + :: forall am mt rw a m. (AuthMethod am, MonadThrow m, Accept mt) + => Maybe am -> GenRequest mt rw a -> m HTTP.Request makeHttpRequest auth r = case r of @@ -318,7 +326,7 @@ makeHttpRequest auth r = case r of return $ setReqHeaders . unTagged (modifyRequest :: Tagged mt (HTTP.Request -> HTTP.Request)) - . setAuthRequest auth + . maybe id setAuthRequest auth . setQueryString qs $ req PagedQuery paths qs _ -> do @@ -326,7 +334,7 @@ makeHttpRequest auth r = case r of return $ setReqHeaders . unTagged (modifyRequest :: Tagged mt (HTTP.Request -> HTTP.Request)) - . setAuthRequest auth + . maybe id setAuthRequest auth . setQueryString qs $ req Command m paths body -> do @@ -334,7 +342,7 @@ makeHttpRequest auth r = case r of return $ setReqHeaders . unTagged (modifyRequest :: Tagged mt (HTTP.Request -> HTTP.Request)) - . setAuthRequest auth + . maybe id setAuthRequest auth . setBody body . setMethod (toMethod m) $ req @@ -343,12 +351,7 @@ makeHttpRequest auth r = case r of parseUrl' = HTTP.parseRequest . T.unpack url :: Paths -> Text - url paths = baseUrl <> "/" <> T.intercalate "/" paths - - baseUrl :: Text - baseUrl = case auth of - Just (EnterpriseOAuth endpoint _) -> endpoint - _ -> "https://api.github.com" + url paths = maybe "https://api.github.com" id (endpoint =<< auth) <> "/" <> T.intercalate "/" paths setReqHeaders :: HTTP.Request -> HTTP.Request setReqHeaders req = req { requestHeaders = reqHeaders <> requestHeaders req } @@ -357,22 +360,12 @@ makeHttpRequest auth r = case r of setMethod m req = req { method = m } reqHeaders :: RequestHeaders - reqHeaders = maybe [] getOAuthHeader auth - <> [("User-Agent", "github.hs/0.21")] -- Version + reqHeaders = [("User-Agent", "github.hs/0.21")] -- Version <> [("Accept", unTagged (contentType :: Tagged mt BS.ByteString))] setBody :: LBS.ByteString -> HTTP.Request -> HTTP.Request setBody body req = req { requestBody = RequestBodyLBS body } - setAuthRequest :: Maybe Auth -> HTTP.Request -> HTTP.Request - setAuthRequest (Just (BasicAuth user pass)) = applyBasicAuth user pass - setAuthRequest _ = id - - getOAuthHeader :: Auth -> RequestHeaders - getOAuthHeader (OAuth token) = [("Authorization", "token " <> token)] - getOAuthHeader (EnterpriseOAuth _ token) = [("Authorization", "token " <> token)] - getOAuthHeader _ = [] - -- | Query @Link@ header with @rel=next@ from the request headers. getNextUrl :: Response a -> Maybe URI getNextUrl req = do From 20f9f39cd7f620bdd01909d6e394a3aac4c5aaad Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Thu, 23 May 2019 17:33:08 +0300 Subject: [PATCH 355/510] Add Webhook events doc link --- src/GitHub/Data/Webhooks.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/GitHub/Data/Webhooks.hs b/src/GitHub/Data/Webhooks.hs index ce28e2d6..c2595fa8 100644 --- a/src/GitHub/Data/Webhooks.hs +++ b/src/GitHub/Data/Webhooks.hs @@ -29,6 +29,7 @@ data RepoWebhook = RepoWebhook instance NFData RepoWebhook where rnf = genericRnf instance Binary RepoWebhook +-- | See . data RepoWebhookEvent = WebhookWildcardEvent | WebhookCheckRunEvent From 3be11c12496f5b6a5941e8308ffd7bbcfa16de82 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Thu, 23 May 2019 21:44:42 +0300 Subject: [PATCH 356/510] Raise bounds --- github.cabal | 17 ++++++++++------- src/GitHub/Internal/Prelude.hs | 2 +- 2 files changed, 11 insertions(+), 8 deletions(-) diff --git a/github.cabal b/github.cabal index 4b098b9c..e20ee4f4 100644 --- a/github.cabal +++ b/github.cabal @@ -155,25 +155,28 @@ library aeson >=1.4.0.0 && <1.5 , base-compat >=0.10.4 && <0.11 , base16-bytestring >=0.1.1.6 && <0.2 - , binary-orphans >=0.1.8.0 && <0.2 + , binary-instances >=1 && <1.1 , cryptohash-sha1 >=0.11.100.1 && <0.12 , deepseq-generics >=0.2.0.0 && <0.3 - , exceptions >=0.10.0 && <0.11 - , hashable >=1.2.7.0 && <1.3 + , exceptions >=0.10.2 && <0.11 + , hashable >=1.2.7.0 && <1.4 , http-client >=0.5.12 && <0.7 , http-client-tls >=0.3.5.3 && <0.4 , http-link-header >=1.0.3.1 && <1.1 - , http-types >=0.12.1 && <0.13 + , http-types >=0.12.3 && <0.13 , iso8601-time >=0.1.5 && <0.2 , network-uri >=2.6.1.0 && <2.7 - , semigroups >=0.18.5 && <0.20 , tagged , tls >=1.4.1 - , transformers-compat >=0.6 && <0.7 - , unordered-containers >=0.2.9.0 && <0.3 + , transformers-compat >=0.6.5 && <0.7 + , unordered-containers >=0.2.10.0 && <0.3 , vector >=0.12.0.1 && <0.13 , vector-instances >=3.4 && <3.5 + if !impl(ghc >= 8.0) + build-depends: + semigroups >=0.18.5 && <0.20 + test-suite github-test default-language: Haskell2010 type: exitcode-stdio-1.0 diff --git a/src/GitHub/Internal/Prelude.hs b/src/GitHub/Internal/Prelude.hs index 0a227092..cf05c99a 100644 --- a/src/GitHub/Internal/Prelude.hs +++ b/src/GitHub/Internal/Prelude.hs @@ -42,7 +42,7 @@ import Data.Aeson withObject, withText, (.!=), (.:), (.:?), (.=)) import Data.Aeson.Types (typeMismatch) import Data.Binary (Binary) -import Data.Binary.Orphans () +import Data.Binary.Instances () import Data.Data (Data, Typeable) import Data.Foldable (toList) import Data.Hashable (Hashable (..)) From ca8e48c3bfb34bbaff5d8042bf36919d977a81cd Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Thu, 30 May 2019 14:04:28 +0300 Subject: [PATCH 357/510] Add allow-newers --- .travis.yml | 11 ++++++----- cabal.project | 6 ++++++ github.cabal | 2 +- 3 files changed, 13 insertions(+), 6 deletions(-) diff --git a/.travis.yml b/.travis.yml index 4e9eb83d..b5789f33 100644 --- a/.travis.yml +++ b/.travis.yml @@ -4,7 +4,7 @@ # # For more information, see https://github.com/haskell-CI/haskell-ci # -# version: 0.3.20190327 +# version: 0.3.20190521 # language: c dist: xenial @@ -29,8 +29,8 @@ before_cache: - rm -rfv $CABALHOME/packages/head.hackage matrix: include: - - compiler: ghc-8.6.3 - addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.6.3","cabal-install-2.4"]}} + - compiler: ghc-8.6.5 + addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.6.5","cabal-install-2.4"]}} - compiler: ghc-8.4.3 addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.4.3","cabal-install-2.4"]}} - compiler: ghc-8.2.2 @@ -86,6 +86,7 @@ install: echo "world-file: $CABALHOME/world" >> $CABALHOME/config echo "extra-prog-path: $CABALHOME/bin" >> $CABALHOME/config echo "symlink-bindir: $CABALHOME/bin" >> $CABALHOME/config + echo "installdir: $CABALHOME/bin" >> $CABALHOME/config echo "build-summary: $CABALHOME/logs/build.log" >> $CABALHOME/config echo "store-dir: $CABALHOME/store" >> $CABALHOME/config echo "install-dirs user" >> $CABALHOME/config @@ -102,7 +103,7 @@ install: echo 'packages: "."' >> cabal.project - | echo "write-ghc-environment-files: always" >> cabal.project - - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | grep -vE -- '^(github)$' | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" + - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(github)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" - cat cabal.project || true - cat cabal.project.local || true - if [ -f "./configure.ac" ]; then (cd "." && autoreconf -i); fi @@ -126,7 +127,7 @@ script: echo 'packages: "github-*/*.cabal"' >> cabal.project - | echo "write-ghc-environment-files: always" >> cabal.project - - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | grep -vE -- '^(github)$' | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" + - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(github)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" - cat cabal.project || true - cat cabal.project.local || true # Building... diff --git a/cabal.project b/cabal.project index cf67e0cf..2f1a8084 100644 --- a/cabal.project +++ b/cabal.project @@ -4,3 +4,9 @@ packages: optimization: False tests: True + +constraints: hashable ^>=1.3 +constraints: semigroups ^>=0.19 + +allow-newer: aeson-1.4.3.0:hashable +allow-newer: aeson-1.4.3.0:semigroups diff --git a/github.cabal b/github.cabal index e20ee4f4..9559e30b 100644 --- a/github.cabal +++ b/github.cabal @@ -30,7 +30,7 @@ copyright: Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016-2019 Oleg Grenrus tested-with: - GHC ==7.8.4 || ==7.10.3 || ==8.0.2 || ==8.2.2 || ==8.4.3 || ==8.6.4 + GHC ==7.8.4 || ==7.10.3 || ==8.0.2 || ==8.2.2 || ==8.4.3 || ==8.6.5 extra-source-files: README.md From 2f06754722577fe3498738d8fda6b6987dc364c6 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Thu, 30 May 2019 15:02:32 +0300 Subject: [PATCH 358/510] Add GHC-8.8 job --- .travis.yml | 17 +++++++++++++++++ github.cabal | 2 +- 2 files changed, 18 insertions(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index b5789f33..073d6a6d 100644 --- a/.travis.yml +++ b/.travis.yml @@ -29,6 +29,9 @@ before_cache: - rm -rfv $CABALHOME/packages/head.hackage matrix: include: + - compiler: ghc-8.8.1 + addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.8.1","cabal-install-3.0"]}} + env: GHCHEAD=true - compiler: ghc-8.6.5 addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.6.5","cabal-install-2.4"]}} - compiler: ghc-8.4.3 @@ -41,6 +44,8 @@ matrix: addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.10.3","cabal-install-2.4"]}} - compiler: ghc-7.8.4 addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.8.4","cabal-install-2.4"]}} + allow_failures: + - compiler: ghc-8.8.1 before_install: - HC=$(echo "/opt/$CC/bin/ghc" | sed 's/-/\//') - HCPKG="$HC-pkg" @@ -93,6 +98,18 @@ install: echo " prefix: $CABALHOME" >> $CABALHOME/config echo "repository hackage.haskell.org" >> $CABALHOME/config echo " url: http://hackage.haskell.org/" >> $CABALHOME/config + - | + if $GHCHEAD; then + echo "allow-newer: $($HCPKG list --simple-output | sed -E 's/([a-zA-Z-]+)-[0-9.]+/*:\1/g')" >> $CABALHOME/config + + echo "repository head.hackage" >> $CABALHOME/config + echo " url: http://head.hackage.haskell.org/" >> $CABALHOME/config + echo " secure: True" >> $CABALHOME/config + echo " root-keys: 07c59cb65787dedfaef5bd5f987ceb5f7e5ebf88b904bbd4c5cbdeb2ff71b740" >> $CABALHOME/config + echo " 2e8555dde16ebd8df076f1a8ef13b8f14c66bad8eafefd7d9e37d0ed711821fb" >> $CABALHOME/config + echo " 8f79fd2389ab2967354407ec852cbe73f2e8635793ac446d09461ffb99527f6e" >> $CABALHOME/config + echo " key-threshold: 3" >> $CABALHOME/config + fi - cat $CABALHOME/config - rm -fv cabal.project cabal.project.local cabal.project.freeze - travis_retry ${CABAL} v2-update -v diff --git a/github.cabal b/github.cabal index 9559e30b..7219c048 100644 --- a/github.cabal +++ b/github.cabal @@ -30,7 +30,7 @@ copyright: Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016-2019 Oleg Grenrus tested-with: - GHC ==7.8.4 || ==7.10.3 || ==8.0.2 || ==8.2.2 || ==8.4.3 || ==8.6.5 + GHC ==7.8.4 || ==7.10.3 || ==8.0.2 || ==8.2.2 || ==8.4.3 || ==8.6.5 || ==8.8.1 extra-source-files: README.md From d29358293c185d5a7fc3e51ab0ab9b03eda75612 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Thu, 30 May 2019 15:35:09 +0300 Subject: [PATCH 359/510] Add WebhookRegistryPackageEvent --- src/GitHub/Data/Webhooks.hs | 99 +++++++++++++++++++------------------ 1 file changed, 51 insertions(+), 48 deletions(-) diff --git a/src/GitHub/Data/Webhooks.hs b/src/GitHub/Data/Webhooks.hs index c2595fa8..cc778555 100644 --- a/src/GitHub/Data/Webhooks.hs +++ b/src/GitHub/Data/Webhooks.hs @@ -70,6 +70,7 @@ data RepoWebhookEvent | WebhookPullRequestReviewEvent | WebhookPullRequestReviewCommentEvent | WebhookPushEvent + | WebhookRegistryPackageEvent | WebhookReleaseEvent | WebhookRepositoryEvent | WebhookRepositoryImportEvent @@ -131,55 +132,56 @@ instance Binary EditRepoWebhook -- JSON instances instance FromJSON RepoWebhookEvent where - parseJSON (String "*") = pure WebhookWildcardEvent - parseJSON (String "check_run") = pure WebhookCheckRunEvent - parseJSON (String "check_suite") = pure WebhookCheckSuiteEvent - parseJSON (String "commit_comment") = pure WebhookCommitCommentEvent - parseJSON (String "content_reference") = pure WebhookContentReferenceEvent - parseJSON (String "create") = pure WebhookCreateEvent - parseJSON (String "delete") = pure WebhookDeleteEvent - parseJSON (String "deploy_key") = pure WebhookDeployKeyEvent - parseJSON (String "deployment") = pure WebhookDeploymentEvent - parseJSON (String "deployment_status") = pure WebhookDeploymentStatusEvent - parseJSON (String "download") = pure WebhookDownloadEvent - parseJSON (String "follow") = pure WebhookFollowEvent - parseJSON (String "fork") = pure WebhookForkEvent - parseJSON (String "fork_apply") = pure WebhookForkApplyEvent - parseJSON (String "github_app_authorization") = pure WebhookGitHubAppAuthorizationEvent - parseJSON (String "gist") = pure WebhookGistEvent - parseJSON (String "gollum") = pure WebhookGollumEvent - parseJSON (String "installation") = pure WebhookInstallationEvent - parseJSON (String "installation_repositories") = pure WebhookInstallationRepositoriesEvent - parseJSON (String "issue_comment") = pure WebhookIssueCommentEvent - parseJSON (String "issues") = pure WebhookIssuesEvent - parseJSON (String "label") = pure WebhookLabelEvent - parseJSON (String "marketplace_purchase") = pure WebhookMarketplacePurchaseEvent - parseJSON (String "member") = pure WebhookMemberEvent - parseJSON (String "membership") = pure WebhookMembershipEvent - parseJSON (String "meta") = pure WebhookMetaEvent - parseJSON (String "milestone") = pure WebhookMilestoneEvent - parseJSON (String "organization") = pure WebhookOrganizationEvent - parseJSON (String "org_block") = pure WebhookOrgBlockEvent - parseJSON (String "page_build") = pure WebhookPageBuildEvent - parseJSON (String "ping") = pure WebhookPingEvent - parseJSON (String "project_card") = pure WebhookProjectCardEvent - parseJSON (String "project_column") = pure WebhookProjectColumnEvent - parseJSON (String "project") = pure WebhookProjectEvent - parseJSON (String "public") = pure WebhookPublicEvent - parseJSON (String "pull_request") = pure WebhookPullRequestEvent - parseJSON (String "pull_request_review") = pure WebhookPullRequestReviewEvent - parseJSON (String "pull_request_review_comment") = pure WebhookPullRequestReviewCommentEvent - parseJSON (String "push") = pure WebhookPushEvent - parseJSON (String "release") = pure WebhookReleaseEvent - parseJSON (String "repository") = pure WebhookRepositoryEvent - parseJSON (String "repository_import") = pure WebhookRepositoryImportEvent + parseJSON (String "*") = pure WebhookWildcardEvent + parseJSON (String "check_run") = pure WebhookCheckRunEvent + parseJSON (String "check_suite") = pure WebhookCheckSuiteEvent + parseJSON (String "commit_comment") = pure WebhookCommitCommentEvent + parseJSON (String "content_reference") = pure WebhookContentReferenceEvent + parseJSON (String "create") = pure WebhookCreateEvent + parseJSON (String "delete") = pure WebhookDeleteEvent + parseJSON (String "deploy_key") = pure WebhookDeployKeyEvent + parseJSON (String "deployment") = pure WebhookDeploymentEvent + parseJSON (String "deployment_status") = pure WebhookDeploymentStatusEvent + parseJSON (String "download") = pure WebhookDownloadEvent + parseJSON (String "follow") = pure WebhookFollowEvent + parseJSON (String "fork") = pure WebhookForkEvent + parseJSON (String "fork_apply") = pure WebhookForkApplyEvent + parseJSON (String "github_app_authorization") = pure WebhookGitHubAppAuthorizationEvent + parseJSON (String "gist") = pure WebhookGistEvent + parseJSON (String "gollum") = pure WebhookGollumEvent + parseJSON (String "installation") = pure WebhookInstallationEvent + parseJSON (String "installation_repositories") = pure WebhookInstallationRepositoriesEvent + parseJSON (String "issue_comment") = pure WebhookIssueCommentEvent + parseJSON (String "issues") = pure WebhookIssuesEvent + parseJSON (String "label") = pure WebhookLabelEvent + parseJSON (String "marketplace_purchase") = pure WebhookMarketplacePurchaseEvent + parseJSON (String "member") = pure WebhookMemberEvent + parseJSON (String "membership") = pure WebhookMembershipEvent + parseJSON (String "meta") = pure WebhookMetaEvent + parseJSON (String "milestone") = pure WebhookMilestoneEvent + parseJSON (String "organization") = pure WebhookOrganizationEvent + parseJSON (String "org_block") = pure WebhookOrgBlockEvent + parseJSON (String "page_build") = pure WebhookPageBuildEvent + parseJSON (String "ping") = pure WebhookPingEvent + parseJSON (String "project_card") = pure WebhookProjectCardEvent + parseJSON (String "project_column") = pure WebhookProjectColumnEvent + parseJSON (String "project") = pure WebhookProjectEvent + parseJSON (String "public") = pure WebhookPublicEvent + parseJSON (String "pull_request") = pure WebhookPullRequestEvent + parseJSON (String "pull_request_review") = pure WebhookPullRequestReviewEvent + parseJSON (String "pull_request_review_comment") = pure WebhookPullRequestReviewCommentEvent + parseJSON (String "push") = pure WebhookPushEvent + parseJSON (String "registry_package") = pure WebhookRegistryPackageEvent + parseJSON (String "release") = pure WebhookReleaseEvent + parseJSON (String "repository") = pure WebhookRepositoryEvent + parseJSON (String "repository_import") = pure WebhookRepositoryImportEvent parseJSON (String "repository_vulnerability_alert") = pure WebhookRepositoryVulnerabilityAlertEvent - parseJSON (String "security_advisory") = pure WebhookSecurityAdvisoryEvent - parseJSON (String "star") = pure WebhookStarEvent - parseJSON (String "status") = pure WebhookStatusEvent - parseJSON (String "team") = pure WebhookTeamEvent - parseJSON (String "team_add") = pure WebhookTeamAddEvent - parseJSON (String "watch") = pure WebhookWatchEvent + parseJSON (String "security_advisory") = pure WebhookSecurityAdvisoryEvent + parseJSON (String "star") = pure WebhookStarEvent + parseJSON (String "status") = pure WebhookStatusEvent + parseJSON (String "team") = pure WebhookTeamEvent + parseJSON (String "team_add") = pure WebhookTeamAddEvent + parseJSON (String "watch") = pure WebhookWatchEvent parseJSON _ = fail "Could not build a Webhook event" instance ToJSON RepoWebhookEvent where @@ -222,6 +224,7 @@ instance ToJSON RepoWebhookEvent where toJSON WebhookPullRequestReviewEvent = String "pull_request_review" toJSON WebhookPullRequestReviewCommentEvent = String "pull_request_review_comment" toJSON WebhookPushEvent = String "push" + toJSON WebhookRegistryPackageEvent = String "registry_package" toJSON WebhookReleaseEvent = String "release" toJSON WebhookRepositoryEvent = String "repository" toJSON WebhookRepositoryImportEvent = String "repository_import" From 899180c1043c604ec4eef87ea31336fb3778ab2e Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Thu, 30 May 2019 16:04:58 +0300 Subject: [PATCH 360/510] Add MtPreview media type: extension point --- github.cabal | 2 + spec/GitHub/PullRequestsSpec.hs | 105 ++++++++++++++++++++++++-------- src/GitHub/Data/Request.hs | 25 ++++---- src/GitHub/Request.hs | 42 +++++++++++-- 4 files changed, 129 insertions(+), 45 deletions(-) diff --git a/github.cabal b/github.cabal index 7219c048..a65a317d 100644 --- a/github.cabal +++ b/github.cabal @@ -206,6 +206,8 @@ test-suite github-test , bytestring , file-embed , github + , tagged + , text , hspec >=2.6.1 && <2.8 , unordered-containers , vector diff --git a/spec/GitHub/PullRequestsSpec.hs b/spec/GitHub/PullRequestsSpec.hs index 0f08ab22..14cbee9a 100644 --- a/spec/GitHub/PullRequestsSpec.hs +++ b/spec/GitHub/PullRequestsSpec.hs @@ -1,21 +1,27 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} module GitHub.PullRequestsSpec where -import qualified GitHub +import qualified GitHub as GH import Prelude () import Prelude.Compat -import Data.Aeson (eitherDecodeStrict) -import Data.ByteString (ByteString) -import Data.Either.Compat (isRight) -import Data.FileEmbed (embedFile) -import Data.Foldable (for_) -import Data.String (fromString) -import qualified Data.Vector as V +import Data.Aeson + (FromJSON (..), eitherDecodeStrict, withObject, (.:)) +import Data.ByteString (ByteString) import qualified Data.ByteString.Lazy.Char8 as LBS8 -import System.Environment (lookupEnv) +import Data.Either.Compat (isRight) +import Data.FileEmbed (embedFile) +import Data.Foldable (for_) +import Data.String (fromString) +import Data.Tagged (Tagged (..)) +import Data.Text (Text) +import qualified Data.Vector as V +import System.Environment (lookupEnv) import Test.Hspec (Spec, describe, it, pendingWith, shouldBe, shouldSatisfy) @@ -23,68 +29,75 @@ fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a -withAuth :: (GitHub.Auth -> IO ()) -> IO () +withAuth :: (GH.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) + Just token -> action (GH.OAuth $ fromString token) spec :: Spec spec = do describe "pullRequestsForR" $ do it "works" $ withAuth $ \auth -> for_ repos $ \(owner, repo) -> do - cs <- GitHub.executeRequest auth $ - GitHub.pullRequestsForR owner repo opts GitHub.FetchAll + cs <- GH.executeRequest auth $ + GH.pullRequestsForR owner repo opts GH.FetchAll cs `shouldSatisfy` isRight describe "pullRequestPatchR" $ it "works" $ withAuth $ \auth -> do - Right patch <- GitHub.executeRequest auth $ - GitHub.pullRequestPatchR "phadej" "github" (GitHub.IssueNumber 349) + Right patch <- GH.executeRequest auth $ + GH.pullRequestPatchR "phadej" "github" (GH.IssueNumber 349) head (LBS8.lines patch) `shouldBe` "From c0e4ad33811be82e1f72ee76116345c681703103 Mon Sep 17 00:00:00 2001" describe "decoding pull request payloads" $ do it "decodes a pull request 'opened' payload" $ do - V.length (GitHub.simplePullRequestRequestedReviewers simplePullRequestOpened) + V.length (GH.simplePullRequestRequestedReviewers simplePullRequestOpened) `shouldBe` 0 - V.length (GitHub.pullRequestRequestedReviewers pullRequestOpened) + V.length (GH.pullRequestRequestedReviewers pullRequestOpened) `shouldBe` 0 it "decodes a pull request 'review_requested' payload" $ do - V.length (GitHub.simplePullRequestRequestedReviewers simplePullRequestReviewRequested) + V.length (GH.simplePullRequestRequestedReviewers simplePullRequestReviewRequested) `shouldBe` 1 - V.length (GitHub.pullRequestRequestedReviewers pullRequestReviewRequested) + V.length (GH.pullRequestRequestedReviewers pullRequestReviewRequested) `shouldBe` 1 describe "checking if a pull request is merged" $ do it "works" $ withAuth $ \auth -> do - b <- GitHub.executeRequest auth $ GitHub.isPullRequestMergedR "phadej" "github" (GitHub.IssueNumber 14) + b <- GH.executeRequest auth $ GH.isPullRequestMergedR "phadej" "github" (GH.IssueNumber 14) b `shouldSatisfy` isRight fromRightS b `shouldBe` True + describe "Draft Pull Request" $ do + it "works" $ withAuth $ \auth -> do + cs <- GH.executeRequest auth $ + draftPullRequestsForR "phadej" "github" opts GH.FetchAll + + cs `shouldSatisfy` isRight + where repos = [ ("thoughtbot", "paperclip") , ("phadej", "github") ] - opts = GitHub.stateClosed + opts = GH.stateClosed - simplePullRequestOpened :: GitHub.SimplePullRequest + simplePullRequestOpened :: GH.SimplePullRequest simplePullRequestOpened = fromRightS (eitherDecodeStrict prOpenedPayload) - pullRequestOpened :: GitHub.PullRequest + pullRequestOpened :: GH.PullRequest pullRequestOpened = fromRightS (eitherDecodeStrict prOpenedPayload) - simplePullRequestReviewRequested :: GitHub.SimplePullRequest + simplePullRequestReviewRequested :: GH.SimplePullRequest simplePullRequestReviewRequested = fromRightS (eitherDecodeStrict prReviewRequestedPayload) - pullRequestReviewRequested :: GitHub.PullRequest + pullRequestReviewRequested :: GH.PullRequest pullRequestReviewRequested = fromRightS (eitherDecodeStrict prReviewRequestedPayload) @@ -93,3 +106,41 @@ spec = do prReviewRequestedPayload :: ByteString prReviewRequestedPayload = $(embedFile "fixtures/pull-request-review-requested.json") + +------------------------------------------------------------------------------- +-- Draft Pull Requests +------------------------------------------------------------------------------- + +draftPullRequestsForR + :: GH.Name GH.Owner + -> GH.Name GH.Repo + -> GH.PullRequestMod + -> GH.FetchCount + -> GH.GenRequest ('GH.MtPreview ShadowCat) k (V.Vector DraftPR) +draftPullRequestsForR user repo opts = GH.PagedQuery + ["repos", GH.toPathPart user, GH.toPathPart repo, "pulls"] + (GH.prModToQueryString opts) + +data DraftPR = DraftPR + { dprId :: !(GH.Id GH.PullRequest) + , dprNumber :: !GH.IssueNumber + , dprTitle :: !Text + , dprDraft :: !Bool + } + deriving (Show) + +instance FromJSON DraftPR where + parseJSON = withObject "DraftPR" $ \obj -> DraftPR + <$> obj .: "id" + <*> obj .: "number" + <*> obj .: "title" + <*> obj .: "draft" + +-- | @application/vnd.github.shadow-cat-preview+json@ +data ShadowCat + +instance GH.PreviewAccept ShadowCat where + previewContentType = Tagged "application/vnd.github.shadow-cat-preview+json" + +instance FromJSON a => GH.PreviewParseResponse ShadowCat a where + previewParseResponse _ res = Tagged (GH.parseResponseJSON res) diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs index 8fe08907..30f3bfbb 100644 --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -105,17 +105,18 @@ instance NFData FetchCount where rnf = genericRnf -- MediaType ------------------------------------------------------------------------------- -data MediaType - = MtJSON -- ^ @application/vnd.github.v3+json@ - | MtRaw -- ^ @application/vnd.github.v3.raw@ - | MtDiff -- ^ @application/vnd.github.v3.diff@ - | MtPatch -- ^ @application/vnd.github.v3.patch@ - | MtSha -- ^ @application/vnd.github.v3.sha@ - | MtStar -- ^ @application/vnd.github.v3.star+json@ - | MtRedirect -- ^ - | MtStatus -- ^ Parse status - | MtUnit -- ^ Always succeeds - deriving (Eq, Ord, Read, Show, Enum, Bounded, Typeable, Data, Generic) +data MediaType a + = MtJSON -- ^ @application/vnd.github.v3+json@ + | MtRaw -- ^ @application/vnd.github.v3.raw@ + | MtDiff -- ^ @application/vnd.github.v3.diff@ + | MtPatch -- ^ @application/vnd.github.v3.patch@ + | MtSha -- ^ @application/vnd.github.v3.sha@ + | MtStar -- ^ @application/vnd.github.v3.star+json@ + | MtRedirect -- ^ + | MtStatus -- ^ Parse status + | MtUnit -- ^ Always succeeds + | MtPreview a -- ^ Some other (preview) type; this is an extension point. + deriving (Eq, Ord, Read, Show, Typeable, Data, Generic) ------------------------------------------------------------------------------ -- RW @@ -151,7 +152,7 @@ instance IReadOnly 'RA where iro = ROA -- * @a@ is the result type -- -- /Note:/ 'Request' is not 'Functor' on purpose. -data GenRequest (mt :: MediaType) (rw :: RW) a where +data GenRequest (mt :: MediaType *) (rw :: RW) a where Query :: Paths -> QueryString -> GenRequest mt rw a PagedQuery :: Paths -> QueryString -> FetchCount -> GenRequest mt rw (Vector a) diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index 4eb28fc7..10acad21 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -51,6 +51,10 @@ module GitHub.Request ( StatusMap, getNextUrl, performPagedRequest, + parseResponseJSON, + -- ** Preview + PreviewAccept (..), + PreviewParseResponse (..), ) where import GitHub.Internal.Prelude @@ -67,9 +71,9 @@ import Data.List (find) import Data.Tagged (Tagged (..)) import Network.HTTP.Client - (HttpException (..), Manager, RequestBody (..), Response (..), - applyBasicAuth, getUri, httpLbs, method, newManager, redirectCount, - requestBody, requestHeaders, setQueryString, setRequestIgnoreStatus) + (HttpException (..), Manager, RequestBody (..), Response (..), getUri, + httpLbs, method, newManager, redirectCount, requestBody, requestHeaders, + setQueryString, setRequestIgnoreStatus) import Network.HTTP.Client.TLS (tlsManagerSettings) import Network.HTTP.Link.Parser (parseLinkHeaderBS) import Network.HTTP.Link.Types (Link (..), LinkParam (..), href, linkParams) @@ -179,15 +183,18 @@ unsafeDropAuthRequirements r = -- Parse response ------------------------------------------------------------------------------- -class Accept (mt :: MediaType) where +class Accept (mt :: MediaType *) where contentType :: Tagged mt BS.ByteString contentType = Tagged "application/json" -- default is JSON modifyRequest :: Tagged mt (HTTP.Request -> HTTP.Request) modifyRequest = Tagged id -class Accept mt => ParseResponse (mt :: MediaType) a where - parseResponse :: MonadError Error m => HTTP.Request -> HTTP.Response LBS.ByteString -> Tagged mt (m a) +class Accept mt => ParseResponse (mt :: MediaType *) a where + parseResponse + :: MonadError Error m + => HTTP.Request -> HTTP.Response LBS.ByteString + -> Tagged mt (m a) ------------------------------------------------------------------------------- -- JSON (+ star) @@ -258,6 +265,29 @@ parseRedirect originalUri rsp = do where noLocation = throwError $ ParseError "no location header in response" +------------------------------------------------------------------------------- +-- Extension point +------------------------------------------------------------------------------- + +class PreviewAccept p where + previewContentType :: Tagged ('MtPreview p) BS.ByteString + + previewModifyRequest :: Tagged ('MtPreview p) (HTTP.Request -> HTTP.Request) + previewModifyRequest = Tagged id + +class PreviewAccept p => PreviewParseResponse p a where + previewParseResponse + :: MonadError Error m + => HTTP.Request -> HTTP.Response LBS.ByteString + -> Tagged ('MtPreview p) (m a) + +instance PreviewAccept p => Accept ('MtPreview p) where + contentType = previewContentType + modifyRequest = previewModifyRequest + +instance PreviewParseResponse p a => ParseResponse ('MtPreview p) a where + parseResponse = previewParseResponse + ------------------------------------------------------------------------------- -- Status ------------------------------------------------------------------------------- From ae57e5fa482a1bb687221ee67aa24db6b45bfef0 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Thu, 30 May 2019 17:56:35 +0300 Subject: [PATCH 361/510] Throw on non-200 responses --- src/GitHub/Request.hs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index 10acad21..d1860dba 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -331,7 +331,9 @@ parseStatus m (Status sci _) = -- Unit ------------------------------------------------------------------------------- -instance Accept 'MtUnit +instance Accept 'MtUnit where + modifyRequest = Tagged setRequestIgnoreStatus + instance a ~ () => ParseResponse 'MtUnit a where parseResponse _ _ = Tagged (return ()) @@ -378,7 +380,7 @@ makeHttpRequest auth r = case r of $ req where parseUrl' :: MonadThrow m => Text -> m HTTP.Request - parseUrl' = HTTP.parseRequest . T.unpack + parseUrl' = HTTP.parseUrlThrow . T.unpack url :: Paths -> Text url paths = maybe "https://api.github.com" id (endpoint =<< auth) <> "/" <> T.intercalate "/" paths From 7f4c8029a82ace5a3035ad0ff2c00b2990f72c63 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Thu, 30 May 2019 17:57:27 +0300 Subject: [PATCH 362/510] Add changelog entry for 0.22 --- CHANGELOG.md | 17 +++++++++++++++++ github.cabal | 2 +- 2 files changed, 18 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index abc96133..8ee2e8da 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,22 @@ ## Changes for next +## Changes for 0.22 + + [#370](https://github.com/phadej/github/pull/370) +- Type-class for various auth methods + [#365](https://github.com/phadej/github/pull/365) +- Throw on non-200 responses + [#350](https://github.com/phadej/github/pull/350) +- Add extension point for (preview) media types +- Add missing webhook event types + [#359](https://github.com/phadej/github/pull/359) +- Update dependencies + [#364](https://github.com/phadej/github/pull/364) + [#368](https://github.com/phadej/github/pull/368) + [#369](https://github.com/phadej/github/pull/369) +- Documentation improvements + [#357](https://github.com/phadej/github/pull/357) + ## Changes for 0.21 - Refactor `Request` type. diff --git a/github.cabal b/github.cabal index a65a317d..8b9d422f 100644 --- a/github.cabal +++ b/github.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: github -version: 0.21 +version: 0.22 synopsis: Access to the GitHub API, v3. category: Network description: From 6d7b17628a04aacb9c9b69949d1661e83af74fbe Mon Sep 17 00:00:00 2001 From: Ivan Malison Date: Fri, 27 Apr 2018 02:37:13 -0700 Subject: [PATCH 363/510] Add notifications endpoint Fixes #323 --- github.cabal | 1 + src/GitHub/Data/Activities.hs | 84 ++++++++++++++++++- .../Endpoints/Activity/Notifications.hs | 39 +++++++++ src/GitHub/Internal/Prelude.hs | 3 +- 4 files changed, 125 insertions(+), 2 deletions(-) create mode 100644 src/GitHub/Endpoints/Activity/Notifications.hs diff --git a/github.cabal b/github.cabal index 8b9d422f..7b6724f1 100644 --- a/github.cabal +++ b/github.cabal @@ -101,6 +101,7 @@ library GitHub.Data.Webhooks.Validate GitHub.Endpoints.Activity.Events GitHub.Endpoints.Activity.Starring + GitHub.Endpoints.Activity.Notifications GitHub.Endpoints.Activity.Watching GitHub.Endpoints.Gists GitHub.Endpoints.Gists.Comments diff --git a/src/GitHub/Data/Activities.hs b/src/GitHub/Data/Activities.hs index 67896cb9..92c82b69 100644 --- a/src/GitHub/Data/Activities.hs +++ b/src/GitHub/Data/Activities.hs @@ -5,8 +5,11 @@ -- module GitHub.Data.Activities where -import GitHub.Data.Repos (Repo) +import GitHub.Data.Id (Id, mkId) +import GitHub.Data.Repos (Repo, RepoRef) +import GitHub.Data.URL (URL) import GitHub.Internal.Prelude + import Prelude () data RepoStarred = RepoStarred @@ -24,3 +27,82 @@ instance FromJSON RepoStarred where <$> o .: "starred_at" <*> o .: "repo" +data Subject = Subject + { subjectTitle :: !Text + , subjectURL :: !URL + , subjectLatestCommentURL :: !(Maybe URL) + -- https://developer.github.com/v3/activity/notifications/ doesn't indicate + -- what the possible values for this field are. + -- TODO: Make an ADT for this. + , subjectType :: !Text + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Subject where rnf = genericRnf +instance Binary Subject + +instance FromJSON Subject where + parseJSON = withObject "Subject" $ \o -> Subject + <$> o .: "title" + <*> o .: "url" + <*> o .:? "latest_comment_url" + <*> o .: "type" + +data NotificationReason + = AssignReason + | AuthorReason + | CommentReason + | InvitationReason + | ManualReason + | MentionReason + | ReviewRequestedReason + | StateChangeReason + | SubscribedReason + | TeamMentionReason + deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic) + +instance NFData NotificationReason where rnf = genericRnf +instance Binary NotificationReason + +instance FromJSON NotificationReason where + parseJSON = withText "NotificationReason" $ \t -> case t of + "assign" -> pure AssignReason + "author" -> pure AuthorReason + "comment" -> pure CommentReason + "invitation" -> pure InvitationReason + "manual" -> pure ManualReason + "mention" -> pure MentionReason + "review_requested" -> pure ReviewRequestedReason + "state_change" -> pure StateChangeReason + "subscribed" -> pure SubscribedReason + "team_mention" -> pure TeamMentionReason + _ -> fail $ "Unknown NotificationReason " ++ show t + +data Notification = Notification + -- XXX: The notification id field type IS in fact string. Not sure why gh + -- chose to do this when all the other ids are Numbers... + { notificationId :: !(Id Notification) + , notificationRepo :: !RepoRef + , notificationSubject :: !Subject + , notificationReason :: !NotificationReason + , notificationUnread :: !Bool + , notificationUpdatedAt :: !(Maybe UTCTime) + , notificationLastReadAt :: !(Maybe UTCTime) + , notificationUrl :: !URL + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Notification where rnf = genericRnf +instance Binary Notification + +instance FromJSON Notification where + parseJSON = withObject "Notification" $ \o -> Notification + <$> (mkId undefined . read <$> o .: "id") + <*> o .: "repository" + <*> o .: "subject" + <*> o .: "reason" + <*> o .: "unread" + <*> o .: "updated_at" + <*> o .: "last_read_at" + <*> o .: "url" + diff --git a/src/GitHub/Endpoints/Activity/Notifications.hs b/src/GitHub/Endpoints/Activity/Notifications.hs new file mode 100644 index 00000000..76792735 --- /dev/null +++ b/src/GitHub/Endpoints/Activity/Notifications.hs @@ -0,0 +1,39 @@ +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +-- The repo watching API as described on +-- . + +module GitHub.Endpoints.Activity.Notifications where + +import GitHub.Data +import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () + +getNotifications :: Auth -> IO (Either Error (Vector Notification)) +getNotifications auth = + executeRequest auth $ getNotificationsR FetchAll + +getNotificationsR :: FetchCount -> Request 'RA (Vector Notification) +getNotificationsR = + pagedQuery ["notifications"] [] + +markNotificationAsRead :: Auth -> Id Notification -> IO (Either Error ()) +markNotificationAsRead auth notificationId = + executeRequest auth $ markNotificationAsReadR notificationId + +markNotificationAsReadR :: Id Notification -> Request 'RW () +markNotificationAsReadR notificationId = SimpleQuery $ + Command Patch ["notifications", "threads", toPathPart notificationId] + (encode ()) + +markNotificationsAsRead :: Auth -> IO (Either Error ()) +markNotificationsAsRead auth = + executeRequest auth markAllNotificationsAsReadR + +markAllNotificationsAsReadR :: Request 'RW () +markAllNotificationsAsReadR = SimpleQuery $ + Command Put ["notifications"] $ encode emptyObject diff --git a/src/GitHub/Internal/Prelude.hs b/src/GitHub/Internal/Prelude.hs index cf05c99a..07a748b3 100644 --- a/src/GitHub/Internal/Prelude.hs +++ b/src/GitHub/Internal/Prelude.hs @@ -22,6 +22,7 @@ module GitHub.Internal.Prelude ( Semigroup(..), -- * Aeson FromJSON(..), ToJSON(..), Value(..), Object, + emptyObject, encode, withText, withObject, (.:), (.:?), (.!=), (.=), object, typeMismatch, -- * Control.Applicative @@ -40,7 +41,7 @@ import Control.DeepSeq.Generics (genericRnf) import Data.Aeson (FromJSON (..), Object, ToJSON (..), Value (..), encode, object, withObject, withText, (.!=), (.:), (.:?), (.=)) -import Data.Aeson.Types (typeMismatch) +import Data.Aeson.Types (emptyObject, typeMismatch) import Data.Binary (Binary) import Data.Binary.Instances () import Data.Data (Data, Typeable) From 7020f6b28a7b043a3108831d944ab303c383fa37 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Thu, 30 May 2019 18:11:14 +0300 Subject: [PATCH 364/510] Cleanup Notifications functionality --- CHANGELOG.md | 2 ++ src/GitHub.hs | 10 ++++++- .../Endpoints/Activity/Notifications.hs | 30 +++++++++++-------- 3 files changed, 29 insertions(+), 13 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 8ee2e8da..6b6554da 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -10,6 +10,8 @@ - Add extension point for (preview) media types - Add missing webhook event types [#359](https://github.com/phadej/github/pull/359) +- Add notifications endpoints + [#324](https://github.com/phadej/github/pull/324) - Update dependencies [#364](https://github.com/phadej/github/pull/364) [#368](https://github.com/phadej/github/pull/368) diff --git a/src/GitHub.hs b/src/GitHub.hs index 078a62f7..fb342a9c 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -16,9 +16,16 @@ module GitHub ( -- | See -- ** Events - -- | See https://developer.github.com/v3/activity/events/#events + -- | See repositoryEventsR, userEventsR, + + -- ** Notifications + -- | See + getNotificationsR, + markNotificationAsReadR, + markAllNotificationsAsReadR, + -- ** Starring -- | See -- @@ -374,6 +381,7 @@ module GitHub ( import GitHub.Data import GitHub.Endpoints.Activity.Events +import GitHub.Endpoints.Activity.Notifications import GitHub.Endpoints.Activity.Starring import GitHub.Endpoints.Activity.Watching import GitHub.Endpoints.Gists diff --git a/src/GitHub/Endpoints/Activity/Notifications.hs b/src/GitHub/Endpoints/Activity/Notifications.hs index 76792735..1561390c 100644 --- a/src/GitHub/Endpoints/Activity/Notifications.hs +++ b/src/GitHub/Endpoints/Activity/Notifications.hs @@ -15,25 +15,31 @@ import Prelude () getNotifications :: Auth -> IO (Either Error (Vector Notification)) getNotifications auth = - executeRequest auth $ getNotificationsR FetchAll + executeRequest auth $ getNotificationsR FetchAll +-- | List your notifications. +-- See getNotificationsR :: FetchCount -> Request 'RA (Vector Notification) -getNotificationsR = - pagedQuery ["notifications"] [] +getNotificationsR = pagedQuery ["notifications"] [] markNotificationAsRead :: Auth -> Id Notification -> IO (Either Error ()) -markNotificationAsRead auth notificationId = - executeRequest auth $ markNotificationAsReadR notificationId +markNotificationAsRead auth nid = + executeRequest auth $ markNotificationAsReadR nid -markNotificationAsReadR :: Id Notification -> Request 'RW () -markNotificationAsReadR notificationId = SimpleQuery $ - Command Patch ["notifications", "threads", toPathPart notificationId] - (encode ()) +-- | Mark a thread as read. +-- See +markNotificationAsReadR :: Id Notification -> GenRequest 'MtUnit 'RW () +markNotificationAsReadR nid = Command + Patch + ["notifications", "threads", toPathPart nid] + (encode ()) markNotificationsAsRead :: Auth -> IO (Either Error ()) markNotificationsAsRead auth = executeRequest auth markAllNotificationsAsReadR -markAllNotificationsAsReadR :: Request 'RW () -markAllNotificationsAsReadR = SimpleQuery $ - Command Put ["notifications"] $ encode emptyObject +-- | Mark as read. +-- See +markAllNotificationsAsReadR :: GenRequest 'MtUnit 'RW () +markAllNotificationsAsReadR = + Command Put ["notifications"] $ encode emptyObject From be9464fd86c68211aead6064f8072a0a36e3ecc0 Mon Sep 17 00:00:00 2001 From: Robbie McMichael <2044464+robbiemcmichael@users.noreply.github.com> Date: Fri, 31 May 2019 01:58:55 +1000 Subject: [PATCH 365/510] Case insensitive enum parsing --- src/GitHub/Data/Content.hs | 15 ++--- src/GitHub/Data/Definitions.hs | 9 ++- src/GitHub/Data/Deployments.hs | 10 +-- src/GitHub/Data/Email.hs | 9 ++- src/GitHub/Data/Invitation.hs | 6 +- src/GitHub/Data/Issues.hs | 6 +- src/GitHub/Data/Options.hs | 22 ++++--- src/GitHub/Data/PullRequests.hs | 26 ++++---- src/GitHub/Data/Reviews.hs | 17 +++--- src/GitHub/Data/Statuses.hs | 12 ++-- src/GitHub/Data/Teams.hs | 40 ++++++------ src/GitHub/Data/Webhooks.hs | 104 ++++++++++++++++---------------- 12 files changed, 147 insertions(+), 129 deletions(-) diff --git a/src/GitHub/Data/Content.hs b/src/GitHub/Data/Content.hs index 81b44177..5461ffa0 100644 --- a/src/GitHub/Data/Content.hs +++ b/src/GitHub/Data/Content.hs @@ -6,13 +6,15 @@ -- 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 () +import Data.Aeson.Types (Pair) +import Data.Maybe (maybe) +import qualified Data.Text as T + data Content = ContentFile !ContentFileData | ContentDirectory !(Vector ContentItem) @@ -142,11 +144,10 @@ instance FromJSON ContentItem where <*> parseJSON (Object o) instance FromJSON ContentItemType where - parseJSON = withText "ContentItemType" $ \t -> - case t of - "file" -> return ItemFile - "dir" -> return ItemDir - _ -> fail $ "Invalid ContentItemType: " ++ unpack t + parseJSON = withText "ContentItemType" $ \t -> case T.toLower t of + "file" -> pure ItemFile + "dir" -> pure ItemDir + _ -> fail $ "Unknown ContentItemType: " <> T.unpack t instance FromJSON ContentInfo where parseJSON = withObject "ContentInfo" $ \o -> diff --git a/src/GitHub/Data/Definitions.hs b/src/GitHub/Data/Definitions.hs index f440c48c..de7f4e54 100644 --- a/src/GitHub/Data/Definitions.hs +++ b/src/GitHub/Data/Definitions.hs @@ -134,11 +134,10 @@ fromOwner (Owner owner) = owner -- JSON instances instance FromJSON OwnerType where - parseJSON = withText "Owner type" $ \t -> - case t of - "User" -> pure $ OwnerUser - "Organization" -> pure $ OwnerOrganization - _ -> fail $ "Unknown owner type: " ++ T.unpack t + parseJSON = withText "OwnerType" $ \t -> case T.toLower t of + "user" -> pure $ OwnerUser + "organization" -> pure $ OwnerOrganization + _ -> fail $ "Unknown OwnerType: " <> T.unpack t instance FromJSON SimpleUser where parseJSON = withObject "SimpleUser" $ \obj -> do diff --git a/src/GitHub/Data/Deployments.hs b/src/GitHub/Data/Deployments.hs index 8234d998..606d4077 100644 --- a/src/GitHub/Data/Deployments.hs +++ b/src/GitHub/Data/Deployments.hs @@ -27,8 +27,8 @@ import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import qualified Data.Aeson as JSON -import qualified Data.Text as Text -import qualified Data.Text.Encoding as Text +import qualified Data.Text as T +import qualified Data.Text.Encoding as T data DeploymentQueryOption = DeploymentQuerySha !Text @@ -42,7 +42,7 @@ instance Binary DeploymentQueryOption renderDeploymentQueryOption :: DeploymentQueryOption -> (ByteString, ByteString) renderDeploymentQueryOption = - second Text.encodeUtf8 . \case + second T.encodeUtf8 . \case DeploymentQuerySha sha -> ("sha", sha) DeploymentQueryRef ref -> ("ref", ref) DeploymentQueryTask task -> ("task", task) @@ -172,13 +172,13 @@ instance ToJSON DeploymentStatusState where DeploymentStatusInactive -> "inactive" instance FromJSON DeploymentStatusState where - parseJSON = withText "GitHub DeploymentStatusState" $ \case + parseJSON = withText "DeploymentStatusState" $ \t -> case T.toLower t of "error" -> pure DeploymentStatusError "failure" -> pure DeploymentStatusFailure "pending" -> pure DeploymentStatusPending "success" -> pure DeploymentStatusSuccess "inactive" -> pure DeploymentStatusInactive - x -> fail $ "Unknown deployment status: " ++ Text.unpack x + _ -> fail $ "Unknown DeploymentStatusState: " <> T.unpack t data CreateDeploymentStatus = CreateDeploymentStatus { createDeploymentStatusState :: !DeploymentStatusState diff --git a/src/GitHub/Data/Email.hs b/src/GitHub/Data/Email.hs index 23f738c6..d27237e5 100644 --- a/src/GitHub/Data/Email.hs +++ b/src/GitHub/Data/Email.hs @@ -8,6 +8,8 @@ module GitHub.Data.Email where import GitHub.Internal.Prelude import Prelude () +import qualified Data.Text as T + data EmailVisibility = EmailVisibilityPrivate | EmailVisibilityPublic @@ -17,9 +19,10 @@ instance NFData EmailVisibility where rnf = genericRnf instance Binary EmailVisibility instance FromJSON EmailVisibility where - parseJSON (String "private") = pure EmailVisibilityPrivate - parseJSON (String "public") = pure EmailVisibilityPublic - parseJSON _ = fail "Could not build an EmailVisibility" + parseJSON = withText "EmailVisibility" $ \t -> case T.toLower t of + "private" -> pure EmailVisibilityPrivate + "public" -> pure EmailVisibilityPublic + _ -> fail $ "Unknown EmailVisibility: " <> T.unpack t data Email = Email { emailAddress :: !Text diff --git a/src/GitHub/Data/Invitation.hs b/src/GitHub/Data/Invitation.hs index b4126ccc..07d4a99f 100644 --- a/src/GitHub/Data/Invitation.hs +++ b/src/GitHub/Data/Invitation.hs @@ -11,6 +11,8 @@ import GitHub.Data.Name (Name) import GitHub.Internal.Prelude import Prelude () +import qualified Data.Text as T + data Invitation = Invitation { invitationId :: !(Id Invitation) -- TODO: technically either one should be, maybe both. use `these` ? @@ -48,10 +50,10 @@ instance NFData InvitationRole where rnf = genericRnf instance Binary InvitationRole instance FromJSON InvitationRole where - parseJSON = withText "InvirationRole" $ \t -> case t of + parseJSON = withText "InvitationRole" $ \t -> case T.toLower t of "direct_member" -> pure InvitationRoleDirectMember "admin" -> pure InvitationRoleAdmin "billing_manager" -> pure InvitationRoleBillingManager "hiring_manager" -> pure InvitationRoleHiringManager "reinstate" -> pure InvitationRoleReinstate - _ -> fail $ "Invalid role " ++ show t + _ -> fail $ "Unknown InvitationRole: " <> T.unpack t diff --git a/src/GitHub/Data/Issues.hs b/src/GitHub/Data/Issues.hs index 1775aeec..6e98da8f 100644 --- a/src/GitHub/Data/Issues.hs +++ b/src/GitHub/Data/Issues.hs @@ -15,6 +15,8 @@ import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () +import qualified Data.Text as T + data Issue = Issue { issueClosedAt :: !(Maybe UTCTime) , issueUpdatedAt :: !UTCTime @@ -141,7 +143,7 @@ instance FromJSON IssueEvent where <*> o .:? "label" instance FromJSON EventType where - parseJSON = withText "EventType" $ \t -> case t of + parseJSON = withText "EventType" $ \t -> case T.toLower t of "closed" -> pure Closed "reopened" -> pure Reopened "subscribed" -> pure Subscribed @@ -169,7 +171,7 @@ instance FromJSON EventType where "removed_from_project" -> pure RemovedFromProject "converted_note_to_issue" -> pure ConvertedNoteToIssue "unsubscribed" -> pure Unsubscribed -- not in api docs list - _ -> fail $ "Unknown EventType " ++ show t + _ -> fail $ "Unknown EventType: " <> T.unpack t instance FromJSON IssueComment where parseJSON = withObject "IssueComment" $ \o -> IssueComment diff --git a/src/GitHub/Data/Options.hs b/src/GitHub/Data/Options.hs index 84105277..9ef2be6a 100644 --- a/src/GitHub/Data/Options.hs +++ b/src/GitHub/Data/Options.hs @@ -82,9 +82,10 @@ instance ToJSON IssueState where toJSON StateClosed = String "closed" instance FromJSON IssueState where - parseJSON (String "open") = pure StateOpen - parseJSON (String "closed") = pure StateClosed - parseJSON v = typeMismatch "IssueState" v + parseJSON = withText "IssueState" $ \t -> case T.toLower t of + "open" -> pure StateOpen + "closed" -> pure StateClosed + _ -> fail $ "Unknown IssueState: " <> T.unpack t instance NFData IssueState where rnf = genericRnf instance Binary IssueState @@ -109,13 +110,14 @@ instance ToJSON MergeableState where toJSON StateBehind = String "behind" instance FromJSON MergeableState where - parseJSON (String "unknown") = pure StateUnknown - parseJSON (String "clean") = pure StateClean - parseJSON (String "dirty") = pure StateDirty - parseJSON (String "unstable") = pure StateUnstable - parseJSON (String "blocked") = pure StateBlocked - parseJSON (String "behind") = pure StateBehind - parseJSON v = typeMismatch "MergeableState" v + parseJSON = withText "MergeableState" $ \t -> case T.toLower t of + "unknown" -> pure StateUnknown + "clean" -> pure StateClean + "dirty" -> pure StateDirty + "unstable" -> pure StateUnstable + "blocked" -> pure StateBlocked + "behind" -> pure StateBehind + _ -> fail $ "Unknown MergeableState: " <> T.unpack t instance NFData MergeableState where rnf = genericRnf instance Binary MergeableState diff --git a/src/GitHub/Data/PullRequests.hs b/src/GitHub/Data/PullRequests.hs index b91311da..5c2f62e1 100644 --- a/src/GitHub/Data/PullRequests.hs +++ b/src/GitHub/Data/PullRequests.hs @@ -283,19 +283,19 @@ instance FromJSON PullRequestEvent where <*> o .: "sender" instance FromJSON PullRequestEventType where - parseJSON (String "opened") = pure PullRequestOpened - parseJSON (String "closed") = pure PullRequestClosed - parseJSON (String "synchronize") = pure PullRequestSynchronized - parseJSON (String "reopened") = pure PullRequestReopened - parseJSON (String "assigned") = pure PullRequestAssigned - 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 + parseJSON = withText "PullRequestEventType" $ \t -> case T.toLower t of + "opened" -> pure PullRequestOpened + "closed" -> pure PullRequestClosed + "synchronize" -> pure PullRequestSynchronized + "reopened" -> pure PullRequestReopened + "assigned" -> pure PullRequestAssigned + "unassigned" -> pure PullRequestUnassigned + "labeled" -> pure PullRequestLabeled + "unlabeled" -> pure PullRequestUnlabeled + "review_requested" -> pure PullRequestReviewRequested + "review_request_removed" -> pure PullRequestReviewRequestRemoved + "edited" -> pure PullRequestEdited + _ -> fail $ "Unknown PullRequestEventType: " <> T.unpack t instance FromJSON PullRequestReference where parseJSON = withObject "PullRequestReference" $ \o -> PullRequestReference diff --git a/src/GitHub/Data/Reviews.hs b/src/GitHub/Data/Reviews.hs index 44405531..27278437 100644 --- a/src/GitHub/Data/Reviews.hs +++ b/src/GitHub/Data/Reviews.hs @@ -1,12 +1,14 @@ 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 () +import Data.Text (Text) +import qualified Data.Text as T + data ReviewState = ReviewStatePending | ReviewStateApproved @@ -21,12 +23,13 @@ instance NFData ReviewState where 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" + parseJSON = withText "ReviewState" $ \t -> case T.toLower t of + "approved" -> pure ReviewStateApproved + "pending" -> pure ReviewStatePending + "dismissed" -> pure ReviewStateDismissed + "commented" -> pure ReviewStateCommented + "changes_requested" -> pure ReviewStateChangesRequested + _ -> fail $ "Unknown ReviewState: " <> T.unpack t data Review = Review { reviewBody :: !Text diff --git a/src/GitHub/Data/Statuses.hs b/src/GitHub/Data/Statuses.hs index 0b5e3b37..09853b26 100644 --- a/src/GitHub/Data/Statuses.hs +++ b/src/GitHub/Data/Statuses.hs @@ -14,6 +14,7 @@ import Prelude () import GitHub.Data.GitData (Commit) import GitHub.Data.Repos (RepoRef) +import qualified Data.Text as T data StatusState = StatusPending @@ -26,11 +27,12 @@ instance NFData StatusState where rnf = genericRnf instance Binary StatusState instance FromJSON StatusState where - parseJSON (String "pending") = pure StatusPending - parseJSON (String "success") = pure StatusSuccess - parseJSON (String "error") = pure StatusError - parseJSON (String "failure") = pure StatusFailure - parseJSON _ = fail "Could not build a StatusState" + parseJSON = withText "StatusState" $ \t -> case T.toLower t of + "pending" -> pure StatusPending + "success" -> pure StatusSuccess + "error" -> pure StatusError + "failure" -> pure StatusFailure + _ -> fail $ "Unknown StatusState: " <> T.unpack t instance ToJSON StatusState where toJSON StatusPending = String "pending" diff --git a/src/GitHub/Data/Teams.hs b/src/GitHub/Data/Teams.hs index 86ddfcfa..387318e0 100644 --- a/src/GitHub/Data/Teams.hs +++ b/src/GitHub/Data/Teams.hs @@ -17,6 +17,8 @@ import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () +import qualified Data.Text as T + data Privacy = PrivacyClosed | PrivacySecret @@ -200,42 +202,42 @@ instance ToJSON AddTeamRepoPermission where object [ "permission" .= permission ] instance FromJSON Role where - parseJSON = withText "Attribute" $ \attr -> case attr of - "maintainer" -> return RoleMaintainer - "member" -> return RoleMember - _ -> fail $ "Unknown Role: " ++ show attr + parseJSON = withText "Role" $ \t -> case T.toLower t of + "maintainer" -> pure RoleMaintainer + "member" -> pure RoleMember + _ -> fail $ "Unknown Role: " <> T.unpack t instance ToJSON Role where toJSON RoleMaintainer = String "maintainer" toJSON RoleMember = String "member" +instance FromJSON Permission where + parseJSON = withText "Permission" $ \t -> case T.toLower t of + "pull" -> pure PermissionPull + "push" -> pure PermissionPush + "admin" -> pure PermissionAdmin + _ -> fail $ "Unknown Permission: " <> T.unpack t + instance ToJSON Permission where toJSON PermissionPull = "pull" toJSON PermissionPush = "push" toJSON PermissionAdmin = "admin" -instance FromJSON Permission where - parseJSON = withText "Permission Attribute" $ \attr -> case attr of - "pull" -> return PermissionPull - "push" -> return PermissionPush - "admin" -> return PermissionAdmin - _ -> fail $ "Unknown Permission Attribute: " ++ show attr - instance FromJSON Privacy where - parseJSON = withText "Privacy Attribute" $ \attr -> case attr of - "secret" -> return PrivacySecret - "closed" -> return PrivacyClosed - _ -> fail $ "Unknown Privacy Attribute: " ++ show attr + parseJSON = withText "Privacy" $ \t -> case T.toLower t of + "secret" -> pure PrivacySecret + "closed" -> pure PrivacyClosed + _ -> fail $ "Unknown Privacy: " <> T.unpack t instance ToJSON Privacy where toJSON PrivacySecret = String "secret" toJSON PrivacyClosed = String "closed" instance FromJSON ReqState where - parseJSON = withText "ReqState" $ \attr -> case attr of - "active" -> return StateActive - "pending" -> return StatePending - _ -> fail $ "Unknown ReqState: " ++ show attr + parseJSON = withText "ReqState" $ \t -> case T.toLower t of + "active" -> pure StateActive + "pending" -> pure StatePending + _ -> fail $ "Unknown ReqState: " <> T.unpack t instance ToJSON ReqState where toJSON StateActive = String "active" diff --git a/src/GitHub/Data/Webhooks.hs b/src/GitHub/Data/Webhooks.hs index cc778555..e58f8e69 100644 --- a/src/GitHub/Data/Webhooks.hs +++ b/src/GitHub/Data/Webhooks.hs @@ -11,6 +11,7 @@ import GitHub.Internal.Prelude import Prelude () import qualified Data.Map as M +import qualified Data.Text as T data RepoWebhook = RepoWebhook { repoWebhookUrl :: !URL @@ -132,57 +133,58 @@ instance Binary EditRepoWebhook -- JSON instances instance FromJSON RepoWebhookEvent where - parseJSON (String "*") = pure WebhookWildcardEvent - parseJSON (String "check_run") = pure WebhookCheckRunEvent - parseJSON (String "check_suite") = pure WebhookCheckSuiteEvent - parseJSON (String "commit_comment") = pure WebhookCommitCommentEvent - parseJSON (String "content_reference") = pure WebhookContentReferenceEvent - parseJSON (String "create") = pure WebhookCreateEvent - parseJSON (String "delete") = pure WebhookDeleteEvent - parseJSON (String "deploy_key") = pure WebhookDeployKeyEvent - parseJSON (String "deployment") = pure WebhookDeploymentEvent - parseJSON (String "deployment_status") = pure WebhookDeploymentStatusEvent - parseJSON (String "download") = pure WebhookDownloadEvent - parseJSON (String "follow") = pure WebhookFollowEvent - parseJSON (String "fork") = pure WebhookForkEvent - parseJSON (String "fork_apply") = pure WebhookForkApplyEvent - parseJSON (String "github_app_authorization") = pure WebhookGitHubAppAuthorizationEvent - parseJSON (String "gist") = pure WebhookGistEvent - parseJSON (String "gollum") = pure WebhookGollumEvent - parseJSON (String "installation") = pure WebhookInstallationEvent - parseJSON (String "installation_repositories") = pure WebhookInstallationRepositoriesEvent - parseJSON (String "issue_comment") = pure WebhookIssueCommentEvent - parseJSON (String "issues") = pure WebhookIssuesEvent - parseJSON (String "label") = pure WebhookLabelEvent - parseJSON (String "marketplace_purchase") = pure WebhookMarketplacePurchaseEvent - parseJSON (String "member") = pure WebhookMemberEvent - parseJSON (String "membership") = pure WebhookMembershipEvent - parseJSON (String "meta") = pure WebhookMetaEvent - parseJSON (String "milestone") = pure WebhookMilestoneEvent - parseJSON (String "organization") = pure WebhookOrganizationEvent - parseJSON (String "org_block") = pure WebhookOrgBlockEvent - parseJSON (String "page_build") = pure WebhookPageBuildEvent - parseJSON (String "ping") = pure WebhookPingEvent - parseJSON (String "project_card") = pure WebhookProjectCardEvent - parseJSON (String "project_column") = pure WebhookProjectColumnEvent - parseJSON (String "project") = pure WebhookProjectEvent - parseJSON (String "public") = pure WebhookPublicEvent - parseJSON (String "pull_request") = pure WebhookPullRequestEvent - parseJSON (String "pull_request_review") = pure WebhookPullRequestReviewEvent - parseJSON (String "pull_request_review_comment") = pure WebhookPullRequestReviewCommentEvent - parseJSON (String "push") = pure WebhookPushEvent - parseJSON (String "registry_package") = pure WebhookRegistryPackageEvent - parseJSON (String "release") = pure WebhookReleaseEvent - parseJSON (String "repository") = pure WebhookRepositoryEvent - parseJSON (String "repository_import") = pure WebhookRepositoryImportEvent - parseJSON (String "repository_vulnerability_alert") = pure WebhookRepositoryVulnerabilityAlertEvent - parseJSON (String "security_advisory") = pure WebhookSecurityAdvisoryEvent - parseJSON (String "star") = pure WebhookStarEvent - parseJSON (String "status") = pure WebhookStatusEvent - parseJSON (String "team") = pure WebhookTeamEvent - parseJSON (String "team_add") = pure WebhookTeamAddEvent - parseJSON (String "watch") = pure WebhookWatchEvent - parseJSON _ = fail "Could not build a Webhook event" + parseJSON = withText "RepoWebhookEvent" $ \t -> case T.toLower t of + "*" -> pure WebhookWildcardEvent + "check_run" -> pure WebhookCheckRunEvent + "check_suite" -> pure WebhookCheckSuiteEvent + "commit_comment" -> pure WebhookCommitCommentEvent + "content_reference" -> pure WebhookContentReferenceEvent + "create" -> pure WebhookCreateEvent + "delete" -> pure WebhookDeleteEvent + "deploy_key" -> pure WebhookDeployKeyEvent + "deployment" -> pure WebhookDeploymentEvent + "deployment_status" -> pure WebhookDeploymentStatusEvent + "download" -> pure WebhookDownloadEvent + "follow" -> pure WebhookFollowEvent + "fork" -> pure WebhookForkEvent + "fork_apply" -> pure WebhookForkApplyEvent + "github_app_authorization" -> pure WebhookGitHubAppAuthorizationEvent + "gist" -> pure WebhookGistEvent + "gollum" -> pure WebhookGollumEvent + "installation" -> pure WebhookInstallationEvent + "installation_repositories" -> pure WebhookInstallationRepositoriesEvent + "issue_comment" -> pure WebhookIssueCommentEvent + "issues" -> pure WebhookIssuesEvent + "label" -> pure WebhookLabelEvent + "marketplace_purchase" -> pure WebhookMarketplacePurchaseEvent + "member" -> pure WebhookMemberEvent + "membership" -> pure WebhookMembershipEvent + "meta" -> pure WebhookMetaEvent + "milestone" -> pure WebhookMilestoneEvent + "organization" -> pure WebhookOrganizationEvent + "org_block" -> pure WebhookOrgBlockEvent + "page_build" -> pure WebhookPageBuildEvent + "ping" -> pure WebhookPingEvent + "project_card" -> pure WebhookProjectCardEvent + "project_column" -> pure WebhookProjectColumnEvent + "project" -> pure WebhookProjectEvent + "public" -> pure WebhookPublicEvent + "pull_request" -> pure WebhookPullRequestEvent + "pull_request_review" -> pure WebhookPullRequestReviewEvent + "pull_request_review_comment" -> pure WebhookPullRequestReviewCommentEvent + "push" -> pure WebhookPushEvent + "registry_package" -> pure WebhookRegistryPackageEvent + "release" -> pure WebhookReleaseEvent + "repository" -> pure WebhookRepositoryEvent + "repository_import" -> pure WebhookRepositoryImportEvent + "repository_vulnerability_alert" -> pure WebhookRepositoryVulnerabilityAlertEvent + "security_advisory" -> pure WebhookSecurityAdvisoryEvent + "star" -> pure WebhookStarEvent + "status" -> pure WebhookStatusEvent + "team" -> pure WebhookTeamEvent + "team_add" -> pure WebhookTeamAddEvent + "watch" -> pure WebhookWatchEvent + _ -> fail $ "Unknown RepoWebhookEvent: " <> T.unpack t instance ToJSON RepoWebhookEvent where toJSON WebhookWildcardEvent = String "*" From 3b7048a34a671c8aa7b0bc6fafd45cfddc669534 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Thu, 30 May 2019 20:58:24 +0300 Subject: [PATCH 366/510] Squashed commit of the following: commit 267979d510cc01fb38ac3428d4168327392f4d4b Author: Sajid Ibne Anower Date: Thu May 2 13:16:38 2019 +1000 Add function to list user's invitations ... and others --- github.cabal | 1 + src/GitHub.hs | 14 +++++++++ src/GitHub/Data/Invitation.hs | 28 +++++++++++++++++ src/GitHub/Data/Request.hs | 2 +- src/GitHub/Endpoints/Repos/Collaborators.hs | 4 +-- src/GitHub/Endpoints/Repos/Invitations.hs | 35 +++++++++++++++++++++ 6 files changed, 81 insertions(+), 3 deletions(-) create mode 100644 src/GitHub/Endpoints/Repos/Invitations.hs diff --git a/github.cabal b/github.cabal index 7b6724f1..5782b8e2 100644 --- a/github.cabal +++ b/github.cabal @@ -132,6 +132,7 @@ library GitHub.Endpoints.Repos.Releases GitHub.Endpoints.Repos.Statuses GitHub.Endpoints.Repos.Webhooks + GitHub.Endpoints.Repos.Invitations GitHub.Endpoints.Search GitHub.Endpoints.Users GitHub.Endpoints.Users.Emails diff --git a/src/GitHub.hs b/src/GitHub.hs index fb342a9c..f847e45d 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -319,6 +319,19 @@ module GitHub ( latestReleaseR, releaseByTagNameR, + -- ** Invitations + -- | See + -- Missing endpoints: + + -- * Delete a repository invitation + -- * Update a repository invitation + -- * Decline a repository invitation + + listInvitationsOnR, + acceptInvitationFromR, + listInvitationsForR, + + -- * Search -- | See -- @@ -408,6 +421,7 @@ import GitHub.Endpoints.Repos.Comments import GitHub.Endpoints.Repos.Commits import GitHub.Endpoints.Repos.Deployments import GitHub.Endpoints.Repos.Forks +import GitHub.Endpoints.Repos.Invitations import GitHub.Endpoints.Repos.Releases import GitHub.Endpoints.Repos.Statuses import GitHub.Endpoints.Repos.Webhooks diff --git a/src/GitHub/Data/Invitation.hs b/src/GitHub/Data/Invitation.hs index 07d4a99f..894ce64f 100644 --- a/src/GitHub/Data/Invitation.hs +++ b/src/GitHub/Data/Invitation.hs @@ -8,6 +8,8 @@ module GitHub.Data.Invitation where import GitHub.Data.Definitions import GitHub.Data.Id (Id) import GitHub.Data.Name (Name) +import GitHub.Data.Repos (Repo) +import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () @@ -57,3 +59,29 @@ instance FromJSON InvitationRole where "hiring_manager" -> pure InvitationRoleHiringManager "reinstate" -> pure InvitationRoleReinstate _ -> fail $ "Unknown InvitationRole: " <> T.unpack t + +data RepoInvitation = RepoInvitation + { repoInvitationId :: !(Id RepoInvitation) + , repoInvitationInvitee :: !SimpleUser + , repoInvitationInviter :: !SimpleUser + , repoInvitationRepo :: !Repo + , repoInvitationUrl :: !URL + , repoInvitationCreatedAt :: !UTCTime + , repoInvitationPermission :: !Text + , repoInvitationHtmlUrl :: !URL + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData RepoInvitation where rnf = genericRnf +instance Binary RepoInvitation + +instance FromJSON RepoInvitation where + parseJSON = withObject "RepoInvitation" $ \o -> RepoInvitation + <$> o .: "id" + <*> o .: "invitee" + <*> o .: "inviter" + <*> o .: "repository" + <*> o .: "url" + <*> o .: "created_at" + <*> o .: "permissions" + <*> o .: "html_url" diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs index 30f3bfbb..04f38339 100644 --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -26,7 +26,7 @@ module GitHub.Data.Request ( Count, ) where -import GitHub.Data.Definitions (Count, QueryString, IssueNumber, unIssueNumber) +import GitHub.Data.Definitions (Count, IssueNumber, QueryString, unIssueNumber) import GitHub.Data.Id (Id, untagId) import GitHub.Data.Name (Name, untagName) import GitHub.Internal.Prelude diff --git a/src/GitHub/Endpoints/Repos/Collaborators.hs b/src/GitHub/Endpoints/Repos/Collaborators.hs index bc441a28..ac0d9c0e 100644 --- a/src/GitHub/Endpoints/Repos/Collaborators.hs +++ b/src/GitHub/Endpoints/Repos/Collaborators.hs @@ -68,7 +68,7 @@ addCollaborator -> Name Owner -- ^ Repository owner -> Name Repo -- ^ Repository name -> Name User -- ^ Collaborator to add - -> IO (Either Error ()) + -> IO (Either Error (Maybe RepoInvitation)) addCollaborator auth owner repo coll = executeRequest auth $ addCollaboratorR owner repo coll @@ -78,6 +78,6 @@ addCollaboratorR :: Name Owner -- ^ Repository owner -> Name Repo -- ^ Repository name -> Name User -- ^ Collaborator to add - -> GenRequest 'MtUnit 'RW () + -> GenRequest 'MtJSON 'RW (Maybe RepoInvitation) addCollaboratorR owner repo coll = Command Put ["repos", toPathPart owner, toPathPart repo, "collaborators", toPathPart coll] mempty diff --git a/src/GitHub/Endpoints/Repos/Invitations.hs b/src/GitHub/Endpoints/Repos/Invitations.hs new file mode 100644 index 00000000..68239961 --- /dev/null +++ b/src/GitHub/Endpoints/Repos/Invitations.hs @@ -0,0 +1,35 @@ +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +-- The repo invitations API as described on +-- . +module GitHub.Endpoints.Repos.Invitations ( + listInvitationsOnR, + listInvitationsForR, + acceptInvitationFromR + ) where + +import GitHub.Data +import GitHub.Internal.Prelude +import Prelude () + +-- | List open invitations of a repository +-- See +listInvitationsOnR :: Name Owner -> Name Repo -> FetchCount -> GenRequest 'MtJSON k (Vector RepoInvitation) +listInvitationsOnR user repo = + PagedQuery ["repos", toPathPart user, toPathPart repo, "invitations"] [] + +-- | List a user's repository invitations +-- See +listInvitationsForR :: FetchCount -> Request k (Vector RepoInvitation) +listInvitationsForR = + pagedQuery ["user", "repository_invitations"] [] + + +-- | Accept a repository invitation +-- See +acceptInvitationFromR :: Id RepoInvitation -> GenRequest 'MtUnit 'RW () +acceptInvitationFromR invId = + Command Patch ["user", "repository_invitations", toPathPart invId] mempty From 0bbfa922fd82fa97e3d4fee86d8c4f0db1c4d7bd Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Thu, 30 May 2019 21:03:09 +0300 Subject: [PATCH 367/510] case-insensitive parsing of NotificationReason --- CHANGELOG.md | 6 +++++- src/GitHub/Data/Activities.hs | 24 +++++++++++++----------- 2 files changed, 18 insertions(+), 12 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 6b6554da..46c0caf7 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,16 +2,20 @@ ## Changes for 0.22 - [#370](https://github.com/phadej/github/pull/370) - Type-class for various auth methods [#365](https://github.com/phadej/github/pull/365) - Throw on non-200 responses [#350](https://github.com/phadej/github/pull/350) - Add extension point for (preview) media types + [#370](https://github.com/phadej/github/pull/370) - Add missing webhook event types [#359](https://github.com/phadej/github/pull/359) +- Add invitation endpoint + [#360](https://github.com/phadej/github/pull/360) - Add notifications endpoints [#324](https://github.com/phadej/github/pull/324) +- Case insensitive enum parsing + [#373](https://github.com/phadej/github/pull/373) - Update dependencies [#364](https://github.com/phadej/github/pull/364) [#368](https://github.com/phadej/github/pull/368) diff --git a/src/GitHub/Data/Activities.hs b/src/GitHub/Data/Activities.hs index 92c82b69..d95d3a25 100644 --- a/src/GitHub/Data/Activities.hs +++ b/src/GitHub/Data/Activities.hs @@ -12,6 +12,8 @@ import GitHub.Internal.Prelude import Prelude () +import qualified Data.Text as T + data RepoStarred = RepoStarred { repoStarredStarredAt :: !UTCTime , repoStarredRepo :: !Repo @@ -65,18 +67,18 @@ instance NFData NotificationReason where rnf = genericRnf instance Binary NotificationReason instance FromJSON NotificationReason where - parseJSON = withText "NotificationReason" $ \t -> case t of - "assign" -> pure AssignReason - "author" -> pure AuthorReason - "comment" -> pure CommentReason - "invitation" -> pure InvitationReason - "manual" -> pure ManualReason - "mention" -> pure MentionReason + parseJSON = withText "NotificationReason" $ \t -> case T.toLower t of + "assign" -> pure AssignReason + "author" -> pure AuthorReason + "comment" -> pure CommentReason + "invitation" -> pure InvitationReason + "manual" -> pure ManualReason + "mention" -> pure MentionReason "review_requested" -> pure ReviewRequestedReason - "state_change" -> pure StateChangeReason - "subscribed" -> pure SubscribedReason - "team_mention" -> pure TeamMentionReason - _ -> fail $ "Unknown NotificationReason " ++ show t + "state_change" -> pure StateChangeReason + "subscribed" -> pure SubscribedReason + "team_mention" -> pure TeamMentionReason + _ -> fail $ "Unknown NotificationReason " ++ show t data Notification = Notification -- XXX: The notification id field type IS in fact string. Not sure why gh From ec65aaea90c10b08fc84719fda9adf91a07eee38 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Thu, 30 May 2019 21:13:28 +0300 Subject: [PATCH 368/510] GHC-8.4.3 -> GHC-8.4.4 on travis --- .travis.yml | 4 ++-- github.cabal | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/.travis.yml b/.travis.yml index 073d6a6d..f041988c 100644 --- a/.travis.yml +++ b/.travis.yml @@ -34,8 +34,8 @@ matrix: env: GHCHEAD=true - compiler: ghc-8.6.5 addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.6.5","cabal-install-2.4"]}} - - compiler: ghc-8.4.3 - addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.4.3","cabal-install-2.4"]}} + - compiler: ghc-8.4.4 + addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.4.4","cabal-install-2.4"]}} - compiler: ghc-8.2.2 addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.2.2","cabal-install-2.4"]}} - compiler: ghc-8.0.2 diff --git a/github.cabal b/github.cabal index 5782b8e2..d09f3eb7 100644 --- a/github.cabal +++ b/github.cabal @@ -30,7 +30,7 @@ copyright: Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016-2019 Oleg Grenrus tested-with: - GHC ==7.8.4 || ==7.10.3 || ==8.0.2 || ==8.2.2 || ==8.4.3 || ==8.6.5 || ==8.8.1 + GHC ==7.8.4 || ==7.10.3 || ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.1 extra-source-files: README.md From 8b31817300eef27c26bdadb66b2c9b420c17d81b Mon Sep 17 00:00:00 2001 From: Todd Mohney Date: Thu, 9 May 2019 21:06:00 +0000 Subject: [PATCH 369/510] Implement interface to GitHub's SSH public key API --- github.cabal | 3 + spec/GitHub/PublicSSHKeysSpec.hs | 43 +++++++++++ src/GitHub/Data.hs | 2 + src/GitHub/Data/PublicSSHKeys.hs | 60 +++++++++++++++ src/GitHub/Endpoints/Users/PublicSSHKeys.hs | 83 +++++++++++++++++++++ 5 files changed, 191 insertions(+) create mode 100644 spec/GitHub/PublicSSHKeysSpec.hs create mode 100644 src/GitHub/Data/PublicSSHKeys.hs create mode 100644 src/GitHub/Endpoints/Users/PublicSSHKeys.hs diff --git a/github.cabal b/github.cabal index d09f3eb7..4380742d 100644 --- a/github.cabal +++ b/github.cabal @@ -87,6 +87,7 @@ library GitHub.Data.Milestone GitHub.Data.Name GitHub.Data.Options + GitHub.Data.PublicSSHKeys GitHub.Data.PullRequests GitHub.Data.RateLimit GitHub.Data.Releases @@ -137,6 +138,7 @@ library GitHub.Endpoints.Users GitHub.Endpoints.Users.Emails GitHub.Endpoints.Users.Followers + GitHub.Endpoints.Users.PublicSSHKeys GitHub.Internal.Prelude GitHub.Request @@ -194,6 +196,7 @@ test-suite github-test GitHub.IssuesSpec GitHub.OrganizationsSpec GitHub.PullRequestReviewsSpec + GitHub.PublicSSHKeysSpec GitHub.PullRequestsSpec GitHub.RateLimitSpec GitHub.ReleasesSpec diff --git a/spec/GitHub/PublicSSHKeysSpec.hs b/spec/GitHub/PublicSSHKeysSpec.hs new file mode 100644 index 00000000..8d84b7b6 --- /dev/null +++ b/spec/GitHub/PublicSSHKeysSpec.hs @@ -0,0 +1,43 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +module GitHub.PublicSSHKeysSpec where + +import GitHub (Auth (..), PublicSSHKeyBasic (..), PublicSSHKey (..), + executeRequest, repositoryR) +import GitHub.Endpoints.Users.PublicSSHKeys (publicSSHKeysFor', publicSSHKeys', + publicSSHKey') + +import Data.Either.Compat (isRight) +import Data.String (fromString) +import System.Environment (lookupEnv) +import Test.Hspec (Spec, describe, it, pendingWith, shouldBe, + shouldSatisfy) + +import qualified Data.HashMap.Strict as HM +import qualified Data.Vector as V + +fromRightS :: Show a => Either a b -> b +fromRightS (Right b) = b +fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a + +withAuth :: (Auth -> IO ()) -> IO () +withAuth action = do + mtoken <- lookupEnv "GITHUB_TOKEN" + case mtoken of + Nothing -> pendingWith "no GITHUB_TOKEN" + Just token -> action (OAuth $ fromString token) + +spec :: Spec +spec = do + describe "publicSSHKeysFor'" $ do + it "works" $ do + keys <- publicSSHKeysFor' "phadej" + V.length (fromRightS keys) `shouldSatisfy` (> 1) + + describe "publicSSHKeys' and publicSSHKey'" $ do + it "works" $ withAuth $ \auth -> do + keys <- publicSSHKeys' auth + V.length (fromRightS keys) `shouldSatisfy` (> 1) + + key <- publicSSHKey' auth (publicSSHKeyId $ V.head (fromRightS keys)) + key `shouldSatisfy` isRight diff --git a/src/GitHub/Data.hs b/src/GitHub/Data.hs index e6fbd4a0..6acc0bf2 100644 --- a/src/GitHub/Data.hs +++ b/src/GitHub/Data.hs @@ -48,6 +48,7 @@ module GitHub.Data ( module GitHub.Data.Issues, module GitHub.Data.Milestone, module GitHub.Data.Options, + module GitHub.Data.PublicSSHKeys, module GitHub.Data.PullRequests, module GitHub.Data.RateLimit, module GitHub.Data.Releases, @@ -81,6 +82,7 @@ import GitHub.Data.Issues import GitHub.Data.Milestone import GitHub.Data.Name import GitHub.Data.Options +import GitHub.Data.PublicSSHKeys import GitHub.Data.PullRequests import GitHub.Data.RateLimit import GitHub.Data.Releases diff --git a/src/GitHub/Data/PublicSSHKeys.hs b/src/GitHub/Data/PublicSSHKeys.hs new file mode 100644 index 00000000..4a469917 --- /dev/null +++ b/src/GitHub/Data/PublicSSHKeys.hs @@ -0,0 +1,60 @@ +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Todd Mohney +-- +module GitHub.Data.PublicSSHKeys where + +import GitHub.Data.Id (Id) +import GitHub.Data.URL (URL) +import GitHub.Internal.Prelude +import Prelude () + +data PublicSSHKeyBasic = PublicSSHKeyBasic + { basicPublicSSHKeyId :: !(Id PublicSSHKey) + , basicPublicSSHKeyKey :: !Text + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance FromJSON PublicSSHKeyBasic where + parseJSON = withObject "PublicSSHKeyBasic" $ \o -> PublicSSHKeyBasic + <$> o .: "id" + <*> o .: "key" + +data PublicSSHKey = PublicSSHKey + { publicSSHKeyId :: !(Id PublicSSHKey) + , publicSSHKeyKey :: !Text + , publicSSHKeyUrl :: !URL + , publicSSHKeyTitle :: !Text + , publicSSHKeyVerified :: !Bool + , publicSSHKeyCreatedAt :: !UTCTime + , publicSSHKeyReadOnly :: !Bool + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance FromJSON PublicSSHKey where + parseJSON = withObject "PublicSSHKey" $ \o -> PublicSSHKey + <$> o .: "id" + <*> o .: "key" + <*> o .: "url" + <*> o .: "title" + <*> o .: "verified" + <*> o .: "created_at" + <*> o .: "read_only" + +data NewPublicSSHKey = NewPublicSSHKey + { newPublicSSHKeyKey :: !Text + , newPublicSSHKeyTitle :: !Text + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance ToJSON NewPublicSSHKey where + toJSON (NewPublicSSHKey key title) = object + [ "key" .= key + , "title" .= title + ] + +instance FromJSON NewPublicSSHKey where + parseJSON = withObject "PublicSSHKey" $ \o -> NewPublicSSHKey + <$> o .: "key" + <*> o .: "title" diff --git a/src/GitHub/Endpoints/Users/PublicSSHKeys.hs b/src/GitHub/Endpoints/Users/PublicSSHKeys.hs new file mode 100644 index 00000000..b55b8bbc --- /dev/null +++ b/src/GitHub/Endpoints/Users/PublicSSHKeys.hs @@ -0,0 +1,83 @@ +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Todd Mohney +-- +-- The public keys API, as described at +-- +module GitHub.Endpoints.Users.PublicSSHKeys ( + -- * Querying public SSH keys + publicSSHKeys', + publicSSHKeysR, + publicSSHKeysFor', + publicSSHKeysForR, + publicSSHKey', + publicSSHKeyR, + + -- ** Create + createUserPublicSSHKey', + createUserPublicSSHKeyR, + + -- ** Delete + deleteUserPublicSSHKey', + deleteUserPublicSSHKeyR, +) where + +import GitHub.Data +import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () + +-- | Querying public SSH keys. +publicSSHKeysFor' :: Name Owner -> IO (Either Error (Vector PublicSSHKeyBasic)) +publicSSHKeysFor' user = + executeRequest' $ publicSSHKeysForR user FetchAll + +-- | Querying public SSH keys. +-- See +publicSSHKeysForR :: Name Owner -> FetchCount -> Request 'RO (Vector PublicSSHKeyBasic) +publicSSHKeysForR user = + pagedQuery ["users", toPathPart user, "keys"] [] + +-- | Querying the authenticated users' public SSH keys +publicSSHKeys' :: Auth -> IO (Either Error (Vector PublicSSHKey)) +publicSSHKeys' auth = + executeRequest auth publicSSHKeysR + +-- | Querying the authenticated users' public SSH keys +-- See +publicSSHKeysR :: Request 'RA (Vector PublicSSHKey) +publicSSHKeysR = + query ["user", "keys"] [] + +-- | Querying a public SSH key +publicSSHKey' :: Auth -> Id PublicSSHKey -> IO (Either Error PublicSSHKey) +publicSSHKey' auth keyId = + executeRequest auth $ publicSSHKeyR keyId + +-- | Querying a public SSH key. +-- See +publicSSHKeyR :: Id PublicSSHKey -> Request 'RA PublicSSHKey +publicSSHKeyR keyId = + query ["user", "keys", toPathPart keyId] [] + +-- | Create a public SSH key +createUserPublicSSHKey' :: Auth -> NewPublicSSHKey -> IO (Either Error PublicSSHKey) +createUserPublicSSHKey' auth key = + executeRequest auth $ createUserPublicSSHKeyR key + +-- | Create a public SSH key. +-- See . +createUserPublicSSHKeyR :: NewPublicSSHKey -> Request 'RW PublicSSHKey +createUserPublicSSHKeyR key = + command Post ["user", "keys"] (encode key) + +deleteUserPublicSSHKey' :: Auth -> Id PublicSSHKey -> IO (Either Error ()) +deleteUserPublicSSHKey' auth keyId = + executeRequest auth $ deleteUserPublicSSHKeyR keyId + +-- | Delete a public SSH key. +-- See +deleteUserPublicSSHKeyR :: Id PublicSSHKey -> Request 'RW () +deleteUserPublicSSHKeyR keyId = + command Delete ["user", "keys", toPathPart keyId] mempty From 6f916af176f2f4ce5aa355e6934e78899ce9fb1b Mon Sep 17 00:00:00 2001 From: Todd Mohney Date: Thu, 9 May 2019 21:06:31 +0000 Subject: [PATCH 370/510] Add SSH public key API samples --- .../Users/PublicSSHKeys/CreatePublicSSHKey.hs | 22 ++++++++ .../Users/PublicSSHKeys/DeletePublicSSHKey.hs | 14 +++++ .../Users/PublicSSHKeys/ListPublicSSHKeys.hs | 24 +++++++++ .../Users/PublicSSHKeys/ShowPublicSSHKey.hs | 15 ++++++ samples/github-samples.cabal | 53 +++++++++++++++++++ 5 files changed, 128 insertions(+) create mode 100644 samples/Users/PublicSSHKeys/CreatePublicSSHKey.hs create mode 100644 samples/Users/PublicSSHKeys/DeletePublicSSHKey.hs create mode 100644 samples/Users/PublicSSHKeys/ListPublicSSHKeys.hs create mode 100644 samples/Users/PublicSSHKeys/ShowPublicSSHKey.hs diff --git a/samples/Users/PublicSSHKeys/CreatePublicSSHKey.hs b/samples/Users/PublicSSHKeys/CreatePublicSSHKey.hs new file mode 100644 index 00000000..e8cd6874 --- /dev/null +++ b/samples/Users/PublicSSHKeys/CreatePublicSSHKey.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main (main) where + +import qualified GitHub.Data.PublicSSHKeys as PK +import qualified GitHub.Endpoints.Users.PublicSSHKeys as PK +import qualified GitHub.Auth as Auth +import Data.Text (Text) + +main :: IO () +main = do + let auth = Auth.OAuth "auth_token" + ePublicSSHKey <- PK.createUserPublicSSHKey' auth newPublicSSHKey + case ePublicSSHKey of + (Left err) -> putStrLn $ "Error: " ++ (show err) + (Right publicSSHKey) -> putStrLn $ show publicSSHKey + +newPublicSSHKey :: PK.NewPublicSSHKey +newPublicSSHKey = + PK.NewPublicSSHKey + { PK.newPublicSSHKeyKey = "test-key" + , PK.newPublicSSHKeyTitle = "some-name-for-your-key" + } diff --git a/samples/Users/PublicSSHKeys/DeletePublicSSHKey.hs b/samples/Users/PublicSSHKeys/DeletePublicSSHKey.hs new file mode 100644 index 00000000..f1f28b17 --- /dev/null +++ b/samples/Users/PublicSSHKeys/DeletePublicSSHKey.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main (main) where + +import GitHub.Data.Id (Id (..)) +import qualified GitHub.Endpoints.Users.PublicSSHKeys as PK +import qualified GitHub.Auth as Auth + +main :: IO () +main = do + let auth = Auth.OAuth "auth_token" + ePublicSSHKey <- PK.deleteUserPublicSSHKey' auth (Id 18530161) + case ePublicSSHKey of + (Left err) -> putStrLn $ "Error: " ++ (show err) + (Right _) -> putStrLn $ "Deleted public SSH key!" diff --git a/samples/Users/PublicSSHKeys/ListPublicSSHKeys.hs b/samples/Users/PublicSSHKeys/ListPublicSSHKeys.hs new file mode 100644 index 00000000..645390f4 --- /dev/null +++ b/samples/Users/PublicSSHKeys/ListPublicSSHKeys.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main (main) where + +import qualified GitHub.Data.PublicSSHKeys as PK +import qualified GitHub.Endpoints.Users.PublicSSHKeys as PK +import qualified GitHub.Auth as Auth +import Data.List (intercalate) +import Data.Vector (toList) + +main :: IO () +main = do + -- Fetch the SSH public keys of another user + ePublicSSHKeys <- PK.publicSSHKeysFor' "github_name" + case ePublicSSHKeys of + (Left err) -> putStrLn $ "Error: " ++ (show err) + (Right publicSSHKeys) -> putStrLn $ intercalate "\n" $ map show (toList publicSSHKeys) + + -- Fetch my SSH public keys + let auth = Auth.OAuth "auth_token" + eMyPublicSSHKeys <- PK.publicSSHKeys' auth + case eMyPublicSSHKeys of + (Left err) -> putStrLn $ "Error: " ++ (show err) + (Right publicSSHKeys) -> putStrLn $ intercalate "\n" $ map show (toList publicSSHKeys) + diff --git a/samples/Users/PublicSSHKeys/ShowPublicSSHKey.hs b/samples/Users/PublicSSHKeys/ShowPublicSSHKey.hs new file mode 100644 index 00000000..f9fe4829 --- /dev/null +++ b/samples/Users/PublicSSHKeys/ShowPublicSSHKey.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main (main) where + +import GitHub.Data.Id (Id (..)) +import qualified GitHub.Data.PublicSSHKeys as PK +import qualified GitHub.Endpoints.Users.PublicSSHKeys as PK +import qualified GitHub.Auth as Auth + +main :: IO () +main = do + let auth = Auth.OAuth "auth_token" + ePublicSSHKey <- PK.publicSSHKey' auth (Id 18528451) + case ePublicSSHKey of + (Left err) -> putStrLn $ "Error: " ++ (show err) + (Right publicSSHKey) -> putStrLn $ show publicSSHKey diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index 830c1e37..4595e3dd 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -269,3 +269,56 @@ executable github-teaminfo-for , text , github-samples default-language: Haskell2010 + +executable github-create-public-ssh-key + main-is: CreatePublicSSHKey.hs + hs-source-dirs: + Users/PublicSSHKeys + ghc-options: -Wall + build-depends: + base + , base-compat + , github + , text + , github-samples + default-language: Haskell2010 + +executable github-delete-public-ssh-key + main-is: DeletePublicSSHKey.hs + hs-source-dirs: + Users/PublicSSHKeys + ghc-options: -Wall + build-depends: + base + , base-compat + , github + , text + , github-samples + default-language: Haskell2010 + +executable github-list-public-ssh-keys + main-is: ListPublicSSHKeys.hs + hs-source-dirs: + Users/PublicSSHKeys + ghc-options: -Wall + build-depends: + base + , base-compat + , github + , text + , github-samples + , vector + default-language: Haskell2010 + +executable github-get-public-ssh-key + main-is: ShowPublicSSHKey.hs + hs-source-dirs: + Users/PublicSSHKeys + ghc-options: -Wall + build-depends: + base + , base-compat + , github + , text + , github-samples + default-language: Haskell2010 From e870a84ea439fa4664614533c06b343e4a74d3f0 Mon Sep 17 00:00:00 2001 From: Todd Mohney Date: Thu, 16 May 2019 20:01:04 +0000 Subject: [PATCH 371/510] Allow created_at field to be null --- src/GitHub/Data/PublicSSHKeys.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/GitHub/Data/PublicSSHKeys.hs b/src/GitHub/Data/PublicSSHKeys.hs index 4a469917..125cd4aa 100644 --- a/src/GitHub/Data/PublicSSHKeys.hs +++ b/src/GitHub/Data/PublicSSHKeys.hs @@ -27,7 +27,7 @@ data PublicSSHKey = PublicSSHKey , publicSSHKeyUrl :: !URL , publicSSHKeyTitle :: !Text , publicSSHKeyVerified :: !Bool - , publicSSHKeyCreatedAt :: !UTCTime + , publicSSHKeyCreatedAt :: !(Maybe UTCTime) , publicSSHKeyReadOnly :: !Bool } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -39,7 +39,7 @@ instance FromJSON PublicSSHKey where <*> o .: "url" <*> o .: "title" <*> o .: "verified" - <*> o .: "created_at" + <*> o .:? "created_at" <*> o .: "read_only" data NewPublicSSHKey = NewPublicSSHKey From 277f9b6c8080d91b7c6e11c0246c41c46e8a17bf Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Thu, 30 May 2019 21:16:36 +0300 Subject: [PATCH 372/510] Add changelog note --- CHANGELOG.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 46c0caf7..83bc1305 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -14,6 +14,8 @@ [#360](https://github.com/phadej/github/pull/360) - Add notifications endpoints [#324](https://github.com/phadej/github/pull/324) +- Add ssh keys endpoints + [#363](https://github.com/phadej/github/pull/365) - Case insensitive enum parsing [#373](https://github.com/phadej/github/pull/373) - Update dependencies From 33b093c565a7fe27db30671c0f190344411b500d Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Fri, 31 May 2019 01:05:28 +0300 Subject: [PATCH 373/510] CI runs out of API rate limit + Other cleanup --- spec/GitHub/PublicSSHKeysSpec.hs | 16 +++++++--------- 1 file changed, 7 insertions(+), 9 deletions(-) diff --git a/spec/GitHub/PublicSSHKeysSpec.hs b/spec/GitHub/PublicSSHKeysSpec.hs index 8d84b7b6..b797c959 100644 --- a/spec/GitHub/PublicSSHKeysSpec.hs +++ b/spec/GitHub/PublicSSHKeysSpec.hs @@ -2,18 +2,16 @@ {-# LANGUAGE TemplateHaskell #-} module GitHub.PublicSSHKeysSpec where -import GitHub (Auth (..), PublicSSHKeyBasic (..), PublicSSHKey (..), - executeRequest, repositoryR) -import GitHub.Endpoints.Users.PublicSSHKeys (publicSSHKeysFor', publicSSHKeys', - publicSSHKey') +import GitHub + (Auth (..), FetchCount (..), PublicSSHKey (..), executeRequest) +import GitHub.Endpoints.Users.PublicSSHKeys + (publicSSHKey', publicSSHKeys', publicSSHKeysForR) import Data.Either.Compat (isRight) import Data.String (fromString) import System.Environment (lookupEnv) -import Test.Hspec (Spec, describe, it, pendingWith, shouldBe, - shouldSatisfy) +import Test.Hspec (Spec, describe, it, pendingWith, shouldSatisfy) -import qualified Data.HashMap.Strict as HM import qualified Data.Vector as V fromRightS :: Show a => Either a b -> b @@ -30,8 +28,8 @@ withAuth action = do spec :: Spec spec = do describe "publicSSHKeysFor'" $ do - it "works" $ do - keys <- publicSSHKeysFor' "phadej" + it "works" $ withAuth $ \auth -> do + keys <- executeRequest auth $ publicSSHKeysForR "phadej" FetchAll V.length (fromRightS keys) `shouldSatisfy` (> 1) describe "publicSSHKeys' and publicSSHKey'" $ do From 0247582839ce23b22acdc07bb1a52b6dc98c9a39 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Fri, 31 May 2019 11:15:56 +0300 Subject: [PATCH 374/510] Use 'MtUnit in Commands returning () --- CHANGELOG.md | 2 ++ src/GitHub/Endpoints/Activity/Starring.hs | 4 ++-- src/GitHub/Endpoints/Gists.hs | 8 ++++---- src/GitHub/Endpoints/Issues/Comments.hs | 4 ++-- src/GitHub/Endpoints/Issues/Labels.hs | 12 ++++++------ src/GitHub/Endpoints/Issues/Milestones.hs | 4 ++-- src/GitHub/Endpoints/Organizations/Teams.hs | 8 ++++---- src/GitHub/Endpoints/Repos.hs | 6 ++++-- src/GitHub/Endpoints/Repos/Contents.hs | 4 ++-- src/GitHub/Endpoints/Repos/DeployKeys.hs | 4 ++-- src/GitHub/Endpoints/Repos/Webhooks.hs | 4 ++-- src/GitHub/Endpoints/Users/PublicSSHKeys.hs | 4 ++-- src/GitHub/Request.hs | 4 +++- 13 files changed, 37 insertions(+), 31 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 83bc1305..0b637c8e 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -18,6 +18,8 @@ [#363](https://github.com/phadej/github/pull/365) - Case insensitive enum parsing [#373](https://github.com/phadej/github/pull/373) +- Don't try parse unitary responses + [#377](https://github.com/phadej/github/issues/377) - Update dependencies [#364](https://github.com/phadej/github/pull/364) [#368](https://github.com/phadej/github/pull/368) diff --git a/src/GitHub/Endpoints/Activity/Starring.hs b/src/GitHub/Endpoints/Activity/Starring.hs index 71558324..4eccfc5b 100644 --- a/src/GitHub/Endpoints/Activity/Starring.hs +++ b/src/GitHub/Endpoints/Activity/Starring.hs @@ -91,7 +91,7 @@ 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 +unstarRepoR :: Name Owner -> Name Repo -> GenRequest 'MtUnit 'RW () +unstarRepoR user repo = Command Delete paths mempty where paths = ["user", "starred", toPathPart user, toPathPart repo] diff --git a/src/GitHub/Endpoints/Gists.hs b/src/GitHub/Endpoints/Gists.hs index c59ba5c5..773e7f17 100644 --- a/src/GitHub/Endpoints/Gists.hs +++ b/src/GitHub/Endpoints/Gists.hs @@ -81,8 +81,8 @@ unstarGist auth gid = executeRequest auth $ unstarGistR gid -- | Unstar a gist by the authenticated user. -- See -unstarGistR :: Name Gist -> Request 'RW () -unstarGistR gid = command Delete ["gists", toPathPart gid, "star"] mempty +unstarGistR :: Name Gist -> GenRequest 'MtUnit 'RW () +unstarGistR gid = Command Delete ["gists", toPathPart gid, "star"] mempty -- | Delete a gist by the authenticated user. -- @@ -92,5 +92,5 @@ deleteGist auth gid = executeRequest auth $ deleteGistR gid -- | Delete a gist by the authenticated user. -- See -deleteGistR :: Name Gist -> Request 'RW () -deleteGistR gid = command Delete ["gists", toPathPart gid] mempty +deleteGistR :: Name Gist -> GenRequest 'MtUnit 'RW () +deleteGistR gid = Command Delete ["gists", toPathPart gid] mempty diff --git a/src/GitHub/Endpoints/Issues/Comments.hs b/src/GitHub/Endpoints/Issues/Comments.hs index 83f67024..0968022b 100644 --- a/src/GitHub/Endpoints/Issues/Comments.hs +++ b/src/GitHub/Endpoints/Issues/Comments.hs @@ -101,8 +101,8 @@ deleteComment auth user repo commid = -- | Delete a comment. -- See -deleteCommentR :: Name Owner -> Name Repo -> Id Comment -> Request 'RW () +deleteCommentR :: Name Owner -> Name Repo -> Id Comment -> GenRequest 'MtUnit 'RW () deleteCommentR user repo commid = - command Delete parts mempty + Command Delete parts mempty where parts = ["repos", toPathPart user, toPathPart repo, "issues", "comments", toPathPart commid] diff --git a/src/GitHub/Endpoints/Issues/Labels.hs b/src/GitHub/Endpoints/Issues/Labels.hs index 6fa03ed3..81affd8a 100644 --- a/src/GitHub/Endpoints/Issues/Labels.hs +++ b/src/GitHub/Endpoints/Issues/Labels.hs @@ -130,9 +130,9 @@ deleteLabel auth user repo lbl = -- | Delete a label. -- See -deleteLabelR :: Name Owner -> Name Repo -> Name IssueLabel -> Request 'RW () +deleteLabelR :: Name Owner -> Name Repo -> Name IssueLabel -> GenRequest 'MtUnit 'RW () deleteLabelR user repo lbl = - command Delete ["repos", toPathPart user, toPathPart repo, "labels", toPathPart lbl] mempty + Command Delete ["repos", toPathPart user, toPathPart repo, "labels", toPathPart lbl] mempty -- | The labels on an issue in a repo. -- @@ -188,9 +188,9 @@ removeLabelFromIssue auth user repo iid lbl = -- | Remove a label from an issue. -- See -removeLabelFromIssueR :: Name Owner -> Name Repo -> Id Issue -> Name IssueLabel -> Request 'RW () +removeLabelFromIssueR :: Name Owner -> Name Repo -> Id Issue -> Name IssueLabel -> GenRequest 'MtUnit 'RW () removeLabelFromIssueR user repo iid lbl = - command Delete ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels", toPathPart lbl] mempty + Command Delete ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels", toPathPart lbl] mempty -- | Replace all labels on an issue. Sending an empty list will remove all labels from the issue. -- @@ -229,9 +229,9 @@ removeAllLabelsFromIssue auth user repo iid = -- | Remove all labels from an issue. -- See -removeAllLabelsFromIssueR :: Name Owner -> Name Repo -> Id Issue -> Request 'RW () +removeAllLabelsFromIssueR :: Name Owner -> Name Repo -> Id Issue -> GenRequest 'MtUnit 'RW () removeAllLabelsFromIssueR user repo iid = - command Delete ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] mempty + Command Delete ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] mempty -- | All the labels on a repo's milestone given the milestone ID. -- diff --git a/src/GitHub/Endpoints/Issues/Milestones.hs b/src/GitHub/Endpoints/Issues/Milestones.hs index 282de6c9..574d2a0e 100644 --- a/src/GitHub/Endpoints/Issues/Milestones.hs +++ b/src/GitHub/Endpoints/Issues/Milestones.hs @@ -80,7 +80,7 @@ deleteMilestone auth user repo mid = executeRequest auth $ deleteMilestoneR user -- | Delete a milestone. -- See -deleteMilestoneR :: Name Owner -> Name Repo -> Id Milestone -> Request 'RW () +deleteMilestoneR :: Name Owner -> Name Repo -> Id Milestone -> GenRequest 'MtUnit 'RW () deleteMilestoneR user repo mid = - command Delete + Command Delete ["repos", toPathPart user, toPathPart repo, "milestones", toPathPart mid] mempty diff --git a/src/GitHub/Endpoints/Organizations/Teams.hs b/src/GitHub/Endpoints/Organizations/Teams.hs index 586d1f99..3aa19401 100644 --- a/src/GitHub/Endpoints/Organizations/Teams.hs +++ b/src/GitHub/Endpoints/Organizations/Teams.hs @@ -124,9 +124,9 @@ deleteTeam' auth tid = -- | Delete team. -- -- See -deleteTeamR :: Id Team -> Request 'RW () +deleteTeamR :: Id Team -> GenRequest 'MtUnit 'RW () deleteTeamR tid = - command Delete ["teams", toPathPart tid] mempty + Command Delete ["teams", toPathPart tid] mempty -- | List team members. -- @@ -214,9 +214,9 @@ deleteTeamMembershipFor' auth tid user = -- | Remove team membership. -- See -deleteTeamMembershipForR :: Id Team -> Name Owner -> Request 'RW () +deleteTeamMembershipForR :: Id Team -> Name Owner -> GenRequest 'MtUnit 'RW () deleteTeamMembershipForR tid user = - command Delete ["teams", toPathPart tid, "memberships", toPathPart user] mempty + Command Delete ["teams", toPathPart tid, "memberships", toPathPart user] mempty -- | List teams for current authenticated user -- diff --git a/src/GitHub/Endpoints/Repos.hs b/src/GitHub/Endpoints/Repos.hs index 0c1cd83f..921204d5 100644 --- a/src/GitHub/Endpoints/Repos.hs +++ b/src/GitHub/Endpoints/Repos.hs @@ -330,6 +330,8 @@ deleteRepo :: Auth -> Name Owner -> Name Repo -> IO (Either Error ()) deleteRepo auth user repo = executeRequest auth $ deleteRepoR user repo -deleteRepoR :: Name Owner -> Name Repo -> Request 'RW () +-- | Delete a repository,. +-- See +deleteRepoR :: Name Owner -> Name Repo -> GenRequest 'MtUnit 'RW () deleteRepoR user repo = - command Delete ["repos", toPathPart user, toPathPart repo] mempty + Command Delete ["repos", toPathPart user, toPathPart repo] mempty diff --git a/src/GitHub/Endpoints/Repos/Contents.hs b/src/GitHub/Endpoints/Repos/Contents.hs index b1e05ebe..bc5a9ab6 100644 --- a/src/GitHub/Endpoints/Repos/Contents.hs +++ b/src/GitHub/Endpoints/Repos/Contents.hs @@ -166,6 +166,6 @@ deleteFileR :: Name Owner -> Name Repo -> DeleteFile - -> Request 'RW () + -> GenRequest 'MtUnit 'RW () deleteFileR user repo body = - command Delete ["repos", toPathPart user, toPathPart repo, "contents", deleteFilePath body] (encode body) + Command Delete ["repos", toPathPart user, toPathPart repo, "contents", deleteFilePath body] (encode body) diff --git a/src/GitHub/Endpoints/Repos/DeployKeys.hs b/src/GitHub/Endpoints/Repos/DeployKeys.hs index 90b87703..f1080680 100644 --- a/src/GitHub/Endpoints/Repos/DeployKeys.hs +++ b/src/GitHub/Endpoints/Repos/DeployKeys.hs @@ -65,6 +65,6 @@ deleteRepoDeployKey' auth user repo keyId = -- | Delete a deploy key. -- See -deleteRepoDeployKeyR :: Name Owner -> Name Repo -> Id RepoDeployKey -> Request 'RW () +deleteRepoDeployKeyR :: Name Owner -> Name Repo -> Id RepoDeployKey -> GenRequest 'MtUnit 'RW () deleteRepoDeployKeyR user repo keyId = - command Delete ["repos", toPathPart user, toPathPart repo, "keys", toPathPart keyId] mempty + Command Delete ["repos", toPathPart user, toPathPart repo, "keys", toPathPart keyId] mempty diff --git a/src/GitHub/Endpoints/Repos/Webhooks.hs b/src/GitHub/Endpoints/Repos/Webhooks.hs index 34619c17..87e37fba 100644 --- a/src/GitHub/Endpoints/Repos/Webhooks.hs +++ b/src/GitHub/Endpoints/Repos/Webhooks.hs @@ -103,9 +103,9 @@ deleteRepoWebhook' auth user repo hookId = -- | Delete a hook. -- See -deleteRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> Request 'RW () +deleteRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> GenRequest 'MtUnit 'RW () deleteRepoWebhookR user repo hookId = - command Delete (createWebhookOpPath user repo hookId Nothing) mempty + Command Delete (createWebhookOpPath user repo hookId Nothing) mempty createBaseWebhookPath :: Name Owner -> Name Repo -> Id RepoWebhook -> Paths createBaseWebhookPath user repo hookId = diff --git a/src/GitHub/Endpoints/Users/PublicSSHKeys.hs b/src/GitHub/Endpoints/Users/PublicSSHKeys.hs index b55b8bbc..0eb9a4ee 100644 --- a/src/GitHub/Endpoints/Users/PublicSSHKeys.hs +++ b/src/GitHub/Endpoints/Users/PublicSSHKeys.hs @@ -78,6 +78,6 @@ deleteUserPublicSSHKey' auth keyId = -- | Delete a public SSH key. -- See -deleteUserPublicSSHKeyR :: Id PublicSSHKey -> Request 'RW () +deleteUserPublicSSHKeyR :: Id PublicSSHKey -> GenRequest 'MtUnit 'RW () deleteUserPublicSSHKeyR keyId = - command Delete ["user", "keys", toPathPart keyId] mempty + Command Delete ["user", "keys", toPathPart keyId] mempty diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index d1860dba..4da807f0 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -331,8 +331,10 @@ parseStatus m (Status sci _) = -- Unit ------------------------------------------------------------------------------- +-- | Note: we don't ignore response status. +-- +-- We only accept any response body. instance Accept 'MtUnit where - modifyRequest = Tagged setRequestIgnoreStatus instance a ~ () => ParseResponse 'MtUnit a where parseResponse _ _ = Tagged (return ()) From 334d451b55c1b9925bd576faa26b8fc478759f77 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Fri, 31 May 2019 13:07:52 +0300 Subject: [PATCH 375/510] Add openssl flag --- cabal.project | 2 ++ github.cabal | 23 ++++++++++++++++++----- src/GitHub/Request.hs | 30 +++++++++++++++++++++++++++--- 3 files changed, 47 insertions(+), 8 deletions(-) diff --git a/cabal.project b/cabal.project index 2f1a8084..b74f6712 100644 --- a/cabal.project +++ b/cabal.project @@ -10,3 +10,5 @@ constraints: semigroups ^>=0.19 allow-newer: aeson-1.4.3.0:hashable allow-newer: aeson-1.4.3.0:semigroups + +constraints: github +openssl diff --git a/github.cabal b/github.cabal index 4380742d..e0be1ae2 100644 --- a/github.cabal +++ b/github.cabal @@ -47,6 +47,11 @@ source-repository head type: git location: git://github.com/phadej/github.git +flag openssl + description: "Use http-client-openssl" + manual: True + default: False + library default-language: Haskell2010 ghc-options: -Wall @@ -165,18 +170,26 @@ library , exceptions >=0.10.2 && <0.11 , hashable >=1.2.7.0 && <1.4 , http-client >=0.5.12 && <0.7 - , http-client-tls >=0.3.5.3 && <0.4 , http-link-header >=1.0.3.1 && <1.1 , http-types >=0.12.3 && <0.13 , iso8601-time >=0.1.5 && <0.2 , network-uri >=2.6.1.0 && <2.7 - , tagged - , tls >=1.4.1 + , tagged >=0.8.5 && <0.9 , transformers-compat >=0.6.5 && <0.7 , unordered-containers >=0.2.10.0 && <0.3 , vector >=0.12.0.1 && <0.13 , vector-instances >=3.4 && <3.5 + if flag(openssl) + build-depends: + http-client-openssl >=0.3.0.0 && <0.4 + , HsOpenSSL >=0.11.4.16 && <0.12 + , HsOpenSSL-x509-system >=0.1.0.3 && <0.2 + else + build-depends: + http-client-tls >=0.3.5.3 && <0.4 + , tls >=1.4.1 + if !impl(ghc >= 8.0) build-depends: semigroups >=0.18.5 && <0.20 @@ -186,8 +199,8 @@ test-suite github-test type: exitcode-stdio-1.0 hs-source-dirs: spec main-is: Spec.hs - ghc-options: -Wall - build-tool-depends: hspec-discover:hspec-discover >=2.6.1 && <2.8 + ghc-options: -Wall -threaded + build-tool-depends: hspec-discover:hspec-discover >=2.7.1 && <2.8 other-extensions: TemplateHaskell other-modules: GitHub.ActivitySpec diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index 4da807f0..2ad73a30 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -74,7 +74,6 @@ import Network.HTTP.Client (HttpException (..), Manager, RequestBody (..), Response (..), getUri, httpLbs, method, newManager, redirectCount, requestBody, requestHeaders, setQueryString, setRequestIgnoreStatus) -import Network.HTTP.Client.TLS (tlsManagerSettings) import Network.HTTP.Link.Parser (parseLinkHeaderBS) import Network.HTTP.Link.Types (Link (..), LinkParam (..), href, linkParams) import Network.HTTP.Types (Method, RequestHeaders, Status (..)) @@ -88,18 +87,43 @@ import qualified Data.Vector as V import qualified Network.HTTP.Client as HTTP import qualified Network.HTTP.Client.Internal as HTTP +#ifdef MIN_VERSION_http_client_tls +import Network.HTTP.Client.TLS (tlsManagerSettings) +#else +import Network.HTTP.Client.OpenSSL (opensslManagerSettings, withOpenSSL) + +import qualified OpenSSL.Session as SSL +import qualified OpenSSL.X509.SystemStore as SSL +#endif + import GitHub.Auth (Auth, AuthMethod, endpoint, setAuthRequest) import GitHub.Data (Error (..)) import GitHub.Data.PullRequests (MergeResult (..)) import GitHub.Data.Request +#ifdef MIN_VERSION_http_client_tls +withOpenSSL :: IO a -> IO a +withOpenSSL = id +#else +tlsManagerSettings :: HTTP.ManagerSettings +tlsManagerSettings = opensslManagerSettings $ do + ctx <- SSL.context + SSL.contextAddOption ctx SSL.SSL_OP_NO_SSLv2 + SSL.contextAddOption ctx SSL.SSL_OP_NO_SSLv3 + SSL.contextAddOption ctx SSL.SSL_OP_NO_TLSv1 + SSL.contextSetCiphers ctx "ECDHE-ECDSA-AES256-GCM-SHA384:ECDHE-RSA-AES256-GCM-SHA384:ECDHE-ECDSA-CHACHA20-POLY1305:ECDHE-RSA-CHACHA20-POLY1305:ECDHE-ECDSA-AES128-GCM-SHA256:ECDHE-RSA-AES128-GCM-SHA256:ECDHE-ECDSA-AES256-SHA384:ECDHE-RSA-AES256-SHA384:ECDHE-ECDSA-AES128-SHA256:ECDHE-RSA-AES128-SHA256" + SSL.contextLoadSystemCerts ctx + SSL.contextSetVerificationMode ctx $ SSL.VerifyPeer True True Nothing + return ctx +#endif + -- | Execute 'Request' in 'IO' executeRequest :: (AuthMethod am, ParseResponse mt a) => am -> GenRequest mt rw a -> IO (Either Error a) -executeRequest auth req = do +executeRequest auth req = withOpenSSL $ withOpenSSL $ do manager <- newManager tlsManagerSettings executeRequestWithMgr manager auth req @@ -137,7 +161,7 @@ executeRequestWithMgr mgr auth req = runExceptT $ do -- | Like 'executeRequest' but without authentication. executeRequest' :: ParseResponse mt a => GenRequest mt 'RO a -> IO (Either Error a) -executeRequest' req = do +executeRequest' req = withOpenSSL $ do manager <- newManager tlsManagerSettings executeRequestWithMgr' manager req From 7d06a0fc02460889fbfc57a5b4d721d647775fe5 Mon Sep 17 00:00:00 2001 From: Ivan Malison Date: Tue, 4 Jun 2019 21:20:21 -0700 Subject: [PATCH 376/510] Update nix files --- default.nix | 29 +++-------------------------- overlay.nix | 31 +++++++++++++++++++++++++++++++ 2 files changed, 34 insertions(+), 26 deletions(-) create mode 100644 overlay.nix diff --git a/default.nix b/default.nix index 4b04872b..e8e50a1b 100644 --- a/default.nix +++ b/default.nix @@ -1,26 +1,3 @@ -{ mkDerivation, aeson, attoparsec, base, base16-bytestring -, byteable, bytestring, case-insensitive, conduit, containers -, cryptohash, data-default, failure, hashable, hspec, HTTP -, http-conduit, http-types, network, old-locale, stdenv, text, time -, unordered-containers, vector -}: -mkDerivation { - pname = "github"; - version = "0.14.0"; - src = ./.; - buildDepends = [ - aeson attoparsec base base16-bytestring byteable bytestring - case-insensitive conduit containers cryptohash data-default failure - hashable HTTP http-conduit http-types network old-locale text time - unordered-containers vector - ]; - testDepends = [ - aeson attoparsec base base16-bytestring byteable bytestring - case-insensitive conduit containers cryptohash data-default failure - hashable hspec HTTP http-conduit http-types network old-locale text - time unordered-containers vector - ]; - homepage = "https://github.com/fpco/github"; - description = "Access to the Github API, v3"; - license = stdenv.lib.licenses.bsd3; -} +let + pkgs = import { overlays = [ (import ./overlay.nix) ]; }; +in pkgs.haskellPackages.callCabal2nix "github" ./. { } diff --git a/overlay.nix b/overlay.nix new file mode 100644 index 00000000..173f195e --- /dev/null +++ b/overlay.nix @@ -0,0 +1,31 @@ +_: pkgs: { + haskellPackages = pkgs.haskellPackages.override (old: { + overrides = pkgs.lib.composeExtensions (old.overrides or (_: _: {})) (self: super: { + unordered-containers = pkgs.haskell.lib.overrideCabal super.unordered-containers (_: { + version = "0.2.10.0"; + sha256 = "0wy5hfrs880hh8hvp648bl07ws777n3kkmczzdszr7papnyigwb5"; + }); + binary-instances = pkgs.haskell.lib.dontCheck (pkgs.haskell.lib.overrideCabal super.binary-instances (old: { + libraryHaskellDepends = old.libraryHaskellDepends ++ [ + self.binary-orphans_1_0_1 + ]; + broken = false; + })); + binary-orphans_1_0_1 = pkgs.haskell.lib.dontCheck super.binary-orphans_1_0_1; + github = pkgs.haskell.lib.overrideCabal super.github (old: { + version = "0.22"; + sha256 = "15py79qcpj0k331i42njgwkirwyiacbc5razmxnm4672dvvip2qk"; + libraryHaskellDepends = old.libraryHaskellDepends ++ [ + self.binary-instances self.exceptions self.transformers-compat + ]; + }); + time-compat = pkgs.haskell.lib.dontCheck (pkgs.haskell.lib.overrideCabal super.time-compat (old: { + version = "1.9.2.2"; + sha256 = "05va0rqs759vbridbcl6hksp967j9anjvys8vx72fnfkhlrn2s52"; + libraryHaskellDepends = old.libraryHaskellDepends ++ [ + self.base-orphans + ]; + })); + }); + }); +} From 00310c34a9cc2c2cd5523ae42288b68f7e200f93 Mon Sep 17 00:00:00 2001 From: Attila Domokos Date: Thu, 27 Jun 2019 01:05:29 -0500 Subject: [PATCH 377/510] Fix compile time warnings --- samples/Users/PublicSSHKeys/CreatePublicSSHKey.hs | 5 ++--- samples/Users/PublicSSHKeys/ListPublicSSHKeys.hs | 1 - samples/Users/PublicSSHKeys/ShowPublicSSHKey.hs | 1 - 3 files changed, 2 insertions(+), 5 deletions(-) diff --git a/samples/Users/PublicSSHKeys/CreatePublicSSHKey.hs b/samples/Users/PublicSSHKeys/CreatePublicSSHKey.hs index e8cd6874..7ccdf478 100644 --- a/samples/Users/PublicSSHKeys/CreatePublicSSHKey.hs +++ b/samples/Users/PublicSSHKeys/CreatePublicSSHKey.hs @@ -4,15 +4,14 @@ module Main (main) where import qualified GitHub.Data.PublicSSHKeys as PK import qualified GitHub.Endpoints.Users.PublicSSHKeys as PK import qualified GitHub.Auth as Auth -import Data.Text (Text) main :: IO () main = do let auth = Auth.OAuth "auth_token" ePublicSSHKey <- PK.createUserPublicSSHKey' auth newPublicSSHKey case ePublicSSHKey of - (Left err) -> putStrLn $ "Error: " ++ (show err) - (Right publicSSHKey) -> putStrLn $ show publicSSHKey + Left err -> putStrLn $ "Error: " ++ show err + Right publicSSHKey -> print publicSSHKey newPublicSSHKey :: PK.NewPublicSSHKey newPublicSSHKey = diff --git a/samples/Users/PublicSSHKeys/ListPublicSSHKeys.hs b/samples/Users/PublicSSHKeys/ListPublicSSHKeys.hs index 645390f4..2a485127 100644 --- a/samples/Users/PublicSSHKeys/ListPublicSSHKeys.hs +++ b/samples/Users/PublicSSHKeys/ListPublicSSHKeys.hs @@ -1,7 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} module Main (main) where -import qualified GitHub.Data.PublicSSHKeys as PK import qualified GitHub.Endpoints.Users.PublicSSHKeys as PK import qualified GitHub.Auth as Auth import Data.List (intercalate) diff --git a/samples/Users/PublicSSHKeys/ShowPublicSSHKey.hs b/samples/Users/PublicSSHKeys/ShowPublicSSHKey.hs index f9fe4829..249a3728 100644 --- a/samples/Users/PublicSSHKeys/ShowPublicSSHKey.hs +++ b/samples/Users/PublicSSHKeys/ShowPublicSSHKey.hs @@ -2,7 +2,6 @@ module Main (main) where import GitHub.Data.Id (Id (..)) -import qualified GitHub.Data.PublicSSHKeys as PK import qualified GitHub.Endpoints.Users.PublicSSHKeys as PK import qualified GitHub.Auth as Auth From e850e83b104abfefb1fbd0f1317f973252029b90 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Thu, 12 Sep 2019 12:11:10 +0300 Subject: [PATCH 378/510] Support ghc-8.8.1 --- .travis.yml | 86 ++++--- cabal.haskell-ci | 2 + cabal.project | 8 +- github.cabal | 42 ++-- samples/LICENSE | 1 + samples/Users/Followers/Example.hs | 2 +- samples/github-samples.cabal | 390 +++++++++-------------------- src/GitHub/Data/Deployments.hs | 5 +- 8 files changed, 197 insertions(+), 339 deletions(-) create mode 100644 cabal.haskell-ci create mode 120000 samples/LICENSE diff --git a/.travis.yml b/.travis.yml index f041988c..594e2d55 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,10 +1,10 @@ # This Travis job script has been generated by a script via # -# haskell-ci '--branches' 'master' '-o' '.travis.yml' 'github.cabal' +# haskell-ci '--config=cabal.haskell-ci' 'cabal.project' # # For more information, see https://github.com/haskell-CI/haskell-ci # -# version: 0.3.20190521 +# version: 0.5.20190908 # language: c dist: xenial @@ -31,30 +31,29 @@ matrix: include: - compiler: ghc-8.8.1 addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.8.1","cabal-install-3.0"]}} - env: GHCHEAD=true - compiler: ghc-8.6.5 - addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.6.5","cabal-install-2.4"]}} + addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.6.5","cabal-install-3.0"]}} - compiler: ghc-8.4.4 - addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.4.4","cabal-install-2.4"]}} + addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.4.4","cabal-install-3.0"]}} - compiler: ghc-8.2.2 - addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.2.2","cabal-install-2.4"]}} + addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.2.2","cabal-install-3.0"]}} - compiler: ghc-8.0.2 - addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.0.2","cabal-install-2.4"]}} + addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.0.2","cabal-install-3.0"]}} - compiler: ghc-7.10.3 - addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.10.3","cabal-install-2.4"]}} + addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.10.3","cabal-install-3.0"]}} - compiler: ghc-7.8.4 - addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.8.4","cabal-install-2.4"]}} - allow_failures: - - compiler: ghc-8.8.1 + addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.8.4","cabal-install-3.0"]}} before_install: - HC=$(echo "/opt/$CC/bin/ghc" | sed 's/-/\//') + - WITHCOMPILER="-w $HC" + - HADDOCK=$(echo "/opt/$CC/bin/haddock" | sed 's/-/\//') - HCPKG="$HC-pkg" - unset CC - CABAL=/opt/ghc/bin/cabal - CABALHOME=$HOME/.cabal - export PATH="$CABALHOME/bin:$PATH" - TOP=$(pwd) - - HCNUMVER=$(( $(${HC} --numeric-version|sed -E 's/([0-9]+)\.([0-9]+)\.([0-9]+).*/\1 * 10000 + \2 * 100 + \3/') )) + - "HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\\d+)\\.(\\d+)\\.(\\d+)(\\.(\\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')" - echo $HCNUMVER - CABAL="$CABAL -vnormal+nowrap+markoutput" - set -o pipefail @@ -81,11 +80,12 @@ install: - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]" - TEST=--enable-tests - BENCH=--enable-benchmarks - - GHCHEAD=${GHCHEAD-false} + - HEADHACKAGE=false - rm -f $CABALHOME/config - | echo "verbose: normal +nowrap +markoutput" >> $CABALHOME/config echo "remote-build-reporting: anonymous" >> $CABALHOME/config + echo "write-ghc-environment-files: always" >> $CABALHOME/config echo "remote-repo-cache: $CABALHOME/packages" >> $CABALHOME/config echo "logs-dir: $CABALHOME/logs" >> $CABALHOME/config echo "world-file: $CABALHOME/world" >> $CABALHOME/config @@ -99,17 +99,8 @@ install: echo "repository hackage.haskell.org" >> $CABALHOME/config echo " url: http://hackage.haskell.org/" >> $CABALHOME/config - | - if $GHCHEAD; then - echo "allow-newer: $($HCPKG list --simple-output | sed -E 's/([a-zA-Z-]+)-[0-9.]+/*:\1/g')" >> $CABALHOME/config - - echo "repository head.hackage" >> $CABALHOME/config - echo " url: http://head.hackage.haskell.org/" >> $CABALHOME/config - echo " secure: True" >> $CABALHOME/config - echo " root-keys: 07c59cb65787dedfaef5bd5f987ceb5f7e5ebf88b904bbd4c5cbdeb2ff71b740" >> $CABALHOME/config - echo " 2e8555dde16ebd8df076f1a8ef13b8f14c66bad8eafefd7d9e37d0ed711821fb" >> $CABALHOME/config - echo " 8f79fd2389ab2967354407ec852cbe73f2e8635793ac446d09461ffb99527f6e" >> $CABALHOME/config - echo " key-threshold: 3" >> $CABALHOME/config - fi + echo "program-default-options" >> $CABALHOME/config + echo " ghc-options: $GHCJOBS +RTS -M6G -RTS" >> $CABALHOME/config - cat $CABALHOME/config - rm -fv cabal.project cabal.project.local cabal.project.freeze - travis_retry ${CABAL} v2-update -v @@ -117,18 +108,23 @@ install: - rm -rf cabal.project cabal.project.local cabal.project.freeze - touch cabal.project - | - echo 'packages: "."' >> cabal.project + echo "packages: ." >> cabal.project + echo "packages: samples" >> cabal.project - | - echo "write-ghc-environment-files: always" >> cabal.project - - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(github)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" + echo "constraints: hashable ^>=1.3" >> cabal.project + echo "constraints: semigroups ^>=0.19" >> cabal.project + echo "constraints: github +openssl" >> cabal.project + echo "optimization: False" >> cabal.project + - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(github|github-samples)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" - cat cabal.project || true - cat cabal.project.local || true - if [ -f "./configure.ac" ]; then (cd "." && autoreconf -i); fi - - ${CABAL} v2-freeze -w ${HC} ${TEST} ${BENCH} | color_cabal_output + - if [ -f "samples/configure.ac" ]; then (cd "samples" && autoreconf -i); fi + - ${CABAL} v2-freeze $WITHCOMPILER ${TEST} ${BENCH} | color_cabal_output - "cat cabal.project.freeze | sed -E 's/^(constraints: *| *)//' | sed 's/any.//'" - rm cabal.project.freeze - - ${CABAL} v2-build -w ${HC} ${TEST} ${BENCH} --dep -j2 all | color_cabal_output - - ${CABAL} v2-build -w ${HC} --disable-tests --disable-benchmarks --dep -j2 all | color_cabal_output + - ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} --dep -j2 all | color_cabal_output + - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks --dep -j2 all | color_cabal_output script: - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX) # Packaging... @@ -136,32 +132,40 @@ script: # Unpacking... - mv dist-newstyle/sdist/*.tar.gz ${DISTDIR}/ - cd ${DISTDIR} || false - - find . -maxdepth 1 -name '*.tar.gz' -exec tar -xvf '{}' \; + - find . -maxdepth 1 -type f -name '*.tar.gz' -exec tar -xvf '{}' \; + - find . -maxdepth 1 -type f -name '*.tar.gz' -exec rm '{}' \; + - PKGDIR_github="$(find . -maxdepth 1 -type d -regex '.*/github-[0-9.]*')" + - PKGDIR_github_samples="$(find . -maxdepth 1 -type d -regex '.*/github-samples-[0-9.]*')" # Generate cabal.project - rm -rf cabal.project cabal.project.local cabal.project.freeze - touch cabal.project - | - echo 'packages: "github-*/*.cabal"' >> cabal.project + echo "packages: ${PKGDIR_github}" >> cabal.project + echo "packages: ${PKGDIR_github_samples}" >> cabal.project - | - echo "write-ghc-environment-files: always" >> cabal.project - - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(github)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" + echo "constraints: hashable ^>=1.3" >> cabal.project + echo "constraints: semigroups ^>=0.19" >> cabal.project + echo "constraints: github +openssl" >> cabal.project + echo "optimization: False" >> cabal.project + - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(github|github-samples)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" - cat cabal.project || true - cat cabal.project.local || true # Building... # this builds all libraries and executables (without tests/benchmarks) - - ${CABAL} v2-build -w ${HC} --disable-tests --disable-benchmarks all | color_cabal_output + - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all | color_cabal_output # Building with tests and benchmarks... # build & run tests, build benchmarks - - ${CABAL} v2-build -w ${HC} ${TEST} ${BENCH} all | color_cabal_output + - ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} all | color_cabal_output # Testing... - - ${CABAL} v2-test -w ${HC} ${TEST} ${BENCH} all | color_cabal_output + - ${CABAL} v2-test $WITHCOMPILER ${TEST} ${BENCH} all | color_cabal_output # cabal check... - - (cd github-* && ${CABAL} -vnormal check) + - (cd ${PKGDIR_github} && ${CABAL} -vnormal check) + - (cd ${PKGDIR_github_samples} && ${CABAL} -vnormal check) # haddock... - - ${CABAL} v2-haddock -w ${HC} ${TEST} ${BENCH} all | color_cabal_output + - if [ $HCNUMVER -ge 80600 ] ; then ${CABAL} v2-haddock $WITHCOMPILER --with-haddock $HADDOCK ${TEST} ${BENCH} all | color_cabal_output ; fi # Building without installed constraints for packages in global-db... - rm -f cabal.project.local - - ${CABAL} v2-build -w ${HC} --disable-tests --disable-benchmarks all | color_cabal_output + - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all | color_cabal_output -# REGENDATA ["--branches","master","-o",".travis.yml","github.cabal"] +# REGENDATA ["--config=cabal.haskell-ci","cabal.project"] # EOF diff --git a/cabal.haskell-ci b/cabal.haskell-ci new file mode 100644 index 00000000..bcb8a5d9 --- /dev/null +++ b/cabal.haskell-ci @@ -0,0 +1,2 @@ +branches: master +haddock: >=8.6 diff --git a/cabal.project b/cabal.project index b74f6712..26dc579d 100644 --- a/cabal.project +++ b/cabal.project @@ -1,6 +1,5 @@ -packages: - "." - samples +packages: . +packages: samples optimization: False tests: True @@ -8,7 +7,4 @@ tests: True constraints: hashable ^>=1.3 constraints: semigroups ^>=0.19 -allow-newer: aeson-1.4.3.0:hashable -allow-newer: aeson-1.4.3.0:semigroups - constraints: github +openssl diff --git a/github.cabal b/github.cabal index e0be1ae2..0a690566 100644 --- a/github.cabal +++ b/github.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: github -version: 0.22 +version: 0.23 synopsis: Access to the GitHub API, v3. category: Network description: @@ -30,7 +30,13 @@ copyright: Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016-2019 Oleg Grenrus tested-with: - GHC ==7.8.4 || ==7.10.3 || ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.1 + GHC ==7.8.4 + || ==7.10.3 + || ==8.0.2 + || ==8.2.2 + || ==8.4.4 + || ==8.6.5 + || ==8.8.1 extra-source-files: README.md @@ -49,8 +55,8 @@ source-repository head flag openssl description: "Use http-client-openssl" - manual: True - default: False + manual: True + default: False library default-language: Haskell2010 @@ -106,8 +112,8 @@ library GitHub.Data.Webhooks GitHub.Data.Webhooks.Validate GitHub.Endpoints.Activity.Events - GitHub.Endpoints.Activity.Starring GitHub.Endpoints.Activity.Notifications + GitHub.Endpoints.Activity.Starring GitHub.Endpoints.Activity.Watching GitHub.Endpoints.Gists GitHub.Endpoints.Gists.Comments @@ -135,10 +141,10 @@ library GitHub.Endpoints.Repos.DeployKeys GitHub.Endpoints.Repos.Deployments GitHub.Endpoints.Repos.Forks + GitHub.Endpoints.Repos.Invitations GitHub.Endpoints.Repos.Releases GitHub.Endpoints.Repos.Statuses GitHub.Endpoints.Repos.Webhooks - GitHub.Endpoints.Repos.Invitations GitHub.Endpoints.Search GitHub.Endpoints.Users GitHub.Endpoints.Users.Emails @@ -149,7 +155,7 @@ library -- Packages bundles with GHC, mtl and text are also here build-depends: - base >=4.7 && <4.13 + base >=4.7 && <4.14 , binary >=0.7.1.0 && <0.11 , bytestring >=0.10.4.0 && <0.11 , containers >=0.5.5.1 && <0.7 @@ -162,7 +168,7 @@ library -- other packages build-depends: aeson >=1.4.0.0 && <1.5 - , base-compat >=0.10.4 && <0.11 + , base-compat >=0.10.4 && <0.12 , base16-bytestring >=0.1.1.6 && <0.2 , binary-instances >=1 && <1.1 , cryptohash-sha1 >=0.11.100.1 && <0.12 @@ -182,17 +188,17 @@ library if flag(openssl) build-depends: - http-client-openssl >=0.3.0.0 && <0.4 - , HsOpenSSL >=0.11.4.16 && <0.12 - , HsOpenSSL-x509-system >=0.1.0.3 && <0.2 + HsOpenSSL >=0.11.4.16 && <0.12 + , HsOpenSSL-x509-system >=0.1.0.3 && <0.2 + , http-client-openssl >=0.2.2.0 && <0.4 + else build-depends: - http-client-tls >=0.3.5.3 && <0.4 - , tls >=1.4.1 + http-client-tls >=0.3.5.3 && <0.4 + , tls >=1.4.1 - if !impl(ghc >= 8.0) - build-depends: - semigroups >=0.18.5 && <0.20 + if !impl(ghc >=8.0) + build-depends: semigroups >=0.18.5 && <0.20 test-suite github-test default-language: Haskell2010 @@ -208,8 +214,8 @@ test-suite github-test GitHub.EventsSpec GitHub.IssuesSpec GitHub.OrganizationsSpec - GitHub.PullRequestReviewsSpec GitHub.PublicSSHKeysSpec + GitHub.PullRequestReviewsSpec GitHub.PullRequestsSpec GitHub.RateLimitSpec GitHub.ReleasesSpec @@ -224,8 +230,8 @@ test-suite github-test , bytestring , file-embed , github + , hspec >=2.6.1 && <2.8 , tagged , text - , hspec >=2.6.1 && <2.8 , unordered-containers , vector diff --git a/samples/LICENSE b/samples/LICENSE new file mode 120000 index 00000000..ea5b6064 --- /dev/null +++ b/samples/LICENSE @@ -0,0 +1 @@ +../LICENSE \ No newline at end of file diff --git a/samples/Users/Followers/Example.hs b/samples/Users/Followers/Example.hs index 78243e9e..6d71c8a5 100644 --- a/samples/Users/Followers/Example.hs +++ b/samples/Users/Followers/Example.hs @@ -1,11 +1,11 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} +import Prelude () import Prelude.Compat import Data.Text (Text, pack) import Data.Text.IO as T (putStrLn) -import Data.Monoid ((<>)) import qualified GitHub.Endpoints.Users.Followers as GitHub diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index 4595e3dd..07538abc 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -1,324 +1,170 @@ -name: github-samples -version: 0.0.0 -build-type: Simple -cabal-version: >= 1.10 +cabal-version: 2.2 +name: github-samples +version: 0.0.0 +category: Examples +synopsis: Samples for github package +license: BSD-3-Clause +license-file: LICENSE +maintainer: Oleg Grenrus +description: Various samples of github package +build-type: Simple +tested-with: + GHC ==7.8.4 + || ==7.10.3 + || ==8.0.2 + || ==8.2.2 + || ==8.4.4 + || ==8.6.5 + || ==8.8.1 library - hs-source-dirs: - src - ghc-options: -Wall + hs-source-dirs: src + ghc-options: -Wall build-depends: - base - , base-compat + , base >=4.7 && <5 + , base-compat-batteries , github , text - exposed-modules: - Common + + exposed-modules: Common default-language: Haskell2010 -executable github-add-team-membership-for - main-is: AddTeamMembershipFor.hs - hs-source-dirs: - Teams/Memberships - ghc-options: -Wall +-- executable github-operational +-- main-is: Operational.hs +-- hs-source-dirs: +-- Operational +-- ghc-options: -Wall +-- build-depends: +-- base <5 +-- , base-compat-batteries +-- , github +-- , text +-- , github-samples +-- , http-client +-- , http-client-tls +-- , operational +-- , transformers +-- , transformers-compat +-- default-language: Haskell2010 + +common deps + default-language: Haskell2010 + ghc-options: -Wall build-depends: - base - , base-compat + , base >=4.7 && <5 + , base-compat-batteries + , base64-bytestring , github - , text , github-samples - default-language: Haskell2010 + , text + , vector + +executable github-add-team-membership-for + import: deps + main-is: AddTeamMembershipFor.hs + hs-source-dirs: Teams/Memberships executable github-create-deploy-key - main-is: CreateDeployKey.hs - hs-source-dirs: - Repos/DeployKeys - ghc-options: -Wall - build-depends: - base - , base-compat - , github - , text - , github-samples - default-language: Haskell2010 + import: deps + main-is: CreateDeployKey.hs + hs-source-dirs: Repos/DeployKeys executable github-delete-deploy-key - main-is: DeleteDeployKey.hs - hs-source-dirs: - Repos/DeployKeys - ghc-options: -Wall - build-depends: - base - , base-compat - , github - , text - , github-samples - default-language: Haskell2010 + import: deps + main-is: DeleteDeployKey.hs + hs-source-dirs: Repos/DeployKeys executable github-delete-team - main-is: DeleteTeam.hs - hs-source-dirs: - Teams - ghc-options: -Wall - build-depends: - base - , base-compat - , github - , text - , github-samples - default-language: Haskell2010 + import: deps + main-is: DeleteTeam.hs + hs-source-dirs: Teams executable github-delete-team-membership-for - main-is: DeleteTeamMembershipFor.hs - hs-source-dirs: - Teams/Memberships - ghc-options: -Wall - build-depends: - base - , base-compat - , github - , text - , github-samples - default-language: Haskell2010 + import: deps + main-is: DeleteTeamMembershipFor.hs + hs-source-dirs: Teams/Memberships executable github-edit-team - main-is: EditTeam.hs - hs-source-dirs: - Teams - ghc-options: -Wall - build-depends: - base - , base-compat - , github - , text - , github-samples - default-language: Haskell2010 + import: deps + main-is: EditTeam.hs + hs-source-dirs: Teams executable github-list-deploy-keys-for - main-is: ListDeployKeys.hs - hs-source-dirs: - Repos/DeployKeys - ghc-options: -Wall - build-depends: - base - , base-compat - , github - , text - , github-samples - , vector - default-language: Haskell2010 + import: deps + main-is: ListDeployKeys.hs + hs-source-dirs: Repos/DeployKeys executable github-list-followers - main-is: ListFollowers.hs - hs-source-dirs: - Users/Followers - ghc-options: -Wall - build-depends: - base - , base-compat - , github - , text - , github-samples - default-language: Haskell2010 + import: deps + main-is: ListFollowers.hs + hs-source-dirs: Users/Followers executable github-list-followers-example - main-is: Example.hs - hs-source-dirs: - Users/Followers - ghc-options: -Wall - build-depends: - base - , base-compat - , github - , text - default-language: Haskell2010 + import: deps + main-is: Example.hs + hs-source-dirs: Users/Followers executable github-list-following - main-is: ListFollowing.hs - hs-source-dirs: - Users/Followers - ghc-options: -Wall - build-depends: - base - , base-compat - , github - , text - , github-samples - default-language: Haskell2010 + import: deps + main-is: ListFollowing.hs + hs-source-dirs: Users/Followers executable github-list-team-current - main-is: ListTeamsCurrent.hs - hs-source-dirs: - Teams - ghc-options: -Wall - build-depends: - base - , base-compat - , github - , text - , github-samples - default-language: Haskell2010 + import: deps + main-is: ListTeamsCurrent.hs + hs-source-dirs: Teams executable github-list-team-repos - main-is: ListRepos.hs - hs-source-dirs: - Teams - ghc-options: -Wall - build-depends: - base - , base-compat - , github - , text - , github-samples - default-language: Haskell2010 - -executable github-operational - main-is: Operational.hs - hs-source-dirs: - Operational - ghc-options: -Wall - build-depends: - base - , base-compat - , github - , text - , github-samples - , http-client - , http-client-tls - , operational - , transformers - , transformers-compat - default-language: Haskell2010 + import: deps + main-is: ListRepos.hs + hs-source-dirs: Teams executable github-repos-contents-example - main-is: Contents.hs - hs-source-dirs: - Repos - ghc-options: -Wall - build-depends: - base - , base-compat - , base64-bytestring - , github - , github-samples - , text - , vector - default-language: Haskell2010 + import: deps + main-is: Contents.hs + hs-source-dirs: Repos executable github-show-deploy-key - main-is: ShowDeployKey.hs - hs-source-dirs: - Repos/DeployKeys - ghc-options: -Wall - build-depends: - base - , base-compat - , github - , text - , github-samples - default-language: Haskell2010 + import: deps + main-is: ShowDeployKey.hs + hs-source-dirs: Repos/DeployKeys executable github-show-user - main-is: ShowUser.hs - hs-source-dirs: - Users - ghc-options: -Wall - build-depends: - base - , base-compat - , github - , text - , github-samples - default-language: Haskell2010 + import: deps + main-is: ShowUser.hs + hs-source-dirs: Users executable github-show-user-2 - main-is: ShowUser2.hs - hs-source-dirs: - Users - ghc-options: -Wall - build-depends: - base - , base-compat - , github - , text - , github-samples - default-language: Haskell2010 + import: deps + main-is: ShowUser2.hs + hs-source-dirs: Users executable github-team-membership-info-for - main-is: TeamMembershipInfoFor.hs - hs-source-dirs: - Teams/Memberships - ghc-options: -Wall - build-depends: - base - , base-compat - , github - , text - , github-samples - default-language: Haskell2010 + import: deps + main-is: TeamMembershipInfoFor.hs + hs-source-dirs: Teams/Memberships executable github-teaminfo-for - main-is: TeamInfoFor.hs - hs-source-dirs: - Teams - ghc-options: -Wall - build-depends: - base - , base-compat - , github - , text - , github-samples - default-language: Haskell2010 + import: deps + main-is: TeamInfoFor.hs + hs-source-dirs: Teams executable github-create-public-ssh-key - main-is: CreatePublicSSHKey.hs - hs-source-dirs: - Users/PublicSSHKeys - ghc-options: -Wall - build-depends: - base - , base-compat - , github - , text - , github-samples - default-language: Haskell2010 + import: deps + main-is: CreatePublicSSHKey.hs + hs-source-dirs: Users/PublicSSHKeys executable github-delete-public-ssh-key - main-is: DeletePublicSSHKey.hs - hs-source-dirs: - Users/PublicSSHKeys - ghc-options: -Wall - build-depends: - base - , base-compat - , github - , text - , github-samples - default-language: Haskell2010 + import: deps + main-is: DeletePublicSSHKey.hs + hs-source-dirs: Users/PublicSSHKeys executable github-list-public-ssh-keys - main-is: ListPublicSSHKeys.hs - hs-source-dirs: - Users/PublicSSHKeys - ghc-options: -Wall - build-depends: - base - , base-compat - , github - , text - , github-samples - , vector - default-language: Haskell2010 + import: deps + main-is: ListPublicSSHKeys.hs + hs-source-dirs: Users/PublicSSHKeys executable github-get-public-ssh-key - main-is: ShowPublicSSHKey.hs - hs-source-dirs: - Users/PublicSSHKeys - ghc-options: -Wall - build-depends: - base - , base-compat - , github - , text - , github-samples - default-language: Haskell2010 + import: deps + main-is: ShowPublicSSHKey.hs + hs-source-dirs: Users/PublicSSHKeys diff --git a/src/GitHub/Data/Deployments.hs b/src/GitHub/Data/Deployments.hs index 606d4077..9e65485d 100644 --- a/src/GitHub/Data/Deployments.hs +++ b/src/GitHub/Data/Deployments.hs @@ -12,6 +12,10 @@ module GitHub.Data.Deployments , CreateDeploymentStatus (..) ) where + +import GitHub.Internal.Prelude +import Prelude () + import Control.Arrow (second) import Data.ByteString (ByteString) @@ -24,7 +28,6 @@ import GitHub.Data.Definitions (SimpleUser) import GitHub.Data.Id (Id) import GitHub.Data.Name (Name) import GitHub.Data.URL (URL) -import GitHub.Internal.Prelude import qualified Data.Aeson as JSON import qualified Data.Text as T From 0ce3767d41c3a9ed1e548ef7aeb1fdb8543d0a11 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Domen=20Ko=C5=BEar?= Date: Wed, 4 Sep 2019 16:38:23 +0200 Subject: [PATCH 379/510] OwnerType: add OwnerBot --- fixtures/user-bot.json | 32 ++++++++++++++++++++++++++++++++ github.cabal | 1 + spec/GitHub/UsersSpec.hs | 4 ++++ src/GitHub/Data/Definitions.hs | 8 +++++--- 4 files changed, 42 insertions(+), 3 deletions(-) create mode 100644 fixtures/user-bot.json diff --git a/fixtures/user-bot.json b/fixtures/user-bot.json new file mode 100644 index 00000000..363ca887 --- /dev/null +++ b/fixtures/user-bot.json @@ -0,0 +1,32 @@ +{ + "login": "mike-burns", + "id": 4550, + "avatar_url": "https://avatars.githubusercontent.com/u/4550?v=3", + "gravatar_id": "", + "url": "https://api.github.com/users/mike-burns", + "html_url": "https://github.com/mike-burns", + "followers_url": "https://api.github.com/users/mike-burns/followers", + "following_url": "https://api.github.com/users/mike-burns/following{/other_user}", + "gists_url": "https://api.github.com/users/mike-burns/gists{/gist_id}", + "starred_url": "https://api.github.com/users/mike-burns/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/mike-burns/subscriptions", + "organizations_url": "https://api.github.com/users/mike-burns/orgs", + "repos_url": "https://api.github.com/users/mike-burns/repos", + "events_url": "https://api.github.com/users/mike-burns/events{/privacy}", + "received_events_url": "https://api.github.com/users/mike-burns/received_events", + "type": "Bot", + "site_admin": false, + "name": "Mike Burns", + "company": "thoughtbot", + "blog": "http://mike-burns.com/", + "location": "Stockholm, Sweden", + "email": "mburns@thoughtbot.com", + "hireable": true, + "bio": null, + "public_repos": 35, + "public_gists": 32, + "followers": 171, + "following": 0, + "created_at": "2008-04-03T17:54:24Z", + "updated_at": "2015-10-02T16:53:25Z" +} diff --git a/github.cabal b/github.cabal index e0be1ae2..86897e16 100644 --- a/github.cabal +++ b/github.cabal @@ -42,6 +42,7 @@ extra-source-files: fixtures/pull-request-review-requested.json fixtures/user-organizations.json fixtures/user.json + fixtures/user-bot.json source-repository head type: git diff --git a/spec/GitHub/UsersSpec.hs b/spec/GitHub/UsersSpec.hs index b0b201c2..6e55b649 100644 --- a/spec/GitHub/UsersSpec.hs +++ b/spec/GitHub/UsersSpec.hs @@ -41,6 +41,10 @@ spec = do let userInfo = eitherDecodeStrict $(embedFile "fixtures/user.json") userLogin (fromRightS userInfo) `shouldBe` "mike-burns" + it "decodes user-bot json" $ do + let userInfo = eitherDecodeStrict $(embedFile "fixtures/user-bot.json") + userLogin (fromRightS userInfo) `shouldBe` "mike-burns" + it "returns information about the user" $ withAuth $ \auth -> do userInfo <- userInfoFor' (Just auth) "mike-burns" userLogin (fromRightS userInfo) `shouldBe` "mike-burns" diff --git a/src/GitHub/Data/Definitions.hs b/src/GitHub/Data/Definitions.hs index de7f4e54..f4503e66 100644 --- a/src/GitHub/Data/Definitions.hs +++ b/src/GitHub/Data/Definitions.hs @@ -32,7 +32,7 @@ data Error instance E.Exception Error -- | Type of the repository owners. -data OwnerType = OwnerUser | OwnerOrganization +data OwnerType = OwnerUser | OwnerOrganization | OwnerBot deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic, Typeable, Data) instance NFData OwnerType @@ -77,7 +77,7 @@ data User = User { userId :: !(Id User) , userLogin :: !(Name User) , userName :: !(Maybe Text) - , userType :: !OwnerType -- ^ Should always be 'OwnerUser' + , userType :: !OwnerType -- ^ Should always be 'OwnerUser' or 'OwnerBot' , userCreatedAt :: !UTCTime , userPublicGists :: !Int , userAvatarUrl :: !URL @@ -137,6 +137,7 @@ instance FromJSON OwnerType where parseJSON = withText "OwnerType" $ \t -> case T.toLower t of "user" -> pure $ OwnerUser "organization" -> pure $ OwnerOrganization + "bot" -> pure $ OwnerBot _ -> fail $ "Unknown OwnerType: " <> T.unpack t instance FromJSON SimpleUser where @@ -205,7 +206,7 @@ parseOrganization obj = Organization <*> obj .: "created_at" instance FromJSON User where - parseJSON = mfilter ((== OwnerUser) . userType) . withObject "User" parseUser + parseJSON = mfilter ((/= OwnerOrganization) . userType) . withObject "User" parseUser instance FromJSON Organization where parseJSON = withObject "Organization" parseOrganization @@ -215,6 +216,7 @@ instance FromJSON Owner where t <- obj .: "type" case t of OwnerUser -> Owner . Left <$> parseUser obj + OwnerBot -> Owner . Left <$> parseUser obj OwnerOrganization -> Owner . Right <$> parseOrganization obj -- | Filter members returned in the list. From fb2aeb6968fed63c29b952d2aa512b91337f7a9e Mon Sep 17 00:00:00 2001 From: Scott Fleischman Date: Sun, 29 Sep 2019 13:58:43 -0700 Subject: [PATCH 380/510] Make File.fileSha optional. (#392) * Make File.fileSha optional. GitHub API for comparing commits returns a null "sha" field when the only change to a file is to its file system permissions. See the following repository for a complete example. https://github.com/scott-fleischman/repo-change-file-permission Example API call: https://api.github.com/repos/scott-fleischman/repo-change-file-permission/compare/80fdf8f83fcd8181411919fbf47394b878c591a0...77a95bbebeb78f4fb25c6a10c3c940b6fe1caa27 Response highlight: ``` "files": [ { "sha": null, "filename": "echo-script", "status": "modified", "additions": 0, "deletions": 0, "changes": 0, "blob_url": "https://github.com/scott-fleischman/repo-change-file-permission/blob/77a95bbebeb78f4fb25c6a10c3c940b6fe1caa27/echo-script", "raw_url": "https://github.com/scott-fleischman/repo-change-file-permission/raw/77a95bbebeb78f4fb25c6a10c3c940b6fe1caa27/echo-script", "contents_url": "https://api.github.com/repos/scott-fleischman/repo-change-file-permission/contents/echo-script?ref=77a95bbebeb78f4fb25c6a10c3c940b6fe1caa27" } ] ``` * Allow sha field to be missing in JSON serialization. * Use Common import. --- samples/Repos/Commits/GitDiff.hs | 25 +++++++++++++++++-------- samples/github-samples.cabal | 5 +++++ src/GitHub/Data/GitData.hs | 4 ++-- 3 files changed, 24 insertions(+), 10 deletions(-) diff --git a/samples/Repos/Commits/GitDiff.hs b/samples/Repos/Commits/GitDiff.hs index 55d5a08f..c671b391 100644 --- a/samples/Repos/Commits/GitDiff.hs +++ b/samples/Repos/Commits/GitDiff.hs @@ -1,13 +1,22 @@ -module GitDiff where +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} -import qualified Github.Repos.Commits as Github -import Data.List +module Main where +import Common +import qualified GitHub.Endpoints.Repos.Commits as Github +import qualified Data.Text.IO as Text + +main :: IO () main = do possibleDiff <- Github.diff "thoughtbot" "paperclip" "41f685f6e01396936bb8cd98e7cca517e2c7d96b" "HEAD" - either (\error -> putStrLn $ "Error: " ++ (show error)) - (putStrLn . showDiff) - possibleDiff + either (fail . show) (Text.putStrLn . showDiff) possibleDiff + + -- Check special case: when a file only changes file permissions in the commits, GitHub returns a null "sha" field for that file. + -- See https://github.com/scott-fleischman/repo-change-file-permission + diffFillNullSha <- Github.diff "scott-fleischman" "repo-change-file-permission" "80fdf8f83fcd8181411919fbf47394b878c591a0" "77a95bbebeb78f4fb25c6a10c3c940b6fe1caa27" + either (fail . show) (const $ Text.putStrLn "Successfully parsed diff with a file with a null sha") diffFillNullSha -showDiff diff = - intercalate "\n\n" $ map Github.filePatch $ Github.diffFiles diff + where + showDiff diff = + foldl (\x y -> x <> "\n\n" <> y) "" $ concatMap (maybe [] pure . Github.filePatch) $ Github.diffFiles diff diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index 07538abc..583629cc 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -168,3 +168,8 @@ executable github-get-public-ssh-key import: deps main-is: ShowPublicSSHKey.hs hs-source-dirs: Users/PublicSSHKeys + +executable github-repos-commits-diff + import: deps + main-is: GitDiff.hs + hs-source-dirs: Repos/Commits diff --git a/src/GitHub/Data/GitData.hs b/src/GitHub/Data/GitData.hs index edeef245..bce1cb52 100644 --- a/src/GitHub/Data/GitData.hs +++ b/src/GitHub/Data/GitData.hs @@ -188,7 +188,7 @@ data File = File , fileStatus :: !Text , fileRawUrl :: !(Maybe URL) , fileAdditions :: !Int - , fileSha :: !Text + , fileSha :: !(Maybe Text) , fileChanges :: !Int , filePatch :: !(Maybe Text) , fileFilename :: !Text @@ -255,7 +255,7 @@ instance FromJSON File where <*> o .: "status" <*> o .:? "raw_url" <*> o .: "additions" - <*> o .: "sha" + <*> o .:? "sha" <*> o .: "changes" <*> o .:? "patch" <*> o .: "filename" From eeb6b429365ca9b809295d8bc83f8cb968699b70 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 30 Sep 2019 00:03:12 +0300 Subject: [PATCH 381/510] Add changelog entries --- CHANGELOG.md | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 0b637c8e..452b4690 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,4 +1,9 @@ -## Changes for next +## Changes for 0.23 + +- Add OwnerBot to OwnerType + [#399](https://github.com/phadej/github/pull/399) +- Make File.fileSha optional + [#392](https://github.com/phadej/github/pull/392) ## Changes for 0.22 From 787c8dbf749e7574b559e1b223f9dcb0bec4406a Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 30 Sep 2019 00:07:03 +0300 Subject: [PATCH 382/510] Keep User-Agent header up to date --- CHANGELOG.md | 3 +++ github.cabal | 2 ++ src/GitHub/Request.hs | 10 +++++++--- 3 files changed, 12 insertions(+), 3 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 452b4690..880008de 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -4,6 +4,9 @@ [#399](https://github.com/phadej/github/pull/399) - Make File.fileSha optional [#392](https://github.com/phadej/github/pull/392) +- Update User-Agent to contain up to date version + [#403](https://github.com/phadej/github/pull/403) + [#394](https://github.com/phadej/github/pull/394) ## Changes for 0.22 diff --git a/github.cabal b/github.cabal index 49495443..33df9fe2 100644 --- a/github.cabal +++ b/github.cabal @@ -154,6 +154,8 @@ library GitHub.Internal.Prelude GitHub.Request + other-modules: Paths_github + -- Packages bundles with GHC, mtl and text are also here build-depends: base >=4.7 && <4.14 diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index 2ad73a30..d2fad11c 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -68,7 +68,9 @@ import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Except (ExceptT (..), runExceptT) import Data.Aeson (eitherDecode) import Data.List (find) +import Data.String (fromString) import Data.Tagged (Tagged (..)) +import Data.Version (showVersion) import Network.HTTP.Client (HttpException (..), Manager, RequestBody (..), Response (..), getUri, @@ -88,11 +90,11 @@ import qualified Network.HTTP.Client as HTTP import qualified Network.HTTP.Client.Internal as HTTP #ifdef MIN_VERSION_http_client_tls -import Network.HTTP.Client.TLS (tlsManagerSettings) +import Network.HTTP.Client.TLS (tlsManagerSettings) #else import Network.HTTP.Client.OpenSSL (opensslManagerSettings, withOpenSSL) -import qualified OpenSSL.Session as SSL +import qualified OpenSSL.Session as SSL import qualified OpenSSL.X509.SystemStore as SSL #endif @@ -101,6 +103,8 @@ import GitHub.Data (Error (..)) import GitHub.Data.PullRequests (MergeResult (..)) import GitHub.Data.Request +import Paths_github (version) + #ifdef MIN_VERSION_http_client_tls withOpenSSL :: IO a -> IO a withOpenSSL = id @@ -418,7 +422,7 @@ makeHttpRequest auth r = case r of setMethod m req = req { method = m } reqHeaders :: RequestHeaders - reqHeaders = [("User-Agent", "github.hs/0.21")] -- Version + reqHeaders = [("User-Agent", "github.hs/" <> fromString (showVersion version))] -- Version <> [("Accept", unTagged (contentType :: Tagged mt BS.ByteString))] setBody :: LBS.ByteString -> HTTP.Request -> HTTP.Request From 098031a3fd015b72ded982e64017a6ae7352c6d2 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 30 Sep 2019 00:20:15 +0300 Subject: [PATCH 383/510] Escape URI paths Resolves https://github.com/phadej/github/issues/398 --- .gitignore | 1 + CHANGELOG.md | 2 ++ src/GitHub/Request.hs | 9 ++++++--- 3 files changed, 9 insertions(+), 3 deletions(-) diff --git a/.gitignore b/.gitignore index 5b3e088e..452bddc6 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,4 @@ +.env dist dist-newstyle .ghc.environment.* diff --git a/CHANGELOG.md b/CHANGELOG.md index 880008de..fa23d79e 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,7 @@ ## Changes for 0.23 +- Escape URI paths + [#404](https://github.com/phadej/github/pull/404) - Add OwnerBot to OwnerType [#399](https://github.com/phadej/github/pull/399) - Make File.fileSha optional diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index d2fad11c..73c8be1b 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -67,7 +67,7 @@ import Control.Monad.Catch (MonadCatch (..), MonadThrow) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Except (ExceptT (..), runExceptT) import Data.Aeson (eitherDecode) -import Data.List (find) +import Data.List (find, intercalate) import Data.String (fromString) import Data.Tagged (Tagged (..)) import Data.Version (showVersion) @@ -79,7 +79,9 @@ import Network.HTTP.Client import Network.HTTP.Link.Parser (parseLinkHeaderBS) import Network.HTTP.Link.Types (Link (..), LinkParam (..), href, linkParams) import Network.HTTP.Types (Method, RequestHeaders, Status (..)) -import Network.URI (URI, parseURIReference, relativeTo) +import Network.URI + (URI, escapeURIString, isUnescapedInURIComponent, parseURIReference, + relativeTo) import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS @@ -413,7 +415,8 @@ makeHttpRequest auth r = case r of parseUrl' = HTTP.parseUrlThrow . T.unpack url :: Paths -> Text - url paths = maybe "https://api.github.com" id (endpoint =<< auth) <> "/" <> T.intercalate "/" paths + url paths = maybe "https://api.github.com" id (endpoint =<< auth) <> "/" <> T.pack (intercalate "/" paths') where + paths' = map (escapeURIString isUnescapedInURIComponent . T.unpack) paths setReqHeaders :: HTTP.Request -> HTTP.Request setReqHeaders req = req { requestHeaders = reqHeaders <> requestHeaders req } From a40db0d5365de175c01e0db5b97c7f477df812b8 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 30 Sep 2019 00:25:50 +0300 Subject: [PATCH 384/510] Less T.pack / T.unpack --- src/GitHub/Request.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index 73c8be1b..04d13c6d 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -411,11 +411,11 @@ makeHttpRequest auth r = case r of . setMethod (toMethod m) $ req where - parseUrl' :: MonadThrow m => Text -> m HTTP.Request - parseUrl' = HTTP.parseUrlThrow . T.unpack + parseUrl' :: MonadThrow m => String -> m HTTP.Request + parseUrl' = HTTP.parseUrlThrow - url :: Paths -> Text - url paths = maybe "https://api.github.com" id (endpoint =<< auth) <> "/" <> T.pack (intercalate "/" paths') where + url :: Paths -> String + url paths = maybe "https://api.github.com" T.unpack (endpoint =<< auth) ++ "/" ++ intercalate "/" paths' where paths' = map (escapeURIString isUnescapedInURIComponent . T.unpack) paths setReqHeaders :: HTTP.Request -> HTTP.Request From 6c743cfcb93420a01192105e5f1d86bf181d51d0 Mon Sep 17 00:00:00 2001 From: MATSUBARA Nobutada Date: Mon, 7 Oct 2019 14:40:06 +0900 Subject: [PATCH 385/510] Update EditRepo type --- src/GitHub/Data/Repos.hs | 57 +++++++++++++++++++++++++--------------- 1 file changed, 36 insertions(+), 21 deletions(-) diff --git a/src/GitHub/Data/Repos.hs b/src/GitHub/Data/Repos.hs index c476fbbb..3cb61f1d 100644 --- a/src/GitHub/Data/Repos.hs +++ b/src/GitHub/Data/Repos.hs @@ -91,13 +91,18 @@ newRepo :: Name Repo -> NewRepo newRepo name = NewRepo name Nothing Nothing Nothing Nothing Nothing Nothing data EditRepo = EditRepo - { editName :: !(Maybe (Name Repo)) - , editDescription :: !(Maybe Text) - , editHomepage :: !(Maybe Text) - , editPublic :: !(Maybe Bool) - , editHasIssues :: !(Maybe Bool) - , editHasWiki :: !(Maybe Bool) - , editHasDownloads :: !(Maybe Bool) + { editName :: !(Maybe (Name Repo)) + , editDescription :: !(Maybe Text) + , editHomepage :: !(Maybe Text) + , editPrivate :: !(Maybe Bool) + , editHasIssues :: !(Maybe Bool) + , editHasProjects :: !(Maybe Bool) + , editHasWiki :: !(Maybe Bool) + , editDefaultBranch :: !(Maybe Text) + , editAllowSquashMerge :: !(Maybe Bool) + , editAllowMergeCommit :: !(Maybe Bool) + , editAllowRebaseMerge :: !(Maybe Bool) + , editArchived :: !(Maybe Bool) } deriving (Eq, Ord, Show, Data, Typeable, Generic) @@ -199,21 +204,31 @@ instance ToJSON NewRepo where ] instance ToJSON EditRepo where - toJSON (EditRepo { editName = name - , editDescription = description - , editHomepage = homepage - , editPublic = public - , editHasIssues = hasIssues - , editHasWiki = hasWiki - , editHasDownloads = hasDownloads + toJSON (EditRepo { editName = name + , editDescription = description + , editHomepage = homepage + , editPrivate = private + , editHasIssues = hasIssues + , editHasProjects = hasProjects + , editHasWiki = hasWiki + , editDefaultBranch = defaultBranch + , editAllowSquashMerge = allowSquashMerge + , editAllowMergeCommit = allowMergeCommit + , editAllowRebaseMerge = allowRebaseMerge + , editArchived = archived }) = object - [ "name" .= name - , "description" .= description - , "homepage" .= homepage - , "public" .= public - , "has_issues" .= hasIssues - , "has_wiki" .= hasWiki - , "has_downloads" .= hasDownloads + [ "name" .= name + , "description" .= description + , "homepage" .= homepage + , "private" .= private + , "has_issues" .= hasIssues + , "has_projects" .= hasProjects + , "has_wiki" .= hasWiki + , "default_branch" .= defaultBranch + , "allow_squash_merge" .= allowSquashMerge + , "allow_merge_commit" .= allowMergeCommit + , "allow_rebase_merge" .= allowRebaseMerge + , "archived" .= archived ] instance FromJSON RepoRef where From ea74dcb62fb1c5db9c8b386dca88ea6708d64816 Mon Sep 17 00:00:00 2001 From: Thomas Tuegel Date: Wed, 16 Oct 2019 14:16:01 -0500 Subject: [PATCH 386/510] Pull requests reviews API uses issue number The pull requests reviews API uses issue numbers, not pull request IDs. --- spec/GitHub/PullRequestReviewsSpec.hs | 4 ++-- src/GitHub/Endpoints/PullRequests/Reviews.hs | 18 +++++++++--------- 2 files changed, 11 insertions(+), 11 deletions(-) diff --git a/spec/GitHub/PullRequestReviewsSpec.hs b/spec/GitHub/PullRequestReviewsSpec.hs index d79e806f..8721efc9 100644 --- a/spec/GitHub/PullRequestReviewsSpec.hs +++ b/spec/GitHub/PullRequestReviewsSpec.hs @@ -2,7 +2,7 @@ module GitHub.PullRequestReviewsSpec where import qualified GitHub -import GitHub.Data.Id (Id (Id)) +import GitHub.Data (IssueNumber (IssueNumber)) import Prelude () import Prelude.Compat @@ -29,4 +29,4 @@ spec = do cs `shouldSatisfy` isRight where prs = - [("phadej", "github", Id 268)] + [("phadej", "github", IssueNumber 268)] diff --git a/src/GitHub/Endpoints/PullRequests/Reviews.hs b/src/GitHub/Endpoints/PullRequests/Reviews.hs index 2143dcd5..afbc158c 100644 --- a/src/GitHub/Endpoints/PullRequests/Reviews.hs +++ b/src/GitHub/Endpoints/PullRequests/Reviews.hs @@ -29,7 +29,7 @@ import Prelude () pullRequestReviewsR :: Name Owner -> Name Repo - -> Id PullRequest + -> IssueNumber -> FetchCount -> Request k (Vector Review) pullRequestReviewsR owner repo prid = @@ -50,7 +50,7 @@ pullRequestReviewsR owner repo prid = pullRequestReviews :: Name Owner -> Name Repo - -> Id PullRequest + -> IssueNumber -> IO (Either Error (Vector Review)) pullRequestReviews owner repo prid = executeRequest' $ pullRequestReviewsR owner repo prid FetchAll @@ -63,7 +63,7 @@ pullRequestReviews' :: Maybe Auth -> Name Owner -> Name Repo - -> Id PullRequest + -> IssueNumber -> IO (Either Error (Vector Review)) pullRequestReviews' auth owner repo pr = executeRequestMaybe auth $ pullRequestReviewsR owner repo pr FetchAll @@ -73,7 +73,7 @@ pullRequestReviews' auth owner repo pr = pullRequestReviewR :: Name Owner -> Name Repo - -> Id PullRequest + -> IssueNumber -> Id Review -> Request k Review pullRequestReviewR owner repo prid rid = @@ -95,7 +95,7 @@ pullRequestReviewR owner repo prid rid = pullRequestReview :: Name Owner -> Name Repo - -> Id PullRequest + -> IssueNumber -> Id Review -> IO (Either Error Review) pullRequestReview owner repo prid rid = @@ -110,7 +110,7 @@ pullRequestReview' :: Maybe Auth -> Name Owner -> Name Repo - -> Id PullRequest + -> IssueNumber -> Id Review -> IO (Either Error Review) pullRequestReview' auth owner repo prid rid = @@ -121,7 +121,7 @@ pullRequestReview' auth owner repo prid rid = pullRequestReviewCommentsR :: Name Owner -> Name Repo - -> Id PullRequest + -> IssueNumber -> Id Review -> Request k [ReviewComment] pullRequestReviewCommentsR owner repo prid rid = @@ -144,7 +144,7 @@ pullRequestReviewCommentsR owner repo prid rid = pullRequestReviewCommentsIO :: Name Owner -> Name Repo - -> Id PullRequest + -> IssueNumber -> Id Review -> IO (Either Error [ReviewComment]) pullRequestReviewCommentsIO owner repo prid rid = @@ -158,7 +158,7 @@ pullRequestReviewCommentsIO' :: Maybe Auth -> Name Owner -> Name Repo - -> Id PullRequest + -> IssueNumber -> Id Review -> IO (Either Error [ReviewComment]) pullRequestReviewCommentsIO' auth owner repo prid rid = From 28e82b94177b113e94b4027efed85a25845e6fdd Mon Sep 17 00:00:00 2001 From: MATSUBARA Nobutada Date: Sun, 20 Oct 2019 12:25:29 +0900 Subject: [PATCH 387/510] Update Repo type --- src/GitHub/Data/Repos.hs | 90 ++++++++++++++++++++-------------------- 1 file changed, 46 insertions(+), 44 deletions(-) diff --git a/src/GitHub/Data/Repos.hs b/src/GitHub/Data/Repos.hs index 3cb61f1d..5819a3d0 100644 --- a/src/GitHub/Data/Repos.hs +++ b/src/GitHub/Data/Repos.hs @@ -29,36 +29,37 @@ import Unsafe.Coerce (unsafeCoerce) #endif data Repo = Repo - { repoSshUrl :: !(Maybe URL) - , repoDescription :: !(Maybe Text) - , repoCreatedAt :: !(Maybe UTCTime) + { repoId :: !(Id Repo) + , repoName :: !(Name Repo) + , repoOwner :: !SimpleOwner + , repoPrivate :: !Bool , repoHtmlUrl :: !URL - , repoSvnUrl :: !(Maybe URL) - , repoForks :: !(Maybe Int) - , repoHomepage :: !(Maybe Text) + , repoDescription :: !(Maybe Text) , repoFork :: !(Maybe Bool) + , repoUrl :: !URL , repoGitUrl :: !(Maybe URL) - , repoPrivate :: !Bool - , repoArchived :: !Bool + , repoSshUrl :: !(Maybe URL) , repoCloneUrl :: !(Maybe URL) - , repoSize :: !(Maybe Int) - , repoUpdatedAt :: !(Maybe UTCTime) - , repoWatchers :: !(Maybe Int) - , repoOwner :: !SimpleOwner - , repoName :: !(Name Repo) + , repoHooksUrl :: !URL + , repoSvnUrl :: !(Maybe URL) + , repoHomepage :: !(Maybe Text) , repoLanguage :: !(Maybe Language) + , repoForksCount :: !Int + , repoStargazersCount :: !Int + , repoWatchersCount :: !Int + , repoSize :: !(Maybe Int) , repoDefaultBranch :: !(Maybe Text) - , repoPushedAt :: !(Maybe UTCTime) -- ^ this is Nothing for new repositories - , repoId :: !(Id Repo) - , repoUrl :: !URL - , repoOpenIssues :: !(Maybe Int) - , repoHasWiki :: !(Maybe Bool) + , repoOpenIssuesCount :: !Int , repoHasIssues :: !(Maybe Bool) + , repoHasProjects :: !(Maybe Bool) + , repoHasWiki :: !(Maybe Bool) + , repoHasPages :: !(Maybe Bool) , repoHasDownloads :: !(Maybe Bool) - , repoParent :: !(Maybe RepoRef) - , repoSource :: !(Maybe RepoRef) - , repoHooksUrl :: !URL - , repoStargazersCount :: !Int + , repoArchived :: !Bool + , repoDisabled :: !Bool + , repoPushedAt :: !(Maybe UTCTime) -- ^ this is Nothing for new repositories + , repoCreatedAt :: !(Maybe UTCTime) + , repoUpdatedAt :: !(Maybe UTCTime) } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -154,36 +155,37 @@ contributorToSimpleUser (KnownContributor _contributions avatarUrl name url uid -- JSON instances instance FromJSON Repo where - parseJSON = withObject "Repo" $ \o -> Repo <$> o .:? "ssh_url" - <*> o .: "description" - <*> o .:? "created_at" + parseJSON = withObject "Repo" $ \o -> Repo <$> o .: "id" + <*> o .: "name" + <*> o .: "owner" + <*> o .: "private" <*> o .: "html_url" - <*> o .:? "svn_url" - <*> o .:? "forks" - <*> o .:? "homepage" + <*> o .:? "description" <*> o .: "fork" + <*> o .: "url" <*> o .:? "git_url" - <*> o .: "private" - <*> o .:? "archived" .!= False + <*> o .:? "ssh_url" <*> o .:? "clone_url" - <*> o .:? "size" - <*> o .:? "updated_at" - <*> o .:? "watchers" - <*> o .: "owner" - <*> o .: "name" + <*> o .: "hooks_url" + <*> o .:? "svn_url" + <*> o .:? "homepage" <*> o .:? "language" + <*> o .: "forks_count" + <*> o .: "stargazers_count" + <*> o .: "watchers_count" + <*> o .:? "size" <*> o .:? "default_branch" - <*> o .:? "pushed_at" - <*> o .: "id" - <*> o .: "url" - <*> o .:? "open_issues" - <*> o .:? "has_wiki" + <*> o .: "open_issues_count" <*> o .:? "has_issues" + <*> o .:? "has_projects" + <*> o .:? "has_wiki" + <*> o .:? "has_pages" <*> o .:? "has_downloads" - <*> o .:? "parent" - <*> o .:? "source" - <*> o .: "hooks_url" - <*> o .: "stargazers_count" + <*> o .:? "archived" .!= False + <*> o .:? "disabled" .!= False + <*> o .:? "pushed_at" + <*> o .:? "created_at" + <*> o .:? "updated_at" instance ToJSON NewRepo where toJSON (NewRepo { newRepoName = name From 56977c72e0c8bf614f1a63d175a824a37bde5897 Mon Sep 17 00:00:00 2001 From: MATSUBARA Nobutada Date: Sun, 20 Oct 2019 17:02:25 +0900 Subject: [PATCH 388/510] Update NewRepo type --- src/GitHub/Data/Repos.hs | 48 +++++++++++++++++++++++++++------------- 1 file changed, 33 insertions(+), 15 deletions(-) diff --git a/src/GitHub/Data/Repos.hs b/src/GitHub/Data/Repos.hs index 5819a3d0..8486fb6a 100644 --- a/src/GitHub/Data/Repos.hs +++ b/src/GitHub/Data/Repos.hs @@ -76,20 +76,26 @@ instance NFData RepoRef where rnf = genericRnf instance Binary RepoRef data NewRepo = NewRepo - { newRepoName :: !(Name Repo) - , newRepoDescription :: !(Maybe Text) - , newRepoHomepage :: !(Maybe Text) - , newRepoPrivate :: !(Maybe Bool) - , newRepoHasIssues :: !(Maybe Bool) - , newRepoHasWiki :: !(Maybe Bool) - , newRepoAutoInit :: !(Maybe Bool) + { newRepoName :: !(Name Repo) + , newRepoDescription :: !(Maybe Text) + , newRepoHomepage :: !(Maybe Text) + , newRepoPrivate :: !(Maybe Bool) + , newRepoHasIssues :: !(Maybe Bool) + , newRepoHasProjects :: !(Maybe Bool) + , newRepoHasWiki :: !(Maybe Bool) + , newRepoAutoInit :: !(Maybe Bool) + , newRepoGitignoreTemplate :: !(Maybe Text) + , newRepoLicenseTemplate :: !(Maybe Text) + , newRepoAllowSquashMerge :: !(Maybe Bool) + , newRepoAllowMergeCommit :: !(Maybe Bool) + , newRepoAllowRebaseMerge :: !(Maybe Bool) } deriving (Eq, Ord, Show, Data, Typeable, Generic) instance NFData NewRepo where rnf = genericRnf instance Binary NewRepo newRepo :: Name Repo -> NewRepo -newRepo name = NewRepo name Nothing Nothing Nothing Nothing Nothing Nothing +newRepo name = NewRepo name Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing data EditRepo = EditRepo { editName :: !(Maybe (Name Repo)) @@ -188,21 +194,33 @@ instance FromJSON Repo where <*> o .:? "updated_at" instance ToJSON NewRepo where - toJSON (NewRepo { newRepoName = name - , newRepoDescription = description - , newRepoHomepage = homepage - , newRepoPrivate = private - , newRepoHasIssues = hasIssues - , newRepoHasWiki = hasWiki - , newRepoAutoInit = autoInit + toJSON (NewRepo { newRepoName = name + , newRepoDescription = description + , newRepoHomepage = homepage + , newRepoPrivate = private + , newRepoHasIssues = hasIssues + , newRepoHasProjects = hasProjects + , newRepoHasWiki = hasWiki + , newRepoAutoInit = autoInit + , newRepoGitignoreTemplate = gitignoreTemplate + , newRepoLicenseTemplate = licenseTemplate + , newRepoAllowSquashMerge = allowSquashMerge + , newRepoAllowMergeCommit = allowMergeCommit + , newRepoAllowRebaseMerge = allowRebaseMerge }) = object [ "name" .= name , "description" .= description , "homepage" .= homepage , "private" .= private , "has_issues" .= hasIssues + , "has_projects" .= hasProjects , "has_wiki" .= hasWiki , "auto_init" .= autoInit + , "gitignore_template" .= gitignoreTemplate + , "license_template" .= licenseTemplate + , "allow_squash_merge" .= allowSquashMerge + , "allow_merge_commit" .= allowMergeCommit + , "allow_rebase_merge" .= allowRebaseMerge ] instance ToJSON EditRepo where From 87a88ac8d3456347a637ed6821cc75690f5f1a0c Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 22 Oct 2019 12:51:35 +0300 Subject: [PATCH 389/510] Resolve #402: Use openssl in operational sample --- samples/Operational/Operational.hs | 23 ++++++++++++++----- samples/github-samples.cabal | 36 ++++++++++++++++-------------- 2 files changed, 37 insertions(+), 22 deletions(-) diff --git a/samples/Operational/Operational.hs b/samples/Operational/Operational.hs index b84f9ab9..ea8208e7 100644 --- a/samples/Operational/Operational.hs +++ b/samples/Operational/Operational.hs @@ -7,11 +7,13 @@ import Common import Prelude () import Control.Monad.Operational -import Control.Monad.Trans.Except (ExceptT (..), runExceptT) -import Network.HTTP.Client (Manager, newManager) -import Network.HTTP.Client.TLS (tlsManagerSettings) +import Control.Monad.Trans.Except (ExceptT (..), runExceptT) +import Network.HTTP.Client (Manager, newManager, ManagerSettings) +import Network.HTTP.Client.OpenSSL (opensslManagerSettings, withOpenSSL) -import qualified GitHub as GH +import qualified GitHub as GH +import qualified OpenSSL.Session as SSL +import qualified OpenSSL.X509.SystemStore as SSL data R a where R :: FromJSON a => GH.Request 'GH.RA a -> R a @@ -29,7 +31,7 @@ githubRequest :: FromJSON a => GH.Request 'GH.RA a -> GithubMonad a githubRequest = singleton . R main :: IO () -main = do +main = withOpenSSL $ do manager <- newManager tlsManagerSettings auth' <- getAuth case auth' of @@ -39,3 +41,14 @@ main = do repo <- githubRequest $ GH.repositoryR "phadej" "github" githubRequest $ GH.ownerInfoForR (GH.simpleOwnerLogin . GH.repoOwner $ repo) print owner + +tlsManagerSettings :: ManagerSettings +tlsManagerSettings = opensslManagerSettings $ do + ctx <- SSL.context + SSL.contextAddOption ctx SSL.SSL_OP_NO_SSLv2 + SSL.contextAddOption ctx SSL.SSL_OP_NO_SSLv3 + SSL.contextAddOption ctx SSL.SSL_OP_NO_TLSv1 + SSL.contextSetCiphers ctx "ECDHE-ECDSA-AES256-GCM-SHA384:ECDHE-RSA-AES256-GCM-SHA384:ECDHE-ECDSA-CHACHA20-POLY1305:ECDHE-RSA-CHACHA20-POLY1305:ECDHE-ECDSA-AES128-GCM-SHA256:ECDHE-RSA-AES128-GCM-SHA256:ECDHE-ECDSA-AES256-SHA384:ECDHE-RSA-AES256-SHA384:ECDHE-ECDSA-AES128-SHA256:ECDHE-RSA-AES128-SHA256" + SSL.contextLoadSystemCerts ctx + SSL.contextSetVerificationMode ctx $ SSL.VerifyPeer True True Nothing + return ctx diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index 583629cc..0fa802e5 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -29,23 +29,25 @@ library exposed-modules: Common default-language: Haskell2010 --- executable github-operational --- main-is: Operational.hs --- hs-source-dirs: --- Operational --- ghc-options: -Wall --- build-depends: --- base <5 --- , base-compat-batteries --- , github --- , text --- , github-samples --- , http-client --- , http-client-tls --- , operational --- , transformers --- , transformers-compat --- default-language: Haskell2010 +executable github-operational + main-is: Operational.hs + hs-source-dirs: Operational + ghc-options: -Wall -threaded + build-depends: + , base >=0 && <5 + , base-compat-batteries + , github + , github-samples + , HsOpenSSL + , HsOpenSSL-x509-system + , http-client + , http-client-openssl + , operational + , text + , transformers + , transformers-compat + + default-language: Haskell2010 common deps default-language: Haskell2010 From a70721b5e90ec9bb2a7b1b20771c0db10b988709 Mon Sep 17 00:00:00 2001 From: Dmitry Ivanov Date: Tue, 26 Nov 2019 12:55:10 +0100 Subject: [PATCH 390/510] Remove redundant withOpenSSL Unless it was intentional? I didn't find anything about double application in its documentation. --- src/GitHub/Request.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index 04d13c6d..dee15fb8 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -129,7 +129,7 @@ executeRequest => am -> GenRequest mt rw a -> IO (Either Error a) -executeRequest auth req = withOpenSSL $ withOpenSSL $ do +executeRequest auth req = withOpenSSL $ do manager <- newManager tlsManagerSettings executeRequestWithMgr manager auth req From a04cba6b0e3ff113a0c4c6d655b78ee9a7bd11fc Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Wed, 27 Nov 2019 03:30:59 +0200 Subject: [PATCH 391/510] Re-export deploy keys from GitHub module --- src/GitHub.hs | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/src/GitHub.hs b/src/GitHub.hs index f847e45d..321c5de7 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -283,6 +283,13 @@ module GitHub ( commitR, diffR, + -- ** Deploy Keys + -- | See + deployKeysForR, + deployKeyForR, + createRepoDeployKeyR, + deleteRepoDeployKeyR, + -- ** Deployments -- | See -- @@ -419,6 +426,7 @@ import GitHub.Endpoints.Repos import GitHub.Endpoints.Repos.Collaborators import GitHub.Endpoints.Repos.Comments import GitHub.Endpoints.Repos.Commits +import GitHub.Endpoints.Repos.DeployKeys import GitHub.Endpoints.Repos.Deployments import GitHub.Endpoints.Repos.Forks import GitHub.Endpoints.Repos.Invitations From 299507c7450305defd14ce3e3204c19df96276e3 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 26 Nov 2019 19:23:38 +0200 Subject: [PATCH 392/510] Add github and github' convinience functions --- README.md | 7 ++-- github.cabal | 2 +- src/GitHub.hs | 10 ++++-- src/GitHub/Request.hs | 76 +++++++++++++++++++++++++++++++++++++++---- 4 files changed, 83 insertions(+), 12 deletions(-) diff --git a/README.md b/README.md index 9136e437..877c51dc 100644 --- a/README.md +++ b/README.md @@ -63,11 +63,12 @@ import Data.Text (Text, pack) import Data.Text.IO as T (putStrLn) import Data.Monoid ((<>)) -import qualified GitHub.Endpoints.Users.Followers as GitHub +import GitHub (github') +import qualified GitHub main :: IO () main = do - possibleUsers <- GitHub.usersFollowing "mike-burns" + possibleUsers <- github GitHub.usersFollowingR "phadej" T.putStrLn $ either (("Error: " <>) . pack . show) (foldMap ((<> "\n") . formatUser)) possibleUsers @@ -98,7 +99,7 @@ Copyright Copyright 2011-2012 Mike Burns. Copyright 2013-2015 John Wiegley. -Copyright 2016 Oleg Grenrus. +Copyright 2016-2019 Oleg Grenrus. Available under the BSD 3-clause license. diff --git a/github.cabal b/github.cabal index 33df9fe2..ff5c3c2a 100644 --- a/github.cabal +++ b/github.cabal @@ -15,7 +15,7 @@ description: > > main :: IO () > main = do - > possibleUser <- GH.executeRequest' $ GH.userInfoForR "phadej" + > possibleUser <- GH.github' GH.userInfoForR "phadej" > print possibleUser . For more of an overview please see the README: diff --git a/src/GitHub.hs b/src/GitHub.hs index 321c5de7..ab660395 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -6,11 +6,17 @@ -- This module re-exports all request constructrors and data definitions from -- this package. -- --- See "GitHub.Request" module for executing 'Request', or other modules --- of this package (e.g. "GitHub.Endpoints.Users") for already composed versions. +-- See "GitHub.Request" module for executing 'Request', in short +-- use @'github' request@, for example +-- +-- @ +-- 'github' 'userInfoForR' +-- :: 'AuthMethod' am => am -> 'Name' 'User' -> IO (Either 'Error' 'User') +-- @ -- -- The missing endpoints lists show which endpoints we know are missing, there -- might be more. +-- module GitHub ( -- * Activity -- | See diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index dee15fb8..83eba89b 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -1,9 +1,11 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE UndecidableInstances #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -29,6 +31,11 @@ -- > githubRequest :: GH.Request 'False a -> GithubMonad a -- > githubRequest = singleton module GitHub.Request ( + -- * A convinient execution of requests + github, + github', + GitHubRW, + GitHubRO, -- * Types Request, GenRequest (..), @@ -107,6 +114,63 @@ import GitHub.Data.Request import Paths_github (version) +------------------------------------------------------------------------------- +-- Convinience +------------------------------------------------------------------------------- + +-- | A convinience function to turn functions returning @'Request' rw x@, +-- into functions returning @IO (Either 'Error' x)@. +-- +-- >>> :t \auth -> github auth userInfoForR +-- \auth -> github auth userInfoForR +-- :: AuthMethod am => am -> Name User -> IO (Either Error User) +-- +-- >>> :t github pullRequestsForR +-- \auth -> github auth pullRequestsForR +-- :: AuthMethod am => +-- am +-- -> Name Owner +-- -> Name Repo +-- -> PullRequestMod +-- -> FetchCount +-- -> IO (Either Error (Data.Vector.Vector SimplePullRequest)) +-- +github :: (AuthMethod am, GitHubRW req res) => am -> req -> res +github = githubImpl + +-- | Like 'github'' but for 'RO' i.e. read-only requests. +-- Note that GitHub has low request limit for non-authenticated requests. +-- +-- >>> :t github' userInfoForR +-- github' userInfoForR :: Name User -> IO (Either Error User) +-- +github' :: GitHubRO req res => req -> res +github' = githubImpl' + +-- | A type-class implementing 'github'. +class GitHubRW req res | req -> res where + githubImpl :: AuthMethod am => am -> req -> res + +-- | A type-class implementing 'github''. +class GitHubRO req res | req -> res where + githubImpl' :: req -> res + +instance (ParseResponse mt req, res ~ Either Error req) => GitHubRW (GenRequest mt rw req) (IO res) where + githubImpl = executeRequest + +instance (ParseResponse mt req, res ~ Either Error req, rw ~ 'RO) => GitHubRO (GenRequest mt rw req) (IO res) where + githubImpl' = executeRequest' + +instance GitHubRW req res => GitHubRW (a -> req) (a -> res) where + githubImpl am req x = githubImpl am (req x) + +instance GitHubRO req res => GitHubRO (a -> req) (a -> res) where + githubImpl' req x = githubImpl' (req x) + +------------------------------------------------------------------------------- +-- Execution +------------------------------------------------------------------------------- + #ifdef MIN_VERSION_http_client_tls withOpenSSL :: IO a -> IO a withOpenSSL = id From 75fa30bfd14599ba09031ad63215d14e7a239d3d Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Wed, 27 Nov 2019 02:26:42 +0200 Subject: [PATCH 393/510] Remove precomposed executeRequest functions Users are adviced to use `github` combinator. This change allows to remove more than a half of symbols, which can be recovered by a single combinator. This makes library at lot slickier. --- samples/RateLimit.hs | 1 - samples/Repos/DeployKeys/CreateDeployKey.hs | 16 +- samples/Repos/DeployKeys/ListDeployKeys.hs | 12 +- samples/Repos/ShowRepo.hs | 19 +- samples/Teams/EditTeam.hs | 4 +- samples/Teams/ListRepos.hs | 7 +- samples/Teams/ListTeamsCurrent.hs | 5 +- .../Teams/Memberships/AddTeamMembershipFor.hs | 16 +- samples/Teams/TeamInfoFor.hs | 7 +- samples/Users/ShowUser.hs | 45 ++-- samples/github-samples.cabal | 122 +++++------ spec/GitHub/ActivitySpec.hs | 1 - spec/GitHub/CommitsSpec.hs | 20 +- spec/GitHub/OrganizationsSpec.hs | 9 +- spec/GitHub/PublicSSHKeysSpec.hs | 11 +- spec/GitHub/ReleasesSpec.hs | 1 - spec/GitHub/ReposSpec.hs | 20 +- spec/GitHub/SearchSpec.hs | 5 +- spec/GitHub/UsersSpec.hs | 22 +- src/GitHub.hs | 9 - .../Endpoints/Activity/Notifications.hs | 19 +- src/GitHub/Endpoints/Activity/Starring.hs | 40 ---- src/GitHub/Endpoints/Activity/Watching.hs | 33 --- src/GitHub/Endpoints/Gists.hs | 52 ----- src/GitHub/Endpoints/Gists/Comments.hs | 17 -- src/GitHub/Endpoints/GitData/Blobs.hs | 17 -- src/GitHub/Endpoints/GitData/Commits.hs | 10 - src/GitHub/Endpoints/GitData/References.hs | 48 +---- src/GitHub/Endpoints/GitData/Trees.hs | 31 --- src/GitHub/Endpoints/Issues.hs | 56 ----- src/GitHub/Endpoints/Issues/Comments.hs | 53 ----- src/GitHub/Endpoints/Issues/Events.hs | 46 ----- src/GitHub/Endpoints/Issues/Labels.hs | 135 ------------ src/GitHub/Endpoints/Issues/Milestones.hs | 36 ---- src/GitHub/Endpoints/Organizations.hs | 30 --- src/GitHub/Endpoints/Organizations/Members.hs | 35 ---- src/GitHub/Endpoints/Organizations/Teams.hs | 127 ------------ src/GitHub/Endpoints/PullRequests.hs | 125 ----------- src/GitHub/Endpoints/PullRequests/Comments.hs | 27 --- src/GitHub/Endpoints/PullRequests/Reviews.hs | 88 -------- src/GitHub/Endpoints/RateLimit.hs | 14 -- src/GitHub/Endpoints/Repos.hs | 194 ------------------ src/GitHub/Endpoints/Repos/Collaborators.hs | 40 ---- src/GitHub/Endpoints/Repos/Comments.hs | 48 ----- src/GitHub/Endpoints/Repos/Commits.hs | 63 ------ src/GitHub/Endpoints/Repos/Contents.hs | 82 -------- src/GitHub/Endpoints/Repos/DeployKeys.hs | 24 --- src/GitHub/Endpoints/Repos/Forks.hs | 17 -- src/GitHub/Endpoints/Repos/Releases.hs | 61 ------ src/GitHub/Endpoints/Repos/Statuses.hs | 29 --- src/GitHub/Endpoints/Repos/Webhooks.hs | 38 ---- src/GitHub/Endpoints/Search.hs | 49 ----- src/GitHub/Endpoints/Users.hs | 32 +-- src/GitHub/Endpoints/Users/Emails.hs | 17 -- src/GitHub/Endpoints/Users/Followers.hs | 17 -- src/GitHub/Endpoints/Users/PublicSSHKeys.hs | 30 --- 56 files changed, 177 insertions(+), 1955 deletions(-) diff --git a/samples/RateLimit.hs b/samples/RateLimit.hs index c0cabd5f..399fd925 100644 --- a/samples/RateLimit.hs +++ b/samples/RateLimit.hs @@ -5,4 +5,3 @@ import qualified Github.RateLimit as Github main = do x <- Github.rateLimit print x - diff --git a/samples/Repos/DeployKeys/CreateDeployKey.hs b/samples/Repos/DeployKeys/CreateDeployKey.hs index f95f3079..953e299a 100644 --- a/samples/Repos/DeployKeys/CreateDeployKey.hs +++ b/samples/Repos/DeployKeys/CreateDeployKey.hs @@ -1,21 +1,19 @@ {-# LANGUAGE OverloadedStrings #-} module Main (main) where -import qualified GitHub.Data.DeployKeys as DK -import qualified GitHub.Endpoints.Repos.DeployKeys as DK -import qualified GitHub.Auth as Auth +import qualified GitHub as GH import Data.Text (Text) main :: IO () main = do - let auth = Auth.OAuth "auth_token" - eDeployKey <- DK.createRepoDeployKey' auth "your_owner" "your_repo" newDeployKey + let auth = GH.OAuth "auth_token" + eDeployKey <- GH.github auth GH.createRepoDeployKeyR "your_owner" "your_repo" newDeployKey case eDeployKey of - (Left err) -> putStrLn $ "Error: " ++ (show err) - (Right deployKey) -> putStrLn $ show deployKey + Left err -> putStrLn $ "Error: " ++ show err + Right deployKey -> print deployKey -newDeployKey :: DK.NewRepoDeployKey -newDeployKey = DK.NewRepoDeployKey publicKey "test-key" True +newDeployKey :: GH.NewRepoDeployKey +newDeployKey = GH.NewRepoDeployKey publicKey "test-key" True where publicKey :: Text publicKey = "your_public_key" diff --git a/samples/Repos/DeployKeys/ListDeployKeys.hs b/samples/Repos/DeployKeys/ListDeployKeys.hs index bde0b665..070eb297 100644 --- a/samples/Repos/DeployKeys/ListDeployKeys.hs +++ b/samples/Repos/DeployKeys/ListDeployKeys.hs @@ -1,19 +1,17 @@ {-# LANGUAGE OverloadedStrings #-} module Main (main) where -import qualified GitHub.Data.DeployKeys as DK -import qualified GitHub.Endpoints.Repos.DeployKeys as DK -import qualified GitHub.Auth as Auth +import qualified GitHub as GH import Data.List (intercalate) import Data.Vector (toList) main :: IO () main = do - let auth = Auth.OAuth "auth_token" - eDeployKeys <- DK.deployKeysFor' auth "your_owner" "your_repo" + let auth = GH.OAuth "auth_token" + eDeployKeys <- GH.github auth GH.deployKeysForR "your_owner" "your_repo" GH.FetchAll case eDeployKeys of - (Left err) -> putStrLn $ "Error: " ++ (show err) - (Right deployKeys) -> putStrLn $ intercalate "\n" $ map formatRepoDeployKey (toList deployKeys) + Left err -> putStrLn $ "Error: " ++ show err + Right deployKeys -> putStrLn $ intercalate "\n" $ map formatRepoDeployKey (toList deployKeys) formatRepoDeployKey :: DK.RepoDeployKey -> String formatRepoDeployKey = show diff --git a/samples/Repos/ShowRepo.hs b/samples/Repos/ShowRepo.hs index 5007cfdc..ac72069a 100644 --- a/samples/Repos/ShowRepo.hs +++ b/samples/Repos/ShowRepo.hs @@ -7,18 +7,17 @@ import Data.Maybe main = do possibleRepo <- Github.repository "mike-burns" "trylambda" case possibleRepo of - (Left error) -> putStrLn $ "Error: " ++ (show error) - (Right repo) -> putStrLn $ formatRepo repo + Left error -> putStrLn $ "Error: " ++ show error + Right repo -> putStrLn $ formatRepo repo -formatRepo repo = - (Github.repoName repo) ++ "\t" ++ - (fromMaybe "" $ Github.repoDescription repo) ++ "\n" ++ - (Github.repoHtmlUrl repo) ++ "\n" ++ - (fromMaybe "" $ Github.repoCloneUrl repo) ++ "\t" ++ - (fromMaybe "" $ formatDate `fmap` Github.repoUpdatedAt repo) ++ "\n" ++ +formatRepo repo = Github.repoName repo ++ "\t" ++ + fromMaybe "" (Github.repoDescription repo) ++ "\n" ++ + Github.repoHtmlUrl repo ++ "\n" ++ + fromMaybe "" (Github.repoCloneUrl repo) ++ "\t" ++ + maybe "" formatDate (Github.repoUpdatedAt repo) ++ "\n" ++ formatLanguage (Github.repoLanguage repo) ++ - "watchers: " ++ (show $ Github.repoWatchers repo) ++ "\t" ++ - "forks: " ++ (show $ Github.repoForks repo) + "watchers: " ++ show (Github.repoWatchers repo) ++ "\t" ++ + "forks: " ++ show (Github.repoForks repo) formatDate = show . Github.fromDate diff --git a/samples/Teams/EditTeam.hs b/samples/Teams/EditTeam.hs index 7e3f63a1..bb0a05ca 100644 --- a/samples/Teams/EditTeam.hs +++ b/samples/Teams/EditTeam.hs @@ -5,15 +5,15 @@ module Main (main) where import Common import qualified GitHub -import qualified GitHub.Endpoints.Organizations.Teams as GitHub main :: IO () main = do args <- getArgs result <- case args of [token, team_id, team_name, desc] -> - GitHub.editTeam' + GitHub.github (GitHub.OAuth $ fromString token) + GitHub.editTeamR (GitHub.mkTeamId $ read team_id) (GitHub.EditTeam (GitHub.mkTeamName $ fromString team_name) (Just $ fromString desc) GitHub.PermissionPull) _ -> diff --git a/samples/Teams/ListRepos.hs b/samples/Teams/ListRepos.hs index 505f4c7b..a03dc143 100644 --- a/samples/Teams/ListRepos.hs +++ b/samples/Teams/ListRepos.hs @@ -4,15 +4,14 @@ module Main (main) where import Common import Prelude () -import qualified GitHub -import qualified GitHub.Endpoints.Organizations.Teams as GitHub +import qualified GitHub as GH main :: IO () main = do args <- getArgs possibleRepos <- case args of - [team_id, token] -> GitHub.listTeamRepos' (Just $ GitHub.OAuth $ fromString token) (GitHub.mkTeamId $ read team_id) - [team_id] -> GitHub.listTeamRepos (GitHub.mkTeamId $ read team_id) + [team_id, token] -> GH.github (GH.OAuth $ fromString token) GH.listTeamReposR (GH.mkTeamId $ read team_id) + [team_id] -> GH.github' GH.listTeamReposR (GH.mkTeamId $ read team_id) _ -> error "usage: TeamListRepos [auth token]" case possibleRepos of Left err -> putStrLn $ "Error: " <> tshow err diff --git a/samples/Teams/ListTeamsCurrent.hs b/samples/Teams/ListTeamsCurrent.hs index 4e75aa6a..eefd1e70 100644 --- a/samples/Teams/ListTeamsCurrent.hs +++ b/samples/Teams/ListTeamsCurrent.hs @@ -4,14 +4,13 @@ module Main (main) where import Common -import qualified GitHub -import qualified GitHub.Endpoints.Organizations.Teams as GitHub +import qualified GitHub as GH main :: IO () main = do args <- getArgs result <- case args of - [token] -> GitHub.listTeamsCurrent' (GitHub.OAuth $ fromString token) + [token] -> GH.github (GH.OAuth $ fromString token) GH.listTeamsCurrentR GH.FetchAll _ -> error "usage: ListTeamsCurrent " case result of Left err -> putStrLn $ "Error: " <> tshow err diff --git a/samples/Teams/Memberships/AddTeamMembershipFor.hs b/samples/Teams/Memberships/AddTeamMembershipFor.hs index b07bee73..58c120a2 100644 --- a/samples/Teams/Memberships/AddTeamMembershipFor.hs +++ b/samples/Teams/Memberships/AddTeamMembershipFor.hs @@ -5,20 +5,18 @@ module Main (main) where import Common import qualified GitHub -import qualified GitHub.Endpoints.Organizations.Teams as GitHub main :: IO () main = do args <- getArgs result <- case args of - [token, team_id, username] -> - GitHub.addTeamMembershipFor' - (GitHub.OAuth $ fromString token) - (GitHub.mkTeamId $ read team_id) - (GitHub.mkOwnerName $ fromString username) - GitHub.RoleMember - _ -> - error "usage: AddTeamMembershipFor " + [token, team_id, username] -> GitHub.github + (GitHub.OAuth $ fromString token) + GitHub.addTeamMembershipForR + (GitHub.mkTeamId $ read team_id) + (GitHub.mkOwnerName $ fromString username) + GitHub.RoleMember + _ -> fail "usage: AddTeamMembershipFor " case result of Left err -> putStrLn $ "Error: " <> tshow err Right team -> putStrLn $ tshow team diff --git a/samples/Teams/TeamInfoFor.hs b/samples/Teams/TeamInfoFor.hs index c128e8b8..7a8744f8 100644 --- a/samples/Teams/TeamInfoFor.hs +++ b/samples/Teams/TeamInfoFor.hs @@ -4,15 +4,14 @@ module Main (main) where import Common -import qualified GitHub -import qualified GitHub.Endpoints.Organizations.Teams as GitHub +import qualified GitHub as GH main :: IO () main = do args <- getArgs result <- case args of - [team_id, token] -> GitHub.teamInfoFor' (Just $ GitHub.OAuth $ fromString token) (GitHub.mkTeamId $ read team_id) - [team_id] -> GitHub.teamInfoFor (GitHub.mkTeamId $ read team_id) + [team_id, token] -> GH.github (GH.OAuth $ fromString token) GH.teamInfoForR (GH.mkTeamId $ read team_id) + [team_id] -> GH.github' GH.teamInfoForR (GH.mkTeamId $ read team_id) _ -> error "usage: TeamInfoFor [auth token]" case result of Left err -> putStrLn $ "Error: " <> tshow err diff --git a/samples/Users/ShowUser.hs b/samples/Users/ShowUser.hs index d5b8f09a..9ec6e423 100644 --- a/samples/Users/ShowUser.hs +++ b/samples/Users/ShowUser.hs @@ -6,38 +6,37 @@ import Prelude () import Data.Maybe (fromMaybe) -import qualified GitHub -import qualified GitHub.Endpoints.Users as GitHub +import qualified GitHub as GH main :: IO () main = do - auth <- getAuth - possibleUser <- GitHub.userInfoFor' auth "mike-burns" + mauth <- getAuth + possibleUser <- maybe GH.github' GH.github mauth GH.userInfoForR "mike-burns" putStrLn $ either (("Error: " <>) . tshow) formatUser possibleUser -formatUser :: GitHub.User -> Text +formatUser :: GH.User -> Text formatUser user = - (formatName userName login) <> "\t" <> (fromMaybe "" company) <> "\t" <> - (fromMaybe "" location) <> "\n" <> - (fromMaybe "" blog) <> "\t" <> "<" <> (fromMaybe "" email) <> ">" <> "\n" <> - GitHub.getUrl htmlUrl <> "\t" <> tshow createdAt <> "\n" <> + formatName userName login <> "\t" <> fromMaybe "" company <> "\t" <> + fromMaybe "" location <> "\n" <> + fromMaybe "" blog <> "\t" <> "<" <> fromMaybe "" email <> ">" <> "\n" <> + GH.getUrl htmlUrl <> "\t" <> tshow createdAt <> "\n" <> "hireable: " <> formatHireable (fromMaybe False isHireable) <> "\n\n" <> - (fromMaybe "" bio) + fromMaybe "" bio where - userName = GitHub.userName user - login = GitHub.userLogin user - company = GitHub.userCompany user - location = GitHub.userLocation user - blog = GitHub.userBlog user - email = GitHub.userEmail user - htmlUrl = GitHub.userHtmlUrl user - createdAt = GitHub.userCreatedAt user - isHireable = GitHub.userHireable user - bio = GitHub.userBio user + userName = GH.userName user + login = GH.userLogin user + company = GH.userCompany user + location = GH.userLocation user + blog = GH.userBlog user + email = GH.userEmail user + htmlUrl = GH.userHtmlUrl user + createdAt = GH.userCreatedAt user + isHireable = GH.userHireable user + bio = GH.userBio user -formatName :: Maybe Text -> GitHub.Name GitHub.User -> Text -formatName Nothing login = GitHub.untagName login -formatName (Just name) login = name <> "(" <> GitHub.untagName login <> ")" +formatName :: Maybe Text -> GH.Name GH.User -> Text +formatName Nothing login = GH.untagName login +formatName (Just name) login = name <> "(" <> GH.untagName login <> ")" formatHireable :: Bool -> Text formatHireable True = "yes" diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index 0fa802e5..f0d4a4e7 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: github-samples -version: 0.0.0 +version: 0 category: Examples synopsis: Samples for github package license: BSD-3-Clause @@ -71,40 +71,40 @@ executable github-create-deploy-key main-is: CreateDeployKey.hs hs-source-dirs: Repos/DeployKeys -executable github-delete-deploy-key - import: deps - main-is: DeleteDeployKey.hs - hs-source-dirs: Repos/DeployKeys +-- executable github-delete-deploy-key +-- import: deps +-- main-is: DeleteDeployKey.hs +-- hs-source-dirs: Repos/DeployKeys -executable github-delete-team - import: deps - main-is: DeleteTeam.hs - hs-source-dirs: Teams +-- executable github-delete-team +-- import: deps +-- main-is: DeleteTeam.hs +-- hs-source-dirs: Teams -executable github-delete-team-membership-for - import: deps - main-is: DeleteTeamMembershipFor.hs - hs-source-dirs: Teams/Memberships +-- executable github-delete-team-membership-for +-- import: deps +-- main-is: DeleteTeamMembershipFor.hs +-- hs-source-dirs: Teams/Memberships executable github-edit-team import: deps main-is: EditTeam.hs hs-source-dirs: Teams -executable github-list-deploy-keys-for - import: deps - main-is: ListDeployKeys.hs - hs-source-dirs: Repos/DeployKeys +-- executable github-list-deploy-keys-for +-- import: deps +-- main-is: ListDeployKeys.hs +-- hs-source-dirs: Repos/DeployKeys executable github-list-followers import: deps main-is: ListFollowers.hs hs-source-dirs: Users/Followers -executable github-list-followers-example - import: deps - main-is: Example.hs - hs-source-dirs: Users/Followers +-- executable github-list-followers-example +-- import: deps +-- main-is: Example.hs +-- hs-source-dirs: Users/Followers executable github-list-following import: deps @@ -116,20 +116,20 @@ executable github-list-team-current main-is: ListTeamsCurrent.hs hs-source-dirs: Teams -executable github-list-team-repos - import: deps - main-is: ListRepos.hs - hs-source-dirs: Teams +-- executable github-list-team-repos +-- import: deps +-- main-is: ListRepos.hs +-- hs-source-dirs: Teams -executable github-repos-contents-example - import: deps - main-is: Contents.hs - hs-source-dirs: Repos +-- executable github-repos-contents-example +-- import: deps +-- main-is: Contents.hs +-- hs-source-dirs: Repos -executable github-show-deploy-key - import: deps - main-is: ShowDeployKey.hs - hs-source-dirs: Repos/DeployKeys +-- executable github-show-deploy-key +-- import: deps +-- main-is: ShowDeployKey.hs +-- hs-source-dirs: Repos/DeployKeys executable github-show-user import: deps @@ -141,37 +141,37 @@ executable github-show-user-2 main-is: ShowUser2.hs hs-source-dirs: Users -executable github-team-membership-info-for - import: deps - main-is: TeamMembershipInfoFor.hs - hs-source-dirs: Teams/Memberships +-- executable github-team-membership-info-for +-- import: deps +-- main-is: TeamMembershipInfoFor.hs +-- hs-source-dirs: Teams/Memberships executable github-teaminfo-for import: deps main-is: TeamInfoFor.hs hs-source-dirs: Teams -executable github-create-public-ssh-key - import: deps - main-is: CreatePublicSSHKey.hs - hs-source-dirs: Users/PublicSSHKeys - -executable github-delete-public-ssh-key - import: deps - main-is: DeletePublicSSHKey.hs - hs-source-dirs: Users/PublicSSHKeys - -executable github-list-public-ssh-keys - import: deps - main-is: ListPublicSSHKeys.hs - hs-source-dirs: Users/PublicSSHKeys - -executable github-get-public-ssh-key - import: deps - main-is: ShowPublicSSHKey.hs - hs-source-dirs: Users/PublicSSHKeys - -executable github-repos-commits-diff - import: deps - main-is: GitDiff.hs - hs-source-dirs: Repos/Commits +-- executable github-create-public-ssh-key +-- import: deps +-- main-is: CreatePublicSSHKey.hs +-- hs-source-dirs: Users/PublicSSHKeys + +-- executable github-delete-public-ssh-key +-- import: deps +-- main-is: DeletePublicSSHKey.hs +-- hs-source-dirs: Users/PublicSSHKeys + +-- executable github-list-public-ssh-keys +-- import: deps +-- main-is: ListPublicSSHKeys.hs +-- hs-source-dirs: Users/PublicSSHKeys + +-- executable github-get-public-ssh-key +-- import: deps +-- main-is: ShowPublicSSHKey.hs +-- hs-source-dirs: Users/PublicSSHKeys + +-- executable github-repos-commits-diff +-- import: deps +-- main-is: GitDiff.hs +-- hs-source-dirs: Repos/Commits diff --git a/spec/GitHub/ActivitySpec.hs b/spec/GitHub/ActivitySpec.hs index aaee99a7..1f3c82c3 100644 --- a/spec/GitHub/ActivitySpec.hs +++ b/spec/GitHub/ActivitySpec.hs @@ -1,5 +1,4 @@ {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} module GitHub.ActivitySpec where import qualified GitHub diff --git a/spec/GitHub/CommitsSpec.hs b/spec/GitHub/CommitsSpec.hs index 3bf5fc53..5bf2d6a0 100644 --- a/spec/GitHub/CommitsSpec.hs +++ b/spec/GitHub/CommitsSpec.hs @@ -1,13 +1,9 @@ {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} module GitHub.CommitsSpec where -import qualified GitHub - import GitHub.Auth (Auth (..)) -import GitHub.Endpoints.Repos.Commits (commitSha, commitsFor', - commitsForR, diffR, mkCommitName) -import GitHub.Request (executeRequest) +import GitHub.Endpoints.Repos.Commits (commitSha, commitsForR, diffR, mkCommitName, FetchCount (..)) +import GitHub.Request (github) import Control.Monad (forM_) import Data.Either.Compat (isRight) @@ -34,13 +30,13 @@ spec :: Spec spec = do describe "commitsFor" $ do it "works" $ withAuth $ \auth -> do - cs <- commitsFor' (Just auth) "phadej" "github" + cs <- github auth commitsForR "phadej" "github" FetchAll cs `shouldSatisfy` isRight V.length (fromRightS cs) `shouldSatisfy` (> 300) -- Page size is 30, so we get 60 commits it "limits the response" $ withAuth $ \auth -> do - cs <- executeRequest auth $ commitsForR "phadej" "github" (GitHub.FetchAtLeast 40) + cs <- github auth commitsForR "phadej" "github" (FetchAtLeast 40) cs `shouldSatisfy` isRight let cs' = fromRightS cs V.length cs' `shouldSatisfy` (< 70) @@ -49,19 +45,19 @@ spec = do describe "diff" $ do it "works" $ withAuth $ \auth -> do - cs <- executeRequest auth $ commitsForR "phadej" "github" (GitHub.FetchAtLeast 30) + cs <- github auth commitsForR "phadej" "github" (FetchAtLeast 30) cs `shouldSatisfy` isRight let commits = take 10 . V.toList . fromRightS $ cs let pairs = zip commits $ drop 1 commits forM_ pairs $ \(a, b) -> do - d <- executeRequest auth $ diffR "phadej" "github" (commitSha a) (commitSha b) + d <- github auth diffR "phadej" "github" (commitSha a) (commitSha b) d `shouldSatisfy` isRight it "issue #155" $ withAuth $ \auth -> do - d <- executeRequest auth $ diffR "nomeata" "codespeed" (mkCommitName "ghc") (mkCommitName "tobami:master") + d <- github auth diffR "nomeata" "codespeed" (mkCommitName "ghc") (mkCommitName "tobami:master") d `shouldSatisfy` isRight -- diff that includes a commit where a submodule is removed it "issue #339" $ withAuth $ \auth -> do - d <- executeRequest auth $ diffR "scott-fleischman" "repo-remove-submodule" "d03c152482169d809be9b1eab71dcf64d7405f76" "42cfd732b20cd093534f246e630b309186eb485d" + d <- github auth diffR "scott-fleischman" "repo-remove-submodule" "d03c152482169d809be9b1eab71dcf64d7405f76" "42cfd732b20cd093534f246e630b309186eb485d" d `shouldSatisfy` isRight diff --git a/spec/GitHub/OrganizationsSpec.hs b/spec/GitHub/OrganizationsSpec.hs index 171a29ed..b6e7aea3 100644 --- a/spec/GitHub/OrganizationsSpec.hs +++ b/spec/GitHub/OrganizationsSpec.hs @@ -2,11 +2,12 @@ {-# LANGUAGE TemplateHaskell #-} module GitHub.OrganizationsSpec where +import GitHub (FetchCount (..), github) import GitHub.Auth (Auth (..)) import GitHub.Data (SimpleOrganization (..), SimpleOwner (..), SimpleTeam (..)) -import GitHub.Endpoints.Organizations (publicOrganizationsFor') -import GitHub.Endpoints.Organizations.Members (membersOf') +import GitHub.Endpoints.Organizations (publicOrganizationsForR) +import GitHub.Endpoints.Organizations.Members (membersOfR) import Data.Aeson (eitherDecodeStrict) import Data.Either.Compat (isRight) @@ -35,7 +36,7 @@ spec = do simpleOrganizationLogin (head $ fromRightS orgs) `shouldBe` "github" it "returns information about the user's organizations" $ withAuth $ \auth -> do - orgs <- publicOrganizationsFor' (Just auth) "mike-burns" + orgs <- github auth publicOrganizationsForR "mike-burns" FetchAll orgs `shouldSatisfy` isRight describe "teamsOf" $ do @@ -49,5 +50,5 @@ spec = do simpleOwnerLogin (head $ fromRightS ms) `shouldBe` "octocat" it "works" $ withAuth $ \auth -> do - ms <- membersOf' (Just auth) "haskell" + ms <- github auth membersOfR "haskell" FetchAll ms `shouldSatisfy` isRight diff --git a/spec/GitHub/PublicSSHKeysSpec.hs b/spec/GitHub/PublicSSHKeysSpec.hs index b797c959..25b17dae 100644 --- a/spec/GitHub/PublicSSHKeysSpec.hs +++ b/spec/GitHub/PublicSSHKeysSpec.hs @@ -1,11 +1,10 @@ {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} module GitHub.PublicSSHKeysSpec where import GitHub - (Auth (..), FetchCount (..), PublicSSHKey (..), executeRequest) + (Auth (..), FetchCount (..), PublicSSHKey (..),github) import GitHub.Endpoints.Users.PublicSSHKeys - (publicSSHKey', publicSSHKeys', publicSSHKeysForR) + (publicSSHKeyR, publicSSHKeysR, publicSSHKeysForR) import Data.Either.Compat (isRight) import Data.String (fromString) @@ -29,13 +28,13 @@ spec :: Spec spec = do describe "publicSSHKeysFor'" $ do it "works" $ withAuth $ \auth -> do - keys <- executeRequest auth $ publicSSHKeysForR "phadej" FetchAll + keys <- github auth publicSSHKeysForR "phadej" FetchAll V.length (fromRightS keys) `shouldSatisfy` (> 1) describe "publicSSHKeys' and publicSSHKey'" $ do it "works" $ withAuth $ \auth -> do - keys <- publicSSHKeys' auth + keys <- github auth publicSSHKeysR V.length (fromRightS keys) `shouldSatisfy` (> 1) - key <- publicSSHKey' auth (publicSSHKeyId $ V.head (fromRightS keys)) + key <- github auth publicSSHKeyR (publicSSHKeyId $ V.head (fromRightS keys)) key `shouldSatisfy` isRight diff --git a/spec/GitHub/ReleasesSpec.hs b/spec/GitHub/ReleasesSpec.hs index db01348f..a2988f91 100644 --- a/spec/GitHub/ReleasesSpec.hs +++ b/spec/GitHub/ReleasesSpec.hs @@ -1,5 +1,4 @@ {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} module GitHub.ReleasesSpec where import qualified GitHub diff --git a/spec/GitHub/ReposSpec.hs b/spec/GitHub/ReposSpec.hs index 5b6ab190..a08ca00d 100644 --- a/spec/GitHub/ReposSpec.hs +++ b/spec/GitHub/ReposSpec.hs @@ -1,16 +1,16 @@ {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} module GitHub.ReposSpec where -import GitHub (Auth (..), Repo (..), RepoPublicity (..), - executeRequest, repositoryR) -import GitHub.Endpoints.Repos (currentUserRepos, languagesFor', userRepos') +import GitHub + (Auth (..), FetchCount (..), Repo (..), RepoPublicity (..), github, + repositoryR) +import GitHub.Endpoints.Repos (currentUserReposR, languagesForR, userReposR) import Data.Either.Compat (isRight) import Data.String (fromString) import System.Environment (lookupEnv) -import Test.Hspec (Spec, describe, it, pendingWith, shouldBe, - shouldSatisfy) +import Test.Hspec + (Spec, describe, it, pendingWith, shouldBe, shouldSatisfy) import qualified Data.HashMap.Strict as HM @@ -29,7 +29,7 @@ spec :: Spec spec = do describe "repositoryR" $ do it "works" $ withAuth $ \auth -> do - er <- executeRequest auth $ repositoryR "phadej" "github" + er <- github auth repositoryR "phadej" "github" er `shouldSatisfy` isRight let Right r = er -- https://github.com/phadej/github/pull/219 @@ -37,16 +37,16 @@ spec = do describe "currentUserRepos" $ do it "works" $ withAuth $ \auth -> do - cs <- currentUserRepos auth RepoPublicityAll + cs <- github auth currentUserReposR RepoPublicityAll FetchAll cs `shouldSatisfy` isRight describe "userRepos" $ do it "works" $ withAuth $ \auth -> do - cs <- userRepos' (Just auth) "phadej" RepoPublicityAll + cs <- github auth userReposR "phadej" RepoPublicityAll FetchAll cs `shouldSatisfy` isRight describe "languagesFor'" $ do it "works" $ withAuth $ \auth -> do - ls <- languagesFor' (Just auth) "phadej" "github" + ls <- github auth languagesForR "phadej" "github" ls `shouldSatisfy` isRight fromRightS ls `shouldSatisfy` HM.member "Haskell" diff --git a/spec/GitHub/SearchSpec.hs b/spec/GitHub/SearchSpec.hs index 64f1680a..ce82900d 100644 --- a/spec/GitHub/SearchSpec.hs +++ b/spec/GitHub/SearchSpec.hs @@ -14,9 +14,10 @@ import Test.Hspec (Spec, describe, it, pendingWith, shouldBe) import qualified Data.Vector as V +import GitHub (github) import GitHub.Data (Auth (..), Issue (..), IssueNumber (..), IssueState (..), mkId) -import GitHub.Endpoints.Search (SearchResult (..), searchIssues') +import GitHub.Endpoints.Search (SearchResult (..), searchIssuesR) fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b @@ -53,6 +54,6 @@ spec = do it "performs an issue search via the API" $ withAuth $ \auth -> do let query = "Decouple in:title repo:phadej/github created:<=2015-12-01" - issues <- searchResultResults . fromRightS <$> searchIssues' (Just auth) query + issues <- searchResultResults . fromRightS <$> github auth searchIssuesR query length issues `shouldBe` 1 issueId (V.head issues) `shouldBe` mkId (Proxy :: Proxy Issue) 119694665 diff --git a/spec/GitHub/UsersSpec.hs b/spec/GitHub/UsersSpec.hs index 6e55b649..abb2a882 100644 --- a/spec/GitHub/UsersSpec.hs +++ b/spec/GitHub/UsersSpec.hs @@ -15,9 +15,9 @@ import qualified GitHub import GitHub.Data (Auth (..), Organization (..), User (..), fromOwner) import GitHub.Endpoints.Users - (ownerInfoForR, userInfoCurrent', userInfoFor') + (ownerInfoForR, userInfoCurrentR, userInfoForR) import GitHub.Endpoints.Users.Followers (usersFollowedByR, usersFollowingR) -import GitHub.Request (executeRequest) +import GitHub.Request (github) fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b @@ -46,37 +46,37 @@ spec = do userLogin (fromRightS userInfo) `shouldBe` "mike-burns" it "returns information about the user" $ withAuth $ \auth -> do - userInfo <- userInfoFor' (Just auth) "mike-burns" + userInfo <- github auth userInfoForR "mike-burns" userLogin (fromRightS userInfo) `shouldBe` "mike-burns" it "catches http exceptions" $ withAuth $ \auth -> do - userInfo <- userInfoFor' (Just auth) "i-hope-this-user-will-never-exist" + userInfo <- github auth userInfoForR "i-hope-this-user-will-never-exist" userInfo `shouldSatisfy` isLeft it "should fail for organization" $ withAuth $ \auth -> do - userInfo <- userInfoFor' (Just auth) "haskell" + userInfo <- github auth userInfoForR "haskell" userInfo `shouldSatisfy` isLeft describe "ownerInfoFor" $ do it "works for users and organizations" $ withAuth $ \auth -> do - a <- executeRequest auth $ ownerInfoForR "haskell" - b <- executeRequest auth $ ownerInfoForR "phadej" + a <- github auth ownerInfoForR "haskell" + b <- github auth ownerInfoForR "phadej" a `shouldSatisfy` isRight b `shouldSatisfy` isRight (organizationLogin . fromRightS . fromOwner . fromRightS $ a) `shouldBe` "haskell" (userLogin . fromLeftS . fromOwner . fromRightS $ b) `shouldBe` "phadej" - describe "userInfoCurrent'" $ do + describe "userInfoCurrentR" $ do it "returns information about the autenticated user" $ withAuth $ \auth -> do - userInfo <- userInfoCurrent' auth + userInfo <- github auth userInfoCurrentR userInfo `shouldSatisfy` isRight describe "usersFollowing" $ do it "works" $ withAuth $ \auth -> do - us <- executeRequest auth $ usersFollowingR "phadej" (GitHub.FetchAtLeast 10) + us <- github auth usersFollowingR "phadej" (GitHub.FetchAtLeast 10) us `shouldSatisfy` isRight describe "usersFollowedBy" $ do it "works" $ withAuth $ \auth -> do - us <- executeRequest auth $ usersFollowedByR "phadej" (GitHub.FetchAtLeast 10) + us <- github auth usersFollowedByR "phadej" (GitHub.FetchAtLeast 10) us `shouldSatisfy` isRight diff --git a/src/GitHub.hs b/src/GitHub.hs index ab660395..2faf1618 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -152,11 +152,8 @@ module GitHub ( -- milestonesR, milestoneR, - createMilestone, createMilestoneR, - updateMilestone, updateMilestoneR, - deleteMilestone, deleteMilestoneR, -- * Organizations @@ -237,14 +234,8 @@ module GitHub ( -- * Submit a pull request review -- * Dismiss a pull request review pullRequestReviewsR, - pullRequestReviews, - pullRequestReviews', pullRequestReviewR, - pullRequestReview, - pullRequestReview', pullRequestReviewCommentsR, - pullRequestReviewCommentsIO, - pullRequestReviewCommentsIO', -- * Repositories -- | See diff --git a/src/GitHub/Endpoints/Activity/Notifications.hs b/src/GitHub/Endpoints/Activity/Notifications.hs index 1561390c..7c246c54 100644 --- a/src/GitHub/Endpoints/Activity/Notifications.hs +++ b/src/GitHub/Endpoints/Activity/Notifications.hs @@ -6,26 +6,21 @@ -- The repo watching API as described on -- . -module GitHub.Endpoints.Activity.Notifications where +module GitHub.Endpoints.Activity.Notifications ( + getNotificationsR, + markNotificationAsReadR, + markAllNotificationsAsReadR, + ) where import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () -getNotifications :: Auth -> IO (Either Error (Vector Notification)) -getNotifications auth = - executeRequest auth $ getNotificationsR FetchAll - -- | List your notifications. -- See getNotificationsR :: FetchCount -> Request 'RA (Vector Notification) getNotificationsR = pagedQuery ["notifications"] [] -markNotificationAsRead :: Auth -> Id Notification -> IO (Either Error ()) -markNotificationAsRead auth nid = - executeRequest auth $ markNotificationAsReadR nid - -- | Mark a thread as read. -- See markNotificationAsReadR :: Id Notification -> GenRequest 'MtUnit 'RW () @@ -34,10 +29,6 @@ markNotificationAsReadR nid = Command ["notifications", "threads", toPathPart nid] (encode ()) -markNotificationsAsRead :: Auth -> IO (Either Error ()) -markNotificationsAsRead auth = - executeRequest auth markAllNotificationsAsReadR - -- | Mark as read. -- See markAllNotificationsAsReadR :: GenRequest 'MtUnit 'RW () diff --git a/src/GitHub/Endpoints/Activity/Starring.hs b/src/GitHub/Endpoints/Activity/Starring.hs index 4eccfc5b..be589db0 100644 --- a/src/GitHub/Endpoints/Activity/Starring.hs +++ b/src/GitHub/Endpoints/Activity/Starring.hs @@ -6,17 +6,11 @@ -- The repo starring API as described on -- . module GitHub.Endpoints.Activity.Starring ( - stargazersFor, stargazersForR, - reposStarredBy, reposStarredByR, - myStarred, myStarredR, - myStarredAcceptStar, myStarredAcceptStarR, - starRepo, starRepoR, - unstarRepo, unstarRepoR, module GitHub.Data, ) where @@ -24,60 +18,30 @@ module GitHub.Endpoints.Activity.Starring ( import GitHub.Auth import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () --- | The list of users that have starred the specified Github repo. --- --- > userInfoFor' Nothing "mike-burns" -stargazersFor :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector SimpleUser)) -stargazersFor auth user repo = - executeRequestMaybe auth $ stargazersForR user repo FetchAll - -- | List Stargazers. -- See stargazersForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector SimpleUser) stargazersForR user repo = pagedQuery ["repos", toPathPart user, toPathPart repo, "stargazers"] [] --- | All the public repos starred by the specified user. --- --- > reposStarredBy Nothing "croaky" -reposStarredBy :: Maybe Auth -> Name Owner -> IO (Either Error (Vector Repo)) -reposStarredBy auth user = - executeRequestMaybe auth $ reposStarredByR user FetchAll - -- | List repositories being starred. -- See reposStarredByR :: Name Owner -> FetchCount -> Request k (Vector Repo) reposStarredByR user = pagedQuery ["users", toPathPart user, "starred"] [] --- | All the repos starred by the authenticated user. -myStarred :: Auth -> IO (Either Error (Vector Repo)) -myStarred auth = - executeRequest auth $ myStarredR FetchAll - -- | All the repos starred by the authenticated user. -- See myStarredR :: FetchCount -> Request 'RA (Vector Repo) myStarredR = pagedQuery ["user", "starred"] [] - --- | All the repos starred by the authenticated user. -myStarredAcceptStar :: Auth -> IO (Either Error (Vector RepoStarred)) -myStarredAcceptStar auth = - executeRequest auth $ myStarredAcceptStarR FetchAll - -- | All the repos starred by the authenticated user. -- See myStarredAcceptStarR :: FetchCount -> GenRequest 'MtStar 'RA (Vector RepoStarred) myStarredAcceptStarR = 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 -> GenRequest 'MtUnit 'RW () @@ -85,10 +49,6 @@ 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 -> GenRequest 'MtUnit 'RW () diff --git a/src/GitHub/Endpoints/Activity/Watching.hs b/src/GitHub/Endpoints/Activity/Watching.hs index d250878e..cd58b44f 100644 --- a/src/GitHub/Endpoints/Activity/Watching.hs +++ b/src/GitHub/Endpoints/Activity/Watching.hs @@ -6,11 +6,7 @@ -- The repo watching API as described on -- . module GitHub.Endpoints.Activity.Watching ( - watchersFor, - watchersFor', watchersForR, - reposWatchedBy, - reposWatchedBy', reposWatchedByR, module GitHub.Data, ) where @@ -18,43 +14,14 @@ module GitHub.Endpoints.Activity.Watching ( import GitHub.Auth import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () --- | The list of users that are watching the specified Github repo. --- --- > watchersFor "thoughtbot" "paperclip" -watchersFor :: Name Owner -> Name Repo -> IO (Either Error (Vector SimpleUser)) -watchersFor = watchersFor' Nothing - --- | The list of users that are watching the specified Github repo. --- With authentication --- --- > watchersFor' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" -watchersFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector SimpleUser)) -watchersFor' auth user repo = - executeRequestMaybe auth $ watchersForR user repo FetchAll - -- | List watchers. -- See watchersForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector SimpleUser) watchersForR user repo limit = pagedQuery ["repos", toPathPart user, toPathPart repo, "watchers"] [] limit --- | All the public repos watched by the specified user. --- --- > reposWatchedBy "croaky" -reposWatchedBy :: Name Owner -> IO (Either Error (Vector Repo)) -reposWatchedBy = reposWatchedBy' Nothing - --- | All the public repos watched by the specified user. --- With authentication --- --- > reposWatchedBy' (Just $ BasicAuth "github-username" "github-password") "croaky" -reposWatchedBy' :: Maybe Auth -> Name Owner -> IO (Either Error (Vector Repo)) -reposWatchedBy' auth user = - executeRequestMaybe auth $ reposWatchedByR user FetchAll - -- | List repositories being watched. -- See reposWatchedByR :: Name Owner -> FetchCount -> Request k (Vector Repo) diff --git a/src/GitHub/Endpoints/Gists.hs b/src/GitHub/Endpoints/Gists.hs index 773e7f17..783e0588 100644 --- a/src/GitHub/Endpoints/Gists.hs +++ b/src/GitHub/Endpoints/Gists.hs @@ -5,91 +5,39 @@ -- -- The gists API as described at . module GitHub.Endpoints.Gists ( - gists, - gists', gistsR, - gist, - gist', gistR, - starGist, starGistR, - unstarGist, unstarGistR, - deleteGist, deleteGistR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () --- | The list of all gists created by the user --- --- > gists' (Just $ BasicAuth "github-username" "github-password") "mike-burns" -gists' :: Maybe Auth -> Name Owner -> IO (Either Error (Vector Gist)) -gists' auth user = - executeRequestMaybe auth $ gistsR user FetchAll - --- | The list of all public gists created by the user. --- --- > gists "mike-burns" -gists :: Name Owner -> IO (Either Error (Vector Gist)) -gists = gists' Nothing - -- | List gists. -- See gistsR :: Name Owner -> FetchCount -> Request k (Vector Gist) gistsR user = pagedQuery ["users", toPathPart user, "gists"] [] --- | A specific gist, given its id, with authentication credentials --- --- > gist' (Just $ BasicAuth "github-username" "github-password") "225074" -gist' :: Maybe Auth -> Name Gist -> IO (Either Error Gist) -gist' auth gid = - executeRequestMaybe auth $ gistR gid - --- | A specific gist, given its id. --- --- > gist "225074" -gist :: Name Gist -> IO (Either Error Gist) -gist = gist' Nothing - -- | Query a single gist. -- See gistR :: Name Gist -> Request k Gist gistR gid = query ["gists", toPathPart gid] [] --- | Star a gist by the authenticated user. --- --- > starGist (BasicAuth "github-username" "github-password") "225074" -starGist :: Auth -> Name Gist -> IO (Either Error ()) -starGist auth gid = executeRequest auth $ starGistR gid - -- | Star a gist by the authenticated user. -- See starGistR :: Name Gist -> GenRequest 'MtUnit 'RW () starGistR gid = Command Put ["gists", toPathPart gid, "star"] mempty --- | Unstar a gist by the authenticated user. --- --- > unstarGist (BasicAuth "github-username" "github-password") "225074" -unstarGist :: Auth -> Name Gist -> IO (Either Error ()) -unstarGist auth gid = executeRequest auth $ unstarGistR gid - -- | Unstar a gist by the authenticated user. -- See unstarGistR :: Name Gist -> GenRequest 'MtUnit 'RW () unstarGistR gid = Command Delete ["gists", toPathPart gid, "star"] mempty --- | Delete a gist by the authenticated user. --- --- > deleteGist (BasicAuth "github-username" "github-password") "225074" -deleteGist :: Auth -> Name Gist -> IO (Either Error ()) -deleteGist auth gid = executeRequest auth $ deleteGistR gid - -- | Delete a gist by the authenticated user. -- See deleteGistR :: Name Gist -> GenRequest 'MtUnit 'RW () diff --git a/src/GitHub/Endpoints/Gists/Comments.hs b/src/GitHub/Endpoints/Gists/Comments.hs index 98da18c2..d6a127dd 100644 --- a/src/GitHub/Endpoints/Gists/Comments.hs +++ b/src/GitHub/Endpoints/Gists/Comments.hs @@ -6,38 +6,21 @@ -- The loving comments people have left on Gists, described on -- . module GitHub.Endpoints.Gists.Comments ( - commentsOn, commentsOnR, - comment, gistCommentR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () --- | All the comments on a Gist, given the Gist ID. --- --- > commentsOn "1174060" -commentsOn :: Name Gist -> IO (Either Error (Vector GistComment)) -commentsOn gid = - executeRequest' $ commentsOnR gid FetchAll - -- | List comments on a gist. -- See commentsOnR :: Name Gist -> FetchCount -> Request k (Vector GistComment) commentsOnR gid = pagedQuery ["gists", toPathPart gid, "comments"] [] --- | A specific comment, by the comment ID. --- --- > comment (Id 62449) -comment :: Id GistComment -> IO (Either Error GistComment) -comment cid = - executeRequest' $ gistCommentR cid - -- | Query a single comment. -- See gistCommentR :: Id GistComment -> Request k GistComment diff --git a/src/GitHub/Endpoints/GitData/Blobs.hs b/src/GitHub/Endpoints/GitData/Blobs.hs index 1de49084..4c3c5f88 100644 --- a/src/GitHub/Endpoints/GitData/Blobs.hs +++ b/src/GitHub/Endpoints/GitData/Blobs.hs @@ -6,30 +6,13 @@ -- The API for dealing with git blobs from Github repos, as described in -- . module GitHub.Endpoints.GitData.Blobs ( - blob, - blob', blobR, module GitHub.Data, ) where import GitHub.Data -import GitHub.Internal.Prelude -import GitHub.Request import Prelude () --- | Query a blob by SHA1. --- --- > blob' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" "bc5c51d1ece1ee45f94b056a0f5a1674d7e8cba9" -blob' :: Maybe Auth -> Name Owner -> Name Repo -> Name Blob -> IO (Either Error Blob) -blob' auth user repo sha = - executeRequestMaybe auth $ blobR user repo sha - --- | Query a blob by SHA1. --- --- > blob "thoughtbot" "paperclip" "bc5c51d1ece1ee45f94b056a0f5a1674d7e8cba9" -blob :: Name Owner -> Name Repo -> Name Blob -> IO (Either Error Blob) -blob = blob' Nothing - -- | Query a blob. -- See blobR :: Name Owner -> Name Repo -> Name Blob -> Request k Blob diff --git a/src/GitHub/Endpoints/GitData/Commits.hs b/src/GitHub/Endpoints/GitData/Commits.hs index 1d8ced18..109ca87d 100644 --- a/src/GitHub/Endpoints/GitData/Commits.hs +++ b/src/GitHub/Endpoints/GitData/Commits.hs @@ -6,23 +6,13 @@ -- The API for underlying git commits of a Github repo, as described on -- . module GitHub.Endpoints.GitData.Commits ( - commit, gitCommitR, module GitHub.Data, ) where import GitHub.Data -import GitHub.Internal.Prelude -import GitHub.Request import Prelude () --- | A single commit, by SHA1. --- --- > commit "thoughtbot" "paperclip" "bc5c51d1ece1ee45f94b056a0f5a1674d7e8cba9" -commit :: Name Owner -> Name Repo -> Name GitCommit -> IO (Either Error GitCommit) -commit user repo sha = - executeRequest' $ gitCommitR user repo sha - -- | Query a commit. -- See gitCommitR :: Name Owner -> Name Repo -> Name GitCommit -> Request k GitCommit diff --git a/src/GitHub/Endpoints/GitData/References.hs b/src/GitHub/Endpoints/GitData/References.hs index ba5e7bc8..270d8805 100644 --- a/src/GitHub/Endpoints/GitData/References.hs +++ b/src/GitHub/Endpoints/GitData/References.hs @@ -7,79 +7,35 @@ -- see. The git internals documentation will also prove handy for understanding -- these. API documentation at . module GitHub.Endpoints.GitData.References ( - reference, - reference', referenceR, - references, - references', referencesR, - createReference, createReferenceR, - namespacedReferences, + namespacedReferencesR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () --- | A single reference by the ref name. --- --- > reference' (Just $ BasicAuth "github-username" "github-password") "mike-burns" "github" "heads/master" -reference' :: Maybe Auth -> Name Owner -> Name Repo -> Name GitReference -> IO (Either Error GitReference) -reference' auth user repo ref = - executeRequestMaybe auth $ referenceR user repo ref - --- | A single reference by the ref name. --- --- > reference "mike-burns" "github" "heads/master" -reference :: Name Owner -> Name Repo -> Name GitReference -> IO (Either Error GitReference) -reference = reference' Nothing - --- | Query a reference. +-- | A single reference -- | Query a reference. -- See referenceR :: Name Owner -> Name Repo -> Name GitReference -> Request k GitReference referenceR user repo ref = query ["repos", toPathPart user, toPathPart repo, "git", "refs", toPathPart ref] [] --- | The history of references for a repo. --- --- > references "mike-burns" "github" -references' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector GitReference)) -references' auth user repo = - executeRequestMaybe auth $ referencesR user repo FetchAll - --- | The history of references for a repo. --- --- > references "mike-burns" "github" -references :: Name Owner -> Name Repo -> IO (Either Error (Vector GitReference)) -references = references' Nothing - -- | Query all References. -- See referencesR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector GitReference) referencesR user repo = pagedQuery ["repos", toPathPart user, toPathPart repo, "git", "refs"] [] --- | Create a reference. -createReference :: Auth -> Name Owner -> Name Repo -> NewGitReference -> IO (Either Error GitReference) -createReference auth user repo newRef = - executeRequest auth $ createReferenceR user repo newRef - -- | Create a reference. -- See createReferenceR :: Name Owner -> Name Repo -> NewGitReference -> Request 'RW GitReference createReferenceR user repo newRef = command Post ["repos", toPathPart user, toPathPart repo , "git", "refs"] (encode newRef) --- | Limited references by a namespace. --- --- > namespacedReferences "thoughtbot" "paperclip" "tags" -namespacedReferences :: Name Owner -> Name Repo -> Text -> IO (Either Error [GitReference]) -namespacedReferences user repo namespace = - executeRequest' $ namespacedReferencesR user repo namespace - -- | Query namespaced references. -- See namespacedReferencesR :: Name Owner -> Name Repo -> Text -> Request k [GitReference] diff --git a/src/GitHub/Endpoints/GitData/Trees.hs b/src/GitHub/Endpoints/GitData/Trees.hs index b6bc550a..434d8e95 100644 --- a/src/GitHub/Endpoints/GitData/Trees.hs +++ b/src/GitHub/Endpoints/GitData/Trees.hs @@ -6,52 +6,21 @@ -- The underlying tree of SHA1s and files that make up a git repo. The API is -- described on . module GitHub.Endpoints.GitData.Trees ( - tree, - tree', treeR, - nestedTree, - nestedTree', nestedTreeR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () --- | A tree for a SHA1. --- --- > tree (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844" -tree' :: Maybe Auth -> Name Owner -> Name Repo -> Name Tree -> IO (Either Error Tree) -tree' auth user repo sha = - executeRequestMaybe auth $ treeR user repo sha - --- | A tree for a SHA1. --- --- > tree "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844" -tree :: Name Owner -> Name Repo -> Name Tree -> IO (Either Error Tree) -tree = tree' Nothing - -- | Query a Tree. -- See treeR :: Name Owner -> Name Repo -> Name Tree -> Request k Tree treeR user repo sha = query ["repos", toPathPart user, toPathPart repo, "git", "trees", toPathPart sha] [] --- | A recursively-nested tree for a SHA1. --- --- > nestedTree' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844" -nestedTree' :: Maybe Auth -> Name Owner -> Name Repo -> Name Tree -> IO (Either Error Tree) -nestedTree' auth user repo sha = - executeRequestMaybe auth $ nestedTreeR user repo sha - --- | A recursively-nested tree for a SHA1. --- --- > nestedTree "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844" -nestedTree :: Name Owner -> Name Repo -> Name Tree -> IO (Either Error Tree) -nestedTree = nestedTree' Nothing - -- | Query a Tree Recursively. -- See nestedTreeR :: Name Owner -> Name Repo -> Name Tree -> Request k Tree diff --git a/src/GitHub/Endpoints/Issues.hs b/src/GitHub/Endpoints/Issues.hs index 92e73bbc..d2b24e69 100644 --- a/src/GitHub/Endpoints/Issues.hs +++ b/src/GitHub/Endpoints/Issues.hs @@ -8,16 +8,10 @@ module GitHub.Endpoints.Issues ( currentUserIssuesR, organizationIssuesR, - issue, - issue', issueR, - issuesForRepo, - issuesForRepo', issuesForRepoR, - createIssue, createIssueR, newIssue, - editIssue, editIssueR, editOfIssue, module GitHub.Data, @@ -25,7 +19,6 @@ module GitHub.Endpoints.Issues ( import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () -- | See . @@ -38,42 +31,12 @@ organizationIssuesR :: Name Organization -> IssueMod -> FetchCount -> Request k organizationIssuesR org opts = pagedQuery ["orgs", toPathPart org, "issues"] (issueModToQueryString opts) --- | Details on a specific issue, given the repo owner and name, and the issue --- number.' --- --- > issue' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" "462" -issue' :: Maybe Auth -> Name Owner -> Name Repo -> Id Issue -> IO (Either Error Issue) -issue' auth user reqRepoName 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" (Id "462") -issue :: Name Owner -> Name Repo -> Id Issue -> IO (Either Error Issue) -issue = issue' Nothing - -- | Query a single issue. -- See issueR :: Name Owner -> Name Repo -> Id Issue -> Request k Issue issueR user reqRepoName reqIssueNumber = query ["repos", toPathPart user, toPathPart reqRepoName, "issues", toPathPart reqIssueNumber] [] --- | All issues for a repo (given the repo owner and name), with optional --- restrictions as described in the 'IssueRepoMod' data type. --- --- > issuesForRepo' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" [NoMilestone, OnlyClosed, Mentions "jyurek", Ascending] -issuesForRepo' :: Maybe Auth -> Name Owner -> Name Repo -> IssueRepoMod -> IO (Either Error (Vector Issue)) -issuesForRepo' auth user reqRepoName opts = - executeRequestMaybe auth $ issuesForRepoR user reqRepoName opts FetchAll - --- | All issues for a repo (given the repo owner and name), with optional --- restrictions as described in the 'IssueRepoMod' data type. --- --- > issuesForRepo "thoughtbot" "paperclip" [NoMilestone, OnlyClosed, Mentions "jyurek", Ascending] -issuesForRepo :: Name Owner -> Name Repo -> IssueRepoMod -> IO (Either Error (Vector Issue)) -issuesForRepo = issuesForRepo' Nothing - -- | List issues for a repository. -- See issuesForRepoR :: Name Owner -> Name Repo -> IssueRepoMod -> FetchCount -> Request k (Vector Issue) @@ -87,16 +50,6 @@ issuesForRepoR user reqRepoName opts = newIssue :: Text -> NewIssue newIssue title = NewIssue title Nothing mempty Nothing Nothing - --- | Create a new issue. --- --- > createIssue (BasicAuth "github-username" "github-password") user repo --- > (newIssue "some_repo") {...} -createIssue :: Auth -> Name Owner -> Name Repo -> NewIssue - -> IO (Either Error Issue) -createIssue auth user repo ni = - executeRequest auth $ createIssueR user repo ni - -- | Create an issue. -- See createIssueR :: Name Owner -> Name Repo -> NewIssue -> Request 'RW Issue @@ -108,15 +61,6 @@ createIssueR user repo = editOfIssue :: EditIssue editOfIssue = EditIssue Nothing Nothing Nothing Nothing Nothing Nothing --- | Edit an issue. --- --- > editIssue (BasicAuth "github-username" "github-password") user repo issue --- > editOfIssue {...} -editIssue :: Auth -> Name Owner -> Name Repo -> Id Issue -> EditIssue - -> IO (Either Error Issue) -editIssue auth user repo iss edit = - executeRequest auth $ editIssueR user repo iss edit - -- | Edit an issue. -- See editIssueR :: Name Owner -> Name Repo -> Id Issue -> EditIssue -> Request 'RW Issue diff --git a/src/GitHub/Endpoints/Issues/Comments.hs b/src/GitHub/Endpoints/Issues/Comments.hs index 0968022b..18550abc 100644 --- a/src/GitHub/Endpoints/Issues/Comments.hs +++ b/src/GitHub/Endpoints/Issues/Comments.hs @@ -6,66 +6,30 @@ -- The Github issue comments API from -- . module GitHub.Endpoints.Issues.Comments ( - comment, commentR, - comments, commentsR, - comments', - createComment, createCommentR, - deleteComment, deleteCommentR, - editComment, editCommentR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () --- | A specific comment, by ID. --- --- > comment "thoughtbot" "paperclip" 1468184 -comment :: Name Owner -> Name Repo -> Id Comment -> IO (Either Error IssueComment) -comment user repo cid = - executeRequest' $ commentR user repo cid - -- | Query a single comment. -- See commentR :: Name Owner -> Name Repo -> Id Comment -> Request k IssueComment commentR user repo cid = query ["repos", toPathPart user, toPathPart repo, "issues", "comments", toPathPart cid] [] --- | All comments on an issue, by the issue's number. --- --- > comments "thoughtbot" "paperclip" 635 -comments :: Name Owner -> Name Repo -> IssueNumber -> IO (Either Error (Vector IssueComment)) -comments = comments' Nothing - --- | All comments on an issue, by the issue's number, using authentication. --- --- > comments' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" 635 -comments' :: Maybe Auth -> Name Owner -> Name Repo -> IssueNumber -> IO (Either Error (Vector IssueComment)) -comments' auth user repo iid = - executeRequestMaybe auth $ commentsR user repo iid FetchAll - -- | List comments on an issue. -- See commentsR :: Name Owner -> Name Repo -> IssueNumber -> FetchCount -> Request k (Vector IssueComment) commentsR user repo iid = pagedQuery ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "comments"] [] --- | Create a new comment. --- --- > createComment (BasicAuth "github-username" "github-password") user repo issue --- > "some words" -createComment :: Auth -> Name Owner -> Name Repo -> IssueNumber -> Text - -> IO (Either Error Comment) -createComment auth user repo iss body = - executeRequest auth $ createCommentR user repo iss body - -- | Create a comment. -- See createCommentR :: Name Owner -> Name Repo -> IssueNumber -> Text -> Request 'RW Comment @@ -74,15 +38,6 @@ createCommentR user repo iss body = where parts = ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iss, "comments"] --- | Edit a comment. --- --- > editComment (BasicAuth "github-username" "github-password") user repo commentid --- > "new words" -editComment :: Auth -> Name Owner -> Name Repo -> Id Comment -> Text - -> IO (Either Error Comment) -editComment auth user repo commid body = - executeRequest auth $ editCommentR user repo commid body - -- | Edit a comment. -- See editCommentR :: Name Owner -> Name Repo -> Id Comment -> Text -> Request 'RW Comment @@ -91,14 +46,6 @@ editCommentR user repo commid body = where parts = ["repos", toPathPart user, toPathPart repo, "issues", "comments", toPathPart commid] --- | Delete a comment. --- --- > deleteComment (BasicAuth "github-username" "github-password") user repo commentid -deleteComment :: Auth -> Name Owner -> Name Repo -> Id Comment - -> IO (Either Error ()) -deleteComment auth user repo commid = - executeRequest auth $ deleteCommentR user repo commid - -- | Delete a comment. -- See deleteCommentR :: Name Owner -> Name Repo -> Id Comment -> GenRequest 'MtUnit 'RW () diff --git a/src/GitHub/Endpoints/Issues/Events.hs b/src/GitHub/Endpoints/Issues/Events.hs index c139f819..e69ed9fa 100644 --- a/src/GitHub/Endpoints/Issues/Events.hs +++ b/src/GitHub/Endpoints/Issues/Events.hs @@ -6,74 +6,28 @@ -- The Github issue events API, which is described on -- module GitHub.Endpoints.Issues.Events ( - eventsForIssue, - eventsForIssue', eventsForIssueR, - eventsForRepo, - eventsForRepo', eventsForRepoR, - event, - event', eventR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () --- | All events that have happened on an issue. --- --- > eventsForIssue "thoughtbot" "paperclip" 49 -eventsForIssue :: Name Owner -> Name Repo -> Id Issue -> IO (Either Error (Vector IssueEvent)) -eventsForIssue = eventsForIssue' Nothing - --- | All events that have happened on an issue, using authentication. --- --- > eventsForIssue' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" 49 -eventsForIssue' :: Maybe Auth -> Name Owner -> Name Repo -> Id Issue -> IO (Either Error (Vector IssueEvent)) -eventsForIssue' auth user repo iid = - executeRequestMaybe auth $ eventsForIssueR user repo iid FetchAll - -- | List events for an issue. -- See eventsForIssueR :: Name Owner -> Name Repo -> Id Issue -> FetchCount -> Request k (Vector IssueEvent) eventsForIssueR user repo iid = pagedQuery ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "events"] [] --- | All the events for all issues in a repo. --- --- > eventsForRepo "thoughtbot" "paperclip" -eventsForRepo :: Name Owner -> Name Repo -> IO (Either Error (Vector IssueEvent)) -eventsForRepo = eventsForRepo' Nothing - --- | All the events for all issues in a repo, using authentication. --- --- > eventsForRepo' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" -eventsForRepo' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector IssueEvent)) -eventsForRepo' auth user repo = - executeRequestMaybe auth $ eventsForRepoR user repo FetchAll - -- | List events for a repository. -- See eventsForRepoR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector IssueEvent) eventsForRepoR user repo = pagedQuery ["repos", toPathPart user, toPathPart repo, "issues", "events"] [] --- | Details on a specific event, by the event's ID. --- --- > event "thoughtbot" "paperclip" 5335772 -event :: Name Owner -> Name Repo -> Id IssueEvent -> IO (Either Error IssueEvent) -event = event' Nothing - --- | Details on a specific event, by the event's ID, using authentication. --- --- > event' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" 5335772 -event' :: Maybe Auth -> Name Owner -> Name Repo -> Id IssueEvent -> IO (Either Error IssueEvent) -event' auth user repo eid = - executeRequestMaybe auth $ eventR user repo eid - -- | Query a single event. -- See eventR :: Name Owner -> Name Repo -> Id IssueEvent -> Request k IssueEvent diff --git a/src/GitHub/Endpoints/Issues/Labels.hs b/src/GitHub/Endpoints/Issues/Labels.hs index 81affd8a..cb80992e 100644 --- a/src/GitHub/Endpoints/Issues/Labels.hs +++ b/src/GitHub/Endpoints/Issues/Labels.hs @@ -6,85 +6,36 @@ -- The API for dealing with labels on Github issues as described on -- . module GitHub.Endpoints.Issues.Labels ( - 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 GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () --- | All the labels available to use on any issue in the repo. --- --- > labelsOnRepo "thoughtbot" "paperclip" -labelsOnRepo :: Name Owner -> Name Repo -> IO (Either Error (Vector IssueLabel)) -labelsOnRepo = labelsOnRepo' Nothing - --- | All the labels available to use on any issue in the repo using authentication. --- --- > labelsOnRepo' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" -labelsOnRepo' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector IssueLabel)) -labelsOnRepo' auth user repo = - executeRequestMaybe auth $ labelsOnRepoR user repo FetchAll - -- | List all labels for this repository. -- See labelsOnRepoR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector IssueLabel) labelsOnRepoR user repo = pagedQuery ["repos", toPathPart user, toPathPart repo, "labels"] [] --- | A label by name. --- --- > label "thoughtbot" "paperclip" "bug" -label :: Name Owner -> Name Repo -> Name IssueLabel -> IO (Either Error IssueLabel) -label = label' Nothing - --- | A label by name using authentication. --- --- > label' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" "bug" -label' :: Maybe Auth -> Name Owner -> Name Repo -> Name IssueLabel -> IO (Either Error IssueLabel) -label' auth user repo lbl = - executeRequestMaybe auth $ labelR user repo lbl - -- | Query a single label. -- See labelR :: Name Owner -> Name Repo -> Name IssueLabel -> Request k IssueLabel labelR user repo lbl = query ["repos", toPathPart user, toPathPart repo, "labels", toPathPart lbl] [] --- | Create a label --- --- > createLabel (BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" "bug" "f29513" -createLabel :: Auth -> Name Owner -> 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 Owner -> Name Repo -> Name IssueLabel -> String -> Request 'RW IssueLabel @@ -94,19 +45,6 @@ createLabelR user repo lbl color = paths = ["repos", toPathPart user, toPathPart repo, "labels"] body = object ["name" .= untagName lbl, "color" .= color] --- | Update a label --- --- > updateLabel (BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" "bug" "new-bug" "ff1111" -updateLabel :: Auth - -> Name Owner - -> 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 Owner @@ -121,51 +59,18 @@ updateLabelR user repo oldLbl newLbl color = paths = ["repos", toPathPart user, toPathPart repo, "labels", toPathPart oldLbl] body = object ["name" .= untagName newLbl, "color" .= color] --- | Delete a label --- --- > deleteLabel (BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" "bug" -deleteLabel :: Auth -> Name Owner -> Name Repo -> Name IssueLabel -> IO (Either Error ()) -deleteLabel auth user repo lbl = - executeRequest auth $ deleteLabelR user repo lbl - -- | Delete a label. -- See deleteLabelR :: Name Owner -> Name Repo -> Name IssueLabel -> GenRequest 'MtUnit 'RW () deleteLabelR user repo lbl = Command Delete ["repos", toPathPart user, toPathPart repo, "labels", toPathPart lbl] mempty --- | The labels on an issue in a repo. --- --- > labelsOnIssue "thoughtbot" "paperclip" 585 -labelsOnIssue :: Name Owner -> Name Repo -> Id Issue -> IO (Either Error (Vector IssueLabel)) -labelsOnIssue = labelsOnIssue' Nothing - --- | The labels on an issue in a repo using authentication. --- --- > labelsOnIssue' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" (Id 585) -labelsOnIssue' :: Maybe Auth -> Name Owner -> Name Repo -> Id Issue -> IO (Either Error (Vector IssueLabel)) -labelsOnIssue' auth user repo iid = - executeRequestMaybe auth $ labelsOnIssueR user repo iid FetchAll - -- | List labels on an issue. -- See labelsOnIssueR :: Name Owner -> Name Repo -> Id Issue -> FetchCount -> Request k (Vector IssueLabel) labelsOnIssueR user repo iid = pagedQuery ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] [] --- | Add labels to an issue. --- --- > addLabelsToIssue (BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" (Id 585) ["Label1" "Label2"] -addLabelsToIssue :: Foldable f - => Auth - -> Name Owner - -> Name Repo - -> Id Issue - -> f (Name IssueLabel) - -> IO (Either Error (Vector IssueLabel)) -addLabelsToIssue auth user repo iid lbls = - executeRequest auth $ addLabelsToIssueR user repo iid lbls - -- | Add lables to an issue. -- See addLabelsToIssueR :: Foldable f @@ -179,32 +84,12 @@ addLabelsToIssueR user repo iid lbls = where paths = ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] --- | Remove a label from an issue. --- --- > removeLabelFromIssue (BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" (Id 585) "bug" -removeLabelFromIssue :: Auth -> Name Owner -> 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 Owner -> Name Repo -> Id Issue -> Name IssueLabel -> GenRequest 'MtUnit 'RW () removeLabelFromIssueR user repo iid lbl = Command Delete ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels", toPathPart lbl] mempty --- | Replace all labels on an issue. Sending an empty list will remove all labels from the issue. --- --- > replaceAllLabelsForIssue (BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" (Id 585) ["Label1" "Label2"] -replaceAllLabelsForIssue :: Foldable f - => Auth - -> Name Owner - -> Name Repo - -> Id Issue - -> f (Name IssueLabel) - -> IO (Either Error (Vector IssueLabel)) -replaceAllLabelsForIssue auth user repo iid lbls = - executeRequest auth $ replaceAllLabelsForIssueR user repo iid lbls - -- | Replace all labels on an issue. -- See -- @@ -220,32 +105,12 @@ replaceAllLabelsForIssueR user repo iid lbls = where paths = ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] --- | Remove all labels from an issue. --- --- > removeAllLabelsFromIssue (BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" (Id 585) -removeAllLabelsFromIssue :: Auth -> Name Owner -> 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 Owner -> Name Repo -> Id Issue -> GenRequest 'MtUnit 'RW () removeAllLabelsFromIssueR user repo iid = Command Delete ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] mempty --- | All the labels on a repo's milestone given the milestone ID. --- --- > labelsOnMilestone "thoughtbot" "paperclip" (Id 2) -labelsOnMilestone :: Name Owner -> Name Repo -> Id Milestone -> IO (Either Error (Vector IssueLabel)) -labelsOnMilestone = labelsOnMilestone' Nothing - --- | All the labels on a repo's milestone given the milestone ID using authentication. --- --- > labelsOnMilestone' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" (Id 2) -labelsOnMilestone' :: Maybe Auth -> Name Owner -> Name Repo -> Id Milestone -> IO (Either Error (Vector IssueLabel)) -labelsOnMilestone' auth user repo mid = - executeRequestMaybe auth $ labelsOnMilestoneR user repo mid FetchAll - -- | Query labels for every issue in a milestone. -- See labelsOnMilestoneR :: Name Owner -> Name Repo -> Id Milestone -> FetchCount -> Request k (Vector IssueLabel) diff --git a/src/GitHub/Endpoints/Issues/Milestones.hs b/src/GitHub/Endpoints/Issues/Milestones.hs index 574d2a0e..78b6531d 100644 --- a/src/GitHub/Endpoints/Issues/Milestones.hs +++ b/src/GitHub/Endpoints/Issues/Milestones.hs @@ -6,78 +6,42 @@ -- The milestones API as described on -- . module GitHub.Endpoints.Issues.Milestones ( - milestones, - milestones', milestonesR, - milestone, milestoneR, - createMilestone, createMilestoneR, - updateMilestone, updateMilestoneR, - deleteMilestone, deleteMilestoneR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () --- | All milestones in the repo. --- --- > milestones "thoughtbot" "paperclip" -milestones :: Name Owner -> Name Repo -> IO (Either Error (Vector Milestone)) -milestones = milestones' Nothing - --- | All milestones in the repo, using authentication. --- --- > milestones' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" -milestones' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Milestone)) -milestones' auth user repo = - executeRequestMaybe auth $ milestonesR user repo FetchAll - -- | List milestones for a repository. -- See milestonesR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Milestone) milestonesR user repo = pagedQuery ["repos", toPathPart user, toPathPart repo, "milestones"] [] --- | Details on a specific milestone, given it's milestone number. --- --- > milestone "thoughtbot" "paperclip" (Id 2) -milestone :: Name Owner -> Name Repo -> Id Milestone -> IO (Either Error Milestone) -milestone user repo mid = - executeRequest' $ milestoneR user repo mid - -- | Query a single milestone. -- See milestoneR :: Name Owner -> Name Repo -> Id Milestone -> Request k Milestone milestoneR user repo mid = query ["repos", toPathPart user, toPathPart repo, "milestones", toPathPart mid] [] -createMilestone :: Auth -> Name Owner -> Name Repo -> NewMilestone -> IO (Either Error Milestone) -createMilestone auth user repo mlstn = executeRequest auth $ createMilestoneR user repo mlstn - -- | Create a milestone. -- See createMilestoneR :: Name Owner -> Name Repo -> NewMilestone -> Request 'RW Milestone createMilestoneR user repo = command Post ["repos", toPathPart user, toPathPart repo, "milestones"] . encode -updateMilestone :: Auth -> Name Owner -> Name Repo -> Id Milestone -> UpdateMilestone -> IO (Either Error Milestone) -updateMilestone auth user repo mid mlstn = executeRequest auth $ updateMilestoneR user repo mid mlstn - -- | Update a milestone. -- See updateMilestoneR :: Name Owner -> Name Repo -> Id Milestone -> UpdateMilestone -> Request 'RW Milestone updateMilestoneR user repo mid = command Patch ["repos", toPathPart user, toPathPart repo, "milestones", toPathPart mid ] . encode -deleteMilestone :: Auth -> Name Owner -> Name Repo -> Id Milestone -> IO (Either Error ()) -deleteMilestone auth user repo mid = executeRequest auth $ deleteMilestoneR user repo mid - -- | Delete a milestone. -- See deleteMilestoneR :: Name Owner -> Name Repo -> Id Milestone -> GenRequest 'MtUnit 'RW () diff --git a/src/GitHub/Endpoints/Organizations.hs b/src/GitHub/Endpoints/Organizations.hs index ee1f5557..12844510 100644 --- a/src/GitHub/Endpoints/Organizations.hs +++ b/src/GitHub/Endpoints/Organizations.hs @@ -5,11 +5,7 @@ -- -- The orgs API as described on . module GitHub.Endpoints.Organizations ( - publicOrganizationsFor, - publicOrganizationsFor', publicOrganizationsForR, - publicOrganization, - publicOrganization', publicOrganizationR, organizationsR, module GitHub.Data, @@ -17,22 +13,8 @@ module GitHub.Endpoints.Organizations ( import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () --- | The public organizations for a user, given the user's login, with authorization --- --- > publicOrganizationsFor' (Just $ BasicAuth "github-username" "github-password") "mike-burns" -publicOrganizationsFor' :: Maybe Auth -> Name User -> IO (Either Error (Vector SimpleOrganization)) -publicOrganizationsFor' auth org = - executeRequestMaybe auth $ publicOrganizationsForR org FetchAll - --- | List user organizations. The public organizations for a user, given the user's login. --- --- > publicOrganizationsFor "mike-burns" -publicOrganizationsFor :: Name User -> IO (Either Error (Vector SimpleOrganization)) -publicOrganizationsFor = publicOrganizationsFor' Nothing - -- | List all user organizations. -- See organizationsR :: FetchCount -> Request k (Vector SimpleOrganization) @@ -43,18 +25,6 @@ organizationsR = pagedQuery ["user", "orgs"] [] publicOrganizationsForR :: Name User -> FetchCount -> Request k (Vector SimpleOrganization) publicOrganizationsForR user = pagedQuery ["users", toPathPart user, "orgs"] [] --- | Details on a public organization. Takes the organization's login. --- --- > publicOrganization' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" -publicOrganization' :: Maybe Auth -> Name Organization -> IO (Either Error Organization) -publicOrganization' auth = executeRequestMaybe auth . publicOrganizationR - --- | Query an organization. Details on a public organization. Takes the organization's login. --- --- > publicOrganization "thoughtbot" -publicOrganization :: Name Organization -> IO (Either Error Organization) -publicOrganization = publicOrganization' Nothing - -- | Query an organization. -- See publicOrganizationR :: Name Organization -> Request k Organization diff --git a/src/GitHub/Endpoints/Organizations/Members.hs b/src/GitHub/Endpoints/Organizations/Members.hs index db952269..26a8f4c4 100644 --- a/src/GitHub/Endpoints/Organizations/Members.hs +++ b/src/GitHub/Endpoints/Organizations/Members.hs @@ -6,12 +6,8 @@ -- The organization members API as described on -- . module GitHub.Endpoints.Organizations.Members ( - membersOf, - membersOf', membersOfR, membersOfWithR, - isMemberOf, - isMemberOf', isMemberOfR, orgInvitationsR, module GitHub.Data, @@ -19,24 +15,8 @@ module GitHub.Endpoints.Organizations.Members ( import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () --- | All the users who are members of the specified organization, --- | with or without authentication. --- --- > membersOf' (Just $ OAuth "token") "thoughtbot" -membersOf' :: Maybe Auth -> Name Organization -> IO (Either Error (Vector SimpleUser)) -membersOf' auth org = - executeRequestMaybe auth $ membersOfR org FetchAll - --- | All the users who are members of the specified organization, --- | without authentication. --- --- > membersOf "thoughtbot" -membersOf :: Name Organization -> IO (Either Error (Vector SimpleUser)) -membersOf = membersOf' Nothing - -- | All the users who are members of the specified organization. -- -- See @@ -59,21 +39,6 @@ membersOfWithR org f r = OrgMemberRoleAdmin -> "admin" OrgMemberRoleMember -> "member" --- | Check if a user is a member of an organization, --- | with or without authentication. --- --- > isMemberOf' (Just $ OAuth "token") "phadej" "haskell-infra" -isMemberOf' :: Maybe Auth -> Name User -> Name Organization -> IO (Either Error Bool) -isMemberOf' auth user org = - executeRequestMaybe auth $ isMemberOfR user org - --- | Check if a user is a member of an organization, --- | without authentication. --- --- > isMemberOf "phadej" "haskell-infra" -isMemberOf :: Name User -> Name Organization -> IO (Either Error Bool) -isMemberOf = isMemberOf' Nothing - -- | Check if a user is a member of an organization. -- -- See diff --git a/src/GitHub/Endpoints/Organizations/Teams.hs b/src/GitHub/Endpoints/Organizations/Teams.hs index 3aa19401..189e68f7 100644 --- a/src/GitHub/Endpoints/Organizations/Teams.hs +++ b/src/GitHub/Endpoints/Organizations/Teams.hs @@ -6,122 +6,49 @@ -- The Owner teams API as described on -- . module GitHub.Endpoints.Organizations.Teams ( - teamsOf, - teamsOf', teamsOfR, - teamInfoFor, - teamInfoFor', teamInfoForR, - createTeamFor', createTeamForR, - editTeam', editTeamR, - deleteTeam', deleteTeamR, listTeamMembersR, - listTeamRepos, - listTeamRepos', listTeamReposR, - addOrUpdateTeamRepo', addOrUpdateTeamRepoR, - teamMembershipInfoFor, - teamMembershipInfoFor', teamMembershipInfoForR, - addTeamMembershipFor', addTeamMembershipForR, - deleteTeamMembershipFor', deleteTeamMembershipForR, - listTeamsCurrent', listTeamsCurrentR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () --- | List teams. List the teams of an Owner. --- When authenticated, lists private teams visible to the authenticated user. --- When unauthenticated, lists only public teams for an Owner. --- --- > teamsOf' (Just $ OAuth "token") "thoughtbot" -teamsOf' :: Maybe Auth -> Name Organization -> IO (Either Error (Vector SimpleTeam)) -teamsOf' auth org = - executeRequestMaybe auth $ teamsOfR org FetchAll - --- | List the public teams of an Owner. --- --- > teamsOf "thoughtbot" -teamsOf :: Name Organization -> IO (Either Error (Vector SimpleTeam)) -teamsOf = teamsOf' Nothing - -- | List teams. -- See teamsOfR :: Name Organization -> FetchCount -> Request k (Vector SimpleTeam) teamsOfR org = pagedQuery ["orgs", toPathPart org, "teams"] [] --- | The information for a single team, by team id. --- With authentication --- --- > teamInfoFor' (Just $ OAuth "token") 1010101 -teamInfoFor' :: Maybe Auth -> Id Team -> IO (Either Error Team) -teamInfoFor' auth tid = - executeRequestMaybe auth $ teamInfoForR tid - --- | The information for a single team, by team id. --- --- > teamInfoFor' (Just $ OAuth "token") 1010101 -teamInfoFor :: Id Team -> IO (Either Error Team) -teamInfoFor = teamInfoFor' Nothing - -- | Query team. -- See teamInfoForR :: Id Team -> Request k Team teamInfoForR tid = query ["teams", toPathPart tid] [] --- | Create a team under an Owner --- --- > createTeamFor' (OAuth "token") "Owner" (CreateTeam "newteamname" "some description" [] PermssionPull) -createTeamFor' :: Auth - -> Name Organization - -> CreateTeam - -> IO (Either Error Team) -createTeamFor' auth org cteam = - executeRequest auth $ createTeamForR org cteam - -- | Create team. -- See createTeamForR :: Name Organization -> CreateTeam -> Request 'RW Team createTeamForR org cteam = command Post ["orgs", toPathPart org, "teams"] (encode cteam) --- | Edit a team, by id. --- --- > editTeamFor' -editTeam' :: Auth - -> Id Team - -> EditTeam - -> IO (Either Error Team) -editTeam' auth tid eteam = - executeRequest auth $ editTeamR tid eteam - -- | Edit team. -- See editTeamR :: Id Team -> EditTeam -> Request 'RW Team editTeamR tid eteam = command Patch ["teams", toPathPart tid] (encode eteam) --- | Delete a team, by id. --- --- > deleteTeam' (OAuth "token") 1010101 -deleteTeam' :: Auth -> Id Team -> IO (Either Error ()) -deleteTeam' auth tid = - executeRequest auth $ deleteTeamR tid - --- | Delete team. -- -- See deleteTeamR :: Id Team -> GenRequest 'MtUnit 'RW () @@ -140,90 +67,36 @@ listTeamMembersR tid r = TeamMemberRoleMaintainer -> "maintainer" TeamMemberRoleMember -> "member" --- | The repositories of a single team, by team id. --- With authentication --- --- > listTeamRepos' (Just $ GitHub.OAuth token) (GitHub.mkTeamId team_id) -listTeamRepos' :: Maybe Auth -> Id Team -> IO (Either Error (Vector Repo)) -listTeamRepos' auth tid = executeRequestMaybe auth $ listTeamReposR tid FetchAll - -- | Query team repositories. -- See listTeamReposR :: Id Team -> FetchCount -> Request k (Vector Repo) listTeamReposR tid = pagedQuery ["teams", toPathPart tid, "repos"] [] --- | Retrieve repositories for a team. --- --- > listTeamRepos (GitHub.mkTeamId team_id) -listTeamRepos :: Id Team -> IO (Either Error (Vector Repo)) -listTeamRepos = listTeamRepos' Nothing - --- | Add a repository to a team or update the permission on the repository. --- --- > addOrUpdateTeamRepo' (OAuth "token") 1010101 "mburns" (Just PermissionPull) -addOrUpdateTeamRepo' :: Auth -> Id Team -> Name Organization -> Name Repo -> Permission -> IO (Either Error ()) -addOrUpdateTeamRepo' auth tid org repo permission = - executeRequest auth $ addOrUpdateTeamRepoR tid org repo permission - -- | Add or update a team repository. -- See addOrUpdateTeamRepoR :: Id Team -> Name Organization -> Name Repo -> Permission -> GenRequest 'MtUnit 'RW () addOrUpdateTeamRepoR tid org repo permission = Command Put ["teams", toPathPart tid, "repos", toPathPart org, toPathPart repo] (encode $ AddTeamRepoPermission permission) --- | Retrieve team mebership information for a user. --- With authentication --- --- > teamMembershipInfoFor' (Just $ OAuth "token") 1010101 "mburns" -teamMembershipInfoFor' :: Maybe Auth -> Id Team -> Name Owner -> IO (Either Error TeamMembership) -teamMembershipInfoFor' auth tid user = - executeRequestMaybe auth $ teamMembershipInfoForR tid user - -- | Query team membership. -- See Name Owner -> Request k TeamMembership teamMembershipInfoForR tid user = query ["teams", toPathPart tid, "memberships", toPathPart user] [] --- | Retrieve team mebership information for a user. --- --- > teamMembershipInfoFor 1010101 "mburns" -teamMembershipInfoFor :: Id Team -> Name Owner -> IO (Either Error TeamMembership) -teamMembershipInfoFor = teamMembershipInfoFor' Nothing - --- | Add (or invite) a member to a team. --- --- > addTeamMembershipFor' (OAuth "token") 1010101 "mburns" RoleMember -addTeamMembershipFor' :: Auth -> Id Team -> Name Owner -> Role -> IO (Either Error TeamMembership) -addTeamMembershipFor' auth tid user role = - executeRequest auth $ addTeamMembershipForR tid user role - -- | Add team membership. -- See addTeamMembershipForR :: Id Team -> Name Owner -> Role -> Request 'RW TeamMembership addTeamMembershipForR tid user role = command Put ["teams", toPathPart tid, "memberships", toPathPart user] (encode $ CreateTeamMembership role) --- | Delete a member of a team. --- --- > deleteTeamMembershipFor' (OAuth "token") 1010101 "mburns" -deleteTeamMembershipFor' :: Auth -> Id Team -> Name Owner -> IO (Either Error ()) -deleteTeamMembershipFor' auth tid user = - executeRequest auth $ deleteTeamMembershipForR tid user - -- | Remove team membership. -- See deleteTeamMembershipForR :: Id Team -> Name Owner -> GenRequest 'MtUnit 'RW () deleteTeamMembershipForR tid user = Command Delete ["teams", toPathPart tid, "memberships", toPathPart user] mempty --- | List teams for current authenticated user --- --- > listTeamsCurrent' (OAuth "token") -listTeamsCurrent' :: Auth -> IO (Either Error (Vector Team)) -listTeamsCurrent' auth = executeRequest auth $ listTeamsCurrentR FetchAll - -- | List user teams. -- See listTeamsCurrentR :: FetchCount -> Request 'RA (Vector Team) diff --git a/src/GitHub/Endpoints/PullRequests.hs b/src/GitHub/Endpoints/PullRequests.hs index 88409839..7217e51b 100644 --- a/src/GitHub/Endpoints/PullRequests.hs +++ b/src/GitHub/Endpoints/PullRequests.hs @@ -6,55 +6,24 @@ -- The pull requests API as documented at -- . module GitHub.Endpoints.PullRequests ( - pullRequestsFor, - pullRequestsFor', pullRequestsForR, - pullRequest', - pullRequest, pullRequestR, - pullRequestDiff', - pullRequestDiff, pullRequestDiffR, - pullRequestPatch', - pullRequestPatch, pullRequestPatchR, - createPullRequest, createPullRequestR, - updatePullRequest, updatePullRequestR, - pullRequestCommits', - pullRequestCommitsIO, pullRequestCommitsR, - pullRequestFiles', - pullRequestFiles, pullRequestFilesR, - isPullRequestMerged, isPullRequestMergedR, - mergePullRequest, mergePullRequestR, module GitHub.Data ) where import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () import Data.ByteString.Lazy (ByteString) --- | All open pull requests for the repo, by owner and repo name. --- --- > pullRequestsFor "rails" "rails" -pullRequestsFor :: Name Owner -> Name Repo -> IO (Either Error (Vector SimplePullRequest)) -pullRequestsFor user repo = - executeRequest' $ pullRequestsForR user repo mempty FetchAll - --- | All open pull requests for the repo, by owner and repo name. --- --- > pullRequestsFor "rails" "rails" -pullRequestsFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector SimplePullRequest)) -pullRequestsFor' auth user repo = - executeRequestMaybe auth $ pullRequestsForR user repo mempty FetchAll - -- | List pull requests. -- See pullRequestsForR @@ -67,71 +36,24 @@ pullRequestsForR user repo opts = pagedQuery ["repos", toPathPart user, toPathPart repo, "pulls"] (prModToQueryString opts) --- | Obtain the diff of a pull request --- See -pullRequestDiff' :: Maybe Auth -> Name Owner -> Name Repo -> IssueNumber -> IO (Either Error ByteString) -pullRequestDiff' auth user repo prid = - executeRequestMaybe auth $ pullRequestDiffR user repo prid - --- | Obtain the diff of a pull request --- See -pullRequestDiff :: Name Owner -> Name Repo -> IssueNumber -> IO (Either Error ByteString) -pullRequestDiff = pullRequestDiff' Nothing - -- | Query a single pull request to obtain the diff -- See pullRequestDiffR :: Name Owner -> Name Repo -> IssueNumber -> GenRequest 'MtDiff rw ByteString pullRequestDiffR user repo prid = Query ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid] [] --- | Obtain the patch of a pull request --- --- See -pullRequestPatch' :: Maybe Auth -> Name Owner -> Name Repo -> IssueNumber -> IO (Either Error ByteString) -pullRequestPatch' auth user repo prid = - executeRequestMaybe auth $ pullRequestPatchR user repo prid - --- | Obtain the patch of a pull request --- See -pullRequestPatch :: Name Owner -> Name Repo -> IssueNumber -> IO (Either Error ByteString) -pullRequestPatch = pullRequestPatch' Nothing - -- | Query a single pull request to obtain the patch -- See pullRequestPatchR :: Name Owner -> Name Repo -> IssueNumber -> GenRequest 'MtPatch rw ByteString pullRequestPatchR user repo prid = Query ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart 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. --- With authentification. --- --- > pullRequest' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" 562 -pullRequest' :: Maybe Auth -> Name Owner -> Name Repo -> IssueNumber -> IO (Either Error PullRequest) -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 :: Name Owner -> Name Repo -> IssueNumber -> IO (Either Error PullRequest) -pullRequest = pullRequest' Nothing - -- | Query a single pull request. -- See pullRequestR :: Name Owner -> Name Repo -> IssueNumber -> Request k PullRequest pullRequestR user repo prid = query ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid] [] -createPullRequest :: Auth - -> Name Owner - -> Name Repo - -> CreatePullRequest - -> IO (Either Error PullRequest) -createPullRequest auth user repo cpr = - executeRequest auth $ createPullRequestR user repo cpr - -- | Create a pull request. -- See createPullRequestR :: Name Owner @@ -141,11 +63,6 @@ createPullRequestR :: Name Owner createPullRequestR user repo cpr = command Post ["repos", toPathPart user, toPathPart repo, "pulls"] (encode cpr) --- | Update a pull request -updatePullRequest :: Auth -> Name Owner -> Name Repo -> IssueNumber -> EditPullRequest -> IO (Either Error PullRequest) -updatePullRequest auth user repo prid epr = - executeRequest auth $ updatePullRequestR user repo prid epr - -- | Update a pull request. -- See updatePullRequestR :: Name Owner @@ -156,66 +73,24 @@ updatePullRequestR :: Name Owner updatePullRequestR user repo prid epr = command Patch ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart 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 $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" 688 -pullRequestCommits' :: Maybe Auth -> Name Owner -> Name Repo -> IssueNumber -> IO (Either Error (Vector Commit)) -pullRequestCommits' auth user repo prid = - executeRequestMaybe auth $ pullRequestCommitsR user repo prid FetchAll - --- | All the commits on a pull request, given the repo owner, repo name, and --- the number of the pull request. --- --- > pullRequestCommits "thoughtbot" "paperclip" 688 -pullRequestCommitsIO :: Name Owner -> Name Repo -> IssueNumber -> IO (Either Error (Vector Commit)) -pullRequestCommitsIO = pullRequestCommits' Nothing - -- | List commits on a pull request. -- See pullRequestCommitsR :: Name Owner -> Name Repo -> IssueNumber -> FetchCount -> Request k (Vector Commit) pullRequestCommitsR user repo prid = pagedQuery ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart 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 $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" 688 -pullRequestFiles' :: Maybe Auth -> Name Owner -> Name Repo -> IssueNumber -> IO (Either Error (Vector File)) -pullRequestFiles' auth user repo prid = - executeRequestMaybe auth $ pullRequestFilesR user repo prid FetchAll - --- | 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 :: Name Owner -> Name Repo -> IssueNumber -> IO (Either Error (Vector File)) -pullRequestFiles = pullRequestFiles' Nothing - -- | List pull requests files. -- See pullRequestFilesR :: Name Owner -> Name Repo -> IssueNumber -> FetchCount -> Request k (Vector File) pullRequestFilesR user repo prid = pagedQuery ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "files"] [] --- | Check if pull request has been merged. -isPullRequestMerged :: Auth -> Name Owner -> Name Repo -> IssueNumber -> IO (Either Error Bool) -isPullRequestMerged auth user repo prid = - executeRequest auth $ isPullRequestMergedR user repo prid - -- | Query if a pull request has been merged. -- See isPullRequestMergedR :: Name Owner -> Name Repo -> IssueNumber -> GenRequest 'MtStatus rw Bool isPullRequestMergedR user repo prid = Query ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "merge"] [] --- | Merge a pull request. -mergePullRequest :: Auth -> Name Owner -> Name Repo -> IssueNumber -> Maybe Text -> IO (Either Error MergeResult) -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 Owner -> Name Repo -> IssueNumber -> Maybe Text -> GenRequest 'MtStatus 'RW MergeResult diff --git a/src/GitHub/Endpoints/PullRequests/Comments.hs b/src/GitHub/Endpoints/PullRequests/Comments.hs index 52103030..889de642 100644 --- a/src/GitHub/Endpoints/PullRequests/Comments.hs +++ b/src/GitHub/Endpoints/PullRequests/Comments.hs @@ -6,55 +6,28 @@ -- The pull request review comments API as described at -- . module GitHub.Endpoints.PullRequests.Comments ( - pullRequestCommentsIO, pullRequestCommentsR, - pullRequestComment, pullRequestCommentR, - createPullComment, createPullCommentR, 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 -> IssueNumber -> 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 -> IssueNumber -> 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] [] --- | Create a new comment. --- --- > createPullComment (BasicAuth "github-username" "github-password") user repo issue commit path position --- > "some words" -createPullComment :: Auth -> Name Owner -> Name Repo -> IssueNumber -> Text -> Text -> Int -> Text - -> IO (Either Error Comment) -createPullComment auth user repo iss commit path position body = - executeRequest auth $ createPullCommentR user repo iss commit path position body - -- | Create a comment. -- -- See diff --git a/src/GitHub/Endpoints/PullRequests/Reviews.hs b/src/GitHub/Endpoints/PullRequests/Reviews.hs index afbc158c..e5c42ac8 100644 --- a/src/GitHub/Endpoints/PullRequests/Reviews.hs +++ b/src/GitHub/Endpoints/PullRequests/Reviews.hs @@ -6,22 +6,14 @@ -- 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. @@ -43,31 +35,6 @@ pullRequestReviewsR owner repo prid = ] [] --- | 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 - -> IssueNumber - -> 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 $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" (Id 101) -pullRequestReviews' - :: Maybe Auth - -> Name Owner - -> Name Repo - -> IssueNumber - -> 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 @@ -88,34 +55,6 @@ pullRequestReviewR owner repo prid 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 - -> IssueNumber - -> 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 $ BasicAuth "github-username" "github-password") --- > "thoughtbot" "factory_girl" (Id 301819) (Id 332) -pullRequestReview' - :: Maybe Auth - -> Name Owner - -> Name Repo - -> IssueNumber - -> 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 @@ -136,30 +75,3 @@ pullRequestReviewCommentsR owner repo prid 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 - -> IssueNumber - -> 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 $ BasicAuth "github-username" "github-password") "thoughtbot" "factory_girl" (Id 301819) (Id 332) -pullRequestReviewCommentsIO' - :: Maybe Auth - -> Name Owner - -> Name Repo - -> IssueNumber - -> 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/RateLimit.hs b/src/GitHub/Endpoints/RateLimit.hs index d357fbe8..3bbe8c2f 100644 --- a/src/GitHub/Endpoints/RateLimit.hs +++ b/src/GitHub/Endpoints/RateLimit.hs @@ -7,26 +7,12 @@ -- . module GitHub.Endpoints.RateLimit ( rateLimitR, - rateLimit, - rateLimit', module GitHub.Data, ) where import GitHub.Data -import GitHub.Internal.Prelude -import GitHub.Request import Prelude () --- | Get your current rate limit status (Note: Accessing this endpoint does not count against your rate limit.) --- With authentication. -rateLimit' :: Maybe Auth -> IO (Either Error RateLimit) -rateLimit' auth = executeRequestMaybe auth rateLimitR - --- | Get your current rate limit status (Note: Accessing this endpoint does not count against your rate limit.) --- Without authentication. -rateLimit :: IO (Either Error RateLimit) -rateLimit = rateLimit' Nothing - -- | Get your current rate limit status. -- rateLimitR :: Request k RateLimit diff --git a/src/GitHub/Endpoints/Repos.hs b/src/GitHub/Endpoints/Repos.hs index 921204d5..38fe1e6f 100644 --- a/src/GitHub/Endpoints/Repos.hs +++ b/src/GitHub/Endpoints/Repos.hs @@ -7,46 +7,24 @@ -- module GitHub.Endpoints.Repos ( -- * Querying repositories - currentUserRepos, currentUserReposR, - userRepos, - userRepos', userReposR, - organizationRepos, - organizationRepos', organizationReposR, - repository, - repository', repositoryR, - contributors, - contributors', contributorsR, - contributorsWithAnonymous, - contributorsWithAnonymous', - languagesFor, - languagesFor', languagesForR, - tagsFor, - tagsFor', tagsForR, - branchesFor, - branchesFor', branchesForR, -- ** Create - createRepo', createRepoR, - createOrganizationRepo', createOrganizationRepoR, - forkExistingRepo', forkExistingRepoR, -- ** Edit - editRepo, editRepoR, -- ** Delete - deleteRepo, deleteRepoR, -- * Data @@ -55,7 +33,6 @@ module GitHub.Endpoints.Repos ( import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () repoPublicityQueryString :: RepoPublicity -> QueryString @@ -65,11 +42,6 @@ repoPublicityQueryString RepoPublicityMember = [("type", Just "member")] repoPublicityQueryString RepoPublicityPublic = [("type", Just "public")] repoPublicityQueryString RepoPublicityPrivate = [("type", Just "private")] --- | List your repositories. -currentUserRepos :: Auth -> RepoPublicity -> IO (Either Error (Vector Repo)) -currentUserRepos auth publicity = - executeRequest auth $ currentUserReposR publicity FetchAll - -- | List your repositories. -- See currentUserReposR :: RepoPublicity -> FetchCount -> Request k (Vector Repo) @@ -78,25 +50,6 @@ currentUserReposR publicity = where qs = repoPublicityQueryString publicity --- | The repos for a user, by their login. Can be restricted to just repos they --- own, are a member of, or publicize. Private repos will return empty list. --- --- > userRepos "mike-burns" All -userRepos :: Name Owner -> RepoPublicity -> IO (Either Error (Vector Repo)) -userRepos = userRepos' Nothing - --- | The repos for a user, by their login. --- With authentication. --- --- > userRepos' (Just $ BasicAuth "github-username" "github-password") "mike-burns" All -userRepos' - :: Maybe Auth - -> Name Owner - -> RepoPublicity - -> IO (Either Error (Vector Repo)) -userRepos' auth user publicity = - executeRequestMaybe auth $ userReposR user publicity FetchAll - -- | List user repositories. -- See userReposR :: Name Owner -> RepoPublicity -> FetchCount -> Request k(Vector Repo) @@ -105,24 +58,6 @@ userReposR user publicity = where qs = repoPublicityQueryString publicity --- | The repos for an organization, by the organization name. --- --- > organizationRepos "thoughtbot" -organizationRepos :: Name Organization -> IO (Either Error (Vector Repo)) -organizationRepos org = organizationRepos' Nothing org RepoPublicityAll - --- | The repos for an organization, by the organization name. --- With authentication. --- --- > organizationRepos (Just $ BasicAuth "github-username" "github-password") "thoughtbot" All -organizationRepos' - :: Maybe Auth - -> Name Organization - -> RepoPublicity - -> IO (Either Error (Vector Repo)) -organizationRepos' auth org publicity = - executeRequestMaybe auth $ organizationReposR org publicity FetchAll - -- | List organization repositories. -- See organizationReposR @@ -135,44 +70,18 @@ organizationReposR org publicity = where qs = repoPublicityQueryString publicity --- | Details on a specific repo, given the owner and repo name. --- --- > repository "mike-burns" "github" -repository :: Name Owner -> Name Repo -> IO (Either Error Repo) -repository = repository' Nothing - --- | Details on a specific repo, given the owner and repo name. --- With authentication. --- --- > repository' (Just $ BasicAuth "github-username" "github-password") "mike-burns" "github" -repository' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error Repo) -repository' auth user repo = - executeRequestMaybe auth $ repositoryR user repo - -- | Query single repository. -- See repositoryR :: Name Owner -> Name Repo -> Request k Repo repositoryR user repo = query ["repos", toPathPart user, toPathPart repo] [] --- | Create a new repository. --- --- > createRepo' (BasicAuth (user, password)) (newRepo "some_repo") {newRepoHasIssues = Just False} -createRepo' :: Auth -> NewRepo -> IO (Either Error Repo) -createRepo' auth nrepo = - executeRequest auth $ createRepoR nrepo - -- | Create a new repository. -- See createRepoR :: NewRepo -> Request 'RW Repo createRepoR nrepo = command Post ["user", "repos"] (encode nrepo) --- | Fork an existing repository. -forkExistingRepo' :: Auth -> Name Owner -> Name Repo -> Maybe (Name Owner) -> IO (Either Error Repo) -forkExistingRepo' auth owner repo morg = - executeRequest auth $ forkExistingRepoR owner repo morg - -- | Fork an existing repository. -- See -- TODO: The third paramater (an optional Organisation) is not used yet. @@ -180,32 +89,12 @@ forkExistingRepoR :: Name Owner -> Name Repo -> Maybe (Name Owner) -> Request 'R forkExistingRepoR owner repo _morg = command Post ["repos", toPathPart owner, toPathPart repo, "forks" ] mempty --- | Create a new repository for an organization. --- --- > createOrganizationRepo (BasicAuth (user, password)) "thoughtbot" (newRepo "some_repo") {newRepoHasIssues = Just False} -createOrganizationRepo' :: Auth -> Name Organization -> NewRepo -> IO (Either Error Repo) -createOrganizationRepo' auth org nrepo = - executeRequest auth $ createOrganizationRepoR org nrepo - -- | Create a new repository for an organization. -- See createOrganizationRepoR :: Name Organization -> NewRepo -> Request 'RW Repo createOrganizationRepoR org nrepo = command Post ["orgs", toPathPart org, "repos"] (encode nrepo) --- | Edit an existing repository. --- --- > editRepo (BasicAuth (user, password)) "some_user" "some_repo" def {editDescription = Just "some description"} -editRepo - :: Auth - -> Name Owner -- ^ owner - -> Name Repo -- ^ repository name - -> EditRepo - -> IO (Either Error Repo) -editRepo auth user repo body = - executeRequest auth $ editRepoR user repo body - - -- | Edit an existing repository. -- See editRepoR :: Name Owner -> Name Repo -> EditRepo -> Request 'RW Repo @@ -215,20 +104,6 @@ editRepoR user repo body = -- if no name is given, use curent name b = body {editName = editName body <|> Just repo} --- | The contributors to a repo, given the owner and repo name. --- --- > contributors "thoughtbot" "paperclip" -contributors :: Name Owner -> Name Repo -> IO (Either Error (Vector Contributor)) -contributors = contributors' Nothing - --- | The contributors to a repo, given the owner and repo name. --- With authentication. --- --- > contributors' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" -contributors' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Contributor)) -contributors' auth user repo = - executeRequestMaybe auth $ contributorsR user repo False FetchAll - -- | List contributors. -- See contributorsR @@ -243,93 +118,24 @@ contributorsR user repo anon = qs | anon = [("anon", Just "true")] | otherwise = [] --- | The contributors to a repo, including anonymous contributors (such as --- deleted users or git commits with unknown email addresses), given the owner --- and repo name. --- --- > contributorsWithAnonymous "thoughtbot" "paperclip" -contributorsWithAnonymous :: Name Owner -> Name Repo -> IO (Either Error (Vector Contributor)) -contributorsWithAnonymous = contributorsWithAnonymous' Nothing - --- | The contributors to a repo, including anonymous contributors (such as --- deleted users or git commits with unknown email addresses), given the owner --- and repo name. --- With authentication. --- --- > contributorsWithAnonymous' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" -contributorsWithAnonymous' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Contributor)) -contributorsWithAnonymous' auth user repo = - executeRequestMaybe auth $ contributorsR user repo True FetchAll - --- | The programming languages used in a repo along with the number of --- characters written in that language. Takes the repo owner and name. --- --- > languagesFor "mike-burns" "ohlaunch" -languagesFor :: Name Owner -> Name Repo -> IO (Either Error Languages) -languagesFor = languagesFor' Nothing - --- | The programming languages used in a repo along with the number of --- characters written in that language. Takes the repo owner and name. --- With authentication. --- --- > languagesFor' (Just $ BasicAuth "github-username" "github-password") "mike-burns" "ohlaunch" -languagesFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error Languages) -languagesFor' auth user repo = - executeRequestMaybe auth $ languagesForR user repo - -- | List languages. -- See languagesForR :: Name Owner -> Name Repo -> Request k Languages languagesForR user repo = query ["repos", toPathPart user, toPathPart repo, "languages"] [] --- | The git tags on a repo, given the repo owner and name. --- --- > tagsFor "thoughtbot" "paperclip" -tagsFor :: Name Owner -> Name Repo -> IO (Either Error (Vector Tag)) -tagsFor = tagsFor' Nothing - --- | The git tags on a repo, given the repo owner and name. --- With authentication. --- --- > tagsFor' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" -tagsFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Tag)) -tagsFor' auth user repo = - executeRequestMaybe auth $ tagsForR user repo FetchAll - -- | List tags. -- See tagsForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Tag) tagsForR user repo = pagedQuery ["repos", toPathPart user, toPathPart repo, "tags"] [] --- | The git branches on a repo, given the repo owner and name. --- --- > branchesFor "thoughtbot" "paperclip" -branchesFor :: Name Owner -> Name Repo -> IO (Either Error (Vector Branch)) -branchesFor = branchesFor' Nothing - --- | The git branches on a repo, given the repo owner and name. --- With authentication. --- --- > branchesFor' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" -branchesFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Branch)) -branchesFor' auth user repo = - executeRequestMaybe auth $ branchesForR user repo FetchAll - -- | List branches. -- See branchesForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Branch) branchesForR user repo = pagedQuery ["repos", toPathPart user, toPathPart repo, "branches"] [] --- | Delete an existing repository. --- --- > deleteRepo (BasicAuth (user, password)) "thoughtbot" "some_repo" -deleteRepo :: Auth -> Name Owner -> Name Repo -> IO (Either Error ()) -deleteRepo auth user repo = - executeRequest auth $ deleteRepoR user repo - -- | Delete a repository,. -- See deleteRepoR :: Name Owner -> Name Repo -> GenRequest 'MtUnit 'RW () diff --git a/src/GitHub/Endpoints/Repos/Collaborators.hs b/src/GitHub/Endpoints/Repos/Collaborators.hs index ac0d9c0e..bc5680c6 100644 --- a/src/GitHub/Endpoints/Repos/Collaborators.hs +++ b/src/GitHub/Endpoints/Repos/Collaborators.hs @@ -6,53 +6,22 @@ -- The repo collaborators API as described on -- . module GitHub.Endpoints.Repos.Collaborators ( - collaboratorsOn, - collaboratorsOn', collaboratorsOnR, - isCollaboratorOn, isCollaboratorOnR, - addCollaborator, addCollaboratorR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () --- | All the users who have collaborated on a repo. --- --- > collaboratorsOn "thoughtbot" "paperclip" -collaboratorsOn :: Name Owner -> Name Repo -> IO (Either Error (Vector SimpleUser)) -collaboratorsOn = collaboratorsOn' Nothing - --- | All the users who have collaborated on a repo. --- With authentication. -collaboratorsOn' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector SimpleUser)) -collaboratorsOn' auth user repo = - executeRequestMaybe auth $ collaboratorsOnR user repo FetchAll - -- | List collaborators. -- See collaboratorsOnR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector SimpleUser) collaboratorsOnR user repo = pagedQuery ["repos", toPathPart user, toPathPart repo, "collaborators"] [] --- | Whether the user is collaborating on a repo. Takes the user in question, --- the user who owns the repo, and the repo name. --- --- > isCollaboratorOn Nothing "mike-burns" "thoughtbot" "paperclip" --- > isCollaboratorOn Nothing "johnson" "thoughtbot" "paperclip" -isCollaboratorOn - :: Maybe Auth - -> Name Owner -- ^ Repository owner - -> Name Repo -- ^ Repository name - -> Name User -- ^ Collaborator? - -> IO (Either Error Bool) -isCollaboratorOn auth user repo coll = - executeRequestMaybe auth $ isCollaboratorOnR user repo coll - -- | Check if a user is a collaborator. -- See isCollaboratorOnR @@ -63,15 +32,6 @@ isCollaboratorOnR isCollaboratorOnR user repo coll = Query ["repos", toPathPart user, toPathPart repo, "collaborators", toPathPart coll] [] -addCollaborator - :: Auth - -> Name Owner -- ^ Repository owner - -> Name Repo -- ^ Repository name - -> Name User -- ^ Collaborator to add - -> IO (Either Error (Maybe RepoInvitation)) -addCollaborator auth owner repo coll = - executeRequest auth $ addCollaboratorR owner repo coll - -- | Invite a user as a collaborator. -- See addCollaboratorR diff --git a/src/GitHub/Endpoints/Repos/Comments.hs b/src/GitHub/Endpoints/Repos/Comments.hs index 5adcf814..2b853c0e 100644 --- a/src/GitHub/Endpoints/Repos/Comments.hs +++ b/src/GitHub/Endpoints/Repos/Comments.hs @@ -7,76 +7,28 @@ -- The repo commits API as described on -- . module GitHub.Endpoints.Repos.Comments ( - commentsFor, - commentsFor', commentsForR, - commitCommentsFor, - commitCommentsFor', commitCommentsForR, - commitCommentFor, - commitCommentFor', commitCommentForR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () --- | All the comments on a Github repo. --- --- > commentsFor "thoughtbot" "paperclip" -commentsFor :: Name Owner -> Name Repo -> IO (Either Error (Vector Comment)) -commentsFor = commentsFor' Nothing - --- | All the comments on a Github repo. --- With authentication. --- --- > commentsFor "thoughtbot" "paperclip" -commentsFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Comment)) -commentsFor' auth user repo = - executeRequestMaybe auth $ commentsForR user repo FetchAll - -- | List commit comments for a repository. -- See commentsForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Comment) commentsForR user repo = pagedQuery ["repos", toPathPart user, toPathPart repo, "comments"] [] --- | Just the comments on a specific SHA for a given Github repo. --- --- > commitCommentsFor "thoughtbot" "paperclip" "41f685f6e01396936bb8cd98e7cca517e2c7d96b" -commitCommentsFor :: Name Owner -> Name Repo -> Name Commit -> IO (Either Error (Vector Comment)) -commitCommentsFor = commitCommentsFor' Nothing - --- | Just the comments on a specific SHA for a given Github repo. --- With authentication. --- --- > commitCommentsFor "thoughtbot" "paperclip" "41f685f6e01396936bb8cd98e7cca517e2c7d96b" -commitCommentsFor' :: Maybe Auth -> Name Owner -> Name Repo -> Name Commit -> IO (Either Error (Vector Comment)) -commitCommentsFor' auth user repo sha = - executeRequestMaybe auth $ commitCommentsForR user repo sha FetchAll - -- | List comments for a single commit. -- See commitCommentsForR :: Name Owner -> Name Repo -> Name Commit -> FetchCount -> Request k (Vector Comment) commitCommentsForR user repo sha = pagedQuery ["repos", toPathPart user, toPathPart repo, "commits", toPathPart sha, "comments"] [] --- | A comment, by its ID, relative to the Github repo. --- --- > commitCommentFor "thoughtbot" "paperclip" "669575" -commitCommentFor :: Name Owner -> Name Repo -> Id Comment -> IO (Either Error Comment) -commitCommentFor = commitCommentFor' Nothing - --- | A comment, by its ID, relative to the Github repo. --- --- > commitCommentFor "thoughtbot" "paperclip" "669575" -commitCommentFor' :: Maybe Auth -> Name Owner -> Name Repo -> Id Comment -> IO (Either Error Comment) -commitCommentFor' auth user repo cid = - executeRequestMaybe auth $ commitCommentForR user repo cid - -- | Query a single commit comment. -- See commitCommentForR :: Name Owner -> Name Repo -> Id Comment -> Request k Comment diff --git a/src/GitHub/Endpoints/Repos/Commits.hs b/src/GitHub/Endpoints/Repos/Commits.hs index affa5044..bfe0cc84 100644 --- a/src/GitHub/Endpoints/Repos/Commits.hs +++ b/src/GitHub/Endpoints/Repos/Commits.hs @@ -8,24 +8,15 @@ -- . module GitHub.Endpoints.Repos.Commits ( CommitQueryOption(..), - commitsFor, - commitsFor', commitsForR, - commitsWithOptionsFor, - commitsWithOptionsFor', commitsWithOptionsForR, - commit, - commit', commitR, - diff, - diff', diffR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () import qualified Data.ByteString as BS @@ -39,37 +30,11 @@ renderCommitQueryOption (CommitQueryAuthor author) = ("author", Just $ TE.encode renderCommitQueryOption (CommitQuerySince date) = ("since", Just $ TE.encodeUtf8 . T.pack $ formatISO8601 date) renderCommitQueryOption (CommitQueryUntil date) = ("until", Just $ TE.encodeUtf8 . T.pack $ formatISO8601 date) --- | The commit history for a repo. --- --- > commitsFor "mike-burns" "github" -commitsFor :: Name Owner -> Name Repo -> IO (Either Error (Vector Commit)) -commitsFor = commitsFor' Nothing - --- | The commit history for a repo. --- With authentication. --- --- > commitsFor' (Just $ BasicAuth "github-username" "github-password") "mike-burns" "github" -commitsFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Commit)) -commitsFor' auth user repo = - commitsWithOptionsFor' auth user repo [] - -- | List commits on a repository. -- See commitsForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Commit) commitsForR user repo limit = commitsWithOptionsForR user repo limit [] -commitsWithOptionsFor :: Name Owner -> Name Repo -> [CommitQueryOption] -> IO (Either Error (Vector Commit)) -commitsWithOptionsFor = commitsWithOptionsFor' Nothing - --- | The commit history for a repo, with commits filtered to satisfy a list of --- query options. --- With authentication. --- --- > commitsWithOptionsFor' (Just $ BasicAuth "github-username" "github-password") "mike-burns" "github" [CommitQueryAuthor "djeik"] -commitsWithOptionsFor' :: Maybe Auth -> Name Owner -> Name Repo -> [CommitQueryOption] -> IO (Either Error (Vector Commit)) -commitsWithOptionsFor' auth user repo opts = - executeRequestMaybe auth $ commitsWithOptionsForR user repo FetchAll opts - -- | List commits on a repository. -- See commitsWithOptionsForR :: Name Owner -> Name Repo -> FetchCount -> [CommitQueryOption] -> Request k (Vector Commit) @@ -78,40 +43,12 @@ commitsWithOptionsForR user repo limit opts = where qs = map renderCommitQueryOption opts - --- | Details on a specific SHA1 for a repo. --- --- > commit "mike-burns" "github" "9d1a9a361266c3c890b1108ad2fdf52f824b1b81" -commit :: Name Owner -> Name Repo -> Name Commit -> IO (Either Error Commit) -commit = commit' Nothing - --- | Details on a specific SHA1 for a repo. --- With authentication. --- --- > commit (Just $ BasicAuth "github-username" "github-password") "mike-burns" "github" "9d1a9a361266c3c890b1108ad2fdf52f824b1b81" -commit' :: Maybe Auth -> Name Owner -> Name Repo -> Name Commit -> IO (Either Error Commit) -commit' auth user repo sha = - executeRequestMaybe auth $ commitR user repo sha - -- | Query a single commit. -- See commitR :: Name Owner -> Name Repo -> Name Commit -> Request k Commit commitR user repo sha = query ["repos", toPathPart user, toPathPart repo, "commits", toPathPart sha] [] --- | The diff between two treeishes on a repo. --- --- > diff "thoughtbot" "paperclip" "41f685f6e01396936bb8cd98e7cca517e2c7d96b" "HEAD" -diff :: Name Owner -> Name Repo -> Name Commit -> Name Commit -> IO (Either Error Diff) -diff = diff' Nothing - --- | The diff between two treeishes on a repo. --- --- > diff "thoughtbot" "paperclip" "41f685f6e01396936bb8cd98e7cca517e2c7d96b" "HEAD" -diff' :: Maybe Auth -> Name Owner -> Name Repo -> Name Commit -> Name Commit -> IO (Either Error Diff) -diff' auth user repo base headref = - executeRequestMaybe auth $ diffR user repo base headref - -- | Compare two commits. -- See diffR :: Name Owner -> Name Repo -> Name Commit -> Name Commit -> Request k Diff diff --git a/src/GitHub/Endpoints/Repos/Contents.hs b/src/GitHub/Endpoints/Repos/Contents.hs index bc5a9ab6..55f48c99 100644 --- a/src/GitHub/Endpoints/Repos/Contents.hs +++ b/src/GitHub/Endpoints/Repos/Contents.hs @@ -7,26 +7,17 @@ -- module GitHub.Endpoints.Repos.Contents ( -- * Querying contents - contentsFor, - contentsFor', contentsForR, - readmeFor, - readmeFor', readmeForR, - archiveFor, - archiveFor', archiveForR, -- ** Create - createFile, createFileR, -- ** Update - updateFile, updateFileR, -- ** Delete - deleteFile, deleteFileR, module GitHub.Data @@ -34,27 +25,12 @@ module GitHub.Endpoints.Repos.Contents ( import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () import Data.Maybe (maybeToList) import qualified Data.Text.Encoding as TE import Network.URI (URI) --- | 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 "github-username" "github-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 @@ -66,38 +42,10 @@ contentsForR user repo path ref = 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 "github-username" "github-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"] [] --- | The archive of a repo, given the repo owner, name, and archive type --- --- > archiveFor "thoughtbot" "paperclip" ArchiveFormatTarball Nothing -archiveFor :: Name Owner -> Name Repo -> ArchiveFormat -> Maybe Text -> IO (Either Error URI) -archiveFor = archiveFor' Nothing - --- | The archive of a repo, given the repo owner, name, and archive type --- With Authentication --- --- > archiveFor' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" ArchiveFormatTarball Nothing -archiveFor' :: Maybe Auth -> Name Owner -> Name Repo -> ArchiveFormat -> Maybe Text -> IO (Either Error URI) -archiveFor' auth user repo path ref = - executeRequestMaybe auth $ archiveForR user repo path ref - -- | Get archive link. -- See archiveForR @@ -110,16 +58,6 @@ archiveForR user repo format ref = Query path [] where path = ["repos", toPathPart user, toPathPart repo, toPathPart format] <> maybeToList ref --- | 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 @@ -130,16 +68,6 @@ createFileR 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 @@ -150,16 +78,6 @@ updateFileR 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 diff --git a/src/GitHub/Endpoints/Repos/DeployKeys.hs b/src/GitHub/Endpoints/Repos/DeployKeys.hs index f1080680..cddbf823 100644 --- a/src/GitHub/Endpoints/Repos/DeployKeys.hs +++ b/src/GitHub/Endpoints/Repos/DeployKeys.hs @@ -7,62 +7,38 @@ -- module GitHub.Endpoints.Repos.DeployKeys ( -- * Querying deploy keys - deployKeysFor', deployKeysForR, - deployKeyFor', deployKeyForR, -- ** Create - createRepoDeployKey', createRepoDeployKeyR, -- ** Delete - deleteRepoDeployKey', deleteRepoDeployKeyR, ) where import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () --- | Querying deploy keys. -deployKeysFor' :: Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector RepoDeployKey)) -deployKeysFor' auth user repo = - executeRequest auth $ deployKeysForR user repo FetchAll - -- | Querying deploy keys. -- See deployKeysForR :: Name Owner -> Name Repo -> FetchCount -> Request 'RA (Vector RepoDeployKey) deployKeysForR user repo = pagedQuery ["repos", toPathPart user, toPathPart repo, "keys"] [] --- | Querying a deploy key -deployKeyFor' :: Auth -> Name Owner -> Name Repo -> Id RepoDeployKey -> IO (Either Error RepoDeployKey) -deployKeyFor' auth user repo keyId = - executeRequest auth $ deployKeyForR user repo keyId - -- | Querying a deploy key. -- See deployKeyForR :: Name Owner -> Name Repo -> Id RepoDeployKey -> Request 'RA RepoDeployKey deployKeyForR user repo keyId = query ["repos", toPathPart user, toPathPart repo, "keys", toPathPart keyId] [] --- | Create a deploy key -createRepoDeployKey' :: Auth -> Name Owner -> Name Repo -> NewRepoDeployKey -> IO (Either Error RepoDeployKey) -createRepoDeployKey' auth user repo key = - executeRequest auth $ createRepoDeployKeyR user repo key - -- | Create a deploy key. -- See . createRepoDeployKeyR :: Name Owner -> Name Repo -> NewRepoDeployKey -> Request 'RW RepoDeployKey createRepoDeployKeyR user repo key = command Post ["repos", toPathPart user, toPathPart repo, "keys"] (encode key) -deleteRepoDeployKey' :: Auth -> Name Owner -> Name Repo -> Id RepoDeployKey -> IO (Either Error ()) -deleteRepoDeployKey' auth user repo keyId = - executeRequest auth $ deleteRepoDeployKeyR user repo keyId - -- | Delete a deploy key. -- See deleteRepoDeployKeyR :: Name Owner -> Name Repo -> Id RepoDeployKey -> GenRequest 'MtUnit 'RW () diff --git a/src/GitHub/Endpoints/Repos/Forks.hs b/src/GitHub/Endpoints/Repos/Forks.hs index 5ca6ac14..f556e1f8 100644 --- a/src/GitHub/Endpoints/Repos/Forks.hs +++ b/src/GitHub/Endpoints/Repos/Forks.hs @@ -6,31 +6,14 @@ -- Hot forking action, as described at -- . module GitHub.Endpoints.Repos.Forks ( - forksFor, - forksFor', forksForR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () --- | All the repos that are forked off the given repo. --- --- > forksFor "thoughtbot" "paperclip" -forksFor :: Name Owner -> Name Repo -> IO (Either Error (Vector Repo)) -forksFor = forksFor' Nothing - --- | All the repos that are forked off the given repo. --- | With authentication --- --- > forksFor' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" -forksFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Repo)) -forksFor' auth user repo = - executeRequestMaybe auth $ forksForR user repo FetchAll - -- | List forks. -- See forksForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Repo) diff --git a/src/GitHub/Endpoints/Repos/Releases.hs b/src/GitHub/Endpoints/Repos/Releases.hs index 9c0e4ed4..6c96bee1 100644 --- a/src/GitHub/Endpoints/Repos/Releases.hs +++ b/src/GitHub/Endpoints/Repos/Releases.hs @@ -1,96 +1,35 @@ -- The Release API, as described at -- . module GitHub.Endpoints.Repos.Releases ( - releases, - releases', releasesR, - release, - release', releaseR, - latestRelease, - latestRelease', latestReleaseR, - releaseByTagName, - releaseByTagName', releaseByTagNameR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () --- | All releases for the given repo. --- --- > releases "calleerlandsson" "pick" -releases :: Name Owner -> Name Repo -> IO (Either Error (Vector Release)) -releases = releases' Nothing - --- | All releases for the given repo with authentication. --- --- > releases' (Just $ BasicAuth "github-username" "github-password") "calleerlandsson" "pick" -releases' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Release)) -releases' auth user repo = - executeRequestMaybe auth $ releasesR user repo FetchAll - -- | List releases for a repository. -- See releasesR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Release) releasesR user repo = pagedQuery ["repos", toPathPart user, toPathPart repo, "releases"] [] --- | Query a single release. --- --- > release "calleerlandsson" "pick" -release :: Name Owner -> Name Repo -> Id Release -> IO (Either Error Release) -release = release' Nothing - --- | Query a single release with authentication. --- --- > release' (Just $ BasicAuth "github-username" "github-password") "calleerlandsson" "pick" -release' :: Maybe Auth -> Name Owner -> Name Repo -> Id Release -> IO (Either Error Release) -release' auth user repo reqReleaseId = - executeRequestMaybe auth $ releaseR user repo reqReleaseId - -- | Get a single release. -- See releaseR :: Name Owner -> Name Repo -> Id Release -> Request k Release releaseR user repo reqReleaseId = query ["repos", toPathPart user, toPathPart repo, "releases", toPathPart reqReleaseId ] [] --- | Query latest release. --- --- > latestRelease "calleerlandsson" "pick" -latestRelease :: Name Owner -> Name Repo -> IO (Either Error Release) -latestRelease = latestRelease' Nothing - --- | Query latest release with authentication. --- --- > latestRelease' (Just $ BasicAuth "github-username" "github-password") "calleerlandsson" "pick" -latestRelease' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error Release) -latestRelease' auth user repo = - executeRequestMaybe auth $ latestReleaseR user repo - -- | Get the latest release. -- See latestReleaseR :: Name Owner -> Name Repo -> Request k Release latestReleaseR user repo = query ["repos", toPathPart user, toPathPart repo, "releases", "latest" ] [] --- | Query release by tag name. --- --- > releaseByTagName "calleerlandsson" "pick" -releaseByTagName :: Name Owner -> Name Repo -> Text -> IO (Either Error Release) -releaseByTagName = releaseByTagName' Nothing - --- | Query release by tag name with authentication. --- --- > releaseByTagName' (Just $ BasicAuth "github-username" "github-password") "calleerlandsson" "pick" -releaseByTagName' :: Maybe Auth -> Name Owner -> Name Repo -> Text -> IO (Either Error Release) -releaseByTagName' auth user repo reqTagName = - executeRequestMaybe auth $ releaseByTagNameR user repo reqTagName - -- | Get a release by tag name -- See releaseByTagNameR :: Name Owner -> Name Repo -> Text -> Request k Release diff --git a/src/GitHub/Endpoints/Repos/Statuses.hs b/src/GitHub/Endpoints/Repos/Statuses.hs index d25186d6..1c1f167d 100644 --- a/src/GitHub/Endpoints/Repos/Statuses.hs +++ b/src/GitHub/Endpoints/Repos/Statuses.hs @@ -6,29 +6,16 @@ -- The repo statuses API as described on -- . module GitHub.Endpoints.Repos.Statuses ( - createStatus, createStatusR, - statusesFor, statusesForR, - statusFor, statusForR, module GitHub.Data ) where import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () --- | Create a new status --- --- > createStatus (BasicAuth user password) "thoughtbot" "paperclip" --- > "41f685f6e01396936bb8cd98e7cca517e2c7d96b" --- > (NewStatus StatusSuccess Nothing "Looks good!" Nothing) -createStatus :: Auth -> Name Owner -> Name Repo -> Name Commit -> NewStatus -> IO (Either Error Status) -createStatus auth owner repo sha ns = - executeRequest auth $ createStatusR owner repo sha ns - -- | Create a new status -- See createStatusR :: Name Owner -> Name Repo -> Name Commit -> NewStatus -> Request 'RW Status @@ -37,28 +24,12 @@ createStatusR owner repo sha = where parts = ["repos", toPathPart owner, toPathPart repo, "statuses", toPathPart sha] --- | All statuses for a commit --- --- > statusesFor (BasicAuth user password) "thoughtbot" "paperclip" --- > "41f685f6e01396936bb8cd98e7cca517e2c7d96b" -statusesFor :: Auth -> Name Owner -> Name Repo -> Name Commit -> IO (Either Error (Vector Status)) -statusesFor auth user repo sha = - executeRequest auth $ statusesForR user repo sha FetchAll - -- | All statuses for a commit -- See statusesForR :: Name Owner -> Name Repo -> Name Commit -> FetchCount -> Request 'RW (Vector Status) statusesForR user repo sha = pagedQuery ["repos", toPathPart user, toPathPart repo, "commits", toPathPart sha, "statuses"] [] --- | The combined status for a specific commit --- --- > statusFor (BasicAuth user password) "thoughtbot" "paperclip" --- > "41f685f6e01396936bb8cd98e7cca517e2c7d96b" -statusFor :: Auth -> Name Owner -> Name Repo -> Name Commit -> IO (Either Error CombinedStatus) -statusFor auth user repo sha = - executeRequest auth $ statusForR user repo sha - -- | The combined status for a specific commit -- See statusForR :: Name Owner -> Name Repo -> Name Commit -> Request 'RW CombinedStatus diff --git a/src/GitHub/Endpoints/Repos/Webhooks.hs b/src/GitHub/Endpoints/Repos/Webhooks.hs index 87e37fba..8b828f30 100644 --- a/src/GitHub/Endpoints/Repos/Webhooks.hs +++ b/src/GitHub/Endpoints/Repos/Webhooks.hs @@ -8,99 +8,61 @@ -- module GitHub.Endpoints.Repos.Webhooks ( -- * Querying repositories - webhooksFor', webhooksForR, - webhookFor', webhookForR, -- ** Create - createRepoWebhook', createRepoWebhookR, -- ** Edit - editRepoWebhook', editRepoWebhookR, -- ** Test - testPushRepoWebhook', testPushRepoWebhookR, - pingRepoWebhook', pingRepoWebhookR, -- ** Delete - deleteRepoWebhook', deleteRepoWebhookR, ) where import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () -webhooksFor' :: Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector RepoWebhook)) -webhooksFor' auth user repo = - executeRequest auth $ webhooksForR user repo FetchAll - -- | List hooks. -- See webhooksForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector RepoWebhook) webhooksForR user repo = pagedQuery ["repos", toPathPart user, toPathPart repo, "hooks"] [] - -webhookFor' :: Auth -> Name Owner -> Name Repo -> Id RepoWebhook -> IO (Either Error RepoWebhook) -webhookFor' auth user repo hookId = - executeRequest auth $ webhookForR user repo hookId - --- | Query single hook. -- See webhookForR :: Name Owner -> Name Repo -> Id RepoWebhook -> Request k RepoWebhook webhookForR user repo hookId = query ["repos", toPathPart user, toPathPart repo, "hooks", toPathPart hookId] [] -createRepoWebhook' :: Auth -> Name Owner -> Name Repo -> NewRepoWebhook -> IO (Either Error RepoWebhook) -createRepoWebhook' auth user repo hook = - executeRequest auth $ createRepoWebhookR user repo hook - -- | Create a hook. -- See createRepoWebhookR :: Name Owner -> Name Repo -> NewRepoWebhook -> Request 'RW RepoWebhook createRepoWebhookR user repo hook = command Post ["repos", toPathPart user, toPathPart repo, "hooks"] (encode hook) -editRepoWebhook' :: Auth -> Name Owner -> Name Repo -> Id RepoWebhook -> EditRepoWebhook -> IO (Either Error RepoWebhook) -editRepoWebhook' auth user repo hookId hookEdit = - executeRequest auth $ editRepoWebhookR user repo hookId hookEdit - -- | Edit a hook. -- See editRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> EditRepoWebhook -> Request 'RW RepoWebhook editRepoWebhookR user repo hookId hookEdit = command Patch ["repos", toPathPart user, toPathPart repo, "hooks", toPathPart hookId] (encode hookEdit) -testPushRepoWebhook' :: Auth -> Name Owner -> Name Repo -> Id RepoWebhook -> IO (Either Error Bool) -testPushRepoWebhook' auth user repo hookId = - executeRequest auth $ testPushRepoWebhookR user repo hookId - -- | Test a push hook. -- See testPushRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> GenRequest 'MtStatus 'RW Bool testPushRepoWebhookR user repo hookId = Command Post (createWebhookOpPath user repo hookId $ Just "tests") (encode ()) -pingRepoWebhook' :: Auth -> Name Owner -> Name Repo -> Id RepoWebhook -> IO (Either Error Bool) -pingRepoWebhook' auth user repo hookId = - executeRequest auth $ pingRepoWebhookR user repo hookId - -- | Ping a hook. -- See pingRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> GenRequest 'MtStatus 'RW Bool pingRepoWebhookR user repo hookId = Command Post (createWebhookOpPath user repo hookId $ Just "pings") (encode ()) -deleteRepoWebhook' :: Auth -> Name Owner -> Name Repo -> Id RepoWebhook -> IO (Either Error ()) -deleteRepoWebhook' auth user repo hookId = - executeRequest auth $ deleteRepoWebhookR user repo hookId - -- | Delete a hook. -- See deleteRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> GenRequest 'MtUnit 'RW () diff --git a/src/GitHub/Endpoints/Search.hs b/src/GitHub/Endpoints/Search.hs index 58a0e4e5..26c134bd 100644 --- a/src/GitHub/Endpoints/Search.hs +++ b/src/GitHub/Endpoints/Search.hs @@ -6,79 +6,30 @@ -- The Github Search API, as described at -- . module GitHub.Endpoints.Search( - searchRepos', - searchRepos, searchReposR, - searchCode', - searchCode, searchCodeR, - searchIssues', - searchIssues, searchIssuesR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () import qualified Data.Text.Encoding as TE --- | Perform a repository search. --- With authentication. --- --- > searchRepos' (Just $ BasicAuth "github-username" "github-password') "a in%3Aname language%3Ahaskell created%3A>2013-10-01&per_page=100" -searchRepos' :: Maybe Auth -> Text -> IO (Either Error (SearchResult Repo)) -searchRepos' auth = executeRequestMaybe auth . searchReposR - --- | Perform a repository search. --- Without authentication. --- --- > searchRepos "q=a in%3Aname language%3Ahaskell created%3A>2013-10-01&per_page=100" -searchRepos :: Text -> IO (Either Error (SearchResult Repo)) -searchRepos = searchRepos' Nothing - -- | Search repositories. -- See searchReposR :: Text -> Request k (SearchResult Repo) searchReposR searchString = query ["search", "repositories"] [("q", Just $ TE.encodeUtf8 searchString)] --- | Perform a code search. --- With authentication. --- --- > searchCode' (Just $ BasicAuth "github-username" "github-password') "a in%3Aname language%3Ahaskell created%3A>2013-10-01&per_page=100" -searchCode' :: Maybe Auth -> Text -> IO (Either Error (SearchResult Code)) -searchCode' auth = executeRequestMaybe auth . searchCodeR - --- | Perform a code search. --- Without authentication. --- --- > searchCode "q=addClass+in:file+language:js+repo:jquery/jquery" -searchCode :: Text -> IO (Either Error (SearchResult Code)) -searchCode = searchCode' Nothing - -- | Search code. -- See searchCodeR :: Text -> Request k (SearchResult Code) searchCodeR searchString = query ["search", "code"] [("q", Just $ TE.encodeUtf8 searchString)] --- | Perform an issue search. --- With authentication. --- --- > searchIssues' (Just $ BasicAuth "github-username" "github-password') "a repo%3Aphadej%2Fgithub&per_page=100" -searchIssues' :: Maybe Auth -> Text -> IO (Either Error (SearchResult Issue)) -searchIssues' auth = executeRequestMaybe auth . searchIssuesR - --- | Perform an issue search. --- Without authentication. --- --- > searchIssues "q=a repo%3Aphadej%2Fgithub&per_page=100" -searchIssues :: Text -> IO (Either Error (SearchResult Issue)) -searchIssues = searchIssues' Nothing - -- | Search issues. -- See searchIssuesR :: Text -> Request k (SearchResult Issue) diff --git a/src/GitHub/Endpoints/Users.hs b/src/GitHub/Endpoints/Users.hs index b3f7621c..ef68bba6 100644 --- a/src/GitHub/Endpoints/Users.hs +++ b/src/GitHub/Endpoints/Users.hs @@ -6,35 +6,24 @@ -- The Github Users API, as described at -- . module GitHub.Endpoints.Users ( - userInfoFor, - userInfoFor', userInfoForR, ownerInfoForR, - userInfoCurrent', userInfoCurrentR, module GitHub.Data, ) where import GitHub.Data -import GitHub.Internal.Prelude -import GitHub.Request import Prelude () --- | The information for a single user, by login name. --- With authentification --- --- > userInfoFor' (Just $ BasicAuth "github-username" "github-password") "mike-burns" -userInfoFor' :: Maybe Auth -> Name User -> IO (Either Error User) -userInfoFor' auth = executeRequestMaybe auth . userInfoForR - --- | The information for a single user, by login name. --- --- > userInfoFor "mike-burns" -userInfoFor :: Name User -> IO (Either Error User) -userInfoFor = executeRequest' . userInfoForR - -- | Query a single user. -- See +-- +-- >>> github' userInfoForR "mike-burns" +-- +-- or +-- +-- >>> github userInfoForR (OAuth "github-token") "mike-burns" +-- userInfoForR :: Name User -> Request k User userInfoForR user = query ["users", toPathPart user] [] @@ -43,13 +32,6 @@ userInfoForR user = query ["users", toPathPart user] [] ownerInfoForR :: Name Owner -> Request k Owner ownerInfoForR owner = query ["users", toPathPart owner] [] --- | Retrieve information about the user associated with the supplied authentication. --- --- > userInfoCurrent' (OAuth "...") -userInfoCurrent' :: Auth -> IO (Either Error User) -userInfoCurrent' auth = - executeRequest auth $ userInfoCurrentR - -- | Query the authenticated user. -- See userInfoCurrentR :: Request 'RA User diff --git a/src/GitHub/Endpoints/Users/Emails.hs b/src/GitHub/Endpoints/Users/Emails.hs index c432aae6..9ba76389 100644 --- a/src/GitHub/Endpoints/Users/Emails.hs +++ b/src/GitHub/Endpoints/Users/Emails.hs @@ -6,38 +6,21 @@ -- The user emails API as described on -- . module GitHub.Endpoints.Users.Emails ( - currentUserEmails', currentUserEmailsR, - currentUserPublicEmails', currentUserPublicEmailsR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () --- | List email addresses for the authenticated user. --- --- > currentUserEmails' (OAuth "token") -currentUserEmails' :: Auth -> IO (Either Error (Vector Email)) -currentUserEmails' auth = - executeRequest auth $ currentUserEmailsR FetchAll - -- | List email addresses. -- See currentUserEmailsR :: FetchCount -> Request 'RA (Vector Email) currentUserEmailsR = pagedQuery ["user", "emails"] [] --- | List public email addresses for the authenticated user. --- --- > currentUserPublicEmails' (OAuth "token") -currentUserPublicEmails' :: Auth -> IO (Either Error (Vector Email)) -currentUserPublicEmails' auth = - executeRequest auth $ currentUserPublicEmailsR FetchAll - -- | List public email addresses. -- See currentUserPublicEmailsR :: FetchCount -> Request 'RA (Vector Email) diff --git a/src/GitHub/Endpoints/Users/Followers.hs b/src/GitHub/Endpoints/Users/Followers.hs index 8ab72ce4..db58900f 100644 --- a/src/GitHub/Endpoints/Users/Followers.hs +++ b/src/GitHub/Endpoints/Users/Followers.hs @@ -6,8 +6,6 @@ -- The user followers API as described on -- . module GitHub.Endpoints.Users.Followers ( - usersFollowing, - usersFollowedBy, usersFollowingR, usersFollowedByR, module GitHub.Data, @@ -15,29 +13,14 @@ module GitHub.Endpoints.Users.Followers ( import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () --- | All the users following the given user. --- --- > usersFollowing "mike-burns" -usersFollowing :: Name User -> IO (Either Error (Vector SimpleUser)) -usersFollowing user = - executeRequest' $ usersFollowingR user FetchAll - -- | List followers of a user. -- See usersFollowingR :: Name User -> FetchCount -> Request k (Vector SimpleUser) usersFollowingR user = pagedQuery ["users", toPathPart user, "followers"] [] --- | All the users that the given user follows. --- --- > usersFollowedBy "mike-burns" -usersFollowedBy :: Name User -> IO (Either Error (Vector SimpleUser)) -usersFollowedBy user = - executeRequest' $ usersFollowedByR user FetchAll - -- | List users followed by another user. -- See usersFollowedByR :: Name User -> FetchCount -> Request k (Vector SimpleUser) diff --git a/src/GitHub/Endpoints/Users/PublicSSHKeys.hs b/src/GitHub/Endpoints/Users/PublicSSHKeys.hs index 0eb9a4ee..663e2641 100644 --- a/src/GitHub/Endpoints/Users/PublicSSHKeys.hs +++ b/src/GitHub/Endpoints/Users/PublicSSHKeys.hs @@ -7,75 +7,45 @@ -- module GitHub.Endpoints.Users.PublicSSHKeys ( -- * Querying public SSH keys - publicSSHKeys', publicSSHKeysR, - publicSSHKeysFor', publicSSHKeysForR, - publicSSHKey', publicSSHKeyR, -- ** Create - createUserPublicSSHKey', createUserPublicSSHKeyR, -- ** Delete - deleteUserPublicSSHKey', deleteUserPublicSSHKeyR, ) where import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () --- | Querying public SSH keys. -publicSSHKeysFor' :: Name Owner -> IO (Either Error (Vector PublicSSHKeyBasic)) -publicSSHKeysFor' user = - executeRequest' $ publicSSHKeysForR user FetchAll - -- | Querying public SSH keys. -- See publicSSHKeysForR :: Name Owner -> FetchCount -> Request 'RO (Vector PublicSSHKeyBasic) publicSSHKeysForR user = pagedQuery ["users", toPathPart user, "keys"] [] --- | Querying the authenticated users' public SSH keys -publicSSHKeys' :: Auth -> IO (Either Error (Vector PublicSSHKey)) -publicSSHKeys' auth = - executeRequest auth publicSSHKeysR - -- | Querying the authenticated users' public SSH keys -- See publicSSHKeysR :: Request 'RA (Vector PublicSSHKey) publicSSHKeysR = query ["user", "keys"] [] --- | Querying a public SSH key -publicSSHKey' :: Auth -> Id PublicSSHKey -> IO (Either Error PublicSSHKey) -publicSSHKey' auth keyId = - executeRequest auth $ publicSSHKeyR keyId - -- | Querying a public SSH key. -- See publicSSHKeyR :: Id PublicSSHKey -> Request 'RA PublicSSHKey publicSSHKeyR keyId = query ["user", "keys", toPathPart keyId] [] --- | Create a public SSH key -createUserPublicSSHKey' :: Auth -> NewPublicSSHKey -> IO (Either Error PublicSSHKey) -createUserPublicSSHKey' auth key = - executeRequest auth $ createUserPublicSSHKeyR key - -- | Create a public SSH key. -- See . createUserPublicSSHKeyR :: NewPublicSSHKey -> Request 'RW PublicSSHKey createUserPublicSSHKeyR key = command Post ["user", "keys"] (encode key) -deleteUserPublicSSHKey' :: Auth -> Id PublicSSHKey -> IO (Either Error ()) -deleteUserPublicSSHKey' auth keyId = - executeRequest auth $ deleteUserPublicSSHKeyR keyId - -- | Delete a public SSH key. -- See deleteUserPublicSSHKeyR :: Id PublicSSHKey -> GenRequest 'MtUnit 'RW () From 7f103113066c38b8c87f833ea8221e01227ac61f Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Wed, 27 Nov 2019 02:46:31 +0200 Subject: [PATCH 394/510] Remove some committed in haddock artifacts --- src/highlight.js | 27 ------------------------ src/style.css | 55 ------------------------------------------------ 2 files changed, 82 deletions(-) delete mode 100644 src/highlight.js delete mode 100644 src/style.css diff --git a/src/highlight.js b/src/highlight.js deleted file mode 100644 index 1e903bd0..00000000 --- a/src/highlight.js +++ /dev/null @@ -1,27 +0,0 @@ - -var highlight = function (on) { - return function () { - var links = document.getElementsByTagName('a'); - for (var i = 0; i < links.length; i++) { - var that = links[i]; - - if (this.href != that.href) { - continue; - } - - if (on) { - that.classList.add("hover-highlight"); - } else { - that.classList.remove("hover-highlight"); - } - } - } -}; - -window.onload = function () { - var links = document.getElementsByTagName('a'); - for (var i = 0; i < links.length; i++) { - links[i].onmouseover = highlight(true); - links[i].onmouseout = highlight(false); - } -}; diff --git a/src/style.css b/src/style.css deleted file mode 100644 index e83dc5ec..00000000 --- a/src/style.css +++ /dev/null @@ -1,55 +0,0 @@ -body { - background-color: #fdf6e3; -} - -.hs-identifier { - color: #073642; -} - -.hs-identifier.hs-var { -} - -.hs-identifier.hs-type { - color: #5f5faf; -} - -.hs-keyword { - color: #af005f; -} - -.hs-string, .hs-char { - color: #cb4b16; -} - -.hs-number { - color: #268bd2; -} - -.hs-operator { - color: #d33682; -} - -.hs-glyph, .hs-special { - color: #dc322f; -} - -.hs-comment { - color: #8a8a8a; -} - -.hs-pragma { - color: #2aa198; -} - -.hs-cpp { - color: #859900; -} - -a:link, a:visited { - text-decoration: none; - border-bottom: 1px solid #eee8d5; -} - -a:hover, a.hover-highlight { - background-color: #eee8d5; -} From dab2a747a1d20746a7701c2c968bc2d35bcfb1cd Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Wed, 27 Nov 2019 02:51:40 +0200 Subject: [PATCH 395/510] Bump version to 0.24 --- CHANGELOG.md | 19 ++++++++++++++++++- github.cabal | 2 +- 2 files changed, 19 insertions(+), 2 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index fa23d79e..cdc67227 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,20 @@ +## Changes for 0.24 + +**Major change**: +Introduce `github` n-ary combinator to hoist `... -> Request rw res` +into `... -> IO (Either Error res)` (i.e. n-ary `executeRequest`). +With that in place drop `.. -> IO (Either Error res)` functions. + +This reduces symbol bloat in the library. +[#415](https://github.com/phadej/github/pull/415) + +- Remove double `withOpenSSL` + [#414](https://github.com/phadej/github/pull/414) +- Pull requests reviews API uses issue number + [#409](https://github.com/phadej/github/pull/409) +- Update `Repo`, `NewRepo` and `EditRepo` data types + [#407](https://github.com/phadej/github/pull/407) + ## Changes for 0.23 - Escape URI paths @@ -93,7 +110,7 @@ ## Changes for 0.18 -- Endpoints for deleting issue comments. +- Endpoints for deleting issue comments. [#294](https://github.com/phadej/github/pull/294) - Endpoints for (un)starring gists. [#296](https://github.com/phadej/github/pull/296) diff --git a/github.cabal b/github.cabal index ff5c3c2a..b3a18432 100644 --- a/github.cabal +++ b/github.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: github -version: 0.23 +version: 0.24 synopsis: Access to the GitHub API, v3. category: Network description: From 01de4b16d2f1ef2aea3d437f1697ea5f318701bb Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Wed, 27 Nov 2019 14:35:13 +0200 Subject: [PATCH 396/510] Remove nix stuff --- default.nix | 3 --- overlay.nix | 31 ------------------------------- 2 files changed, 34 deletions(-) delete mode 100644 default.nix delete mode 100644 overlay.nix diff --git a/default.nix b/default.nix deleted file mode 100644 index e8e50a1b..00000000 --- a/default.nix +++ /dev/null @@ -1,3 +0,0 @@ -let - pkgs = import { overlays = [ (import ./overlay.nix) ]; }; -in pkgs.haskellPackages.callCabal2nix "github" ./. { } diff --git a/overlay.nix b/overlay.nix deleted file mode 100644 index 173f195e..00000000 --- a/overlay.nix +++ /dev/null @@ -1,31 +0,0 @@ -_: pkgs: { - haskellPackages = pkgs.haskellPackages.override (old: { - overrides = pkgs.lib.composeExtensions (old.overrides or (_: _: {})) (self: super: { - unordered-containers = pkgs.haskell.lib.overrideCabal super.unordered-containers (_: { - version = "0.2.10.0"; - sha256 = "0wy5hfrs880hh8hvp648bl07ws777n3kkmczzdszr7papnyigwb5"; - }); - binary-instances = pkgs.haskell.lib.dontCheck (pkgs.haskell.lib.overrideCabal super.binary-instances (old: { - libraryHaskellDepends = old.libraryHaskellDepends ++ [ - self.binary-orphans_1_0_1 - ]; - broken = false; - })); - binary-orphans_1_0_1 = pkgs.haskell.lib.dontCheck super.binary-orphans_1_0_1; - github = pkgs.haskell.lib.overrideCabal super.github (old: { - version = "0.22"; - sha256 = "15py79qcpj0k331i42njgwkirwyiacbc5razmxnm4672dvvip2qk"; - libraryHaskellDepends = old.libraryHaskellDepends ++ [ - self.binary-instances self.exceptions self.transformers-compat - ]; - }); - time-compat = pkgs.haskell.lib.dontCheck (pkgs.haskell.lib.overrideCabal super.time-compat (old: { - version = "1.9.2.2"; - sha256 = "05va0rqs759vbridbcl6hksp967j9anjvys8vx72fnfkhlrn2s52"; - libraryHaskellDepends = old.libraryHaskellDepends ++ [ - self.base-orphans - ]; - })); - }); - }); -} From e99858d26ed21472b2405a56e42c73693b319145 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 3 Dec 2019 11:48:37 +0200 Subject: [PATCH 397/510] Remove stackage badges from README --- README.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index 877c51dc..45492903 100644 --- a/README.md +++ b/README.md @@ -3,8 +3,6 @@ Github [![Build Status](https://travis-ci.org/phadej/github.svg?branch=master)](https://travis-ci.org/phadej/github) [![Hackage](https://img.shields.io/hackage/v/github.svg)][hackage] -[![Stackage LTS 5](http://stackage.org/package/github/badge/lts-5)](http://stackage.org/lts-5/package/github) -[![Stackage Nightly](http://stackage.org/package/github/badge/nightly)](http://stackage.org/nightly/package/github) The Github API v3 for Haskell. @@ -34,6 +32,8 @@ Example Usage See the samples in the [samples/](https://github.com/fpco/github/tree/master/samples) directory. +Note: some samples might be outdated. + Documentation ============= From 75afbf8d7bfa4d82724064a9a10ef49da9ff29d1 Mon Sep 17 00:00:00 2001 From: Robbie McMichael <2044464+robbiemcmichael@users.noreply.github.com> Date: Sat, 14 Dec 2019 23:42:27 +1100 Subject: [PATCH 398/510] Add openssl flag to samples --- cabal.project | 1 + samples/Operational/Operational.hs | 14 +++++++++++++- samples/github-samples.cabal | 18 +++++++++++++++--- 3 files changed, 29 insertions(+), 4 deletions(-) diff --git a/cabal.project b/cabal.project index 26dc579d..555119f5 100644 --- a/cabal.project +++ b/cabal.project @@ -8,3 +8,4 @@ constraints: hashable ^>=1.3 constraints: semigroups ^>=0.19 constraints: github +openssl +constraints: github-samples +openssl diff --git a/samples/Operational/Operational.hs b/samples/Operational/Operational.hs index ea8208e7..1117e72e 100644 --- a/samples/Operational/Operational.hs +++ b/samples/Operational/Operational.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-} @@ -9,11 +10,17 @@ import Prelude () import Control.Monad.Operational import Control.Monad.Trans.Except (ExceptT (..), runExceptT) import Network.HTTP.Client (Manager, newManager, ManagerSettings) + +#ifdef MIN_VERSION_http_client_tls +import Network.HTTP.Client.TLS (tlsManagerSettings) +#else import Network.HTTP.Client.OpenSSL (opensslManagerSettings, withOpenSSL) -import qualified GitHub as GH import qualified OpenSSL.Session as SSL import qualified OpenSSL.X509.SystemStore as SSL +#endif + +import qualified GitHub as GH data R a where R :: FromJSON a => GH.Request 'GH.RA a -> R a @@ -42,6 +49,10 @@ main = withOpenSSL $ do githubRequest $ GH.ownerInfoForR (GH.simpleOwnerLogin . GH.repoOwner $ repo) print owner +#ifdef MIN_VERSION_http_client_tls +withOpenSSL :: IO a -> IO a +withOpenSSL = id +#else tlsManagerSettings :: ManagerSettings tlsManagerSettings = opensslManagerSettings $ do ctx <- SSL.context @@ -52,3 +63,4 @@ tlsManagerSettings = opensslManagerSettings $ do SSL.contextLoadSystemCerts ctx SSL.contextSetVerificationMode ctx $ SSL.VerifyPeer True True Nothing return ctx +#endif diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index f0d4a4e7..2b4d2f69 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -17,6 +17,11 @@ tested-with: || ==8.6.5 || ==8.8.1 +flag openssl + description: "Use http-client-openssl" + manual: True + default: False + library hs-source-dirs: src ghc-options: -Wall @@ -38,15 +43,22 @@ executable github-operational , base-compat-batteries , github , github-samples - , HsOpenSSL - , HsOpenSSL-x509-system , http-client - , http-client-openssl , operational , text , transformers , transformers-compat + if flag(openssl) + build-depends: + HsOpenSSL + , HsOpenSSL-x509-system + , http-client-openssl + + else + build-depends: + http-client-tls + default-language: Haskell2010 common deps From 6b42b3031961920bdb719227893566dbd81f9ce5 Mon Sep 17 00:00:00 2001 From: Robbie McMichael <2044464+robbiemcmichael@users.noreply.github.com> Date: Sun, 15 Dec 2019 22:13:36 +1100 Subject: [PATCH 399/510] Manage orgs in GitHub Enterprise --- github.cabal | 2 + src/GitHub.hs | 9 +++ src/GitHub/Data.hs | 2 + src/GitHub/Data/Enterprise/Organizations.hs | 64 +++++++++++++++++++ .../Endpoints/Enterprise/Organizations.hs | 27 ++++++++ 5 files changed, 104 insertions(+) create mode 100644 src/GitHub/Data/Enterprise/Organizations.hs create mode 100644 src/GitHub/Endpoints/Enterprise/Organizations.hs diff --git a/github.cabal b/github.cabal index b3a18432..669bbb77 100644 --- a/github.cabal +++ b/github.cabal @@ -90,6 +90,7 @@ library GitHub.Data.DeployKeys GitHub.Data.Deployments GitHub.Data.Email + GitHub.Data.Enterprise.Organizations GitHub.Data.Events GitHub.Data.Gists GitHub.Data.GitData @@ -116,6 +117,7 @@ library GitHub.Endpoints.Activity.Notifications GitHub.Endpoints.Activity.Starring GitHub.Endpoints.Activity.Watching + GitHub.Endpoints.Enterprise.Organizations GitHub.Endpoints.Gists GitHub.Endpoints.Gists.Comments GitHub.Endpoints.GitData.Blobs diff --git a/src/GitHub.hs b/src/GitHub.hs index 2faf1618..d5845972 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -56,6 +56,14 @@ module GitHub ( watchersForR, reposWatchedByR, + -- * Enterprise + -- | See + + -- ** Organizations + -- | See + createOrganizationR, + renameOrganizationR, + -- * Gists -- | See -- @@ -401,6 +409,7 @@ import GitHub.Endpoints.Activity.Events import GitHub.Endpoints.Activity.Notifications import GitHub.Endpoints.Activity.Starring import GitHub.Endpoints.Activity.Watching +import GitHub.Endpoints.Enterprise.Organizations import GitHub.Endpoints.Gists import GitHub.Endpoints.Gists.Comments import GitHub.Endpoints.GitData.Blobs diff --git a/src/GitHub/Data.hs b/src/GitHub/Data.hs index 6acc0bf2..bdedb894 100644 --- a/src/GitHub/Data.hs +++ b/src/GitHub/Data.hs @@ -41,6 +41,7 @@ module GitHub.Data ( module GitHub.Data.DeployKeys, module GitHub.Data.Deployments, module GitHub.Data.Email, + module GitHub.Data.Enterprise.Organizations, module GitHub.Data.Events, module GitHub.Data.Gists, module GitHub.Data.GitData, @@ -73,6 +74,7 @@ import GitHub.Data.Definitions import GitHub.Data.DeployKeys import GitHub.Data.Deployments import GitHub.Data.Email +import GitHub.Data.Enterprise.Organizations import GitHub.Data.Events import GitHub.Data.Gists import GitHub.Data.GitData diff --git a/src/GitHub/Data/Enterprise/Organizations.hs b/src/GitHub/Data/Enterprise/Organizations.hs new file mode 100644 index 00000000..967cd718 --- /dev/null +++ b/src/GitHub/Data/Enterprise/Organizations.hs @@ -0,0 +1,64 @@ +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +module GitHub.Data.Enterprise.Organizations where + +import GitHub.Data.Definitions +import GitHub.Data.Name (Name) +import GitHub.Data.URL (URL) +import GitHub.Internal.Prelude +import Prelude () + +data CreateOrganization = CreateOrganization + { createOrganizationLogin :: !(Name Organization) + , createOrganizationAdmin :: !(Name User) + , createOrganizationProfileName :: !(Maybe Text) + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData CreateOrganization where rnf = genericRnf +instance Binary CreateOrganization + +data RenameOrganization = RenameOrganization + { renameOrganizationLogin :: !(Name Organization) + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData RenameOrganization where rnf = genericRnf +instance Binary RenameOrganization + +data RenameOrganizationResponse = RenameOrganizationResponse + { renameOrganizationResponseMessage :: !Text + , renameOrganizationResponseUrl :: !URL + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData RenameOrganizationResponse where rnf = genericRnf +instance Binary RenameOrganizationResponse + +-- JSON Instances + +instance ToJSON CreateOrganization where + toJSON (CreateOrganization login admin profileName) = + object $ filter notNull + [ "login" .= login + , "admin" .= admin + , "profile_name" .= profileName + ] + where + notNull (_, Null) = False + notNull (_, _) = True + +instance ToJSON RenameOrganization where + toJSON (RenameOrganization login) = + object + [ "login" .= login + ] + +instance FromJSON RenameOrganizationResponse where + parseJSON = withObject "RenameOrganizationResponse" $ \o -> + RenameOrganizationResponse + <$> o .: "message" + <*> o .: "url" diff --git a/src/GitHub/Endpoints/Enterprise/Organizations.hs b/src/GitHub/Endpoints/Enterprise/Organizations.hs new file mode 100644 index 00000000..d94c7c72 --- /dev/null +++ b/src/GitHub/Endpoints/Enterprise/Organizations.hs @@ -0,0 +1,27 @@ +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +-- The GitHub Enterprise orgs API as described on . +module GitHub.Endpoints.Enterprise.Organizations ( + createOrganizationR, + renameOrganizationR, + module GitHub.Data, + ) where + +import GitHub.Data +import GitHub.Internal.Prelude +import Prelude () + +-- | Create an organization. +-- See +createOrganizationR :: CreateOrganization -> Request 'RW SimpleOrganization +createOrganizationR = + command Post ["admin", "organizations"] . encode + +-- | Rename an organization. +-- See +renameOrganizationR :: Name Organization -> RenameOrganization -> Request 'RW RenameOrganizationResponse +renameOrganizationR org = + command Patch ["admin", "organizations", toPathPart org] . encode From b277deb25f76b88cd28d2c97b715041e05346d7f Mon Sep 17 00:00:00 2001 From: Robbie McMichael <2044464+robbiemcmichael@users.noreply.github.com> Date: Mon, 16 Dec 2019 19:24:18 +1100 Subject: [PATCH 400/510] Add samples for GitHub Enterprise org management --- samples/Enterprise/CreateOrganization.hs | 29 ++++++++++++++++++++++++ samples/Enterprise/RenameOrganization.hs | 28 +++++++++++++++++++++++ samples/github-samples.cabal | 10 ++++++++ 3 files changed, 67 insertions(+) create mode 100644 samples/Enterprise/CreateOrganization.hs create mode 100644 samples/Enterprise/RenameOrganization.hs diff --git a/samples/Enterprise/CreateOrganization.hs b/samples/Enterprise/CreateOrganization.hs new file mode 100644 index 00000000..897e7cd5 --- /dev/null +++ b/samples/Enterprise/CreateOrganization.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +module Main (main) where + +import Common + +import qualified GitHub + +main :: IO () +main = do + args <- getArgs + result <- case args of + [api_endpoint, token, org_login, org_admin, org_profile_name] -> + GitHub.github + (GitHub.EnterpriseOAuth + (fromString api_endpoint) + (fromString token) + ) + GitHub.createOrganizationR + (GitHub.CreateOrganization + (GitHub.mkOrganizationName $ fromString org_login) + (GitHub.mkUserName $ fromString org_admin) + (Just $ fromString org_profile_name) + ) + _ -> + error "usage: CreateOrganization " + case result of + Left err -> putStrLn $ "Error: " <> tshow err + Right org -> putStrLn $ tshow org diff --git a/samples/Enterprise/RenameOrganization.hs b/samples/Enterprise/RenameOrganization.hs new file mode 100644 index 00000000..bee86142 --- /dev/null +++ b/samples/Enterprise/RenameOrganization.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +module Main (main) where + +import Common + +import qualified GitHub + +main :: IO () +main = do + args <- getArgs + result <- case args of + [api_endpoint, token, current_name, new_name] -> + GitHub.github + (GitHub.EnterpriseOAuth + (fromString api_endpoint) + (fromString token) + ) + GitHub.renameOrganizationR + (GitHub.mkOrganizationName $ fromString current_name) + (GitHub.RenameOrganization + (GitHub.mkOrganizationName $ fromString new_name) + ) + _ -> + error "usage: RenameOrganization " + case result of + Left err -> putStrLn $ "Error: " <> tshow err + Right x -> putStrLn $ tshow x diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index 2b4d2f69..b6a75728 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -98,6 +98,16 @@ executable github-create-deploy-key -- main-is: DeleteTeamMembershipFor.hs -- hs-source-dirs: Teams/Memberships +executable github-enterprise-create-organization + import: deps + main-is: CreateOrganization.hs + hs-source-dirs: Enterprise + +executable github-enterprise-rename-organization + import: deps + main-is: RenameOrganization.hs + hs-source-dirs: Enterprise + executable github-edit-team import: deps main-is: EditTeam.hs From 3fb5f0ce6c0359f37909d3315cee6c6ef9b38db8 Mon Sep 17 00:00:00 2001 From: Robbie McMichael <2044464+robbiemcmichael@users.noreply.github.com> Date: Mon, 16 Dec 2019 20:42:26 +1100 Subject: [PATCH 401/510] Add GitHub.Enterprise module --- github.cabal | 2 ++ samples/Enterprise/CreateOrganization.hs | 1 + samples/Enterprise/RenameOrganization.hs | 1 + src/GitHub.hs | 2 +- src/GitHub/Data.hs | 2 -- src/GitHub/Data/Enterprise.hs | 12 ++++++++++ .../Endpoints/Enterprise/Organizations.hs | 1 + src/GitHub/Enterprise.hs | 23 +++++++++++++++++++ 8 files changed, 41 insertions(+), 3 deletions(-) create mode 100644 src/GitHub/Data/Enterprise.hs create mode 100644 src/GitHub/Enterprise.hs diff --git a/github.cabal b/github.cabal index 669bbb77..700d80cf 100644 --- a/github.cabal +++ b/github.cabal @@ -90,6 +90,7 @@ library GitHub.Data.DeployKeys GitHub.Data.Deployments GitHub.Data.Email + GitHub.Data.Enterprise GitHub.Data.Enterprise.Organizations GitHub.Data.Events GitHub.Data.Gists @@ -153,6 +154,7 @@ library GitHub.Endpoints.Users.Emails GitHub.Endpoints.Users.Followers GitHub.Endpoints.Users.PublicSSHKeys + GitHub.Enterprise GitHub.Internal.Prelude GitHub.Request diff --git a/samples/Enterprise/CreateOrganization.hs b/samples/Enterprise/CreateOrganization.hs index 897e7cd5..32fc97cc 100644 --- a/samples/Enterprise/CreateOrganization.hs +++ b/samples/Enterprise/CreateOrganization.hs @@ -5,6 +5,7 @@ module Main (main) where import Common import qualified GitHub +import qualified GitHub.Enterprise as GitHub main :: IO () main = do diff --git a/samples/Enterprise/RenameOrganization.hs b/samples/Enterprise/RenameOrganization.hs index bee86142..c16fdf56 100644 --- a/samples/Enterprise/RenameOrganization.hs +++ b/samples/Enterprise/RenameOrganization.hs @@ -5,6 +5,7 @@ module Main (main) where import Common import qualified GitHub +import qualified GitHub.Enterprise as GitHub main :: IO () main = do diff --git a/src/GitHub.hs b/src/GitHub.hs index d5845972..850258d1 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -3,7 +3,7 @@ -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- --- This module re-exports all request constructrors and data definitions from +-- This module re-exports all request constructors and data definitions from -- this package. -- -- See "GitHub.Request" module for executing 'Request', in short diff --git a/src/GitHub/Data.hs b/src/GitHub/Data.hs index bdedb894..6acc0bf2 100644 --- a/src/GitHub/Data.hs +++ b/src/GitHub/Data.hs @@ -41,7 +41,6 @@ module GitHub.Data ( module GitHub.Data.DeployKeys, module GitHub.Data.Deployments, module GitHub.Data.Email, - module GitHub.Data.Enterprise.Organizations, module GitHub.Data.Events, module GitHub.Data.Gists, module GitHub.Data.GitData, @@ -74,7 +73,6 @@ import GitHub.Data.Definitions import GitHub.Data.DeployKeys import GitHub.Data.Deployments import GitHub.Data.Email -import GitHub.Data.Enterprise.Organizations import GitHub.Data.Events import GitHub.Data.Gists import GitHub.Data.GitData diff --git a/src/GitHub/Data/Enterprise.hs b/src/GitHub/Data/Enterprise.hs new file mode 100644 index 00000000..125a8d69 --- /dev/null +++ b/src/GitHub/Data/Enterprise.hs @@ -0,0 +1,12 @@ +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +-- This module re-exports the @GitHub.Data.Enterprise.@ submodules. +module GitHub.Data.Enterprise ( + -- * Module re-exports + module GitHub.Data.Enterprise.Organizations, + ) where + +import GitHub.Data.Enterprise.Organizations diff --git a/src/GitHub/Endpoints/Enterprise/Organizations.hs b/src/GitHub/Endpoints/Enterprise/Organizations.hs index d94c7c72..589c3d35 100644 --- a/src/GitHub/Endpoints/Enterprise/Organizations.hs +++ b/src/GitHub/Endpoints/Enterprise/Organizations.hs @@ -11,6 +11,7 @@ module GitHub.Endpoints.Enterprise.Organizations ( ) where import GitHub.Data +import GitHub.Data.Enterprise import GitHub.Internal.Prelude import Prelude () diff --git a/src/GitHub/Enterprise.hs b/src/GitHub/Enterprise.hs new file mode 100644 index 00000000..bb64b7d7 --- /dev/null +++ b/src/GitHub/Enterprise.hs @@ -0,0 +1,23 @@ +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +-- This module re-exports all request constructors and data definitions for +-- working with GitHub Enterprise. +-- +module GitHub.Enterprise ( + -- * Enterprise Admin + -- | See + + -- ** Organizations + -- | See + createOrganizationR, + renameOrganizationR, + + -- * Data definitions + module GitHub.Data.Enterprise, + ) where + +import GitHub.Data.Enterprise +import GitHub.Endpoints.Enterprise.Organizations From b7ee2b803157948479ceccd85233aa1e9474adc9 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Thu, 19 Dec 2019 15:55:38 +0200 Subject: [PATCH 402/510] Export withOpenSSL and tlsManagerSettings --- samples/Operational/Operational.hs | 31 +++--------------------------- samples/github-samples.cabal | 18 +---------------- src/GitHub/Request.hs | 5 +++++ 3 files changed, 9 insertions(+), 45 deletions(-) diff --git a/samples/Operational/Operational.hs b/samples/Operational/Operational.hs index 1117e72e..15833ece 100644 --- a/samples/Operational/Operational.hs +++ b/samples/Operational/Operational.hs @@ -9,16 +9,7 @@ import Prelude () import Control.Monad.Operational import Control.Monad.Trans.Except (ExceptT (..), runExceptT) -import Network.HTTP.Client (Manager, newManager, ManagerSettings) - -#ifdef MIN_VERSION_http_client_tls -import Network.HTTP.Client.TLS (tlsManagerSettings) -#else -import Network.HTTP.Client.OpenSSL (opensslManagerSettings, withOpenSSL) - -import qualified OpenSSL.Session as SSL -import qualified OpenSSL.X509.SystemStore as SSL -#endif +import Network.HTTP.Client (Manager, newManager) import qualified GitHub as GH @@ -38,8 +29,8 @@ githubRequest :: FromJSON a => GH.Request 'GH.RA a -> GithubMonad a githubRequest = singleton . R main :: IO () -main = withOpenSSL $ do - manager <- newManager tlsManagerSettings +main = GH.withOpenSSL $ do + manager <- newManager GH.tlsManagerSettings auth' <- getAuth case auth' of Nothing -> return () @@ -48,19 +39,3 @@ main = withOpenSSL $ do repo <- githubRequest $ GH.repositoryR "phadej" "github" githubRequest $ GH.ownerInfoForR (GH.simpleOwnerLogin . GH.repoOwner $ repo) print owner - -#ifdef MIN_VERSION_http_client_tls -withOpenSSL :: IO a -> IO a -withOpenSSL = id -#else -tlsManagerSettings :: ManagerSettings -tlsManagerSettings = opensslManagerSettings $ do - ctx <- SSL.context - SSL.contextAddOption ctx SSL.SSL_OP_NO_SSLv2 - SSL.contextAddOption ctx SSL.SSL_OP_NO_SSLv3 - SSL.contextAddOption ctx SSL.SSL_OP_NO_TLSv1 - SSL.contextSetCiphers ctx "ECDHE-ECDSA-AES256-GCM-SHA384:ECDHE-RSA-AES256-GCM-SHA384:ECDHE-ECDSA-CHACHA20-POLY1305:ECDHE-RSA-CHACHA20-POLY1305:ECDHE-ECDSA-AES128-GCM-SHA256:ECDHE-RSA-AES128-GCM-SHA256:ECDHE-ECDSA-AES256-SHA384:ECDHE-RSA-AES256-SHA384:ECDHE-ECDSA-AES128-SHA256:ECDHE-RSA-AES128-SHA256" - SSL.contextLoadSystemCerts ctx - SSL.contextSetVerificationMode ctx $ SSL.VerifyPeer True True Nothing - return ctx -#endif diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index 2b4d2f69..a26ffcfe 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -17,11 +17,6 @@ tested-with: || ==8.6.5 || ==8.8.1 -flag openssl - description: "Use http-client-openssl" - manual: True - default: False - library hs-source-dirs: src ghc-options: -Wall @@ -35,6 +30,7 @@ library default-language: Haskell2010 executable github-operational + default-language: Haskell2010 main-is: Operational.hs hs-source-dirs: Operational ghc-options: -Wall -threaded @@ -49,18 +45,6 @@ executable github-operational , transformers , transformers-compat - if flag(openssl) - build-depends: - HsOpenSSL - , HsOpenSSL-x509-system - , http-client-openssl - - else - build-depends: - http-client-tls - - default-language: Haskell2010 - common deps default-language: Haskell2010 ghc-options: -Wall diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index 83eba89b..fc0fd7dd 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -62,6 +62,11 @@ module GitHub.Request ( -- ** Preview PreviewAccept (..), PreviewParseResponse (..), + -- * SSL + -- | This always exist, independently of @openssl@ configuration flag. + -- They change accordingly, to make use of the library simpler. + withOpenSSL, + tlsManagerSettings, ) where import GitHub.Internal.Prelude From 2503b54595acee2683b81bf37d1f927f6e32b3c4 Mon Sep 17 00:00:00 2001 From: Sajid Ibne Anower Date: Fri, 20 Dec 2019 22:26:03 +1100 Subject: [PATCH 403/510] Label description (#418) * Add description field to IssueLabel * Add types for Update and New label * Use NewIssueLabel and UpdateIssueLabel for generating requests --- src/GitHub/Data/Definitions.hs | 55 +++++++++++++++++++++++++++ src/GitHub/Endpoints/Issues/Labels.hs | 19 +++------ 2 files changed, 61 insertions(+), 13 deletions(-) diff --git a/src/GitHub/Data/Definitions.hs b/src/GitHub/Data/Definitions.hs index f4503e66..8da8b761 100644 --- a/src/GitHub/Data/Definitions.hs +++ b/src/GitHub/Data/Definitions.hs @@ -268,6 +268,7 @@ data IssueLabel = IssueLabel { labelColor :: !Text , labelUrl :: !URL , labelName :: !(Name IssueLabel) + , labelDesc :: !(Maybe Text) } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -279,3 +280,57 @@ instance FromJSON IssueLabel where <$> o .: "color" <*> o .:? "url" .!= URL "" -- in events there aren't URL <*> o .: "name" + <*> o .:? "description" + + +------------------------------------------------------------------------------- +-- NewIssueLabel +------------------------------------------------------------------------------- + +data NewIssueLabel = NewIssueLabel + { newLabelColor :: !Text + , newLabelName :: !(Name NewIssueLabel) + , newLabelDesc :: !(Maybe Text) + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData NewIssueLabel where rnf = genericRnf +instance Binary NewIssueLabel + + +instance ToJSON NewIssueLabel where + toJSON (NewIssueLabel color lblName lblDesc) = object $ filter notNull + [ "name" .= lblName + , "color" .= color + , "description" .= lblDesc + ] + where + notNull (_, Null) = False + notNull (_, _) = True + + + +------------------------------------------------------------------------------- +-- UpdateIssueLabel +------------------------------------------------------------------------------- + +data UpdateIssueLabel = UpdateIssueLabel + { updateLabelColor :: !Text + , updateLabelName :: !(Name UpdateIssueLabel) + , updateLabelDesc :: !(Maybe Text) + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData UpdateIssueLabel where rnf = genericRnf +instance Binary UpdateIssueLabel + + +instance ToJSON UpdateIssueLabel where + toJSON (UpdateIssueLabel color lblName lblDesc) = object $ filter notNull + [ "new_name" .= lblName + , "color" .= color + , "description" .= lblDesc + ] + where + notNull (_, Null) = False + notNull (_, _) = True diff --git a/src/GitHub/Endpoints/Issues/Labels.hs b/src/GitHub/Endpoints/Issues/Labels.hs index cb80992e..3d129e8c 100644 --- a/src/GitHub/Endpoints/Issues/Labels.hs +++ b/src/GitHub/Endpoints/Issues/Labels.hs @@ -38,26 +38,19 @@ labelR user repo lbl = -- | Create a label. -- See -createLabelR :: Name Owner -> Name Repo -> Name IssueLabel -> String -> Request 'RW IssueLabel -createLabelR user repo lbl color = - command Post paths $ encode body - where - paths = ["repos", toPathPart user, toPathPart repo, "labels"] - body = object ["name" .= untagName lbl, "color" .= color] +createLabelR :: Name Owner -> Name Repo -> NewIssueLabel -> Request 'RW IssueLabel +createLabelR user repo = + command Post ["repos", toPathPart user, toPathPart repo, "labels"] . encode -- | Update a label. -- See updateLabelR :: Name Owner -> Name Repo -> Name IssueLabel -- ^ old label name - -> Name IssueLabel -- ^ new label name - -> String -- ^ new color + -> UpdateIssueLabel -- ^ new label -> Request 'RW IssueLabel -updateLabelR user repo oldLbl newLbl color = - command Patch paths (encode body) - where - paths = ["repos", toPathPart user, toPathPart repo, "labels", toPathPart oldLbl] - body = object ["name" .= untagName newLbl, "color" .= color] +updateLabelR user repo oldLbl = + command Patch ["repos", toPathPart user, toPathPart repo, "labels", toPathPart oldLbl] . encode -- | Delete a label. -- See From bbe378bbe2fad28ff4069537bc2b46fa4b8e89c9 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Fri, 20 Dec 2019 15:17:59 +0200 Subject: [PATCH 404/510] Add executeRequestWithMgrAndRes --- CHANGELOG.md | 6 +++ github.cabal | 2 +- samples/Operational/Operational.hs | 34 +++++++++----- src/GitHub/Auth.hs | 6 +++ src/GitHub/Data/Deployments.hs | 1 - src/GitHub/Data/RateLimit.hs | 31 +++++++++++-- src/GitHub/Internal/Prelude.hs | 2 +- src/GitHub/Request.hs | 74 +++++++++++++++--------------- 8 files changed, 102 insertions(+), 54 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index cdc67227..8d776cb8 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -14,6 +14,12 @@ This reduces symbol bloat in the library. [#409](https://github.com/phadej/github/pull/409) - Update `Repo`, `NewRepo` and `EditRepo` data types [#407](https://github.com/phadej/github/pull/407) +- Add `executeRequestWithMgrAndRes` + [#421](https://github.com/phadej/github/pull/421) +- Add `limitsFromHttpResponse` + [#421](https://github.com/phadej/github/pull/421) +- Add label descriptions + [#418](https://github.com/phadej/github/pull/418) ## Changes for 0.23 diff --git a/github.cabal b/github.cabal index b3a18432..0e9a7335 100644 --- a/github.cabal +++ b/github.cabal @@ -165,7 +165,7 @@ library , deepseq >=1.3.0.2 && <1.5 , mtl >=2.1.3.1 && <2.2 || >=2.2.1 && <2.3 , text >=1.2.0.6 && <1.3 - , time >=1.4 && <1.10 + , time-compat >=1.9.2.2 && <1.10 , transformers >=0.3.0.0 && <0.6 -- other packages diff --git a/samples/Operational/Operational.hs b/samples/Operational/Operational.hs index 15833ece..4e669ff4 100644 --- a/samples/Operational/Operational.hs +++ b/samples/Operational/Operational.hs @@ -7,23 +7,26 @@ module Main (main) where import Common import Prelude () -import Control.Monad.Operational -import Control.Monad.Trans.Except (ExceptT (..), runExceptT) -import Network.HTTP.Client (Manager, newManager) +import Control.Exception (throw) +import Control.Monad.IO.Class (liftIO) +import Control.Monad.Operational (Program, ProgramViewT (..), singleton, view) +import Control.Monad.Trans.Except (ExceptT (..), runExceptT) +import Network.HTTP.Client (Manager, newManager, responseBody) -import qualified GitHub as GH +import qualified GitHub as GH data R a where R :: FromJSON a => GH.Request 'GH.RA a -> R a type GithubMonad a = Program R a -runMonad :: Manager -> GH.Auth -> GithubMonad a -> ExceptT GH.Error IO a +runMonad :: GH.AuthMethod auth => Manager -> auth -> GithubMonad a -> ExceptT GH.Error IO a runMonad mgr auth m = case view m of Return a -> return a R req :>>= k -> do - b <- ExceptT $ GH.executeRequestWithMgr mgr auth req - runMonad mgr auth (k b) + res <- ExceptT $ GH.executeRequestWithMgrAndRes mgr auth req + liftIO $ print $ GH.limitsFromHttpResponse res + runMonad mgr auth (k (responseBody res)) githubRequest :: FromJSON a => GH.Request 'GH.RA a -> GithubMonad a githubRequest = singleton . R @@ -33,9 +36,18 @@ main = GH.withOpenSSL $ do manager <- newManager GH.tlsManagerSettings auth' <- getAuth case auth' of - Nothing -> return () + Nothing -> do + (owner, rl) <- runExceptT (runMonad manager () script) >>= either throw return + print owner + print rl Just auth -> do - owner <- runExceptT $ runMonad manager auth $ do - repo <- githubRequest $ GH.repositoryR "phadej" "github" - githubRequest $ GH.ownerInfoForR (GH.simpleOwnerLogin . GH.repoOwner $ repo) + (owner, rl) <- runExceptT (runMonad manager auth script) >>= either throw return print owner + print rl + +script :: Program R (GH.Owner, GH.Limits) +script = do + repo <- githubRequest $ GH.repositoryR "phadej" "github" + owner <- githubRequest $ GH.ownerInfoForR (GH.simpleOwnerLogin . GH.repoOwner $ repo) + rl <- githubRequest GH.rateLimitR + return (owner, GH.rateLimitCore rl) diff --git a/src/GitHub/Auth.hs b/src/GitHub/Auth.hs index 7918c0af..432b2486 100644 --- a/src/GitHub/Auth.hs +++ b/src/GitHub/Auth.hs @@ -30,12 +30,18 @@ instance Binary Auth instance Hashable Auth -- | A type class for different authentication methods +-- +-- Note the '()' intance, which doee nothing, i.e. is unauthenticated. class AuthMethod a where -- | Custom API endpoint without trailing slash endpoint :: a -> Maybe Text -- | A function which sets authorisation on an HTTP request setAuthRequest :: a -> HTTP.Request -> HTTP.Request +instance AuthMethod () where + endpoint _ = Nothing + setAuthRequest _ = id + instance AuthMethod Auth where endpoint (BasicAuth _ _) = Nothing endpoint (OAuth _) = Nothing diff --git a/src/GitHub/Data/Deployments.hs b/src/GitHub/Data/Deployments.hs index 9e65485d..face7a52 100644 --- a/src/GitHub/Data/Deployments.hs +++ b/src/GitHub/Data/Deployments.hs @@ -21,7 +21,6 @@ import Control.Arrow (second) import Data.ByteString (ByteString) import Data.Maybe (catMaybes) import Data.Text (Text) -import Data.Time.Clock (UTCTime) import Data.Vector (Vector) import GitHub.Data.Definitions (SimpleUser) diff --git a/src/GitHub/Data/RateLimit.hs b/src/GitHub/Data/RateLimit.hs index 3fbd6211..2ba008f0 100644 --- a/src/GitHub/Data/RateLimit.hs +++ b/src/GitHub/Data/RateLimit.hs @@ -8,12 +8,17 @@ module GitHub.Data.RateLimit where import GitHub.Internal.Prelude import Prelude () +import Data.Time.Clock.System.Compat (SystemTime (..)) + +import qualified Data.ByteString.Char8 as BS8 +import qualified Network.HTTP.Client as HTTP + data Limits = Limits { limitsMax :: !Int , limitsRemaining :: !Int - , limitsReset :: !Int -- TODO: change to proper type + , limitsReset :: !SystemTime } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, {- Data, -} Typeable, Eq, Ord, Generic) instance NFData Limits where rnf = genericRnf instance Binary Limits @@ -22,14 +27,14 @@ instance FromJSON Limits where parseJSON = withObject "Limits" $ \obj -> Limits <$> obj .: "limit" <*> obj .: "remaining" - <*> obj .: "reset" + <*> fmap (\t -> MkSystemTime t 0) (obj .: "reset") data RateLimit = RateLimit { rateLimitCore :: Limits , rateLimitSearch :: Limits , rateLimitGraphQL :: Limits } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, {- Data, -} Typeable, Eq, Ord, Generic) instance NFData RateLimit where rnf = genericRnf instance Binary RateLimit @@ -41,3 +46,21 @@ instance FromJSON RateLimit where <$> resources .: "core" <*> resources .: "search" <*> resources .: "graphql" + +------------------------------------------------------------------------------- +-- Extras +------------------------------------------------------------------------------- + +-- | @since 0.24 +limitsFromHttpResponse :: HTTP.Response a -> Maybe Limits +limitsFromHttpResponse res = do + let hdrs = HTTP.responseHeaders res + m <- lookup "X-RateLimit-Limit" hdrs >>= readIntegral + r <- lookup "X-RateLimit-Remaining" hdrs >>= readIntegral + t <- lookup "X-RateLimit-Reset" hdrs >>= readIntegral + return (Limits m r (MkSystemTime t 0)) + where + readIntegral :: Num a => BS8.ByteString -> Maybe a + readIntegral bs = case BS8.readInt bs of + Just (n, bs') | BS8.null bs' -> Just (fromIntegral n) + _ -> Nothing diff --git a/src/GitHub/Internal/Prelude.hs b/src/GitHub/Internal/Prelude.hs index 07a748b3..8c4785c3 100644 --- a/src/GitHub/Internal/Prelude.hs +++ b/src/GitHub/Internal/Prelude.hs @@ -53,7 +53,7 @@ import Data.Maybe (catMaybes) import Data.Semigroup (Semigroup (..)) import Data.String (IsString (..)) import Data.Text (Text, pack, unpack) -import Data.Time (UTCTime) +import Data.Time.Compat (UTCTime) import Data.Time.ISO8601 (formatISO8601) import Data.Vector (Vector) import Data.Vector.Instances () diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index fc0fd7dd..b72d25be 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -46,6 +46,7 @@ module GitHub.Request ( -- * Request execution in IO executeRequest, executeRequestWithMgr, + executeRequestWithMgrAndRes, executeRequest', executeRequestWithMgr', executeRequestMaybe, @@ -66,7 +67,7 @@ module GitHub.Request ( -- | This always exist, independently of @openssl@ configuration flag. -- They change accordingly, to make use of the library simpler. withOpenSSL, - tlsManagerSettings, + tlsManagerSettings, ) where import GitHub.Internal.Prelude @@ -112,7 +113,7 @@ import qualified OpenSSL.Session as SSL import qualified OpenSSL.X509.SystemStore as SSL #endif -import GitHub.Auth (Auth, AuthMethod, endpoint, setAuthRequest) +import GitHub.Auth (AuthMethod, endpoint, setAuthRequest) import GitHub.Data (Error (..)) import GitHub.Data.PullRequests (MergeResult (..)) import GitHub.Data.Request @@ -206,6 +207,7 @@ lessFetchCount :: Int -> FetchCount -> Bool lessFetchCount _ FetchAll = True lessFetchCount i (FetchAtLeast j) = i < fromIntegral j + -- | Like 'executeRequest' but with provided 'Manager'. executeRequestWithMgr :: (AuthMethod am, ParseResponse mt a) @@ -213,26 +215,38 @@ executeRequestWithMgr -> am -> GenRequest mt rw a -> IO (Either Error a) -executeRequestWithMgr mgr auth req = runExceptT $ do +executeRequestWithMgr mgr auth req = + fmap (fmap responseBody) (executeRequestWithMgrAndRes mgr auth req) + +-- | Execute request and return the last received 'HTTP.Response'. +-- +-- @since 0.24 +executeRequestWithMgrAndRes + :: (AuthMethod am, ParseResponse mt a) + => Manager + -> am + -> GenRequest mt rw a + -> IO (Either Error (HTTP.Response a)) +executeRequestWithMgrAndRes mgr auth req = runExceptT $ do httpReq <- makeHttpRequest (Just auth) req performHttpReq httpReq req where - httpLbs' :: HTTP.Request -> ExceptT Error IO (Response LBS.ByteString) + httpLbs' :: HTTP.Request -> ExceptT Error IO (HTTP.Response LBS.ByteString) httpLbs' req' = lift (httpLbs req' mgr) `catch` onHttpException - performHttpReq :: forall rw mt b. ParseResponse mt b => HTTP.Request -> GenRequest mt rw b -> ExceptT Error IO b + performHttpReq :: forall rw mt b. ParseResponse mt b => HTTP.Request -> GenRequest mt rw b -> ExceptT Error IO (HTTP.Response b) performHttpReq httpReq Query {} = do res <- httpLbs' httpReq - unTagged (parseResponse httpReq res :: Tagged mt (ExceptT Error IO b)) + (<$ res) <$> unTagged (parseResponse httpReq res :: Tagged mt (ExceptT Error IO b)) performHttpReq httpReq (PagedQuery _ _ l) = - unTagged (performPagedRequest httpLbs' predicate httpReq :: Tagged mt (ExceptT Error IO b)) + unTagged (performPagedRequest httpLbs' predicate httpReq :: Tagged mt (ExceptT Error IO (HTTP.Response b))) where predicate v = lessFetchCount (V.length v) l performHttpReq httpReq (Command _ _ _) = do res <- httpLbs' httpReq - unTagged (parseResponse httpReq res :: Tagged mt (ExceptT Error IO b)) + (<$ res) <$> unTagged (parseResponse httpReq res :: Tagged mt (ExceptT Error IO b)) -- | Like 'executeRequest' but without authentication. executeRequest' :: ParseResponse mt a => GenRequest mt 'RO a -> IO (Either Error a) @@ -246,21 +260,7 @@ executeRequestWithMgr' => Manager -> GenRequest mt 'RO a -> IO (Either Error a) -executeRequestWithMgr' mgr req = runExceptT $ do - httpReq <- makeHttpRequest (Nothing :: Maybe Auth) req - performHttpReq httpReq req - where - httpLbs' :: HTTP.Request -> ExceptT Error IO (Response LBS.ByteString) - httpLbs' req' = lift (httpLbs req' mgr) `catch` onHttpException - - performHttpReq :: forall mt b. ParseResponse mt b => HTTP.Request -> GenRequest mt 'RO b -> ExceptT Error IO b - performHttpReq httpReq Query {} = do - res <- httpLbs' httpReq - unTagged (parseResponse httpReq res :: Tagged mt (ExceptT Error IO b)) - performHttpReq httpReq (PagedQuery _ _ l) = - unTagged (performPagedRequest httpLbs' predicate httpReq :: Tagged mt (ExceptT Error IO b)) - where - predicate v = lessFetchCount (V.length v) l +executeRequestWithMgr' mgr = executeRequestWithMgr mgr () -- | Helper for picking between 'executeRequest' and 'executeRequest''. -- @@ -302,9 +302,9 @@ class Accept mt => ParseResponse (mt :: MediaType *) a where -- | Parse API response. -- -- @ --- parseResponse :: 'FromJSON' a => 'Response' 'LBS.ByteString' -> 'Either' 'Error' a +-- parseResponse :: 'FromJSON' a => 'HTTP.Response' 'LBS.ByteString' -> 'Either' 'Error' a -- @ -parseResponseJSON :: (FromJSON a, MonadError Error m) => Response LBS.ByteString -> m a +parseResponseJSON :: (FromJSON a, MonadError Error m) => HTTP.Response LBS.ByteString -> m a parseResponseJSON res = case eitherDecode (responseBody res) of Right x -> return x Left err -> throwError . ParseError . T.pack $ err @@ -349,9 +349,9 @@ instance b ~ URI => ParseResponse 'MtRedirect b where -- | Helper for handling of 'RequestRedirect'. -- -- @ --- parseRedirect :: 'Response' 'LBS.ByteString' -> 'Either' 'Error' a +-- parseRedirect :: 'HTTP.Response' 'LBS.ByteString' -> 'Either' 'Error' a -- @ -parseRedirect :: MonadError Error m => URI -> Response LBS.ByteString -> m URI +parseRedirect :: MonadError Error m => URI -> HTTP.Response LBS.ByteString -> m URI parseRedirect originalUri rsp = do let status = responseStatus rsp when (statusCode status /= 302) $ @@ -501,7 +501,7 @@ makeHttpRequest auth r = case r of setBody body req = req { requestBody = RequestBodyLBS body } -- | Query @Link@ header with @rel=next@ from the request headers. -getNextUrl :: Response a -> Maybe URI +getNextUrl :: HTTP.Response a -> Maybe URI getNextUrl req = do linkHeader <- lookup "Link" (responseHeaders req) links <- parseLinkHeaderBS linkHeader @@ -516,25 +516,27 @@ getNextUrl req = do -- | Helper for making paginated requests. Responses, @a@ are combined monoidally. -- +-- The result is wrapped in the last received 'HTTP.Response'. +-- -- @ -- performPagedRequest :: ('FromJSON' a, 'Semigroup' a) --- => ('HTTP.Request' -> 'ExceptT' 'Error' 'IO' ('Response' 'LBS.ByteString')) +-- => ('HTTP.Request' -> 'ExceptT' 'Error' 'IO' ('HTTP.Response' 'LBS.ByteString')) -- -> (a -> 'Bool') -- -> 'HTTP.Request' --- -> 'ExceptT' 'Error' 'IO' a +-- -> 'ExceptT' 'Error' 'IO' ('HTTP.Response' a) -- @ performPagedRequest :: forall a m mt. (ParseResponse mt a, Semigroup a, MonadCatch m, MonadError Error m) - => (HTTP.Request -> m (Response LBS.ByteString)) -- ^ `httpLbs` analogue - -> (a -> Bool) -- ^ predicate to continue iteration - -> HTTP.Request -- ^ initial request - -> Tagged mt (m a) + => (HTTP.Request -> m (HTTP.Response LBS.ByteString)) -- ^ `httpLbs` analogue + -> (a -> Bool) -- ^ predicate to continue iteration + -> HTTP.Request -- ^ initial request + -> Tagged mt (m (HTTP.Response a)) performPagedRequest httpLbs' predicate initReq = Tagged $ do res <- httpLbs' initReq m <- unTagged (parseResponse initReq res :: Tagged mt (m a)) go m res initReq where - go :: a -> Response LBS.ByteString -> HTTP.Request -> m a + go :: a -> HTTP.Response LBS.ByteString -> HTTP.Request -> m (HTTP.Response a) go acc res req = case (predicate acc, getNextUrl res) of (True, Just uri) -> do @@ -542,7 +544,7 @@ performPagedRequest httpLbs' predicate initReq = Tagged $ do res' <- httpLbs' req' m <- unTagged (parseResponse req' res' :: Tagged mt (m a)) go (acc <> m) res' req' - (_, _) -> return acc + (_, _) -> return (acc <$ res) ------------------------------------------------------------------------------- -- Internal From e4ddc1ab3a0e8c7830ca1d682faf4c8eff71fbcf Mon Sep 17 00:00:00 2001 From: "Thomas M. DuBuisson" Date: Fri, 3 Jan 2020 15:59:36 -0800 Subject: [PATCH 405/510] Add support for the comment reply endpoint --- src/GitHub/Data/Comments.hs | 12 ++++++++++++ src/GitHub/Endpoints/PullRequests/Comments.hs | 11 +++++++++++ 2 files changed, 23 insertions(+) diff --git a/src/GitHub/Data/Comments.hs b/src/GitHub/Data/Comments.hs index 91c6d4e5..cb52b04b 100644 --- a/src/GitHub/Data/Comments.hs +++ b/src/GitHub/Data/Comments.hs @@ -83,3 +83,15 @@ instance ToJSON NewPullComment where , "path" .= path , "position" .= pos ] + +data PullCommentReply = PullCommentReply + { pullCommentReplyBody :: Text + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData PullCommentReply where rnf = genericRnf + +instance ToJSON PullCommentReply where + toJSON (PullCommentReply b) = + object [ "body" .= b + ] diff --git a/src/GitHub/Endpoints/PullRequests/Comments.hs b/src/GitHub/Endpoints/PullRequests/Comments.hs index 889de642..9bb6fca2 100644 --- a/src/GitHub/Endpoints/PullRequests/Comments.hs +++ b/src/GitHub/Endpoints/PullRequests/Comments.hs @@ -9,6 +9,7 @@ module GitHub.Endpoints.PullRequests.Comments ( pullRequestCommentsR, pullRequestCommentR, createPullCommentR, + createPullCommentReplyR, module GitHub.Data, ) where @@ -36,3 +37,13 @@ createPullCommentR user repo iss commit path position body = command Post parts (encode $ NewPullComment commit path position body) where parts = ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart iss, "comments"] + +-- | Create a comment reply. +-- +-- See +createPullCommentReplyR :: Name Owner -> Name Repo -> IssueNumber -> Id Comment -> Text -> Request 'RW Comment +createPullCommentReplyR user repo iss cid body = + command Post parts (encode $ PullCommentReply body) + where + parts = ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart iss + , "comments", toPathPart cid, "replies"] From e712718ff99c1846391ebed9c38ebfb70f7844fa Mon Sep 17 00:00:00 2001 From: Ruud van Asseldonk Date: Thu, 9 Jan 2020 13:32:03 +0100 Subject: [PATCH 406/510] Add support for collaborator permission endpoint This endpoint allows checking whether a collaborator has read, write, or admin permissions. We are using this endpoint in [1], from this branch, and so far it has been working fine. [1]: https://github.com/channable/hoff --- src/GitHub.hs | 1 + src/GitHub/Data/Repos.hs | 41 +++++++++++++++++++++ src/GitHub/Endpoints/Repos/Collaborators.hs | 11 ++++++ 3 files changed, 53 insertions(+) diff --git a/src/GitHub.hs b/src/GitHub.hs index 2faf1618..0c0abc3d 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -258,6 +258,7 @@ module GitHub ( -- ** Collaborators -- | See collaboratorsOnR, + collaboratorPermissionOnR, isCollaboratorOnR, addCollaboratorR, diff --git a/src/GitHub/Data/Repos.hs b/src/GitHub/Data/Repos.hs index 8486fb6a..d9c9cf1b 100644 --- a/src/GitHub/Data/Repos.hs +++ b/src/GitHub/Data/Repos.hs @@ -20,6 +20,7 @@ import GitHub.Internal.Prelude import Prelude () import qualified Data.HashMap.Strict as HM +import qualified Data.Text as T #if MIN_VERSION_aeson(1,0,0) import Data.Aeson.Types (FromJSONKey (..), fromJSONKeyCoerce) #else @@ -158,6 +159,27 @@ contributorToSimpleUser (AnonymousContributor _ _) = Nothing contributorToSimpleUser (KnownContributor _contributions avatarUrl name url uid _gravatarid) = Just $ SimpleUser uid name avatarUrl url +-- | The permission of a collaborator on a repository. +-- See +data CollaboratorPermission + = CollaboratorPermissionAdmin + | CollaboratorPermissionWrite + | CollaboratorPermissionRead + | CollaboratorPermissionNone + deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic) + +instance NFData CollaboratorPermission where rnf = genericRnf +instance Binary CollaboratorPermission + +-- | A collaborator and its permission on a repository. +-- See +data CollaboratorWithPermission + = CollaboratorWithPermission SimpleUser CollaboratorPermission + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData CollaboratorWithPermission where rnf = genericRnf +instance Binary CollaboratorWithPermission + -- JSON instances instance FromJSON Repo where @@ -303,3 +325,22 @@ instance IsPathPart ArchiveFormat where toPathPart af = case af of ArchiveFormatTarball -> "tarball" ArchiveFormatZipball -> "zipball" + +instance FromJSON CollaboratorPermission where + parseJSON = withText "CollaboratorPermission" $ \t -> case T.toLower t of + "admin" -> pure CollaboratorPermissionAdmin + "write" -> pure CollaboratorPermissionWrite + "read" -> pure CollaboratorPermissionRead + "none" -> pure CollaboratorPermissionNone + _ -> fail $ "Unknown CollaboratorPermission: " <> T.unpack t + +instance ToJSON CollaboratorPermission where + toJSON CollaboratorPermissionAdmin = "admin" + toJSON CollaboratorPermissionWrite = "write" + toJSON CollaboratorPermissionRead = "read" + toJSON CollaboratorPermissionNone = "none" + +instance FromJSON CollaboratorWithPermission where + parseJSON = withObject "CollaboratorWithPermission" $ \o -> CollaboratorWithPermission + <$> o .: "user" + <*> o .: "permission" diff --git a/src/GitHub/Endpoints/Repos/Collaborators.hs b/src/GitHub/Endpoints/Repos/Collaborators.hs index bc5680c6..5322b36d 100644 --- a/src/GitHub/Endpoints/Repos/Collaborators.hs +++ b/src/GitHub/Endpoints/Repos/Collaborators.hs @@ -7,6 +7,7 @@ -- . module GitHub.Endpoints.Repos.Collaborators ( collaboratorsOnR, + collaboratorPermissionOnR, isCollaboratorOnR, addCollaboratorR, module GitHub.Data, @@ -22,6 +23,16 @@ collaboratorsOnR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector S collaboratorsOnR user repo = pagedQuery ["repos", toPathPart user, toPathPart repo, "collaborators"] [] +-- | Review a user's permission level. +-- +collaboratorPermissionOnR + :: Name Owner -- ^ Repository owner + -> Name Repo -- ^ Repository name + -> Name User -- ^ Collaborator to check permissions of. + -> GenRequest 'MtJSON rw CollaboratorWithPermission +collaboratorPermissionOnR owner repo coll = + query ["repos", toPathPart owner, toPathPart repo, "collaborators", toPathPart coll, "permission"] [] + -- | Check if a user is a collaborator. -- See isCollaboratorOnR From 3cb9b2343fc7a23009aaa897e7944cee73e5f116 Mon Sep 17 00:00:00 2001 From: vrom911 Date: Mon, 10 Feb 2020 19:00:39 +0000 Subject: [PATCH 407/510] Use IssueNumber in editIssueR and issueR --- spec/GitHub/IssuesSpec.hs | 5 +++++ src/GitHub/Endpoints/Issues.hs | 4 ++-- 2 files changed, 7 insertions(+), 2 deletions(-) diff --git a/spec/GitHub/IssuesSpec.hs b/spec/GitHub/IssuesSpec.hs index cfad56e3..2ed08278 100644 --- a/spec/GitHub/IssuesSpec.hs +++ b/spec/GitHub/IssuesSpec.hs @@ -38,6 +38,11 @@ spec = do cms <- GitHub.executeRequest auth $ GitHub.commentsR owner repo (GitHub.issueNumber i) 1 cms `shouldSatisfy` isRight + describe "issueR" $ do + it "fetches issue #428" $ withAuth $ \auth -> do + resIss <- GitHub.executeRequest auth $ + GitHub.issueR "phadej" "github" (GitHub.IssueNumber 428) + resIss `shouldSatisfy` isRight where repos = [ ("thoughtbot", "paperclip") diff --git a/src/GitHub/Endpoints/Issues.hs b/src/GitHub/Endpoints/Issues.hs index d2b24e69..f1980dbf 100644 --- a/src/GitHub/Endpoints/Issues.hs +++ b/src/GitHub/Endpoints/Issues.hs @@ -33,7 +33,7 @@ organizationIssuesR org opts = -- | Query a single issue. -- See -issueR :: Name Owner -> Name Repo -> Id Issue -> Request k Issue +issueR :: Name Owner -> Name Repo -> IssueNumber -> Request k Issue issueR user reqRepoName reqIssueNumber = query ["repos", toPathPart user, toPathPart reqRepoName, "issues", toPathPart reqIssueNumber] [] @@ -63,6 +63,6 @@ editOfIssue = EditIssue Nothing Nothing Nothing Nothing Nothing Nothing -- | Edit an issue. -- See -editIssueR :: Name Owner -> Name Repo -> Id Issue -> EditIssue -> Request 'RW Issue +editIssueR :: Name Owner -> Name Repo -> IssueNumber -> EditIssue -> Request 'RW Issue editIssueR user repo iss = command Patch ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iss] . encode From 7d9fcbaed66dd2ac742d4d8c06ec20de0a0bf312 Mon Sep 17 00:00:00 2001 From: Robbie McMichael <2044464+robbiemcmichael@users.noreply.github.com> Date: Tue, 11 Feb 2020 23:48:53 +1100 Subject: [PATCH 408/510] Housekeeping for data and endpoint exports - Add missing data and endpoint exports - Move statuses exports under repositories - Remove duplicated enterprise exports --- src/GitHub.hs | 38 ++++++++++++++++++++++++-------------- src/GitHub/Data.hs | 4 +++- 2 files changed, 27 insertions(+), 15 deletions(-) diff --git a/src/GitHub.hs b/src/GitHub.hs index e2220376..087a72d1 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -56,14 +56,6 @@ module GitHub ( watchersForR, reposWatchedByR, - -- * Enterprise - -- | See - - -- ** Organizations - -- | See - createOrganizationR, - renameOrganizationR, - -- * Gists -- | See -- @@ -289,6 +281,15 @@ module GitHub ( commitR, diffR, + -- ** Contents + -- | See + contentsForR, + readmeForR, + archiveForR, + createFileR, + updateFileR, + deleteFileR, + -- ** Deploy Keys -- | See deployKeysForR, @@ -316,6 +317,12 @@ module GitHub ( -- * Create a fork forksForR, + -- ** Statuses + -- | See + createStatusR, + statusesForR, + statusForR, + -- ** Webhooks -- | See webhooksForR, @@ -389,11 +396,13 @@ module GitHub ( usersFollowingR, usersFollowedByR, - -- ** Statuses - -- | See - createStatusR, - statusesForR, - statusForR, + -- ** Git SSH Keys + -- | See + publicSSHKeysR, + publicSSHKeysForR, + publicSSHKeyR, + createUserPublicSSHKeyR, + deleteUserPublicSSHKeyR, -- ** Rate Limit -- | See @@ -410,7 +419,6 @@ import GitHub.Endpoints.Activity.Events import GitHub.Endpoints.Activity.Notifications import GitHub.Endpoints.Activity.Starring import GitHub.Endpoints.Activity.Watching -import GitHub.Endpoints.Enterprise.Organizations import GitHub.Endpoints.Gists import GitHub.Endpoints.Gists.Comments import GitHub.Endpoints.GitData.Blobs @@ -433,6 +441,7 @@ import GitHub.Endpoints.Repos import GitHub.Endpoints.Repos.Collaborators import GitHub.Endpoints.Repos.Comments import GitHub.Endpoints.Repos.Commits +import GitHub.Endpoints.Repos.Contents import GitHub.Endpoints.Repos.DeployKeys import GitHub.Endpoints.Repos.Deployments import GitHub.Endpoints.Repos.Forks @@ -444,4 +453,5 @@ import GitHub.Endpoints.Search import GitHub.Endpoints.Users import GitHub.Endpoints.Users.Emails import GitHub.Endpoints.Users.Followers +import GitHub.Endpoints.Users.PublicSSHKeys import GitHub.Request diff --git a/src/GitHub/Data.hs b/src/GitHub/Data.hs index 6acc0bf2..6b475d40 100644 --- a/src/GitHub/Data.hs +++ b/src/GitHub/Data.hs @@ -59,7 +59,8 @@ module GitHub.Data ( module GitHub.Data.Statuses, module GitHub.Data.Teams, module GitHub.Data.URL, - module GitHub.Data.Webhooks + module GitHub.Data.Webhooks, + module GitHub.Data.Webhooks.Validate, ) where import GitHub.Internal.Prelude @@ -94,6 +95,7 @@ import GitHub.Data.Statuses import GitHub.Data.Teams import GitHub.Data.URL import GitHub.Data.Webhooks +import GitHub.Data.Webhooks.Validate mkOwnerId :: Int -> Id Owner mkOwnerId = Id From b9d2d1ba2326d417d1dcbbc4ce225835af76a108 Mon Sep 17 00:00:00 2001 From: Ali Abrar Date: Fri, 14 Feb 2020 10:37:53 -0500 Subject: [PATCH 409/510] Add draft option to mergeable state --- src/GitHub/Data/Options.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/GitHub/Data/Options.hs b/src/GitHub/Data/Options.hs index 9ef2be6a..70665317 100644 --- a/src/GitHub/Data/Options.hs +++ b/src/GitHub/Data/Options.hs @@ -98,6 +98,7 @@ data MergeableState | StateUnstable | StateBlocked | StateBehind + | StateDraft deriving (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) @@ -108,6 +109,7 @@ instance ToJSON MergeableState where toJSON StateUnstable = String "unstable" toJSON StateBlocked = String "blocked" toJSON StateBehind = String "behind" + toJSON StateDraft = String "draft" instance FromJSON MergeableState where parseJSON = withText "MergeableState" $ \t -> case T.toLower t of @@ -117,6 +119,7 @@ instance FromJSON MergeableState where "unstable" -> pure StateUnstable "blocked" -> pure StateBlocked "behind" -> pure StateBehind + "draft" -> pure StateDraft _ -> fail $ "Unknown MergeableState: " <> T.unpack t instance NFData MergeableState where rnf = genericRnf From dce8c7fe404083b1ddad5c665f0e7e7cb4dddf8b Mon Sep 17 00:00:00 2001 From: Victor Nawothnig Date: Sat, 15 Feb 2020 02:10:00 +0100 Subject: [PATCH 410/510] Add missing tick --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index 45492903..cc825f98 100644 --- a/README.md +++ b/README.md @@ -68,7 +68,7 @@ import qualified GitHub main :: IO () main = do - possibleUsers <- github GitHub.usersFollowingR "phadej" + possibleUsers <- github' GitHub.usersFollowingR "phadej" T.putStrLn $ either (("Error: " <>) . pack . show) (foldMap ((<> "\n") . formatUser)) possibleUsers From e6163c44ab932671219b5595fd9bac5afc8b5745 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 18 Feb 2020 21:37:36 +0200 Subject: [PATCH 411/510] Add recent PRs to Changelog --- CHANGELOG.md | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 8d776cb8..52400168 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -20,6 +20,18 @@ This reduces symbol bloat in the library. [#421](https://github.com/phadej/github/pull/421) - Add label descriptions [#418](https://github.com/phadej/github/pull/418) +- Add "draft" option to mergeable state + [#431](https://github.com/phadej/github/pull/431) +- Use IssueNumber in editIssueR and issueR + [#429](https://github.com/phadej/github/pull/429) +- Manage orgs in GitHub Enterprise + [#420](https://github.com/phadej/github/pull/420) +- Add support for collaborator permission endpoint + [#425](https://github.com/phadej/github/pull/425) +- Add support for the comment reply endpoint + [#424](Add support for the comment reply endpoint) +- Organise exports in `GitHub` + [#430](https://github.com/phadej/github/pull/430) ## Changes for 0.23 From 807d74c5ecb5f9c30a75dd15af526a6103bff9cc Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 18 Feb 2020 21:44:14 +0200 Subject: [PATCH 412/510] Export createPullCommentReplyR, --- src/GitHub.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/GitHub.hs b/src/GitHub.hs index 087a72d1..62c1ea6d 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -223,6 +223,7 @@ module GitHub ( pullRequestCommentsR, pullRequestCommentR, createPullCommentR, + createPullCommentReplyR, -- ** Pull request reviews -- | See From b924756659ccb930a070c6c5fa05c070611c86d2 Mon Sep 17 00:00:00 2001 From: Alexandre Esteves <2335822+alexfmpe@users.noreply.github.com> Date: Tue, 21 Apr 2020 20:45:43 +0100 Subject: [PATCH 413/510] Fix typo --- src/GitHub/Request.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index b72d25be..f0724d2c 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -31,7 +31,7 @@ -- > githubRequest :: GH.Request 'False a -> GithubMonad a -- > githubRequest = singleton module GitHub.Request ( - -- * A convinient execution of requests + -- * A convenient execution of requests github, github', GitHubRW, @@ -121,10 +121,10 @@ import GitHub.Data.Request import Paths_github (version) ------------------------------------------------------------------------------- --- Convinience +-- Convenience ------------------------------------------------------------------------------- --- | A convinience function to turn functions returning @'Request' rw x@, +-- | A convenience function to turn functions returning @'Request' rw x@, -- into functions returning @IO (Either 'Error' x)@. -- -- >>> :t \auth -> github auth userInfoForR From c705c34e9fcdfc8e787fba95150eb9cceb02afd2 Mon Sep 17 00:00:00 2001 From: "Thomas M. DuBuisson" Date: Mon, 27 Apr 2020 22:46:27 -0700 Subject: [PATCH 414/510] Generalize PagedQuery to allow queries of any foldable semigroup. --- src/GitHub/Data/Request.hs | 2 +- src/GitHub/Request.hs | 3 +-- 2 files changed, 2 insertions(+), 3 deletions(-) diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs index 04f38339..4180a938 100644 --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -154,7 +154,7 @@ instance IReadOnly 'RA where iro = ROA -- /Note:/ 'Request' is not 'Functor' on purpose. data GenRequest (mt :: MediaType *) (rw :: RW) a where Query :: Paths -> QueryString -> GenRequest mt rw a - PagedQuery :: Paths -> QueryString -> FetchCount -> GenRequest mt rw (Vector a) + PagedQuery :: (a ~ t b, Foldable t, Semigroup a) => Paths -> QueryString -> FetchCount -> GenRequest mt rw a -- | Command Command diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index f0724d2c..4f58fa61 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -100,7 +100,6 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS import qualified Data.Text as T import qualified Data.Text.Encoding as TE -import qualified Data.Vector as V import qualified Network.HTTP.Client as HTTP import qualified Network.HTTP.Client.Internal as HTTP @@ -242,7 +241,7 @@ executeRequestWithMgrAndRes mgr auth req = runExceptT $ do performHttpReq httpReq (PagedQuery _ _ l) = unTagged (performPagedRequest httpLbs' predicate httpReq :: Tagged mt (ExceptT Error IO (HTTP.Response b))) where - predicate v = lessFetchCount (V.length v) l + predicate v = lessFetchCount (length v) l performHttpReq httpReq (Command _ _ _) = do res <- httpLbs' httpReq From f3765823d99ed99111415e0af9b0cf3c9e4a0c5a Mon Sep 17 00:00:00 2001 From: Marco Perone Date: Fri, 15 May 2020 08:55:31 +0200 Subject: [PATCH 415/510] add endpoint for users search --- spec/GitHub/SearchSpec.hs | 12 ++++++++++-- src/GitHub.hs | 5 +---- src/GitHub/Endpoints/Search.hs | 7 +++++++ 3 files changed, 18 insertions(+), 6 deletions(-) diff --git a/spec/GitHub/SearchSpec.hs b/spec/GitHub/SearchSpec.hs index ce82900d..5cc5a15f 100644 --- a/spec/GitHub/SearchSpec.hs +++ b/spec/GitHub/SearchSpec.hs @@ -16,8 +16,9 @@ import qualified Data.Vector as V import GitHub (github) import GitHub.Data - (Auth (..), Issue (..), IssueNumber (..), IssueState (..), mkId) -import GitHub.Endpoints.Search (SearchResult (..), searchIssuesR) + (Auth (..), Issue (..), IssueNumber (..), IssueState (..), + SimpleUser (..), User, mkId) +import GitHub.Endpoints.Search (SearchResult (..), searchIssuesR, searchUsersR) fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b @@ -57,3 +58,10 @@ spec = do issues <- searchResultResults . fromRightS <$> github auth searchIssuesR query length issues `shouldBe` 1 issueId (V.head issues) `shouldBe` mkId (Proxy :: Proxy Issue) 119694665 + + describe "searchUsers" $ + it "performs a user search via the API" $ withAuth $ \auth -> do + let query = "oleg.grenrus@iki.fi created:<2020-01-01" + users <- searchResultResults . fromRightS <$> github auth searchUsersR query + length users `shouldBe` 1 + simpleUserId (V.head users) `shouldBe` mkId (Proxy :: Proxy User) 51087 diff --git a/src/GitHub.hs b/src/GitHub.hs index 62c1ea6d..7fdcc111 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -355,13 +355,10 @@ module GitHub ( -- * Search -- | See - -- - -- Missing endpoints: - -- - -- * Search users searchReposR, searchCodeR, searchIssuesR, + searchUsersR, -- * Users -- | See diff --git a/src/GitHub/Endpoints/Search.hs b/src/GitHub/Endpoints/Search.hs index 26c134bd..3fb50e85 100644 --- a/src/GitHub/Endpoints/Search.hs +++ b/src/GitHub/Endpoints/Search.hs @@ -9,6 +9,7 @@ module GitHub.Endpoints.Search( searchReposR, searchCodeR, searchIssuesR, + searchUsersR, module GitHub.Data, ) where @@ -35,3 +36,9 @@ searchCodeR searchString = searchIssuesR :: Text -> Request k (SearchResult Issue) searchIssuesR searchString = query ["search", "issues"] [("q", Just $ TE.encodeUtf8 searchString)] + +-- | Search users. +-- See +searchUsersR :: Text -> Request k (SearchResult SimpleUser) +searchUsersR searchString = + query ["search", "users"] [("q", Just $ TE.encodeUtf8 searchString)] From 3a3f3b8a36d78d050bb7fb7f87b8dc74ce8f2877 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Domen=20Ko=C5=BEar?= Date: Mon, 25 May 2020 13:55:07 +0200 Subject: [PATCH 416/510] Organizations: allow listing outside collaborators --- github.cabal | 1 + src/GitHub.hs | 6 ++++++ .../Organizations/OutsideCollaborators.hs | 21 +++++++++++++++++++ 3 files changed, 28 insertions(+) create mode 100644 src/GitHub/Endpoints/Organizations/OutsideCollaborators.hs diff --git a/github.cabal b/github.cabal index 643fcbb0..8ebe2b39 100644 --- a/github.cabal +++ b/github.cabal @@ -132,6 +132,7 @@ library GitHub.Endpoints.Issues.Milestones GitHub.Endpoints.Organizations GitHub.Endpoints.Organizations.Members + GitHub.Endpoints.Organizations.OutsideCollaborators GitHub.Endpoints.Organizations.Teams GitHub.Endpoints.PullRequests GitHub.Endpoints.PullRequests.Comments diff --git a/src/GitHub.hs b/src/GitHub.hs index 62c1ea6d..a5d7f454 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -175,6 +175,11 @@ module GitHub ( membersOfWithR, isMemberOfR, orgInvitationsR, + -- ** Outside Collaborators + -- | See + -- + -- Missing endpoints: All except /Outside Collaborator List/ + outsideCollaboratorsR, -- ** Teams -- | See @@ -433,6 +438,7 @@ import GitHub.Endpoints.Issues.Labels import GitHub.Endpoints.Issues.Milestones import GitHub.Endpoints.Organizations import GitHub.Endpoints.Organizations.Members +import GitHub.Endpoints.Organizations.OutsideCollaborators import GitHub.Endpoints.Organizations.Teams import GitHub.Endpoints.PullRequests import GitHub.Endpoints.PullRequests.Comments diff --git a/src/GitHub/Endpoints/Organizations/OutsideCollaborators.hs b/src/GitHub/Endpoints/Organizations/OutsideCollaborators.hs new file mode 100644 index 00000000..9bc392dd --- /dev/null +++ b/src/GitHub/Endpoints/Organizations/OutsideCollaborators.hs @@ -0,0 +1,21 @@ +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +-- The organization members API as described on +-- . +module GitHub.Endpoints.Organizations.OutsideCollaborators ( + outsideCollaboratorsR, + ) where + +import GitHub.Data +import GitHub.Internal.Prelude +import Prelude () + +-- | All the users who are outside collaborators of the specified organization. +-- +-- See +outsideCollaboratorsR :: Name Organization -> FetchCount -> Request k (Vector SimpleUser) +outsideCollaboratorsR organization = + pagedQuery ["orgs", toPathPart organization, "outside_collaborators"] [] From 1484325f652a1178e2a0bb6c5ef25da28d79820e Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 18 Feb 2020 22:19:39 +0200 Subject: [PATCH 417/510] Bump version --- CHANGELOG.md | 42 +++++++++++++++++++++++++++--------------- github.cabal | 2 +- 2 files changed, 28 insertions(+), 16 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 52400168..51e42146 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,19 +1,14 @@ -## Changes for 0.24 - -**Major change**: -Introduce `github` n-ary combinator to hoist `... -> Request rw res` -into `... -> IO (Either Error res)` (i.e. n-ary `executeRequest`). -With that in place drop `.. -> IO (Either Error res)` functions. +## Changes for 0.26 -This reduces symbol bloat in the library. -[#415](https://github.com/phadej/github/pull/415) +- Generalize PagedQuery to allow its reuse by preview github APIs + [#439](https://github.com/phadej/github/pull/439) +- Add endpoint for listing organizations outside collaborators + [#445](https://github.com/phadej/github/pull/445) +- Add endpoint for users search + [#444](https://github.com/phadej/github/pull/444) + +## Changes for 0.25 -- Remove double `withOpenSSL` - [#414](https://github.com/phadej/github/pull/414) -- Pull requests reviews API uses issue number - [#409](https://github.com/phadej/github/pull/409) -- Update `Repo`, `NewRepo` and `EditRepo` data types - [#407](https://github.com/phadej/github/pull/407) - Add `executeRequestWithMgrAndRes` [#421](https://github.com/phadej/github/pull/421) - Add `limitsFromHttpResponse` @@ -29,10 +24,27 @@ This reduces symbol bloat in the library. - Add support for collaborator permission endpoint [#425](https://github.com/phadej/github/pull/425) - Add support for the comment reply endpoint - [#424](Add support for the comment reply endpoint) + [#424](https://github.com/phadej/github/pull/424) - Organise exports in `GitHub` [#430](https://github.com/phadej/github/pull/430) +## Changes for 0.24 + +**Major change**: +Introduce `github` n-ary combinator to hoist `... -> Request rw res` +into `... -> IO (Either Error res)` (i.e. n-ary `executeRequest`). +With that in place drop `.. -> IO (Either Error res)` functions. + +This reduces symbol bloat in the library. +[#415](https://github.com/phadej/github/pull/415) + +- Remove double `withOpenSSL` + [#414](https://github.com/phadej/github/pull/414) +- Pull requests reviews API uses issue number + [#409](https://github.com/phadej/github/pull/409) +- Update `Repo`, `NewRepo` and `EditRepo` data types + [#407](https://github.com/phadej/github/pull/407) + ## Changes for 0.23 - Escape URI paths diff --git a/github.cabal b/github.cabal index 8ebe2b39..1ff2e5ea 100644 --- a/github.cabal +++ b/github.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: github -version: 0.24 +version: 0.26 synopsis: Access to the GitHub API, v3. category: Network description: From 59f9efe12c30960c3f435362d6cf026c5489b1e7 Mon Sep 17 00:00:00 2001 From: Doug Beardsley Date: Fri, 17 Apr 2020 07:58:33 -0400 Subject: [PATCH 418/510] Make repoWebhookResponseStatus optional I have encountered situations where the `repoWebhookResponseStatus` field returned by GitHub is `null` (in my case it was in last_response). When this happens, I get the following error: ``` ParseError "Error in $[1]['last_response'].status: expected Text, encountered Null" ``` Unfortunately I can't find anything in the documentation (https://developer.github.com/v3/repos/hooks/) indicating that the status field is nullable. At any rate, this PR fixes the problem for me. --- CHANGELOG.md | 3 +++ src/GitHub/Data/Webhooks.hs | 6 +++--- 2 files changed, 6 insertions(+), 3 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 51e42146..12f7575f 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -6,6 +6,9 @@ [#445](https://github.com/phadej/github/pull/445) - Add endpoint for users search [#444](https://github.com/phadej/github/pull/444) +- Make repoWebhookResponseStatus optional + [#436](https://github.com/phadej/github/pull/436) + ## Changes for 0.25 diff --git a/src/GitHub/Data/Webhooks.hs b/src/GitHub/Data/Webhooks.hs index e58f8e69..fb81969d 100644 --- a/src/GitHub/Data/Webhooks.hs +++ b/src/GitHub/Data/Webhooks.hs @@ -89,7 +89,7 @@ instance Binary RepoWebhookEvent data RepoWebhookResponse = RepoWebhookResponse { repoWebhookResponseCode :: !(Maybe Int) - , repoWebhookResponseStatus :: !Text + , repoWebhookResponseStatus :: !(Maybe Text) , repoWebhookResponseMessage :: !(Maybe Text) } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -254,8 +254,8 @@ instance FromJSON RepoWebhook where instance FromJSON RepoWebhookResponse where parseJSON = withObject "RepoWebhookResponse" $ \o -> RepoWebhookResponse <$> o .: "code" - <*> o .: "status" - <*> o .: "message" + <*> o .:? "status" + <*> o .:? "message" instance ToJSON NewRepoWebhook where toJSON (NewRepoWebhook { newRepoWebhookName = name From 5b12b032ba7a22948558b993f270d308ce9375cb Mon Sep 17 00:00:00 2001 From: Robbie McMichael <2044464+robbiemcmichael@users.noreply.github.com> Date: Tue, 3 Dec 2019 22:26:22 +1100 Subject: [PATCH 419/510] Fix permission field in types for teams Add privacy field to types for teams The privacy field was previously commented out while the privacy level of a team was part of the `ironman` API preview. This feature is now part of the official v3 API, so this commit adds support for this field. Make privacy field non-optional in teams The `privacy` field is optional when creating/editing teams, but has a context dependent default value. When getting the team details, the field is expected to always be populated due to these default values. Update team privacy/permission optionality Makes team `privacy` and `permission` fields required when creating a team so users are forced to choose, but optional when editing a team. Filter null values from types for teams --- CHANGELOG.md | 2 + samples/Organizations/Teams/CreateTeamFor.hs | 2 +- samples/Teams/EditTeam.hs | 2 +- src/GitHub/Data/Teams.hs | 48 ++++++++++++-------- 4 files changed, 33 insertions(+), 21 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 12f7575f..7d59fa1f 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -8,6 +8,8 @@ [#444](https://github.com/phadej/github/pull/444) - Make repoWebhookResponseStatus optional [#436](https://github.com/phadej/github/pull/436) +- Teams improvements + [#417](https://github.com/phadej/github/pull/417) ## Changes for 0.25 diff --git a/samples/Organizations/Teams/CreateTeamFor.hs b/samples/Organizations/Teams/CreateTeamFor.hs index 6004b100..df270bce 100644 --- a/samples/Organizations/Teams/CreateTeamFor.hs +++ b/samples/Organizations/Teams/CreateTeamFor.hs @@ -13,7 +13,7 @@ main = do Github.createTeamFor' (Github.OAuth token) org - (Github.CreateTeam team (Just desc) (read repos :: [String]) Github.PermissionPull) + (Github.CreateTeam team (Just desc) (read repos :: [String]) Github.PrivacyClosed Github.PermissionPull) _ -> error "usage: CreateTeamFor <[\"repos\"]>" case result of diff --git a/samples/Teams/EditTeam.hs b/samples/Teams/EditTeam.hs index bb0a05ca..7e83e5c9 100644 --- a/samples/Teams/EditTeam.hs +++ b/samples/Teams/EditTeam.hs @@ -15,7 +15,7 @@ main = do (GitHub.OAuth $ fromString token) GitHub.editTeamR (GitHub.mkTeamId $ read team_id) - (GitHub.EditTeam (GitHub.mkTeamName $ fromString team_name) (Just $ fromString desc) GitHub.PermissionPull) + (GitHub.EditTeam (GitHub.mkTeamName $ fromString team_name) (Just $ fromString desc) Nothing Nothing) _ -> error "usage: EditTeam " case result of diff --git a/src/GitHub/Data/Teams.hs b/src/GitHub/Data/Teams.hs index 387318e0..79ef9706 100644 --- a/src/GitHub/Data/Teams.hs +++ b/src/GitHub/Data/Teams.hs @@ -50,7 +50,7 @@ data SimpleTeam = SimpleTeam , simpleTeamName :: !Text -- TODO (0.15.0): unify this and 'simpleTeamSlug' as in 'Team'. , simpleTeamSlug :: !(Name Team) , simpleTeamDescription :: !(Maybe Text) - , simpleTeamPrivacy :: !(Maybe Privacy) + , simpleTeamPrivacy :: !Privacy , simpleTeamPermission :: !Permission , simpleTeamMembersUrl :: !URL , simpleTeamRepositoriesUrl :: !URL @@ -66,7 +66,7 @@ data Team = Team , teamName :: !Text , teamSlug :: !(Name Team) , teamDescription :: !(Maybe Text) - , teamPrivacy :: !(Maybe Privacy) + , teamPrivacy :: !Privacy , teamPermission :: !Permission , teamMembersUrl :: !URL , teamRepositoriesUrl :: !URL @@ -83,8 +83,8 @@ data CreateTeam = CreateTeam { createTeamName :: !(Name Team) , createTeamDescription :: !(Maybe Text) , createTeamRepoNames :: !(Vector (Name Repo)) - -- , createTeamPrivacy :: Privacy - , createTeamPermission :: Permission + , createTeamPrivacy :: !Privacy + , createTeamPermission :: !Permission } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -94,8 +94,8 @@ instance Binary CreateTeam data EditTeam = EditTeam { editTeamName :: !(Name Team) , editTeamDescription :: !(Maybe Text) - -- , editTeamPrivacy :: Privacy - , editTeamPermission :: !Permission + , editTeamPrivacy :: !(Maybe Privacy) + , editTeamPermission :: !(Maybe Permission) } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -144,7 +144,7 @@ instance FromJSON SimpleTeam where <*> o .: "name" <*> o .: "slug" <*> o .:?"description" .!= Nothing - <*> o .:?"privacy" .!= Nothing + <*> o .: "privacy" <*> o .: "permission" <*> o .: "members_url" <*> o .: "repositories_url" @@ -156,7 +156,7 @@ instance FromJSON Team where <*> o .: "name" <*> o .: "slug" <*> o .:?"description" .!= Nothing - <*> o .:?"privacy" .!= Nothing + <*> o .: "privacy" <*> o .: "permission" <*> o .: "members_url" <*> o .: "repositories_url" @@ -165,19 +165,29 @@ instance FromJSON Team where <*> o .: "organization" instance ToJSON CreateTeam where - toJSON (CreateTeam name desc repo_names {-privacy-} permissions) = - object [ "name" .= name - , "description" .= desc - , "repo_names" .= repo_names - {-, "privacy" .= privacy-} - , "permissions" .= permissions ] + toJSON (CreateTeam name desc repo_names privacy permission) = + object $ filter notNull + [ "name" .= name + , "description" .= desc + , "repo_names" .= repo_names + , "privacy" .= privacy + , "permission" .= permission + ] + where + notNull (_, Null) = False + notNull (_, _) = True instance ToJSON EditTeam where - toJSON (EditTeam name desc {-privacy-} permissions) = - object [ "name" .= name - , "description" .= desc - {-, "privacy" .= privacy-} - , "permissions" .= permissions ] + toJSON (EditTeam name desc privacy permission) = + object $ filter notNull + [ "name" .= name + , "description" .= desc + , "privacy" .= privacy + , "permission" .= permission + ] + where + notNull (_, Null) = False + notNull (_, _) = True instance FromJSON TeamMembership where parseJSON = withObject "TeamMembership" $ \o -> TeamMembership From ebc378a6b0453796606136ae2f9d47576fcd846b Mon Sep 17 00:00:00 2001 From: patrick brisbin Date: Tue, 18 Jun 2019 19:26:15 -0400 Subject: [PATCH 420/510] Change gitReferenceRef type to Name GitReference --- src/GitHub/Data/GitData.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/GitHub/Data/GitData.hs b/src/GitHub/Data/GitData.hs index bce1cb52..fa9973d1 100644 --- a/src/GitHub/Data/GitData.hs +++ b/src/GitHub/Data/GitData.hs @@ -156,7 +156,7 @@ instance Binary NewGitReference data GitReference = GitReference { gitReferenceObject :: !GitObject , gitReferenceUrl :: !URL - , gitReferenceRef :: !Text + , gitReferenceRef :: !(Name GitReference) } deriving (Show, Data, Typeable, Eq, Ord, Generic) From 9db8cf11dc4f2af5334800d99649872954b7ead7 Mon Sep 17 00:00:00 2001 From: patrick brisbin Date: Tue, 18 Jun 2019 12:32:02 -0400 Subject: [PATCH 421/510] Add deleteReference --- CHANGELOG.md | 3 ++- src/GitHub.hs | 2 ++ src/GitHub/Endpoints/GitData/References.hs | 7 +++++++ 3 files changed, 11 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 7d59fa1f..991d24c7 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -10,7 +10,8 @@ [#436](https://github.com/phadej/github/pull/436) - Teams improvements [#417](https://github.com/phadej/github/pull/417) - +- Add deleteReference endpoint + [#388](https://github.com/phadej/github/pull/388) ## Changes for 0.25 diff --git a/src/GitHub.hs b/src/GitHub.hs index 646ecd98..6b5f8d36 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -100,6 +100,8 @@ module GitHub ( referenceR, referencesR, createReferenceR, + deleteReferenceR, + namespacedReferencesR, -- ** Trees -- | See diff --git a/src/GitHub/Endpoints/GitData/References.hs b/src/GitHub/Endpoints/GitData/References.hs index 270d8805..bf64657f 100644 --- a/src/GitHub/Endpoints/GitData/References.hs +++ b/src/GitHub/Endpoints/GitData/References.hs @@ -10,6 +10,7 @@ module GitHub.Endpoints.GitData.References ( referenceR, referencesR, createReferenceR, + deleteReferenceR, namespacedReferencesR, module GitHub.Data, ) where @@ -36,6 +37,12 @@ createReferenceR :: Name Owner -> Name Repo -> NewGitReference -> Request 'RW Gi createReferenceR user repo newRef = command Post ["repos", toPathPart user, toPathPart repo , "git", "refs"] (encode newRef) +-- | Delete a reference. +-- See +deleteReferenceR :: Name Owner -> Name Repo -> Name GitReference -> GenRequest 'MtUnit 'RW () +deleteReferenceR user repo ref = + Command Delete ["repos", toPathPart user, toPathPart repo , "git", "refs", toPathPart ref] mempty + -- | Query namespaced references. -- See namespacedReferencesR :: Name Owner -> Name Repo -> Text -> Request k [GitReference] From 878a452590dc00ac337d8390d1940f97be2d25c3 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 26 May 2020 22:32:00 +0300 Subject: [PATCH 422/510] Prepare for 0.26 --- .travis.yml | 109 +++++++++++++++++++---------------- github.cabal | 11 ++-- samples/github-samples.cabal | 3 +- 3 files changed, 67 insertions(+), 56 deletions(-) diff --git a/.travis.yml b/.travis.yml index 594e2d55..69a83ce4 100644 --- a/.travis.yml +++ b/.travis.yml @@ -2,11 +2,17 @@ # # haskell-ci '--config=cabal.haskell-ci' 'cabal.project' # +# To regenerate the script (for example after adjusting tested-with) run +# +# haskell-ci regenerate +# # For more information, see https://github.com/haskell-CI/haskell-ci # -# version: 0.5.20190908 +# version: 0.10.1 # +version: ~> 1.0 language: c +os: linux dist: xenial git: # whether to recursively clone submodules @@ -18,6 +24,7 @@ cache: directories: - $HOME/.cabal/packages - $HOME/.cabal/store + - $HOME/.hlint before_cache: - rm -fv $CABALHOME/packages/hackage.haskell.org/build-reports.log # remove files that are regenerated by 'cabal update' @@ -27,22 +34,32 @@ before_cache: - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar.idx - rm -rfv $CABALHOME/packages/head.hackage -matrix: +jobs: include: - - compiler: ghc-8.8.1 - addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.8.1","cabal-install-3.0"]}} + - compiler: ghc-8.10.1 + addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.10.1","cabal-install-3.2"]}} + os: linux + - compiler: ghc-8.8.3 + addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.8.3","cabal-install-3.2"]}} + os: linux - compiler: ghc-8.6.5 - addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.6.5","cabal-install-3.0"]}} + addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.6.5","cabal-install-3.2"]}} + os: linux - compiler: ghc-8.4.4 - addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.4.4","cabal-install-3.0"]}} + addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.4.4","cabal-install-3.2"]}} + os: linux - compiler: ghc-8.2.2 - addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.2.2","cabal-install-3.0"]}} + addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.2.2","cabal-install-3.2"]}} + os: linux - compiler: ghc-8.0.2 - addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.0.2","cabal-install-3.0"]}} + addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.0.2","cabal-install-3.2"]}} + os: linux - compiler: ghc-7.10.3 - addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.10.3","cabal-install-3.0"]}} + addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-7.10.3","cabal-install-3.2"]}} + os: linux - compiler: ghc-7.8.4 - addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.8.4","cabal-install-3.0"]}} + addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-7.8.4","cabal-install-3.2"]}} + os: linux before_install: - HC=$(echo "/opt/$CC/bin/ghc" | sed 's/-/\//') - WITHCOMPILER="-w $HC" @@ -55,29 +72,8 @@ before_install: - TOP=$(pwd) - "HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\\d+)\\.(\\d+)\\.(\\d+)(\\.(\\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')" - echo $HCNUMVER - - CABAL="$CABAL -vnormal+nowrap+markoutput" + - CABAL="$CABAL -vnormal+nowrap" - set -o pipefail - - | - echo 'function blue(s) { printf "\033[0;34m" s "\033[0m " }' >> .colorful.awk - echo 'BEGIN { state = "output"; }' >> .colorful.awk - echo '/^-----BEGIN CABAL OUTPUT-----$/ { state = "cabal" }' >> .colorful.awk - echo '/^-----END CABAL OUTPUT-----$/ { state = "output" }' >> .colorful.awk - echo '!/^(-----BEGIN CABAL OUTPUT-----|-----END CABAL OUTPUT-----)/ {' >> .colorful.awk - echo ' if (state == "cabal") {' >> .colorful.awk - echo ' print blue($0)' >> .colorful.awk - echo ' } else {' >> .colorful.awk - echo ' print $0' >> .colorful.awk - echo ' }' >> .colorful.awk - echo '}' >> .colorful.awk - - cat .colorful.awk - - | - color_cabal_output () { - awk -f $TOP/.colorful.awk - } - - echo text | color_cabal_output -install: - - ${CABAL} --version - - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]" - TEST=--enable-tests - BENCH=--enable-benchmarks - HEADHACKAGE=false @@ -98,6 +94,9 @@ install: echo " prefix: $CABALHOME" >> $CABALHOME/config echo "repository hackage.haskell.org" >> $CABALHOME/config echo " url: http://hackage.haskell.org/" >> $CABALHOME/config +install: + - ${CABAL} --version + - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]" - | echo "program-default-options" >> $CABALHOME/config echo " ghc-options: $GHCJOBS +RTS -M6G -RTS" >> $CABALHOME/config @@ -110,25 +109,30 @@ install: - | echo "packages: ." >> cabal.project echo "packages: samples" >> cabal.project + - if [ $HCNUMVER -ge 80200 ] ; then echo 'package github' >> cabal.project ; fi + - "if [ $HCNUMVER -ge 80200 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" + - if [ $HCNUMVER -ge 80200 ] ; then echo 'package github-samples' >> cabal.project ; fi + - "if [ $HCNUMVER -ge 80200 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" - | - echo "constraints: hashable ^>=1.3" >> cabal.project - echo "constraints: semigroups ^>=0.19" >> cabal.project - echo "constraints: github +openssl" >> cabal.project - echo "optimization: False" >> cabal.project + echo "constraints: hashable ^>=1.3" >> cabal.project + echo "constraints: semigroups ^>=0.19" >> cabal.project + echo "constraints: github +openssl" >> cabal.project + echo "constraints: github-samples +openssl" >> cabal.project + echo "optimization: False" >> cabal.project - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(github|github-samples)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" - cat cabal.project || true - cat cabal.project.local || true - if [ -f "./configure.ac" ]; then (cd "." && autoreconf -i); fi - if [ -f "samples/configure.ac" ]; then (cd "samples" && autoreconf -i); fi - - ${CABAL} v2-freeze $WITHCOMPILER ${TEST} ${BENCH} | color_cabal_output + - ${CABAL} v2-freeze $WITHCOMPILER ${TEST} ${BENCH} - "cat cabal.project.freeze | sed -E 's/^(constraints: *| *)//' | sed 's/any.//'" - rm cabal.project.freeze - - ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} --dep -j2 all | color_cabal_output - - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks --dep -j2 all | color_cabal_output + - travis_wait 40 ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} --dep -j2 all + - travis_wait 40 ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks --dep -j2 all script: - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX) # Packaging... - - ${CABAL} v2-sdist all | color_cabal_output + - ${CABAL} v2-sdist all # Unpacking... - mv dist-newstyle/sdist/*.tar.gz ${DISTDIR}/ - cd ${DISTDIR} || false @@ -142,30 +146,35 @@ script: - | echo "packages: ${PKGDIR_github}" >> cabal.project echo "packages: ${PKGDIR_github_samples}" >> cabal.project + - if [ $HCNUMVER -ge 80200 ] ; then echo 'package github' >> cabal.project ; fi + - "if [ $HCNUMVER -ge 80200 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" + - if [ $HCNUMVER -ge 80200 ] ; then echo 'package github-samples' >> cabal.project ; fi + - "if [ $HCNUMVER -ge 80200 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" - | - echo "constraints: hashable ^>=1.3" >> cabal.project - echo "constraints: semigroups ^>=0.19" >> cabal.project - echo "constraints: github +openssl" >> cabal.project - echo "optimization: False" >> cabal.project + echo "constraints: hashable ^>=1.3" >> cabal.project + echo "constraints: semigroups ^>=0.19" >> cabal.project + echo "constraints: github +openssl" >> cabal.project + echo "constraints: github-samples +openssl" >> cabal.project + echo "optimization: False" >> cabal.project - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(github|github-samples)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" - cat cabal.project || true - cat cabal.project.local || true # Building... # this builds all libraries and executables (without tests/benchmarks) - - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all | color_cabal_output + - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all # Building with tests and benchmarks... # build & run tests, build benchmarks - - ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} all | color_cabal_output + - ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} all # Testing... - - ${CABAL} v2-test $WITHCOMPILER ${TEST} ${BENCH} all | color_cabal_output + - ${CABAL} v2-test $WITHCOMPILER ${TEST} ${BENCH} all # cabal check... - (cd ${PKGDIR_github} && ${CABAL} -vnormal check) - (cd ${PKGDIR_github_samples} && ${CABAL} -vnormal check) # haddock... - - if [ $HCNUMVER -ge 80600 ] ; then ${CABAL} v2-haddock $WITHCOMPILER --with-haddock $HADDOCK ${TEST} ${BENCH} all | color_cabal_output ; fi + - if [ $HCNUMVER -ge 80600 ] ; then ${CABAL} v2-haddock $WITHCOMPILER --with-haddock $HADDOCK ${TEST} ${BENCH} all ; fi # Building without installed constraints for packages in global-db... - rm -f cabal.project.local - - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all | color_cabal_output + - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all -# REGENDATA ["--config=cabal.haskell-ci","cabal.project"] +# REGENDATA ("0.10.1",["--config=cabal.haskell-ci","cabal.project"]) # EOF diff --git a/github.cabal b/github.cabal index 1ff2e5ea..ed0045b0 100644 --- a/github.cabal +++ b/github.cabal @@ -36,7 +36,8 @@ tested-with: || ==8.2.2 || ==8.4.4 || ==8.6.5 - || ==8.8.1 + || ==8.8.3 + || ==8.10.1 extra-source-files: README.md @@ -163,7 +164,7 @@ library -- Packages bundles with GHC, mtl and text are also here build-depends: - base >=4.7 && <4.14 + base >=4.7 && <4.15 , binary >=0.7.1.0 && <0.11 , bytestring >=0.10.4.0 && <0.11 , containers >=0.5.5.1 && <0.7 @@ -175,15 +176,15 @@ library -- other packages build-depends: - aeson >=1.4.0.0 && <1.5 - , base-compat >=0.10.4 && <0.12 + aeson >=1.4.0.0 && <1.6 + , base-compat >=0.11.1 && <0.12 , base16-bytestring >=0.1.1.6 && <0.2 , binary-instances >=1 && <1.1 , cryptohash-sha1 >=0.11.100.1 && <0.12 , deepseq-generics >=0.2.0.0 && <0.3 , exceptions >=0.10.2 && <0.11 , hashable >=1.2.7.0 && <1.4 - , http-client >=0.5.12 && <0.7 + , http-client >=0.5.12 && <0.8 , http-link-header >=1.0.3.1 && <1.1 , http-types >=0.12.3 && <0.13 , iso8601-time >=0.1.5 && <0.2 diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index ae4fb3f2..41d6dccf 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -15,7 +15,8 @@ tested-with: || ==8.2.2 || ==8.4.4 || ==8.6.5 - || ==8.8.1 + || ==8.8.3 + || ==8.10.1 library hs-source-dirs: src From 5277e66ad07b37e0745c18c2370ea7d74ec02b4e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Domen=20Ko=C5=BEar?= Date: Mon, 20 Jul 2020 13:47:23 +0200 Subject: [PATCH 423/510] typos --- src/GitHub/Data/Definitions.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/GitHub/Data/Definitions.hs b/src/GitHub/Data/Definitions.hs index 8da8b761..0d56171b 100644 --- a/src/GitHub/Data/Definitions.hs +++ b/src/GitHub/Data/Definitions.hs @@ -121,7 +121,7 @@ data Organization = Organization instance NFData Organization where rnf = genericRnf instance Binary Organization --- | In practic, you cam't have concrete values of 'Owner'. +-- | In practice you can't have concrete values of 'Owner'. newtype Owner = Owner (Either User Organization) deriving (Show, Data, Typeable, Eq, Ord, Generic) From f5c0dd6be826f3beb10924da829c0e210c00ac33 Mon Sep 17 00:00:00 2001 From: Alexandre Esteves <2335822+alexfmpe@users.noreply.github.com> Date: Tue, 28 Jul 2020 11:23:29 +0100 Subject: [PATCH 424/510] Fix typo --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index cc825f98..d6996412 100644 --- a/README.md +++ b/README.md @@ -42,7 +42,7 @@ For details see the reference [documentation on Hackage][hackage]. Each module lines up with the hierarchy of [documentation from the Github API](http://developer.github.com/v3/). -Request functions (ending with `R`) construct a data type with can be executed +Request functions (ending with `R`) construct a data type which can be executed in `IO` by `executeRequest` functions. They are all listed in the root `GitHub` module. From 514b175851dd7c4a9722ff203dd6f652a15d33e8 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Thu, 22 Oct 2020 13:09:14 +0300 Subject: [PATCH 425/510] Update dependencies 20201022 --- github.cabal | 4 ++-- src/GitHub/Request.hs | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/github.cabal b/github.cabal index ed0045b0..1b4f2e40 100644 --- a/github.cabal +++ b/github.cabal @@ -178,14 +178,14 @@ library build-depends: aeson >=1.4.0.0 && <1.6 , base-compat >=0.11.1 && <0.12 - , base16-bytestring >=0.1.1.6 && <0.2 + , base16-bytestring >=0.1.1.6 && <1.1 , binary-instances >=1 && <1.1 , cryptohash-sha1 >=0.11.100.1 && <0.12 , deepseq-generics >=0.2.0.0 && <0.3 , exceptions >=0.10.2 && <0.11 , hashable >=1.2.7.0 && <1.4 , http-client >=0.5.12 && <0.8 - , http-link-header >=1.0.3.1 && <1.1 + , http-link-header >=1.0.3.1 && <1.3 , http-types >=0.12.3 && <0.13 , iso8601-time >=0.1.5 && <0.2 , network-uri >=2.6.1.0 && <2.7 diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index 4f58fa61..808f33a7 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -90,7 +90,7 @@ import Network.HTTP.Client httpLbs, method, newManager, redirectCount, requestBody, requestHeaders, setQueryString, setRequestIgnoreStatus) import Network.HTTP.Link.Parser (parseLinkHeaderBS) -import Network.HTTP.Link.Types (Link (..), LinkParam (..), href, linkParams) +import Network.HTTP.Link.Types (LinkParam (..), href, linkParams) import Network.HTTP.Types (Method, RequestHeaders, Status (..)) import Network.URI (URI, escapeURIString, isUnescapedInURIComponent, parseURIReference, @@ -507,7 +507,7 @@ getNextUrl req = do nextURI <- find isRelNext links return $ href nextURI where - isRelNext :: Link -> Bool + -- isRelNext :: Link -> Bool or Link uri -> Bool isRelNext = any (== relNextLinkParam) . linkParams relNextLinkParam :: (LinkParam, Text) From f18d8ac45191c8cfa0105e8d364e994480b1df96 Mon Sep 17 00:00:00 2001 From: Jean-Paul Calderone Date: Wed, 2 Dec 2020 18:33:27 -0500 Subject: [PATCH 426/510] Add vector of SimpleTeam in "requested_teams" field of PullRequest --- .../pull-request-team-review-requested.json | 362 ++++++++++++++++++ spec/GitHub/PullRequestsSpec.hs | 18 + src/GitHub/Data/PullRequests.hs | 5 + 3 files changed, 385 insertions(+) create mode 100644 fixtures/pull-request-team-review-requested.json diff --git a/fixtures/pull-request-team-review-requested.json b/fixtures/pull-request-team-review-requested.json new file mode 100644 index 00000000..7eeb71f7 --- /dev/null +++ b/fixtures/pull-request-team-review-requested.json @@ -0,0 +1,362 @@ +{ + "url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/pulls/910", + "id": 529597962, + "node_id": "MDExOlB1bGxSZXF1ZXN0NTI5NTk3OTYy", + "html_url": "https://github.com/tahoe-lafs/tahoe-lafs/pull/910", + "diff_url": "https://github.com/tahoe-lafs/tahoe-lafs/pull/910.diff", + "patch_url": "https://github.com/tahoe-lafs/tahoe-lafs/pull/910.patch", + "issue_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/issues/910", + "number": 910, + "state": "open", + "locked": false, + "title": "Fix NodeMaker's use of the WeakValueDictionary", + "user": { + "login": "exarkun", + "id": 254565, + "node_id": "MDQ6VXNlcjI1NDU2NQ==", + "avatar_url": "https://avatars1.githubusercontent.com/u/254565?v=4", + "gravatar_id": "", + "url": "https://api.github.com/users/exarkun", + "html_url": "https://github.com/exarkun", + "followers_url": "https://api.github.com/users/exarkun/followers", + "following_url": "https://api.github.com/users/exarkun/following{/other_user}", + "gists_url": "https://api.github.com/users/exarkun/gists{/gist_id}", + "starred_url": "https://api.github.com/users/exarkun/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/exarkun/subscriptions", + "organizations_url": "https://api.github.com/users/exarkun/orgs", + "repos_url": "https://api.github.com/users/exarkun/repos", + "events_url": "https://api.github.com/users/exarkun/events{/privacy}", + "received_events_url": "https://api.github.com/users/exarkun/received_events", + "type": "User", + "site_admin": false + }, + "body": "https://tahoe-lafs.org/trac/tahoe-lafs/ticket/3539", + "created_at": "2020-11-30T14:46:37Z", + "updated_at": "2020-12-02T17:23:41Z", + "closed_at": null, + "merged_at": null, + "merge_commit_sha": "3c97064ee5f71357c88f7940a91da8859641c2c6", + "assignee": null, + "assignees": [ + + ], + "requested_reviewers": [ + + ], + "requested_teams": [ + { + "name": "Tahoe Committers", + "id": 121616, + "node_id": "MDQ6VGVhbTEyMTYxNg==", + "slug": "tahoe-committers", + "description": null, + "privacy": "closed", + "url": "https://api.github.com/organizations/1156454/team/121616", + "html_url": "https://github.com/orgs/tahoe-lafs/teams/tahoe-committers", + "members_url": "https://api.github.com/organizations/1156454/team/121616/members{/member}", + "repositories_url": "https://api.github.com/organizations/1156454/team/121616/repos", + "permission": "push", + "parent": null + } + ], + "labels": [ + + ], + "milestone": null, + "draft": false, + "commits_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/pulls/910/commits", + "review_comments_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/pulls/910/comments", + "review_comment_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/pulls/comments{/number}", + "comments_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/issues/910/comments", + "statuses_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/statuses/ef2f7e61364c6a3187d2ab4859adfc4031213bdd", + "head": { + "label": "tahoe-lafs:3539.nodemaker-weakrefdict", + "ref": "3539.nodemaker-weakrefdict", + "sha": "ef2f7e61364c6a3187d2ab4859adfc4031213bdd", + "user": { + "login": "tahoe-lafs", + "id": 1156454, + "node_id": "MDEyOk9yZ2FuaXphdGlvbjExNTY0NTQ=", + "avatar_url": "https://avatars1.githubusercontent.com/u/1156454?v=4", + "gravatar_id": "", + "url": "https://api.github.com/users/tahoe-lafs", + "html_url": "https://github.com/tahoe-lafs", + "followers_url": "https://api.github.com/users/tahoe-lafs/followers", + "following_url": "https://api.github.com/users/tahoe-lafs/following{/other_user}", + "gists_url": "https://api.github.com/users/tahoe-lafs/gists{/gist_id}", + "starred_url": "https://api.github.com/users/tahoe-lafs/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/tahoe-lafs/subscriptions", + "organizations_url": "https://api.github.com/users/tahoe-lafs/orgs", + "repos_url": "https://api.github.com/users/tahoe-lafs/repos", + "events_url": "https://api.github.com/users/tahoe-lafs/events{/privacy}", + "received_events_url": "https://api.github.com/users/tahoe-lafs/received_events", + "type": "Organization", + "site_admin": false + }, + "repo": { + "id": 3007569, + "node_id": "MDEwOlJlcG9zaXRvcnkzMDA3NTY5", + "name": "tahoe-lafs", + "full_name": "tahoe-lafs/tahoe-lafs", + "private": false, + "owner": { + "login": "tahoe-lafs", + "id": 1156454, + "node_id": "MDEyOk9yZ2FuaXphdGlvbjExNTY0NTQ=", + "avatar_url": "https://avatars1.githubusercontent.com/u/1156454?v=4", + "gravatar_id": "", + "url": "https://api.github.com/users/tahoe-lafs", + "html_url": "https://github.com/tahoe-lafs", + "followers_url": "https://api.github.com/users/tahoe-lafs/followers", + "following_url": "https://api.github.com/users/tahoe-lafs/following{/other_user}", + "gists_url": "https://api.github.com/users/tahoe-lafs/gists{/gist_id}", + "starred_url": "https://api.github.com/users/tahoe-lafs/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/tahoe-lafs/subscriptions", + "organizations_url": "https://api.github.com/users/tahoe-lafs/orgs", + "repos_url": "https://api.github.com/users/tahoe-lafs/repos", + "events_url": "https://api.github.com/users/tahoe-lafs/events{/privacy}", + "received_events_url": "https://api.github.com/users/tahoe-lafs/received_events", + "type": "Organization", + "site_admin": false + }, + "html_url": "https://github.com/tahoe-lafs/tahoe-lafs", + "description": "The Tahoe-LAFS decentralized secure filesystem.", + "fork": false, + "url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs", + "forks_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/forks", + "keys_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/keys{/key_id}", + "collaborators_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/collaborators{/collaborator}", + "teams_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/teams", + "hooks_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/hooks", + "issue_events_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/issues/events{/number}", + "events_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/events", + "assignees_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/assignees{/user}", + "branches_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/branches{/branch}", + "tags_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/tags", + "blobs_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/git/blobs{/sha}", + "git_tags_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/git/tags{/sha}", + "git_refs_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/git/refs{/sha}", + "trees_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/git/trees{/sha}", + "statuses_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/statuses/{sha}", + "languages_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/languages", + "stargazers_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/stargazers", + "contributors_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/contributors", + "subscribers_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/subscribers", + "subscription_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/subscription", + "commits_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/commits{/sha}", + "git_commits_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/git/commits{/sha}", + "comments_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/comments{/number}", + "issue_comment_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/issues/comments{/number}", + "contents_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/contents/{+path}", + "compare_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/compare/{base}...{head}", + "merges_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/merges", + "archive_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/{archive_format}{/ref}", + "downloads_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/downloads", + "issues_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/issues{/number}", + "pulls_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/pulls{/number}", + "milestones_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/milestones{/number}", + "notifications_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/notifications{?since,all,participating}", + "labels_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/labels{/name}", + "releases_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/releases{/id}", + "deployments_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/deployments", + "created_at": "2011-12-18T19:33:55Z", + "updated_at": "2020-12-02T20:24:23Z", + "pushed_at": "2020-12-02T20:27:05Z", + "git_url": "git://github.com/tahoe-lafs/tahoe-lafs.git", + "ssh_url": "git@github.com:tahoe-lafs/tahoe-lafs.git", + "clone_url": "https://github.com/tahoe-lafs/tahoe-lafs.git", + "svn_url": "https://github.com/tahoe-lafs/tahoe-lafs", + "homepage": "https://tahoe-lafs.org/", + "size": 73606, + "stargazers_count": 1018, + "watchers_count": 1018, + "language": "Python", + "has_issues": false, + "has_projects": false, + "has_downloads": true, + "has_wiki": false, + "has_pages": false, + "forks_count": 236, + "mirror_url": null, + "archived": false, + "disabled": false, + "open_issues_count": 21, + "license": { + "key": "other", + "name": "Other", + "spdx_id": "NOASSERTION", + "url": null, + "node_id": "MDc6TGljZW5zZTA=" + }, + "forks": 236, + "open_issues": 21, + "watchers": 1018, + "default_branch": "master" + } + }, + "base": { + "label": "tahoe-lafs:master", + "ref": "master", + "sha": "fba386cb8ee2b48a34c0d954b5c6b5b080d3234e", + "user": { + "login": "tahoe-lafs", + "id": 1156454, + "node_id": "MDEyOk9yZ2FuaXphdGlvbjExNTY0NTQ=", + "avatar_url": "https://avatars1.githubusercontent.com/u/1156454?v=4", + "gravatar_id": "", + "url": "https://api.github.com/users/tahoe-lafs", + "html_url": "https://github.com/tahoe-lafs", + "followers_url": "https://api.github.com/users/tahoe-lafs/followers", + "following_url": "https://api.github.com/users/tahoe-lafs/following{/other_user}", + "gists_url": "https://api.github.com/users/tahoe-lafs/gists{/gist_id}", + "starred_url": "https://api.github.com/users/tahoe-lafs/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/tahoe-lafs/subscriptions", + "organizations_url": "https://api.github.com/users/tahoe-lafs/orgs", + "repos_url": "https://api.github.com/users/tahoe-lafs/repos", + "events_url": "https://api.github.com/users/tahoe-lafs/events{/privacy}", + "received_events_url": "https://api.github.com/users/tahoe-lafs/received_events", + "type": "Organization", + "site_admin": false + }, + "repo": { + "id": 3007569, + "node_id": "MDEwOlJlcG9zaXRvcnkzMDA3NTY5", + "name": "tahoe-lafs", + "full_name": "tahoe-lafs/tahoe-lafs", + "private": false, + "owner": { + "login": "tahoe-lafs", + "id": 1156454, + "node_id": "MDEyOk9yZ2FuaXphdGlvbjExNTY0NTQ=", + "avatar_url": "https://avatars1.githubusercontent.com/u/1156454?v=4", + "gravatar_id": "", + "url": "https://api.github.com/users/tahoe-lafs", + "html_url": "https://github.com/tahoe-lafs", + "followers_url": "https://api.github.com/users/tahoe-lafs/followers", + "following_url": "https://api.github.com/users/tahoe-lafs/following{/other_user}", + "gists_url": "https://api.github.com/users/tahoe-lafs/gists{/gist_id}", + "starred_url": "https://api.github.com/users/tahoe-lafs/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/tahoe-lafs/subscriptions", + "organizations_url": "https://api.github.com/users/tahoe-lafs/orgs", + "repos_url": "https://api.github.com/users/tahoe-lafs/repos", + "events_url": "https://api.github.com/users/tahoe-lafs/events{/privacy}", + "received_events_url": "https://api.github.com/users/tahoe-lafs/received_events", + "type": "Organization", + "site_admin": false + }, + "html_url": "https://github.com/tahoe-lafs/tahoe-lafs", + "description": "The Tahoe-LAFS decentralized secure filesystem.", + "fork": false, + "url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs", + "forks_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/forks", + "keys_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/keys{/key_id}", + "collaborators_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/collaborators{/collaborator}", + "teams_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/teams", + "hooks_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/hooks", + "issue_events_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/issues/events{/number}", + "events_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/events", + "assignees_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/assignees{/user}", + "branches_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/branches{/branch}", + "tags_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/tags", + "blobs_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/git/blobs{/sha}", + "git_tags_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/git/tags{/sha}", + "git_refs_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/git/refs{/sha}", + "trees_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/git/trees{/sha}", + "statuses_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/statuses/{sha}", + "languages_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/languages", + "stargazers_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/stargazers", + "contributors_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/contributors", + "subscribers_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/subscribers", + "subscription_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/subscription", + "commits_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/commits{/sha}", + "git_commits_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/git/commits{/sha}", + "comments_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/comments{/number}", + "issue_comment_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/issues/comments{/number}", + "contents_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/contents/{+path}", + "compare_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/compare/{base}...{head}", + "merges_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/merges", + "archive_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/{archive_format}{/ref}", + "downloads_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/downloads", + "issues_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/issues{/number}", + "pulls_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/pulls{/number}", + "milestones_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/milestones{/number}", + "notifications_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/notifications{?since,all,participating}", + "labels_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/labels{/name}", + "releases_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/releases{/id}", + "deployments_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/deployments", + "created_at": "2011-12-18T19:33:55Z", + "updated_at": "2020-12-02T20:24:23Z", + "pushed_at": "2020-12-02T20:27:05Z", + "git_url": "git://github.com/tahoe-lafs/tahoe-lafs.git", + "ssh_url": "git@github.com:tahoe-lafs/tahoe-lafs.git", + "clone_url": "https://github.com/tahoe-lafs/tahoe-lafs.git", + "svn_url": "https://github.com/tahoe-lafs/tahoe-lafs", + "homepage": "https://tahoe-lafs.org/", + "size": 73606, + "stargazers_count": 1018, + "watchers_count": 1018, + "language": "Python", + "has_issues": false, + "has_projects": false, + "has_downloads": true, + "has_wiki": false, + "has_pages": false, + "forks_count": 236, + "mirror_url": null, + "archived": false, + "disabled": false, + "open_issues_count": 21, + "license": { + "key": "other", + "name": "Other", + "spdx_id": "NOASSERTION", + "url": null, + "node_id": "MDc6TGljZW5zZTA=" + }, + "forks": 236, + "open_issues": 21, + "watchers": 1018, + "default_branch": "master" + } + }, + "_links": { + "self": { + "href": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/pulls/910" + }, + "html": { + "href": "https://github.com/tahoe-lafs/tahoe-lafs/pull/910" + }, + "issue": { + "href": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/issues/910" + }, + "comments": { + "href": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/issues/910/comments" + }, + "review_comments": { + "href": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/pulls/910/comments" + }, + "review_comment": { + "href": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/pulls/comments{/number}" + }, + "commits": { + "href": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/pulls/910/commits" + }, + "statuses": { + "href": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/statuses/ef2f7e61364c6a3187d2ab4859adfc4031213bdd" + } + }, + "author_association": "MEMBER", + "active_lock_reason": null, + "merged": false, + "mergeable": true, + "rebaseable": true, + "mergeable_state": "clean", + "merged_by": null, + "comments": 1, + "review_comments": 0, + "maintainer_can_modify": false, + "commits": 5, + "additions": 223, + "deletions": 4, + "changed_files": 5 +} diff --git a/spec/GitHub/PullRequestsSpec.hs b/spec/GitHub/PullRequestsSpec.hs index 14cbee9a..7a49bc97 100644 --- a/spec/GitHub/PullRequestsSpec.hs +++ b/spec/GitHub/PullRequestsSpec.hs @@ -65,6 +65,13 @@ spec = do V.length (GH.pullRequestRequestedReviewers pullRequestReviewRequested) `shouldBe` 1 + it "decodes a pull request 'team_requested' payload" $ do + V.length (GH.simplePullRequestRequestedTeamReviewers simplePullRequestTeamReviewRequested) + `shouldBe` 1 + + V.length (GH.pullRequestRequestedTeamReviewers pullRequestTeamReviewRequested) + `shouldBe` 1 + describe "checking if a pull request is merged" $ do it "works" $ withAuth $ \auth -> do b <- GH.executeRequest auth $ GH.isPullRequestMergedR "phadej" "github" (GH.IssueNumber 14) @@ -97,16 +104,27 @@ spec = do simplePullRequestReviewRequested = fromRightS (eitherDecodeStrict prReviewRequestedPayload) + simplePullRequestTeamReviewRequested :: GH.SimplePullRequest + simplePullRequestTeamReviewRequested = + fromRightS (eitherDecodeStrict prTeamReviewRequestedPayload) + pullRequestReviewRequested :: GH.PullRequest pullRequestReviewRequested = fromRightS (eitherDecodeStrict prReviewRequestedPayload) + pullRequestTeamReviewRequested :: GH.PullRequest + pullRequestTeamReviewRequested = + fromRightS (eitherDecodeStrict prTeamReviewRequestedPayload) + prOpenedPayload :: ByteString prOpenedPayload = $(embedFile "fixtures/pull-request-opened.json") prReviewRequestedPayload :: ByteString prReviewRequestedPayload = $(embedFile "fixtures/pull-request-review-requested.json") + prTeamReviewRequestedPayload :: ByteString + prTeamReviewRequestedPayload = $(embedFile "fixtures/pull-request-team-review-requested.json") + ------------------------------------------------------------------------------- -- Draft Pull Requests ------------------------------------------------------------------------------- diff --git a/src/GitHub/Data/PullRequests.hs b/src/GitHub/Data/PullRequests.hs index 5c2f62e1..0075986a 100644 --- a/src/GitHub/Data/PullRequests.hs +++ b/src/GitHub/Data/PullRequests.hs @@ -21,6 +21,7 @@ import GitHub.Data.Id (Id) import GitHub.Data.Options (IssueState (..), MergeableState (..)) import GitHub.Data.Repos (Repo) import GitHub.Data.URL (URL) +import GitHub.Data.Teams (SimpleTeam) import GitHub.Internal.Prelude import Prelude () @@ -38,6 +39,7 @@ data SimplePullRequest = SimplePullRequest , simplePullRequestBody :: !(Maybe Text) , simplePullRequestAssignees :: (Vector SimpleUser) , simplePullRequestRequestedReviewers :: (Vector SimpleUser) + , simplePullRequestRequestedTeamReviewers:: (Vector SimpleTeam) , simplePullRequestIssueUrl :: !URL , simplePullRequestDiffUrl :: !URL , simplePullRequestUrl :: !URL @@ -63,6 +65,7 @@ data PullRequest = PullRequest , pullRequestBody :: !(Maybe Text) , pullRequestAssignees :: (Vector SimpleUser) , pullRequestRequestedReviewers :: (Vector SimpleUser) + , pullRequestRequestedTeamReviewers :: (Vector SimpleTeam) , pullRequestIssueUrl :: !URL , pullRequestDiffUrl :: !URL , pullRequestUrl :: !URL @@ -198,6 +201,7 @@ instance FromJSON SimplePullRequest where <*> o .:? "body" <*> o .: "assignees" <*> o .:? "requested_reviewers" .!= mempty + <*> o .:? "requested_teams" .!= mempty <*> o .: "issue_url" <*> o .: "diff_url" <*> o .: "url" @@ -239,6 +243,7 @@ instance FromJSON PullRequest where <*> o .:? "body" <*> o .: "assignees" <*> o .:? "requested_reviewers" .!= mempty + <*> o .:? "requested_teams" .!= mempty <*> o .: "issue_url" <*> o .: "diff_url" <*> o .: "url" From a6a76128dfdc99560cbdf7a42936087aae1120e9 Mon Sep 17 00:00:00 2001 From: Jean-Paul Calderone Date: Wed, 2 Dec 2020 19:20:15 -0500 Subject: [PATCH 427/510] Attempt to get the new data fixture where it needs to be --- github.cabal | 9 +-------- 1 file changed, 1 insertion(+), 8 deletions(-) diff --git a/github.cabal b/github.cabal index 1b4f2e40..d0fd875f 100644 --- a/github.cabal +++ b/github.cabal @@ -42,14 +42,7 @@ tested-with: extra-source-files: README.md CHANGELOG.md - fixtures/issue-search.json - fixtures/list-teams.json - fixtures/members-list.json - fixtures/pull-request-opened.json - fixtures/pull-request-review-requested.json - fixtures/user-organizations.json - fixtures/user.json - fixtures/user-bot.json + fixtures/*.json source-repository head type: git From b060eca8855010a3ba3bb2b17702343e1d54e437 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 14 Dec 2020 20:06:30 +0200 Subject: [PATCH 428/510] Use GitHub Actions --- .github/workflows/haskell-ci.yml | 181 +++++++++++++++++++++++++++++++ .travis.yml | 180 ------------------------------ 2 files changed, 181 insertions(+), 180 deletions(-) create mode 100644 .github/workflows/haskell-ci.yml delete mode 100644 .travis.yml diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml new file mode 100644 index 00000000..2dd020d0 --- /dev/null +++ b/.github/workflows/haskell-ci.yml @@ -0,0 +1,181 @@ +# This GitHub workflow config has been generated by a script via +# +# haskell-ci '--config=cabal.haskell-ci' 'github' 'cabal.project' +# +# To regenerate the script (for example after adjusting tested-with) run +# +# haskell-ci regenerate +# +# For more information, see https://github.com/haskell-CI/haskell-ci +# +# version: 0.11.20201213 +# +# REGENDATA ("0.11.20201213",["--config=cabal.haskell-ci","github","cabal.project"]) +# +name: Haskell-CI +on: + push: + branches: + - master + pull_request: + branches: + - master +jobs: + linux: + name: Haskell-CI Linux + runs-on: ubuntu-18.04 + container: + image: buildpack-deps:bionic + strategy: + matrix: + include: + - ghc: 8.10.1 + - ghc: 8.8.3 + - ghc: 8.6.5 + - ghc: 8.4.4 + - ghc: 8.2.2 + - ghc: 8.0.2 + - ghc: 7.10.3 + - ghc: 7.8.4 + fail-fast: false + steps: + - name: apt + run: | + apt-get update + apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common + apt-add-repository -y 'ppa:hvr/ghc' + apt-get update + apt-get install -y ghc-$GHC_VERSION cabal-install-3.2 + env: + GHC_VERSION: ${{ matrix.ghc }} + - name: Set PATH and environment variables + run: | + echo "$HOME/.cabal/bin" >> $GITHUB_PATH + echo "LANG=C.UTF-8" >> $GITHUB_ENV + echo "CABAL_DIR=$HOME/.cabal" >> $GITHUB_ENV + echo "CABAL_CONFIG=$HOME/.cabal/config" >> $GITHUB_ENV + HC=/opt/ghc/$GHC_VERSION/bin/ghc + echo "HC=$HC" >> $GITHUB_ENV + echo "HCPKG=/opt/ghc/$GHC_VERSION/bin/ghc-pkg" >> $GITHUB_ENV + echo "HADDOCK=/opt/ghc/$GHC_VERSION/bin/haddock" >> $GITHUB_ENV + echo "CABAL=/opt/cabal/3.2/bin/cabal -vnormal+nowrap" >> $GITHUB_ENV + HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))') + echo "HCNUMVER=$HCNUMVER" >> $GITHUB_ENV + echo "ARG_TESTS=--enable-tests" >> $GITHUB_ENV + echo "ARG_BENCH=--enable-benchmarks" >> $GITHUB_ENV + echo "ARG_COMPILER=--ghc --with-compiler=/opt/ghc/$GHC_VERSION/bin/ghc" >> $GITHUB_ENV + echo "GHCJSARITH=0" >> $GITHUB_ENV + env: + GHC_VERSION: ${{ matrix.ghc }} + - name: env + run: | + env + - name: write cabal config + run: | + mkdir -p $CABAL_DIR + cat >> $CABAL_CONFIG < cabal-plan.xz + echo 'de73600b1836d3f55e32d80385acc055fd97f60eaa0ab68a755302685f5d81bc cabal-plan.xz' | sha256sum -c - + xz -d < cabal-plan.xz > $HOME/.cabal/bin/cabal-plan + rm -f cabal-plan.xz + chmod a+x $HOME/.cabal/bin/cabal-plan + - name: checkout + uses: actions/checkout@v2 + with: + path: source + - name: sdist + run: | + mkdir -p sdist + cd source || false + $CABAL sdist all --output-dir $GITHUB_WORKSPACE/sdist + - name: unpack + run: | + mkdir -p unpacked + find sdist -maxdepth 1 -type f -name '*.tar.gz' -exec tar -C $GITHUB_WORKSPACE/unpacked -xzvf {} \; + - name: generate cabal.project + run: | + PKGDIR_github="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/github-[0-9.]*')" + echo "PKGDIR_github=${PKGDIR_github}" >> $GITHUB_ENV + PKGDIR_github_samples="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/github-samples-[0-9.]*')" + echo "PKGDIR_github_samples=${PKGDIR_github_samples}" >> $GITHUB_ENV + touch cabal.project + touch cabal.project.local + echo "packages: ${PKGDIR_github}" >> cabal.project + echo "packages: ${PKGDIR_github_samples}" >> cabal.project + if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo "package github" >> cabal.project ; fi + if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods" >> cabal.project ; fi + if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo "package github-samples" >> cabal.project ; fi + if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods" >> cabal.project ; fi + cat >> cabal.project <=1.3 + constraints: semigroups ^>=0.19 + constraints: github +openssl + constraints: github-samples +openssl + optimization: False + EOF + $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: $_ installed\n" unless /^(github|github-samples)$/; }' >> cabal.project.local + cat cabal.project + cat cabal.project.local + - name: dump install plan + run: | + $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all + cabal-plan + - name: cache + uses: actions/cache@v2 + with: + key: ${{ runner.os }}-${{ matrix.ghc }}-${{ github.sha }} + path: ~/.cabal/store + restore-keys: ${{ runner.os }}-${{ matrix.ghc }}- + - name: install dependencies + run: | + $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --dependencies-only all + $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dependencies-only all + - name: build w/o tests + run: | + $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all + - name: build + run: | + $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH all + - name: tests + run: | + $CABAL v2-test $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --test-show-details=direct + - name: cabal check + run: | + cd ${PKGDIR_github} || false + ${CABAL} -vnormal check + cd ${PKGDIR_github_samples} || false + ${CABAL} -vnormal check + - name: haddock + run: | + if [ $((HCNUMVER >= 80600)) -ne 0 ] ; then $CABAL v2-haddock $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all ; fi + - name: unconstrained build + run: | + rm -f cabal.project.local + $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all diff --git a/.travis.yml b/.travis.yml deleted file mode 100644 index 69a83ce4..00000000 --- a/.travis.yml +++ /dev/null @@ -1,180 +0,0 @@ -# This Travis job script has been generated by a script via -# -# haskell-ci '--config=cabal.haskell-ci' 'cabal.project' -# -# To regenerate the script (for example after adjusting tested-with) run -# -# haskell-ci regenerate -# -# For more information, see https://github.com/haskell-CI/haskell-ci -# -# version: 0.10.1 -# -version: ~> 1.0 -language: c -os: linux -dist: xenial -git: - # whether to recursively clone submodules - submodules: false -branches: - only: - - master -cache: - directories: - - $HOME/.cabal/packages - - $HOME/.cabal/store - - $HOME/.hlint -before_cache: - - rm -fv $CABALHOME/packages/hackage.haskell.org/build-reports.log - # remove files that are regenerated by 'cabal update' - - rm -fv $CABALHOME/packages/hackage.haskell.org/00-index.* - - rm -fv $CABALHOME/packages/hackage.haskell.org/*.json - - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.cache - - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar - - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar.idx - - rm -rfv $CABALHOME/packages/head.hackage -jobs: - include: - - compiler: ghc-8.10.1 - addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.10.1","cabal-install-3.2"]}} - os: linux - - compiler: ghc-8.8.3 - addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.8.3","cabal-install-3.2"]}} - os: linux - - compiler: ghc-8.6.5 - addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.6.5","cabal-install-3.2"]}} - os: linux - - compiler: ghc-8.4.4 - addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.4.4","cabal-install-3.2"]}} - os: linux - - compiler: ghc-8.2.2 - addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.2.2","cabal-install-3.2"]}} - os: linux - - compiler: ghc-8.0.2 - addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.0.2","cabal-install-3.2"]}} - os: linux - - compiler: ghc-7.10.3 - addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-7.10.3","cabal-install-3.2"]}} - os: linux - - compiler: ghc-7.8.4 - addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-7.8.4","cabal-install-3.2"]}} - os: linux -before_install: - - HC=$(echo "/opt/$CC/bin/ghc" | sed 's/-/\//') - - WITHCOMPILER="-w $HC" - - HADDOCK=$(echo "/opt/$CC/bin/haddock" | sed 's/-/\//') - - HCPKG="$HC-pkg" - - unset CC - - CABAL=/opt/ghc/bin/cabal - - CABALHOME=$HOME/.cabal - - export PATH="$CABALHOME/bin:$PATH" - - TOP=$(pwd) - - "HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\\d+)\\.(\\d+)\\.(\\d+)(\\.(\\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')" - - echo $HCNUMVER - - CABAL="$CABAL -vnormal+nowrap" - - set -o pipefail - - TEST=--enable-tests - - BENCH=--enable-benchmarks - - HEADHACKAGE=false - - rm -f $CABALHOME/config - - | - echo "verbose: normal +nowrap +markoutput" >> $CABALHOME/config - echo "remote-build-reporting: anonymous" >> $CABALHOME/config - echo "write-ghc-environment-files: always" >> $CABALHOME/config - echo "remote-repo-cache: $CABALHOME/packages" >> $CABALHOME/config - echo "logs-dir: $CABALHOME/logs" >> $CABALHOME/config - echo "world-file: $CABALHOME/world" >> $CABALHOME/config - echo "extra-prog-path: $CABALHOME/bin" >> $CABALHOME/config - echo "symlink-bindir: $CABALHOME/bin" >> $CABALHOME/config - echo "installdir: $CABALHOME/bin" >> $CABALHOME/config - echo "build-summary: $CABALHOME/logs/build.log" >> $CABALHOME/config - echo "store-dir: $CABALHOME/store" >> $CABALHOME/config - echo "install-dirs user" >> $CABALHOME/config - echo " prefix: $CABALHOME" >> $CABALHOME/config - echo "repository hackage.haskell.org" >> $CABALHOME/config - echo " url: http://hackage.haskell.org/" >> $CABALHOME/config -install: - - ${CABAL} --version - - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]" - - | - echo "program-default-options" >> $CABALHOME/config - echo " ghc-options: $GHCJOBS +RTS -M6G -RTS" >> $CABALHOME/config - - cat $CABALHOME/config - - rm -fv cabal.project cabal.project.local cabal.project.freeze - - travis_retry ${CABAL} v2-update -v - # Generate cabal.project - - rm -rf cabal.project cabal.project.local cabal.project.freeze - - touch cabal.project - - | - echo "packages: ." >> cabal.project - echo "packages: samples" >> cabal.project - - if [ $HCNUMVER -ge 80200 ] ; then echo 'package github' >> cabal.project ; fi - - "if [ $HCNUMVER -ge 80200 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" - - if [ $HCNUMVER -ge 80200 ] ; then echo 'package github-samples' >> cabal.project ; fi - - "if [ $HCNUMVER -ge 80200 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" - - | - echo "constraints: hashable ^>=1.3" >> cabal.project - echo "constraints: semigroups ^>=0.19" >> cabal.project - echo "constraints: github +openssl" >> cabal.project - echo "constraints: github-samples +openssl" >> cabal.project - echo "optimization: False" >> cabal.project - - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(github|github-samples)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" - - cat cabal.project || true - - cat cabal.project.local || true - - if [ -f "./configure.ac" ]; then (cd "." && autoreconf -i); fi - - if [ -f "samples/configure.ac" ]; then (cd "samples" && autoreconf -i); fi - - ${CABAL} v2-freeze $WITHCOMPILER ${TEST} ${BENCH} - - "cat cabal.project.freeze | sed -E 's/^(constraints: *| *)//' | sed 's/any.//'" - - rm cabal.project.freeze - - travis_wait 40 ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} --dep -j2 all - - travis_wait 40 ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks --dep -j2 all -script: - - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX) - # Packaging... - - ${CABAL} v2-sdist all - # Unpacking... - - mv dist-newstyle/sdist/*.tar.gz ${DISTDIR}/ - - cd ${DISTDIR} || false - - find . -maxdepth 1 -type f -name '*.tar.gz' -exec tar -xvf '{}' \; - - find . -maxdepth 1 -type f -name '*.tar.gz' -exec rm '{}' \; - - PKGDIR_github="$(find . -maxdepth 1 -type d -regex '.*/github-[0-9.]*')" - - PKGDIR_github_samples="$(find . -maxdepth 1 -type d -regex '.*/github-samples-[0-9.]*')" - # Generate cabal.project - - rm -rf cabal.project cabal.project.local cabal.project.freeze - - touch cabal.project - - | - echo "packages: ${PKGDIR_github}" >> cabal.project - echo "packages: ${PKGDIR_github_samples}" >> cabal.project - - if [ $HCNUMVER -ge 80200 ] ; then echo 'package github' >> cabal.project ; fi - - "if [ $HCNUMVER -ge 80200 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" - - if [ $HCNUMVER -ge 80200 ] ; then echo 'package github-samples' >> cabal.project ; fi - - "if [ $HCNUMVER -ge 80200 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" - - | - echo "constraints: hashable ^>=1.3" >> cabal.project - echo "constraints: semigroups ^>=0.19" >> cabal.project - echo "constraints: github +openssl" >> cabal.project - echo "constraints: github-samples +openssl" >> cabal.project - echo "optimization: False" >> cabal.project - - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(github|github-samples)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" - - cat cabal.project || true - - cat cabal.project.local || true - # Building... - # this builds all libraries and executables (without tests/benchmarks) - - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all - # Building with tests and benchmarks... - # build & run tests, build benchmarks - - ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} all - # Testing... - - ${CABAL} v2-test $WITHCOMPILER ${TEST} ${BENCH} all - # cabal check... - - (cd ${PKGDIR_github} && ${CABAL} -vnormal check) - - (cd ${PKGDIR_github_samples} && ${CABAL} -vnormal check) - # haddock... - - if [ $HCNUMVER -ge 80600 ] ; then ${CABAL} v2-haddock $WITHCOMPILER --with-haddock $HADDOCK ${TEST} ${BENCH} all ; fi - # Building without installed constraints for packages in global-db... - - rm -f cabal.project.local - - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all - -# REGENDATA ("0.10.1",["--config=cabal.haskell-ci","cabal.project"]) -# EOF From c7960f4eea56365bf10239a61ebc45b7ce24cc9d Mon Sep 17 00:00:00 2001 From: MATSUBARA Nobutada Date: Thu, 31 Dec 2020 01:20:48 +0900 Subject: [PATCH 429/510] Add endpoint to create gist --- src/GitHub.hs | 2 +- src/GitHub/Data/Gists.hs | 29 +++++++++++++++++++++++++++++ src/GitHub/Endpoints/Gists.hs | 6 ++++++ 3 files changed, 36 insertions(+), 1 deletion(-) diff --git a/src/GitHub.hs b/src/GitHub.hs index 6b5f8d36..e00a53cb 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -62,7 +62,6 @@ module GitHub ( -- Missing endpoints: -- -- * Query a specific revision of a gist - -- * Create a gist -- * Edit a gist -- * List gist commits -- * Check if a gist is starred @@ -70,6 +69,7 @@ module GitHub ( -- * List gist forks gistsR, gistR, + createGistR, starGistR, unstarGistR, deleteGistR, diff --git a/src/GitHub/Data/Gists.hs b/src/GitHub/Data/Gists.hs index 3e1fbe79..04c98bae 100644 --- a/src/GitHub/Data/Gists.hs +++ b/src/GitHub/Data/Gists.hs @@ -89,3 +89,32 @@ instance FromJSON GistComment where <*> o .: "body" <*> o .: "updated_at" <*> o .: "id" + +data NewGist = NewGist + { newGistDescription :: !Text + , newGistFiles :: !(HashMap Text NewGistFile) + , newGistPublic :: !Bool + } deriving (Show, Data, Typeable, Eq, Generic) + +instance NFData NewGist where rnf = genericRnf +instance Binary NewGist + +instance ToJSON NewGist where + toJSON (NewGist { newGistDescription = description + , newGistFiles = files + , newGistPublic = public + }) = object + [ "description" .= description + , "files" .= files + , "public" .= public + ] + +data NewGistFile = NewGistFile + { newGistFileContent :: !Text + } deriving (Show, Data, Typeable, Eq, Generic) + +instance NFData NewGistFile where rnf = genericRnf +instance Binary NewGistFile + +instance ToJSON NewGistFile where + toJSON (NewGistFile c) = object ["content" .= c] diff --git a/src/GitHub/Endpoints/Gists.hs b/src/GitHub/Endpoints/Gists.hs index 783e0588..de8e6c20 100644 --- a/src/GitHub/Endpoints/Gists.hs +++ b/src/GitHub/Endpoints/Gists.hs @@ -7,6 +7,7 @@ module GitHub.Endpoints.Gists ( gistsR, gistR, + createGistR, starGistR, unstarGistR, deleteGistR, @@ -28,6 +29,11 @@ gistR :: Name Gist -> Request k Gist gistR gid = query ["gists", toPathPart gid] [] +-- | Create a new gist +-- See +createGistR :: NewGist -> Request 'RW Gist +createGistR ngist = command Post ["gists"] (encode ngist) + -- | Star a gist by the authenticated user. -- See starGistR :: Name Gist -> GenRequest 'MtUnit 'RW () From 91424a994ab2a3c353e5356e065c341c3c638b83 Mon Sep 17 00:00:00 2001 From: MATSUBARA Nobutada Date: Fri, 1 Jan 2021 12:30:19 +0900 Subject: [PATCH 430/510] Refactor: remove brackets that are redundant --- src/GitHub/Data/Gists.hs | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/GitHub/Data/Gists.hs b/src/GitHub/Data/Gists.hs index 04c98bae..b9402943 100644 --- a/src/GitHub/Data/Gists.hs +++ b/src/GitHub/Data/Gists.hs @@ -100,14 +100,14 @@ instance NFData NewGist where rnf = genericRnf instance Binary NewGist instance ToJSON NewGist where - toJSON (NewGist { newGistDescription = description - , newGistFiles = files - , newGistPublic = public - }) = object - [ "description" .= description - , "files" .= files - , "public" .= public - ] + toJSON NewGist { newGistDescription = description + , newGistFiles = files + , newGistPublic = public + } = object + [ "description" .= description + , "files" .= files + , "public" .= public + ] data NewGistFile = NewGistFile { newGistFileContent :: !Text From c44824bb6c41aad7fc9ac59e4686e138c9d67066 Mon Sep 17 00:00:00 2001 From: MATSUBARA Nobutada Date: Fri, 1 Jan 2021 15:10:37 +0900 Subject: [PATCH 431/510] Fix: use Maybe a for optional params with filter notNull --- src/GitHub/Data/Gists.hs | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/src/GitHub/Data/Gists.hs b/src/GitHub/Data/Gists.hs index b9402943..b6d1b673 100644 --- a/src/GitHub/Data/Gists.hs +++ b/src/GitHub/Data/Gists.hs @@ -91,9 +91,9 @@ instance FromJSON GistComment where <*> o .: "id" data NewGist = NewGist - { newGistDescription :: !Text + { newGistDescription :: !(Maybe Text) , newGistFiles :: !(HashMap Text NewGistFile) - , newGistPublic :: !Bool + , newGistPublic :: !(Maybe Bool) } deriving (Show, Data, Typeable, Eq, Generic) instance NFData NewGist where rnf = genericRnf @@ -103,11 +103,14 @@ instance ToJSON NewGist where toJSON NewGist { newGistDescription = description , newGistFiles = files , newGistPublic = public - } = object + } = object $ filter notNull [ "description" .= description , "files" .= files , "public" .= public ] + where + notNull (_, Null) = False + notNull (_, _) = True data NewGistFile = NewGistFile { newGistFileContent :: !Text From bf5f8fd3828698b28f5c307af6cc21ffe9fffb5b Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sat, 6 Mar 2021 23:34:15 +0200 Subject: [PATCH 432/510] Allow base-4.15 --- .github/workflows/haskell-ci.yml | 47 +++++++++++++++++++++++--------- cabal.project | 4 +++ github.cabal | 9 +++--- samples/github-samples.cabal | 5 ++-- 4 files changed, 46 insertions(+), 19 deletions(-) diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index 2dd020d0..637021b1 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -8,9 +8,9 @@ # # For more information, see https://github.com/haskell-CI/haskell-ci # -# version: 0.11.20201213 +# version: 0.11.20210222 # -# REGENDATA ("0.11.20201213",["--config=cabal.haskell-ci","github","cabal.project"]) +# REGENDATA ("0.11.20210222",["--config=cabal.haskell-ci","github","cabal.project"]) # name: Haskell-CI on: @@ -22,21 +22,32 @@ on: - master jobs: linux: - name: Haskell-CI Linux + name: Haskell-CI - Linux - GHC ${{ matrix.ghc }} runs-on: ubuntu-18.04 container: image: buildpack-deps:bionic + continue-on-error: ${{ matrix.allow-failure }} strategy: matrix: include: - - ghc: 8.10.1 - - ghc: 8.8.3 + - ghc: 9.0.1 + allow-failure: false + - ghc: 8.10.4 + allow-failure: false + - ghc: 8.8.4 + allow-failure: false - ghc: 8.6.5 + allow-failure: false - ghc: 8.4.4 + allow-failure: false - ghc: 8.2.2 + allow-failure: false - ghc: 8.0.2 + allow-failure: false - ghc: 7.10.3 + allow-failure: false - ghc: 7.8.4 + allow-failure: false fail-fast: false steps: - name: apt @@ -45,7 +56,7 @@ jobs: apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common apt-add-repository -y 'ppa:hvr/ghc' apt-get update - apt-get install -y ghc-$GHC_VERSION cabal-install-3.2 + apt-get install -y ghc-$GHC_VERSION cabal-install-3.4 env: GHC_VERSION: ${{ matrix.ghc }} - name: Set PATH and environment variables @@ -58,12 +69,13 @@ jobs: echo "HC=$HC" >> $GITHUB_ENV echo "HCPKG=/opt/ghc/$GHC_VERSION/bin/ghc-pkg" >> $GITHUB_ENV echo "HADDOCK=/opt/ghc/$GHC_VERSION/bin/haddock" >> $GITHUB_ENV - echo "CABAL=/opt/cabal/3.2/bin/cabal -vnormal+nowrap" >> $GITHUB_ENV + echo "CABAL=/opt/cabal/3.4/bin/cabal -vnormal+nowrap" >> $GITHUB_ENV HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))') echo "HCNUMVER=$HCNUMVER" >> $GITHUB_ENV echo "ARG_TESTS=--enable-tests" >> $GITHUB_ENV echo "ARG_BENCH=--enable-benchmarks" >> $GITHUB_ENV - echo "ARG_COMPILER=--ghc --with-compiler=/opt/ghc/$GHC_VERSION/bin/ghc" >> $GITHUB_ENV + echo "HEADHACKAGE=false" >> $GITHUB_ENV + echo "ARG_COMPILER=--ghc --with-compiler=$HC" >> $GITHUB_ENV echo "GHCJSARITH=0" >> $GITHUB_ENV env: GHC_VERSION: ${{ matrix.ghc }} @@ -75,7 +87,7 @@ jobs: mkdir -p $CABAL_DIR cat >> $CABAL_CONFIG < $HOME/.cabal/bin/cabal-plan rm -f cabal-plan.xz chmod a+x $HOME/.cabal/bin/cabal-plan + cabal-plan --version - name: checkout uses: actions/checkout@v2 with: path: source + - name: initial cabal.project for sdist + run: | + touch cabal.project + echo "packages: $GITHUB_WORKSPACE/source/." >> cabal.project + echo "packages: $GITHUB_WORKSPACE/source/samples" >> cabal.project + cat cabal.project - name: sdist run: | mkdir -p sdist - cd source || false $CABAL sdist all --output-dir $GITHUB_WORKSPACE/sdist - name: unpack run: | @@ -138,6 +156,9 @@ jobs: constraints: semigroups ^>=0.19 constraints: github +openssl constraints: github-samples +openssl + allow-newer: deepseq-generics-0.2.0.0:base + allow-newer: deepseq-generics-0.2.0.0:ghc-prim + allow-newer: cryptohash-sha1-0.11.100.1:base optimization: False EOF $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: $_ installed\n" unless /^(github|github-samples)$/; }' >> cabal.project.local @@ -155,14 +176,14 @@ jobs: restore-keys: ${{ runner.os }}-${{ matrix.ghc }}- - name: install dependencies run: | - $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --dependencies-only all - $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dependencies-only all + $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --dependencies-only -j2 all + $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dependencies-only -j2 all - name: build w/o tests run: | $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all - name: build run: | - $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH all + $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --write-ghc-environment-files=always - name: tests run: | $CABAL v2-test $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --test-show-details=direct diff --git a/cabal.project b/cabal.project index 555119f5..5e40418a 100644 --- a/cabal.project +++ b/cabal.project @@ -9,3 +9,7 @@ constraints: semigroups ^>=0.19 constraints: github +openssl constraints: github-samples +openssl + +allow-newer: deepseq-generics-0.2.0.0:base +allow-newer: deepseq-generics-0.2.0.0:ghc-prim +allow-newer: cryptohash-sha1-0.11.100.1:base diff --git a/github.cabal b/github.cabal index 1b4f2e40..348a9345 100644 --- a/github.cabal +++ b/github.cabal @@ -27,7 +27,7 @@ maintainer: Oleg Grenrus homepage: https://github.com/phadej/github build-type: Simple copyright: - Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016-2019 Oleg Grenrus + Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016-2021 Oleg Grenrus tested-with: GHC ==7.8.4 @@ -36,8 +36,9 @@ tested-with: || ==8.2.2 || ==8.4.4 || ==8.6.5 - || ==8.8.3 - || ==8.10.1 + || ==8.8.4 + || ==8.10.4 + || ==9.0.1 extra-source-files: README.md @@ -164,7 +165,7 @@ library -- Packages bundles with GHC, mtl and text are also here build-depends: - base >=4.7 && <4.15 + base >=4.7 && <4.16 , binary >=0.7.1.0 && <0.11 , bytestring >=0.10.4.0 && <0.11 , containers >=0.5.5.1 && <0.7 diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index 41d6dccf..270609d7 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -15,8 +15,9 @@ tested-with: || ==8.2.2 || ==8.4.4 || ==8.6.5 - || ==8.8.3 - || ==8.10.1 + || ==8.8.4 + || ==8.10.4 + || ==9.0.1 library hs-source-dirs: src From 492735656d6a8efa4bf0ec4ce4cca1855327d78c Mon Sep 17 00:00:00 2001 From: Gautier DI FOLCO Date: Mon, 13 Sep 2021 18:51:27 +0200 Subject: [PATCH 433/510] Update RepoWebhookEvent --- src/GitHub/Data/Webhooks.hs | 52 +++++++++++++++++++++++++++---------- 1 file changed, 38 insertions(+), 14 deletions(-) diff --git a/src/GitHub/Data/Webhooks.hs b/src/GitHub/Data/Webhooks.hs index fb81969d..8ca2fe8e 100644 --- a/src/GitHub/Data/Webhooks.hs +++ b/src/GitHub/Data/Webhooks.hs @@ -35,6 +35,7 @@ data RepoWebhookEvent = WebhookWildcardEvent | WebhookCheckRunEvent | WebhookCheckSuiteEvent + | WebhookCodeScanningAlert | WebhookCommitCommentEvent | WebhookContentReferenceEvent | WebhookCreateEvent @@ -42,12 +43,13 @@ data RepoWebhookEvent | WebhookDeployKeyEvent | WebhookDeploymentEvent | WebhookDeploymentStatusEvent + | WebhookDiscussion + | WebhookDiscussionComment | WebhookDownloadEvent | WebhookFollowEvent | WebhookForkEvent - | WebhookForkApplyEvent - | WebhookGitHubAppAuthorizationEvent | WebhookGistEvent + | WebhookGitHubAppAuthorizationEvent | WebhookGollumEvent | WebhookInstallationEvent | WebhookInstallationRepositoriesEvent @@ -59,8 +61,9 @@ data RepoWebhookEvent | WebhookMembershipEvent | WebhookMetaEvent | WebhookMilestoneEvent - | WebhookOrganizationEvent | WebhookOrgBlockEvent + | WebhookOrganizationEvent + | WebhookPackage | WebhookPageBuildEvent | WebhookPingEvent | WebhookProjectCardEvent @@ -68,20 +71,25 @@ data RepoWebhookEvent | WebhookProjectEvent | WebhookPublicEvent | WebhookPullRequestEvent - | WebhookPullRequestReviewEvent | WebhookPullRequestReviewCommentEvent + | WebhookPullRequestReviewEvent | WebhookPushEvent | WebhookRegistryPackageEvent | WebhookReleaseEvent + | WebhookRepositoryDispatch | WebhookRepositoryEvent | WebhookRepositoryImportEvent | WebhookRepositoryVulnerabilityAlertEvent + | WebhookSecretScanningAlert | WebhookSecurityAdvisoryEvent + | WebhookSponsorship | WebhookStarEvent | WebhookStatusEvent - | WebhookTeamEvent | WebhookTeamAddEvent + | WebhookTeamEvent | WebhookWatchEvent + | WebhookWorkflowDispatch + | WebhookWorkflowRun deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData RepoWebhookEvent where rnf = genericRnf @@ -137,6 +145,7 @@ instance FromJSON RepoWebhookEvent where "*" -> pure WebhookWildcardEvent "check_run" -> pure WebhookCheckRunEvent "check_suite" -> pure WebhookCheckSuiteEvent + "code_scanning_alert" -> pure WebhookCodeScanningAlert "commit_comment" -> pure WebhookCommitCommentEvent "content_reference" -> pure WebhookContentReferenceEvent "create" -> pure WebhookCreateEvent @@ -144,12 +153,13 @@ instance FromJSON RepoWebhookEvent where "deploy_key" -> pure WebhookDeployKeyEvent "deployment" -> pure WebhookDeploymentEvent "deployment_status" -> pure WebhookDeploymentStatusEvent + "discussion" -> pure WebhookDiscussion + "discussion_comment" -> pure WebhookDiscussionComment "download" -> pure WebhookDownloadEvent "follow" -> pure WebhookFollowEvent "fork" -> pure WebhookForkEvent - "fork_apply" -> pure WebhookForkApplyEvent - "github_app_authorization" -> pure WebhookGitHubAppAuthorizationEvent "gist" -> pure WebhookGistEvent + "github_app_authorization" -> pure WebhookGitHubAppAuthorizationEvent "gollum" -> pure WebhookGollumEvent "installation" -> pure WebhookInstallationEvent "installation_repositories" -> pure WebhookInstallationRepositoriesEvent @@ -161,13 +171,14 @@ instance FromJSON RepoWebhookEvent where "membership" -> pure WebhookMembershipEvent "meta" -> pure WebhookMetaEvent "milestone" -> pure WebhookMilestoneEvent - "organization" -> pure WebhookOrganizationEvent "org_block" -> pure WebhookOrgBlockEvent + "organization" -> pure WebhookOrganizationEvent + "package" -> pure WebhookPackage "page_build" -> pure WebhookPageBuildEvent "ping" -> pure WebhookPingEvent + "project" -> pure WebhookProjectEvent "project_card" -> pure WebhookProjectCardEvent "project_column" -> pure WebhookProjectColumnEvent - "project" -> pure WebhookProjectEvent "public" -> pure WebhookPublicEvent "pull_request" -> pure WebhookPullRequestEvent "pull_request_review" -> pure WebhookPullRequestReviewEvent @@ -176,20 +187,26 @@ instance FromJSON RepoWebhookEvent where "registry_package" -> pure WebhookRegistryPackageEvent "release" -> pure WebhookReleaseEvent "repository" -> pure WebhookRepositoryEvent + "repository_dispatch" -> pure WebhookRepositoryDispatch "repository_import" -> pure WebhookRepositoryImportEvent "repository_vulnerability_alert" -> pure WebhookRepositoryVulnerabilityAlertEvent + "secret_scanning_alert" -> pure WebhookSecretScanningAlert "security_advisory" -> pure WebhookSecurityAdvisoryEvent + "sponsorship" -> pure WebhookSponsorship "star" -> pure WebhookStarEvent "status" -> pure WebhookStatusEvent "team" -> pure WebhookTeamEvent "team_add" -> pure WebhookTeamAddEvent "watch" -> pure WebhookWatchEvent + "workflow_dispatch" -> pure WebhookWorkflowDispatch + "workflow_run" -> pure WebhookWorkflowRun _ -> fail $ "Unknown RepoWebhookEvent: " <> T.unpack t instance ToJSON RepoWebhookEvent where toJSON WebhookWildcardEvent = String "*" toJSON WebhookCheckRunEvent = String "check_run" toJSON WebhookCheckSuiteEvent = String "check_suite" + toJSON WebhookCodeScanningAlert = String "code_scanning_alert" toJSON WebhookCommitCommentEvent = String "commit_comment" toJSON WebhookContentReferenceEvent = String "content_reference" toJSON WebhookCreateEvent = String "create" @@ -197,12 +214,13 @@ instance ToJSON RepoWebhookEvent where toJSON WebhookDeployKeyEvent = String "deploy_key" toJSON WebhookDeploymentEvent = String "deployment" toJSON WebhookDeploymentStatusEvent = String "deployment_status" + toJSON WebhookDiscussion = String "discussion" + toJSON WebhookDiscussionComment = String "discussion_comment" toJSON WebhookDownloadEvent = String "download" toJSON WebhookFollowEvent = String "follow" toJSON WebhookForkEvent = String "fork" - toJSON WebhookForkApplyEvent = String "fork_apply" - toJSON WebhookGitHubAppAuthorizationEvent = String "github_app_authorization" toJSON WebhookGistEvent = String "gist" + toJSON WebhookGitHubAppAuthorizationEvent = String "github_app_authorization" toJSON WebhookGollumEvent = String "gollum" toJSON WebhookInstallationEvent = String "installation" toJSON WebhookInstallationRepositoriesEvent = String "installation_repositories" @@ -214,8 +232,9 @@ instance ToJSON RepoWebhookEvent where toJSON WebhookMembershipEvent = String "membership" toJSON WebhookMetaEvent = String "meta" toJSON WebhookMilestoneEvent = String "milestone" - toJSON WebhookOrganizationEvent = String "organization" toJSON WebhookOrgBlockEvent = String "org_block" + toJSON WebhookOrganizationEvent = String "organization" + toJSON WebhookPackage = String "package" toJSON WebhookPageBuildEvent = String "page_build" toJSON WebhookPingEvent = String "ping" toJSON WebhookProjectCardEvent = String "project_card" @@ -223,20 +242,25 @@ instance ToJSON RepoWebhookEvent where toJSON WebhookProjectEvent = String "project" toJSON WebhookPublicEvent = String "public" toJSON WebhookPullRequestEvent = String "pull_request" - toJSON WebhookPullRequestReviewEvent = String "pull_request_review" toJSON WebhookPullRequestReviewCommentEvent = String "pull_request_review_comment" + toJSON WebhookPullRequestReviewEvent = String "pull_request_review" toJSON WebhookPushEvent = String "push" toJSON WebhookRegistryPackageEvent = String "registry_package" toJSON WebhookReleaseEvent = String "release" + toJSON WebhookRepositoryDispatch = String "repository_dispatch" toJSON WebhookRepositoryEvent = String "repository" toJSON WebhookRepositoryImportEvent = String "repository_import" toJSON WebhookRepositoryVulnerabilityAlertEvent = String "repository_vulnerability_alert" + toJSON WebhookSecretScanningAlert = String "secret_scanning_alert" toJSON WebhookSecurityAdvisoryEvent = String "security_advisory" + toJSON WebhookSponsorship = String "sponsorship" toJSON WebhookStarEvent = String "star" toJSON WebhookStatusEvent = String "status" - toJSON WebhookTeamEvent = String "team" toJSON WebhookTeamAddEvent = String "team_add" + toJSON WebhookTeamEvent = String "team" toJSON WebhookWatchEvent = String "watch" + toJSON WebhookWorkflowDispatch = String "workflow_dispatch" + toJSON WebhookWorkflowRun = String "workflow_run" instance FromJSON RepoWebhook where parseJSON = withObject "RepoWebhook" $ \o -> RepoWebhook From 2d3bd03f72e5640ff9a7708d3ef35890dbdce998 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sun, 10 Oct 2021 00:27:27 +0300 Subject: [PATCH 434/510] Regenerate CI --- .github/workflows/haskell-ci.yml | 101 ++++++++++++++++++++----------- 1 file changed, 67 insertions(+), 34 deletions(-) diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index 637021b1..f70f1749 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -8,9 +8,9 @@ # # For more information, see https://github.com/haskell-CI/haskell-ci # -# version: 0.11.20210222 +# version: 0.13.20210827 # -# REGENDATA ("0.11.20210222",["--config=cabal.haskell-ci","github","cabal.project"]) +# REGENDATA ("0.13.20210827",["--config=cabal.haskell-ci","github","cabal.project"]) # name: Haskell-CI on: @@ -22,7 +22,7 @@ on: - master jobs: linux: - name: Haskell-CI - Linux - GHC ${{ matrix.ghc }} + name: Haskell-CI - Linux - ${{ matrix.compiler }} runs-on: ubuntu-18.04 container: image: buildpack-deps:bionic @@ -30,55 +30,87 @@ jobs: strategy: matrix: include: - - ghc: 9.0.1 + - compiler: ghc-9.0.1 + compilerKind: ghc + compilerVersion: 9.0.1 + setup-method: hvr-ppa allow-failure: false - - ghc: 8.10.4 + - compiler: ghc-8.10.4 + compilerKind: ghc + compilerVersion: 8.10.4 + setup-method: hvr-ppa allow-failure: false - - ghc: 8.8.4 + - compiler: ghc-8.8.4 + compilerKind: ghc + compilerVersion: 8.8.4 + setup-method: hvr-ppa allow-failure: false - - ghc: 8.6.5 + - compiler: ghc-8.6.5 + compilerKind: ghc + compilerVersion: 8.6.5 + setup-method: hvr-ppa allow-failure: false - - ghc: 8.4.4 + - compiler: ghc-8.4.4 + compilerKind: ghc + compilerVersion: 8.4.4 + setup-method: hvr-ppa allow-failure: false - - ghc: 8.2.2 + - compiler: ghc-8.2.2 + compilerKind: ghc + compilerVersion: 8.2.2 + setup-method: hvr-ppa allow-failure: false - - ghc: 8.0.2 + - compiler: ghc-8.0.2 + compilerKind: ghc + compilerVersion: 8.0.2 + setup-method: hvr-ppa allow-failure: false - - ghc: 7.10.3 + - compiler: ghc-7.10.3 + compilerKind: ghc + compilerVersion: 7.10.3 + setup-method: hvr-ppa allow-failure: false - - ghc: 7.8.4 + - compiler: ghc-7.8.4 + compilerKind: ghc + compilerVersion: 7.8.4 + setup-method: hvr-ppa allow-failure: false fail-fast: false steps: - name: apt run: | apt-get update - apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common + apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5 apt-add-repository -y 'ppa:hvr/ghc' apt-get update - apt-get install -y ghc-$GHC_VERSION cabal-install-3.4 + apt-get install -y "$HCNAME" cabal-install-3.4 env: - GHC_VERSION: ${{ matrix.ghc }} + HCKIND: ${{ matrix.compilerKind }} + HCNAME: ${{ matrix.compiler }} + HCVER: ${{ matrix.compilerVersion }} - name: Set PATH and environment variables run: | echo "$HOME/.cabal/bin" >> $GITHUB_PATH - echo "LANG=C.UTF-8" >> $GITHUB_ENV - echo "CABAL_DIR=$HOME/.cabal" >> $GITHUB_ENV - echo "CABAL_CONFIG=$HOME/.cabal/config" >> $GITHUB_ENV - HC=/opt/ghc/$GHC_VERSION/bin/ghc - echo "HC=$HC" >> $GITHUB_ENV - echo "HCPKG=/opt/ghc/$GHC_VERSION/bin/ghc-pkg" >> $GITHUB_ENV - echo "HADDOCK=/opt/ghc/$GHC_VERSION/bin/haddock" >> $GITHUB_ENV - echo "CABAL=/opt/cabal/3.4/bin/cabal -vnormal+nowrap" >> $GITHUB_ENV + echo "LANG=C.UTF-8" >> "$GITHUB_ENV" + echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV" + echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV" + HCDIR=/opt/$HCKIND/$HCVER + HC=$HCDIR/bin/$HCKIND + echo "HC=$HC" >> "$GITHUB_ENV" + echo "HCPKG=$HCDIR/bin/$HCKIND-pkg" >> "$GITHUB_ENV" + echo "HADDOCK=$HCDIR/bin/haddock" >> "$GITHUB_ENV" + echo "CABAL=/opt/cabal/3.4/bin/cabal -vnormal+nowrap" >> "$GITHUB_ENV" HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))') - echo "HCNUMVER=$HCNUMVER" >> $GITHUB_ENV - echo "ARG_TESTS=--enable-tests" >> $GITHUB_ENV - echo "ARG_BENCH=--enable-benchmarks" >> $GITHUB_ENV - echo "HEADHACKAGE=false" >> $GITHUB_ENV - echo "ARG_COMPILER=--ghc --with-compiler=$HC" >> $GITHUB_ENV - echo "GHCJSARITH=0" >> $GITHUB_ENV + echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV" + echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV" + echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV" + echo "HEADHACKAGE=false" >> "$GITHUB_ENV" + echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV" + echo "GHCJSARITH=0" >> "$GITHUB_ENV" env: - GHC_VERSION: ${{ matrix.ghc }} + HCKIND: ${{ matrix.compilerKind }} + HCNAME: ${{ matrix.compiler }} + HCVER: ${{ matrix.compilerVersion }} - name: env run: | env @@ -140,9 +172,10 @@ jobs: - name: generate cabal.project run: | PKGDIR_github="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/github-[0-9.]*')" - echo "PKGDIR_github=${PKGDIR_github}" >> $GITHUB_ENV + echo "PKGDIR_github=${PKGDIR_github}" >> "$GITHUB_ENV" PKGDIR_github_samples="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/github-samples-[0-9.]*')" - echo "PKGDIR_github_samples=${PKGDIR_github_samples}" >> $GITHUB_ENV + echo "PKGDIR_github_samples=${PKGDIR_github_samples}" >> "$GITHUB_ENV" + rm -f cabal.project cabal.project.local touch cabal.project touch cabal.project.local echo "packages: ${PKGDIR_github}" >> cabal.project @@ -171,9 +204,9 @@ jobs: - name: cache uses: actions/cache@v2 with: - key: ${{ runner.os }}-${{ matrix.ghc }}-${{ github.sha }} + key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }} path: ~/.cabal/store - restore-keys: ${{ runner.os }}-${{ matrix.ghc }}- + restore-keys: ${{ runner.os }}-${{ matrix.compiler }}- - name: install dependencies run: | $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --dependencies-only -j2 all From a9656e92a8312e08df9a5f0000e6d1c8bd32d4fa Mon Sep 17 00:00:00 2001 From: sanjiv sahayam Date: Mon, 3 Aug 2020 09:28:54 +1000 Subject: [PATCH 435/510] Fix decoding of optional submitted_at field in review --- fixtures/pull-request-approved-review.json | 38 ++++++++++++++++++++++ fixtures/pull-request-pending-review.json | 37 +++++++++++++++++++++ github.cabal | 1 + spec/GitHub/ReviewDecodeSpec.hs | 25 ++++++++++++++ src/GitHub/Data/Reviews.hs | 12 +++---- 5 files changed, 107 insertions(+), 6 deletions(-) create mode 100644 fixtures/pull-request-approved-review.json create mode 100644 fixtures/pull-request-pending-review.json create mode 100644 spec/GitHub/ReviewDecodeSpec.hs diff --git a/fixtures/pull-request-approved-review.json b/fixtures/pull-request-approved-review.json new file mode 100644 index 00000000..d675f9af --- /dev/null +++ b/fixtures/pull-request-approved-review.json @@ -0,0 +1,38 @@ +{ + "id": 80, + "node_id": "MDE3OlB1bGxSZXF1ZXN0UmV2aWV3ODA=", + "user": { + "login": "octocat", + "id": 1, + "node_id": "MDQ6VXNlcjE=", + "avatar_url": "https://github.com/images/error/octocat_happy.gif", + "gravatar_id": "", + "url": "https://api.github.com/users/octocat", + "html_url": "https://github.com/octocat", + "followers_url": "https://api.github.com/users/octocat/followers", + "following_url": "https://api.github.com/users/octocat/following{/other_user}", + "gists_url": "https://api.github.com/users/octocat/gists{/gist_id}", + "starred_url": "https://api.github.com/users/octocat/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/octocat/subscriptions", + "organizations_url": "https://api.github.com/users/octocat/orgs", + "repos_url": "https://api.github.com/users/octocat/repos", + "events_url": "https://api.github.com/users/octocat/events{/privacy}", + "received_events_url": "https://api.github.com/users/octocat/received_events", + "type": "User", + "site_admin": false + }, + "body": "Here is the body for the review.", + "state": "APPROVED", + "html_url": "https://github.com/octocat/Hello-World/pull/12#pullrequestreview-80", + "pull_request_url": "https://api.github.com/repos/octocat/Hello-World/pulls/12", + "_links": { + "html": { + "href": "https://github.com/octocat/Hello-World/pull/12#pullrequestreview-80" + }, + "pull_request": { + "href": "https://api.github.com/repos/octocat/Hello-World/pulls/12" + } + }, + "submitted_at": "2019-11-17T17:43:43Z", + "commit_id": "ecdd80bb57125d7ba9641ffaa4d7d2c19d3f3091" +} \ No newline at end of file diff --git a/fixtures/pull-request-pending-review.json b/fixtures/pull-request-pending-review.json new file mode 100644 index 00000000..bea632a7 --- /dev/null +++ b/fixtures/pull-request-pending-review.json @@ -0,0 +1,37 @@ +{ + "id": 80, + "node_id": "MDE3OlB1bGxSZXF1ZXN0UmV2aWV3ODA=", + "user": { + "login": "octocat", + "id": 1, + "node_id": "MDQ6VXNlcjE=", + "avatar_url": "https://github.com/images/error/octocat_happy.gif", + "gravatar_id": "", + "url": "https://api.github.com/users/octocat", + "html_url": "https://github.com/octocat", + "followers_url": "https://api.github.com/users/octocat/followers", + "following_url": "https://api.github.com/users/octocat/following{/other_user}", + "gists_url": "https://api.github.com/users/octocat/gists{/gist_id}", + "starred_url": "https://api.github.com/users/octocat/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/octocat/subscriptions", + "organizations_url": "https://api.github.com/users/octocat/orgs", + "repos_url": "https://api.github.com/users/octocat/repos", + "events_url": "https://api.github.com/users/octocat/events{/privacy}", + "received_events_url": "https://api.github.com/users/octocat/received_events", + "type": "User", + "site_admin": false + }, + "body": "Here is the body for the review.", + "state": "PENDING", + "html_url": "https://github.com/octocat/Hello-World/pull/12#pullrequestreview-80", + "pull_request_url": "https://api.github.com/repos/octocat/Hello-World/pulls/12", + "_links": { + "html": { + "href": "https://github.com/octocat/Hello-World/pull/12#pullrequestreview-80" + }, + "pull_request": { + "href": "https://api.github.com/repos/octocat/Hello-World/pulls/12" + } + }, + "commit_id": "ecdd80bb57125d7ba9641ffaa4d7d2c19d3f3091" +} \ No newline at end of file diff --git a/github.cabal b/github.cabal index 3d2cd03b..8b24a863 100644 --- a/github.cabal +++ b/github.cabal @@ -223,6 +223,7 @@ test-suite github-test GitHub.RateLimitSpec GitHub.ReleasesSpec GitHub.ReposSpec + GitHub.ReviewDecodeSpec GitHub.SearchSpec GitHub.UsersSpec diff --git a/spec/GitHub/ReviewDecodeSpec.hs b/spec/GitHub/ReviewDecodeSpec.hs new file mode 100644 index 00000000..76060513 --- /dev/null +++ b/spec/GitHub/ReviewDecodeSpec.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +module GitHub.ReviewDecodeSpec where + +import Data.Aeson (eitherDecodeStrict) +import Data.Either.Compat (isRight) +import Data.FileEmbed (embedFile) +import Test.Hspec + (Spec, describe, it, shouldSatisfy) + +import GitHub.Data (Review) + +spec :: Spec +spec = do + describe "PENDING state" $ do + -- https://docs.github.com/en/rest/reference/pulls#create-a-review-for-a-pull-request + -- > Pull request reviews created in the PENDING state do not include the submitted_at property in the response. + it "decodes review when submitted_at is missing" $ do + let reviewInfo = eitherDecodeStrict $(embedFile "fixtures/pull-request-pending-review.json") :: Either String Review + reviewInfo `shouldSatisfy` isRight + + describe "Other states" $ do + it "decodes review" $ do + let reviewInfo = eitherDecodeStrict $(embedFile "fixtures/pull-request-approved-review.json") :: Either String Review + reviewInfo `shouldSatisfy` isRight diff --git a/src/GitHub/Data/Reviews.hs b/src/GitHub/Data/Reviews.hs index 27278437..72c6f6be 100644 --- a/src/GitHub/Data/Reviews.hs +++ b/src/GitHub/Data/Reviews.hs @@ -35,7 +35,7 @@ data Review = Review { reviewBody :: !Text , reviewCommitId :: !Text , reviewState :: ReviewState - , reviewSubmittedAt :: !UTCTime + , reviewSubmittedAt :: !(Maybe UTCTime) , reviewPullRequestUrl :: !URL , reviewHtmlUrl :: !Text , reviewUser :: !SimpleUser @@ -51,11 +51,11 @@ 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" + o .:? "submitted_at" <*> + o .: "pull_request_url" <*> + o .: "html_url" <*> + o .: "user" <*> + o .: "id" data ReviewComment = ReviewComment { reviewCommentId :: !(Id ReviewComment) From dd3dfbccaf4de4c3095b52fefb52c6b3c961a8f8 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sun, 10 Oct 2021 00:28:23 +0300 Subject: [PATCH 436/510] Support aeson-2.0, and more bound relaxations --- .github/workflows/haskell-ci.yml | 1 + cabal.project | 1 + github.cabal | 6 +++--- src/GitHub/Data/Content.hs | 9 +++++++++ src/GitHub/Internal/Prelude.hs | 1 + 5 files changed, 15 insertions(+), 3 deletions(-) diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index f70f1749..7bddbf8e 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -192,6 +192,7 @@ jobs: allow-newer: deepseq-generics-0.2.0.0:base allow-newer: deepseq-generics-0.2.0.0:ghc-prim allow-newer: cryptohash-sha1-0.11.100.1:base + allow-newer: http-link-header-1.2.0:attoparsec optimization: False EOF $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: $_ installed\n" unless /^(github|github-samples)$/; }' >> cabal.project.local diff --git a/cabal.project b/cabal.project index 5e40418a..0f0cd647 100644 --- a/cabal.project +++ b/cabal.project @@ -13,3 +13,4 @@ constraints: github-samples +openssl allow-newer: deepseq-generics-0.2.0.0:base allow-newer: deepseq-generics-0.2.0.0:ghc-prim allow-newer: cryptohash-sha1-0.11.100.1:base +allow-newer: http-link-header-1.2.0:attoparsec diff --git a/github.cabal b/github.cabal index 3d2cd03b..bf5dd3ba 100644 --- a/github.cabal +++ b/github.cabal @@ -170,8 +170,8 @@ library -- other packages build-depends: - aeson >=1.4.0.0 && <1.6 - , base-compat >=0.11.1 && <0.12 + aeson >=1.4.0.0 && <1.6 || >=2.0.1.0 && <2.1 + , base-compat >=0.11.1 && <0.13 , base16-bytestring >=0.1.1.6 && <1.1 , binary-instances >=1 && <1.1 , cryptohash-sha1 >=0.11.100.1 && <0.12 @@ -184,7 +184,7 @@ library , iso8601-time >=0.1.5 && <0.2 , network-uri >=2.6.1.0 && <2.7 , tagged >=0.8.5 && <0.9 - , transformers-compat >=0.6.5 && <0.7 + , transformers-compat >=0.6.5 && <0.8 , unordered-containers >=0.2.10.0 && <0.3 , vector >=0.12.0.1 && <0.13 , vector-instances >=3.4 && <3.5 diff --git a/src/GitHub/Data/Content.hs b/src/GitHub/Data/Content.hs index 5461ffa0..5580c866 100644 --- a/src/GitHub/Data/Content.hs +++ b/src/GitHub/Data/Content.hs @@ -1,4 +1,5 @@ {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -15,6 +16,10 @@ import Data.Aeson.Types (Pair) import Data.Maybe (maybe) import qualified Data.Text as T +#if MIN_VERSION_aeson(2,0,0) +import Data.Aeson (Key) +#endif + data Content = ContentFile !ContentFileData | ContentDirectory !(Vector ContentItem) @@ -205,5 +210,9 @@ instance ToJSON DeleteFile where ++ "author" .=? deleteFileAuthor ++ "committer" .=? deleteFileCommitter +#if MIN_VERSION_aeson(2,0,0) +(.=?) :: ToJSON v => Key -> Maybe v -> [Pair] +#else (.=?) :: ToJSON v => Text -> Maybe v -> [Pair] +#endif name .=? value = maybe [] (pure . (name .=)) value diff --git a/src/GitHub/Internal/Prelude.hs b/src/GitHub/Internal/Prelude.hs index 8c4785c3..2ac8633c 100644 --- a/src/GitHub/Internal/Prelude.hs +++ b/src/GitHub/Internal/Prelude.hs @@ -1,4 +1,5 @@ {-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause From 25682961a30c6c18869cf00c24c2a44f232d0873 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sun, 10 Oct 2021 17:54:20 +0300 Subject: [PATCH 437/510] Prepare 0.27 --- CHANGELOG.md | 11 +++++++++++ github.cabal | 2 +- 2 files changed, 12 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 991d24c7..eddba7a7 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,14 @@ +## Changes for 0.27 + +- Add vector of SimpleTeam in "requested_teams" field of PullRequest + [#453](https://github.com/phadej/github/pull/453) +- Add endpoint to create gist + [#455](https://github.com/phadej/github/pull/455) +- Update RepoWebhookEvent + [#461](https://github.com/phadej/github/pull/461) +- PullRequest Reviews may not have submitted_at field + [#450](https://github.com/phadej/github/pull/450) + ## Changes for 0.26 - Generalize PagedQuery to allow its reuse by preview github APIs diff --git a/github.cabal b/github.cabal index e3edf30a..c25f94f3 100644 --- a/github.cabal +++ b/github.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: github -version: 0.26 +version: 0.27 synopsis: Access to the GitHub API, v3. category: Network description: From 9df0ad57644a8af9de15e222da233e5e2eba8c61 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sat, 13 Nov 2021 20:25:31 +0200 Subject: [PATCH 438/510] Allow base-4.16, hashable-1.4, bytestring-0.11 --- .github/workflows/haskell-ci.yml | 63 ++++++++++++++++++++++++-------- cabal.project | 5 +-- github.cabal | 14 ++++--- samples/github-samples.cabal | 3 +- 4 files changed, 59 insertions(+), 26 deletions(-) diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index 7bddbf8e..463233e7 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -8,9 +8,9 @@ # # For more information, see https://github.com/haskell-CI/haskell-ci # -# version: 0.13.20210827 +# version: 0.13.20211111 # -# REGENDATA ("0.13.20210827",["--config=cabal.haskell-ci","github","cabal.project"]) +# REGENDATA ("0.13.20211111",["--config=cabal.haskell-ci","github","cabal.project"]) # name: Haskell-CI on: @@ -24,21 +24,28 @@ jobs: linux: name: Haskell-CI - Linux - ${{ matrix.compiler }} runs-on: ubuntu-18.04 + timeout-minutes: + 60 container: image: buildpack-deps:bionic continue-on-error: ${{ matrix.allow-failure }} strategy: matrix: include: + - compiler: ghc-9.2.1 + compilerKind: ghc + compilerVersion: 9.2.1 + setup-method: ghcup + allow-failure: false - compiler: ghc-9.0.1 compilerKind: ghc compilerVersion: 9.0.1 setup-method: hvr-ppa allow-failure: false - - compiler: ghc-8.10.4 + - compiler: ghc-8.10.7 compilerKind: ghc - compilerVersion: 8.10.4 - setup-method: hvr-ppa + compilerVersion: 8.10.7 + setup-method: ghcup allow-failure: false - compiler: ghc-8.8.4 compilerKind: ghc @@ -81,9 +88,21 @@ jobs: run: | apt-get update apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5 - apt-add-repository -y 'ppa:hvr/ghc' - apt-get update - apt-get install -y "$HCNAME" cabal-install-3.4 + if [ "${{ matrix.setup-method }}" = ghcup ]; then + mkdir -p "$HOME/.ghcup/bin" + curl -sL https://downloads.haskell.org/ghcup/0.1.17.3/x86_64-linux-ghcup-0.1.17.3 > "$HOME/.ghcup/bin/ghcup" + chmod a+x "$HOME/.ghcup/bin/ghcup" + "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" + "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0 + else + apt-add-repository -y 'ppa:hvr/ghc' + apt-get update + apt-get install -y "$HCNAME" + mkdir -p "$HOME/.ghcup/bin" + curl -sL https://downloads.haskell.org/ghcup/0.1.17.3/x86_64-linux-ghcup-0.1.17.3 > "$HOME/.ghcup/bin/ghcup" + chmod a+x "$HOME/.ghcup/bin/ghcup" + "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0 + fi env: HCKIND: ${{ matrix.compilerKind }} HCNAME: ${{ matrix.compiler }} @@ -95,11 +114,20 @@ jobs: echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV" echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV" HCDIR=/opt/$HCKIND/$HCVER - HC=$HCDIR/bin/$HCKIND - echo "HC=$HC" >> "$GITHUB_ENV" - echo "HCPKG=$HCDIR/bin/$HCKIND-pkg" >> "$GITHUB_ENV" - echo "HADDOCK=$HCDIR/bin/haddock" >> "$GITHUB_ENV" - echo "CABAL=/opt/cabal/3.4/bin/cabal -vnormal+nowrap" >> "$GITHUB_ENV" + if [ "${{ matrix.setup-method }}" = ghcup ]; then + HC=$HOME/.ghcup/bin/$HCKIND-$HCVER + echo "HC=$HC" >> "$GITHUB_ENV" + echo "HCPKG=$HOME/.ghcup/bin/$HCKIND-pkg-$HCVER" >> "$GITHUB_ENV" + echo "HADDOCK=$HOME/.ghcup/bin/haddock-$HCVER" >> "$GITHUB_ENV" + echo "CABAL=$HOME/.ghcup/bin/cabal-3.6.2.0 -vnormal+nowrap" >> "$GITHUB_ENV" + else + HC=$HCDIR/bin/$HCKIND + echo "HC=$HC" >> "$GITHUB_ENV" + echo "HCPKG=$HCDIR/bin/$HCKIND-pkg" >> "$GITHUB_ENV" + echo "HADDOCK=$HCDIR/bin/haddock" >> "$GITHUB_ENV" + echo "CABAL=$HOME/.ghcup/bin/cabal-3.6.2.0 -vnormal+nowrap" >> "$GITHUB_ENV" + fi + HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))') echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV" echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV" @@ -133,6 +161,10 @@ jobs: repository hackage.haskell.org url: http://hackage.haskell.org/ EOF + cat >> $CABAL_CONFIG <= 80200)) -ne 0 ] ; then echo "package github-samples" >> cabal.project ; fi if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods" >> cabal.project ; fi cat >> cabal.project <=1.3 + constraints: hashable >=1.3 constraints: semigroups ^>=0.19 constraints: github +openssl constraints: github-samples +openssl allow-newer: deepseq-generics-0.2.0.0:base allow-newer: deepseq-generics-0.2.0.0:ghc-prim - allow-newer: cryptohash-sha1-0.11.100.1:base - allow-newer: http-link-header-1.2.0:attoparsec + allow-newer: HsOpenSSL:bytestring optimization: False EOF $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: $_ installed\n" unless /^(github|github-samples)$/; }' >> cabal.project.local diff --git a/cabal.project b/cabal.project index 0f0cd647..b9ac7eb6 100644 --- a/cabal.project +++ b/cabal.project @@ -4,7 +4,7 @@ packages: samples optimization: False tests: True -constraints: hashable ^>=1.3 +constraints: hashable >=1.3 constraints: semigroups ^>=0.19 constraints: github +openssl @@ -12,5 +12,4 @@ constraints: github-samples +openssl allow-newer: deepseq-generics-0.2.0.0:base allow-newer: deepseq-generics-0.2.0.0:ghc-prim -allow-newer: cryptohash-sha1-0.11.100.1:base -allow-newer: http-link-header-1.2.0:attoparsec +allow-newer: HsOpenSSL:bytestring diff --git a/github.cabal b/github.cabal index c25f94f3..e9f0b5bf 100644 --- a/github.cabal +++ b/github.cabal @@ -1,6 +1,7 @@ cabal-version: >=1.10 name: github version: 0.27 +x-revision: 1 synopsis: Access to the GitHub API, v3. category: Network description: @@ -37,8 +38,9 @@ tested-with: || ==8.4.4 || ==8.6.5 || ==8.8.4 - || ==8.10.4 + || ==8.10.7 || ==9.0.1 + || ==9.2.1 extra-source-files: README.md @@ -158,9 +160,9 @@ library -- Packages bundles with GHC, mtl and text are also here build-depends: - base >=4.7 && <4.16 + base >=4.7 && <4.17 , binary >=0.7.1.0 && <0.11 - , bytestring >=0.10.4.0 && <0.11 + , bytestring >=0.10.4.0 && <0.12 , containers >=0.5.5.1 && <0.7 , deepseq >=1.3.0.2 && <1.5 , mtl >=2.1.3.1 && <2.2 || >=2.2.1 && <2.3 @@ -177,7 +179,7 @@ library , cryptohash-sha1 >=0.11.100.1 && <0.12 , deepseq-generics >=0.2.0.0 && <0.3 , exceptions >=0.10.2 && <0.11 - , hashable >=1.2.7.0 && <1.4 + , hashable >=1.2.7.0 && <1.5 , http-client >=0.5.12 && <0.8 , http-link-header >=1.0.3.1 && <1.3 , http-types >=0.12.3 && <0.13 @@ -209,7 +211,7 @@ test-suite github-test hs-source-dirs: spec main-is: Spec.hs ghc-options: -Wall -threaded - build-tool-depends: hspec-discover:hspec-discover >=2.7.1 && <2.8 + build-tool-depends: hspec-discover:hspec-discover >=2.7.1 && <2.10 other-extensions: TemplateHaskell other-modules: GitHub.ActivitySpec @@ -234,7 +236,7 @@ test-suite github-test , bytestring , file-embed , github - , hspec >=2.6.1 && <2.8 + , hspec >=2.6.1 && <2.10 , tagged , text , unordered-containers diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index 270609d7..f1ff2045 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -16,8 +16,9 @@ tested-with: || ==8.4.4 || ==8.6.5 || ==8.8.4 - || ==8.10.4 + || ==8.10.7 || ==9.0.1 + || ==9.2.1 library hs-source-dirs: src From 558ab0d73d93837c0c53c75df4a1cc439884ff54 Mon Sep 17 00:00:00 2001 From: snxx-lppxx Date: Sat, 18 Dec 2021 19:54:02 +0500 Subject: [PATCH 439/510] readme: fix company name --- README.md | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/README.md b/README.md index d6996412..f808c2a8 100644 --- a/README.md +++ b/README.md @@ -1,13 +1,13 @@ -Github +GitHub ------ [![Build Status](https://travis-ci.org/phadej/github.svg?branch=master)](https://travis-ci.org/phadej/github) [![Hackage](https://img.shields.io/hackage/v/github.svg)][hackage] -The Github API v3 for Haskell. +The GitHub API v3 for Haskell. -Some functions are missing; these are functions where the Github API did -not work as expected. The full Github API is in beta and constantly +Some functions are missing; these are functions where the GitHub API did +not work as expected. The full GitHub API is in beta and constantly improving. Installation From 4184b466b968ad25d7e1e38c08ec9315ed1ce145 Mon Sep 17 00:00:00 2001 From: snxx-lppxx Date: Sat, 18 Dec 2021 21:13:01 +0500 Subject: [PATCH 440/510] addition #471 --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index f808c2a8..0a27ff91 100644 --- a/README.md +++ b/README.md @@ -40,7 +40,7 @@ Documentation For details see the reference [documentation on Hackage][hackage]. Each module lines up with the hierarchy of -[documentation from the Github API](http://developer.github.com/v3/). +[documentation from the GitHub API](http://developer.github.com/v3/). Request functions (ending with `R`) construct a data type which can be executed in `IO` by `executeRequest` functions. They are all listed in the root `GitHub` From ec59ef8c683a8f2fa5a91efaf78ff8154420716c Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Wed, 8 Dec 2021 22:36:18 +0100 Subject: [PATCH 441/510] Silence compilation warnings for github library - remove unused imports - disable star-is-type warning while we are supporting GHC 7 --- github.cabal | 8 +++++++- src/GitHub/Data/Content.hs | 1 - src/GitHub/Data/Deployments.hs | 3 --- src/GitHub/Data/Reviews.hs | 1 - src/GitHub/Endpoints/PullRequests/Reviews.hs | 1 - src/GitHub/Endpoints/Repos/Deployments.hs | 2 -- src/GitHub/Request.hs | 3 +-- 7 files changed, 8 insertions(+), 11 deletions(-) diff --git a/github.cabal b/github.cabal index e9f0b5bf..c2da752b 100644 --- a/github.cabal +++ b/github.cabal @@ -58,7 +58,13 @@ flag openssl library default-language: Haskell2010 - ghc-options: -Wall + ghc-options: + -Wall + if impl(ghc >= 8.0) + ghc-options: + -Wcompat + -Wno-star-is-type + -- The star-is-type warning cannot be sensiblity addressed while supporting GHC 7. hs-source-dirs: src default-extensions: DataKinds diff --git a/src/GitHub/Data/Content.hs b/src/GitHub/Data/Content.hs index 5580c866..7a4dca9b 100644 --- a/src/GitHub/Data/Content.hs +++ b/src/GitHub/Data/Content.hs @@ -13,7 +13,6 @@ import GitHub.Internal.Prelude import Prelude () import Data.Aeson.Types (Pair) -import Data.Maybe (maybe) import qualified Data.Text as T #if MIN_VERSION_aeson(2,0,0) diff --git a/src/GitHub/Data/Deployments.hs b/src/GitHub/Data/Deployments.hs index face7a52..e14a214e 100644 --- a/src/GitHub/Data/Deployments.hs +++ b/src/GitHub/Data/Deployments.hs @@ -19,9 +19,6 @@ import Prelude () import Control.Arrow (second) import Data.ByteString (ByteString) -import Data.Maybe (catMaybes) -import Data.Text (Text) -import Data.Vector (Vector) import GitHub.Data.Definitions (SimpleUser) import GitHub.Data.Id (Id) diff --git a/src/GitHub/Data/Reviews.hs b/src/GitHub/Data/Reviews.hs index 72c6f6be..b00edb74 100644 --- a/src/GitHub/Data/Reviews.hs +++ b/src/GitHub/Data/Reviews.hs @@ -6,7 +6,6 @@ import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () -import Data.Text (Text) import qualified Data.Text as T data ReviewState diff --git a/src/GitHub/Endpoints/PullRequests/Reviews.hs b/src/GitHub/Endpoints/PullRequests/Reviews.hs index e5c42ac8..fe95d25b 100644 --- a/src/GitHub/Endpoints/PullRequests/Reviews.hs +++ b/src/GitHub/Endpoints/PullRequests/Reviews.hs @@ -12,7 +12,6 @@ module GitHub.Endpoints.PullRequests.Reviews ) where import GitHub.Data -import GitHub.Data.Id (Id) import GitHub.Internal.Prelude import Prelude () diff --git a/src/GitHub/Endpoints/Repos/Deployments.hs b/src/GitHub/Endpoints/Repos/Deployments.hs index ed94c16a..39724771 100644 --- a/src/GitHub/Endpoints/Repos/Deployments.hs +++ b/src/GitHub/Endpoints/Repos/Deployments.hs @@ -11,8 +11,6 @@ module GitHub.Endpoints.Repos.Deployments import Control.Arrow (second) -import Data.Vector (Vector) - import GitHub.Data import GitHub.Internal.Prelude diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index 808f33a7..2481deea 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -80,8 +80,7 @@ import Control.Monad.Catch (MonadCatch (..), MonadThrow) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Except (ExceptT (..), runExceptT) import Data.Aeson (eitherDecode) -import Data.List (find, intercalate) -import Data.String (fromString) +import Data.List (find) import Data.Tagged (Tagged (..)) import Data.Version (showVersion) From abc27cab9af8769eed34242d1f0a2718d05d15b1 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Wed, 8 Dec 2021 22:54:49 +0100 Subject: [PATCH 442/510] Complete API for repo-issues Add missing methods to set the following fields of 'IssueRepoOptions': - specific milestone - specific assignee - creator - mentioned --- github.cabal | 3 +- src/GitHub/Data/Options.hs | 107 ++++++++++++++++++++++++++++++++----- 2 files changed, 96 insertions(+), 14 deletions(-) diff --git a/github.cabal b/github.cabal index c2da752b..2d90197f 100644 --- a/github.cabal +++ b/github.cabal @@ -1,7 +1,6 @@ cabal-version: >=1.10 name: github -version: 0.27 -x-revision: 1 +version: 0.28 synopsis: Access to the GitHub API, v3. category: Network description: diff --git a/src/GitHub/Data/Options.hs b/src/GitHub/Data/Options.hs index 70665317..c861c212 100644 --- a/src/GitHub/Data/Options.hs +++ b/src/GitHub/Data/Options.hs @@ -38,12 +38,16 @@ module GitHub.Data.Options ( -- * Repo issues IssueRepoMod, issueRepoModToQueryString, + optionsCreator, + optionsMentioned, optionsIrrelevantMilestone, optionsAnyMilestone, optionsNoMilestone, + optionsMilestone, optionsIrrelevantAssignee, optionsAnyAssignee, optionsNoAssignee, + optionsAssignee, -- * Data IssueState (..), MergeableState (..), @@ -351,7 +355,7 @@ sortByLongRunning = PRMod $ \opts -> -- Issues ------------------------------------------------------------------------------- --- | See . +-- | See . data IssueOptions = IssueOptions { issueOptionsFilter :: !IssueFilter , issueOptionsState :: !(Maybe IssueState) @@ -373,7 +377,7 @@ defaultIssueOptions = IssueOptions , issueOptionsSince = Nothing } --- | See . +-- | See . newtype IssueMod = IssueMod (IssueOptions -> IssueOptions) instance Semigroup IssueMod where @@ -491,16 +495,70 @@ issueFilter f = IssueMod $ \opts -> -- Issues repo ------------------------------------------------------------------------------- +-- | See . +-- Retrieved: 2021-12-08 +-- +-- Parameters of "list repository issues" (@get /repos/{owner}/{repo}/issues@) +-- +-- * milestone : string +-- +-- If an integer is passed, it should refer to a milestone by its number field. If the string * is passed, issues with any milestone are accepted. If the string none is passed, issues without milestones are returned. +-- +-- * state : string +-- +-- Indicates the state of the issues to return. Can be either open, closed, or all. +-- Default: open +-- +-- * assignee : string +-- +-- Can be the name of a user. Pass in none for issues with no assigned user, and * for issues assigned to any user. +-- +-- * creator : string +-- +-- The user that created the issue. +-- +-- * mentioned : string +-- +-- A user that's mentioned in the issue. +-- +-- * labels : string +-- +-- A list of comma separated label names. Example: bug,ui,@high +-- +-- * sort : string +-- +-- What to sort results by. Can be either created, updated, comments. +-- Default: created +-- +-- * direction : string +-- +-- One of asc (ascending) or desc (descending). +-- Default: desc +-- +-- * since : string +-- +-- Only show notifications updated after the given time. This is a timestamp in ISO 8601 format: YYYY-MM-DDTHH:MM:SSZ. +-- +-- * per_page : integer +-- +-- Results per page (max 100) +-- Default: 30 +-- +-- * page : integer +-- +-- Page number of the results to fetch. +-- Default: 1 +-- data IssueRepoOptions = IssueRepoOptions - { issueRepoOptionsMilestone :: !(FilterBy (Id Milestone)) - , issueRepoOptionsState :: !(Maybe IssueState) - , issueRepoOptionsAssignee :: !(FilterBy (Name User)) - , issueRepoOptionsCreator :: !(Maybe (Name User)) - , issueRepoOptionsMentioned :: !(Maybe (Name User)) - , issueRepoOptionsLabels :: ![Name IssueLabel] - , issueRepoOptionsSort :: !SortIssue - , issueRepoOptionsDirection :: !SortDirection - , issueRepoOptionsSince :: !(Maybe UTCTime) + { issueRepoOptionsMilestone :: !(FilterBy (Id Milestone)) -- ^ 'optionsMilestone' etc. + , issueRepoOptionsState :: !(Maybe IssueState) -- ^ 'HasState' + , issueRepoOptionsAssignee :: !(FilterBy (Name User)) -- ^ 'optionsAssignee' etc. + , issueRepoOptionsCreator :: !(Maybe (Name User)) -- ^ 'optionsCreator' + , issueRepoOptionsMentioned :: !(Maybe (Name User)) -- ^ 'optionsMentioned' + , issueRepoOptionsLabels :: ![Name IssueLabel] -- ^ 'HasLabels' + , issueRepoOptionsSort :: !SortIssue -- ^ 'HasCreatedUpdated' and 'HasComments' + , issueRepoOptionsDirection :: !SortDirection -- ^ 'HasDirection' + , issueRepoOptionsSince :: !(Maybe UTCTime) -- ^ 'HasSince' } deriving (Eq, Ord, Show, Generic, Typeable, Data) @@ -579,7 +637,17 @@ issueRepoOptionsToQueryString IssueRepoOptions {..} = -- Issues repo modifiers ------------------------------------------------------------------------------- --- | Don't care about milestones. +-- | Issues created by a certain user. +optionsCreator :: Name User -> IssueRepoMod +optionsCreator u = IssueRepoMod $ \opts -> + opts { issueRepoOptionsCreator = Just u } + +-- | Issue mentioning the given user. +optionsMentioned :: Name User -> IssueRepoMod +optionsMentioned u = IssueRepoMod $ \opts -> + opts { issueRepoOptionsMentioned = Just u } + +-- | Don't care about milestones (default). -- -- 'optionsAnyMilestone' means there should be some milestone, but it can be any. -- @@ -588,22 +656,37 @@ optionsIrrelevantMilestone :: IssueRepoMod optionsIrrelevantMilestone = IssueRepoMod $ \opts -> opts { issueRepoOptionsMilestone = FilterNotSpecified } +-- | Issues that have a milestone. optionsAnyMilestone :: IssueRepoMod optionsAnyMilestone = IssueRepoMod $ \opts -> opts { issueRepoOptionsMilestone = FilterAny } +-- | Issues that have no milestone. optionsNoMilestone :: IssueRepoMod optionsNoMilestone = IssueRepoMod $ \opts -> opts { issueRepoOptionsMilestone = FilterNone } +-- | Issues with the given milestone. +optionsMilestone :: Id Milestone -> IssueRepoMod +optionsMilestone m = IssueRepoMod $ \opts -> + opts { issueRepoOptionsMilestone = FilterBy m } + +-- | Issues with or without assignee (default). optionsIrrelevantAssignee :: IssueRepoMod optionsIrrelevantAssignee = IssueRepoMod $ \opts -> opts { issueRepoOptionsAssignee = FilterNotSpecified } +-- | Issues assigned to someone. optionsAnyAssignee :: IssueRepoMod optionsAnyAssignee = IssueRepoMod $ \opts -> opts { issueRepoOptionsAssignee = FilterAny } +-- | Issues assigned to nobody. optionsNoAssignee :: IssueRepoMod optionsNoAssignee = IssueRepoMod $ \opts -> opts { issueRepoOptionsAssignee = FilterNone } + +-- | Issues assigned to a specific user. +optionsAssignee :: Name User -> IssueRepoMod +optionsAssignee u = IssueRepoMod $ \opts -> + opts { issueRepoOptionsAssignee = FilterBy u } From 3a26d2f17d345c0cd706b8fbe869d6fdd0528af5 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Tue, 21 Dec 2021 15:12:18 +0100 Subject: [PATCH 443/510] PR #470: no major version bump, remove clone of GitHub API docs --- github.cabal | 2 +- src/GitHub/Data/Options.hs | 54 ++------------------------------------ 2 files changed, 3 insertions(+), 53 deletions(-) diff --git a/github.cabal b/github.cabal index 2d90197f..be54e398 100644 --- a/github.cabal +++ b/github.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: github -version: 0.28 +version: 0.27.1 synopsis: Access to the GitHub API, v3. category: Network description: diff --git a/src/GitHub/Data/Options.hs b/src/GitHub/Data/Options.hs index c861c212..24bc4369 100644 --- a/src/GitHub/Data/Options.hs +++ b/src/GitHub/Data/Options.hs @@ -495,59 +495,9 @@ issueFilter f = IssueMod $ \opts -> -- Issues repo ------------------------------------------------------------------------------- --- | See . --- Retrieved: 2021-12-08 +-- | Parameters of "list repository issues" (@get /repos/{owner}/{repo}/issues@). -- --- Parameters of "list repository issues" (@get /repos/{owner}/{repo}/issues@) --- --- * milestone : string --- --- If an integer is passed, it should refer to a milestone by its number field. If the string * is passed, issues with any milestone are accepted. If the string none is passed, issues without milestones are returned. --- --- * state : string --- --- Indicates the state of the issues to return. Can be either open, closed, or all. --- Default: open --- --- * assignee : string --- --- Can be the name of a user. Pass in none for issues with no assigned user, and * for issues assigned to any user. --- --- * creator : string --- --- The user that created the issue. --- --- * mentioned : string --- --- A user that's mentioned in the issue. --- --- * labels : string --- --- A list of comma separated label names. Example: bug,ui,@high --- --- * sort : string --- --- What to sort results by. Can be either created, updated, comments. --- Default: created --- --- * direction : string --- --- One of asc (ascending) or desc (descending). --- Default: desc --- --- * since : string --- --- Only show notifications updated after the given time. This is a timestamp in ISO 8601 format: YYYY-MM-DDTHH:MM:SSZ. --- --- * per_page : integer --- --- Results per page (max 100) --- Default: 30 --- --- * page : integer --- --- Page number of the results to fetch. --- Default: 1 +-- See . -- data IssueRepoOptions = IssueRepoOptions { issueRepoOptionsMilestone :: !(FilterBy (Id Milestone)) -- ^ 'optionsMilestone' etc. From 16d5350a57a5b9917dac7ee42f00c3473bf8e75e Mon Sep 17 00:00:00 2001 From: Robert Hensing Date: Sat, 2 Apr 2022 13:19:37 +0200 Subject: [PATCH 444/510] Repo: add permissions field (#476) Adds field `repoPermissions` to `Repo` record. --- src/GitHub/Data/Repos.hs | 21 +++++++++++++++++++++ src/GitHub/Endpoints/Repos.hs | 6 +++--- 2 files changed, 24 insertions(+), 3 deletions(-) diff --git a/src/GitHub/Data/Repos.hs b/src/GitHub/Data/Repos.hs index d9c9cf1b..0019b173 100644 --- a/src/GitHub/Data/Repos.hs +++ b/src/GitHub/Data/Repos.hs @@ -61,12 +61,26 @@ data Repo = Repo , repoPushedAt :: !(Maybe UTCTime) -- ^ this is Nothing for new repositories , repoCreatedAt :: !(Maybe UTCTime) , repoUpdatedAt :: !(Maybe UTCTime) + , repoPermissions :: !(Maybe RepoPermissions) -- ^ Repository permissions as they relate to the authenticated user. } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Repo where rnf = genericRnf instance Binary Repo +-- | Repository permissions, as they relate to the authenticated user. +-- +-- Returned by for example 'GitHub.Endpoints.Repos.currentUserReposR' +data RepoPermissions = RepoPermissions + { repoPermissionAdmin :: !Bool + , repoPermissionPush :: !Bool + , repoPermissionPull :: !Bool + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData RepoPermissions where rnf = genericRnf +instance Binary RepoPermissions + data RepoRef = RepoRef { repoRefOwner :: !SimpleOwner , repoRefRepo :: !(Name Repo) @@ -214,6 +228,7 @@ instance FromJSON Repo where <*> o .:? "pushed_at" <*> o .:? "created_at" <*> o .:? "updated_at" + <*> o .:? "permissions" instance ToJSON NewRepo where toJSON (NewRepo { newRepoName = name @@ -273,6 +288,12 @@ instance ToJSON EditRepo where , "archived" .= archived ] +instance FromJSON RepoPermissions where + parseJSON = withObject "RepoPermissions" $ \o -> RepoPermissions + <$> o .: "admin" + <*> o .: "push" + <*> o .: "pull" + instance FromJSON RepoRef where parseJSON = withObject "RepoRef" $ \o -> RepoRef <$> o .: "owner" diff --git a/src/GitHub/Endpoints/Repos.hs b/src/GitHub/Endpoints/Repos.hs index 38fe1e6f..b8c9d79d 100644 --- a/src/GitHub/Endpoints/Repos.hs +++ b/src/GitHub/Endpoints/Repos.hs @@ -43,7 +43,7 @@ repoPublicityQueryString RepoPublicityPublic = [("type", Just "public")] repoPublicityQueryString RepoPublicityPrivate = [("type", Just "private")] -- | List your repositories. --- See +-- See currentUserReposR :: RepoPublicity -> FetchCount -> Request k (Vector Repo) currentUserReposR publicity = pagedQuery ["user", "repos"] qs @@ -51,7 +51,7 @@ currentUserReposR publicity = qs = repoPublicityQueryString publicity -- | List user repositories. --- See +-- See userReposR :: Name Owner -> RepoPublicity -> FetchCount -> Request k(Vector Repo) userReposR user publicity = pagedQuery ["users", toPathPart user, "repos"] qs @@ -59,7 +59,7 @@ userReposR user publicity = qs = repoPublicityQueryString publicity -- | List organization repositories. --- See +-- See organizationReposR :: Name Organization -> RepoPublicity From e619f76caf672cc78b676f56755e362dc1c838b8 Mon Sep 17 00:00:00 2001 From: Andrea Bedini Date: Mon, 4 Apr 2022 06:13:22 +0800 Subject: [PATCH 445/510] Replace Travis CI with GitHub Actions in README (#475) --- README.md | 18 ++++-------------- 1 file changed, 4 insertions(+), 14 deletions(-) diff --git a/README.md b/README.md index 0a27ff91..18313f24 100644 --- a/README.md +++ b/README.md @@ -1,7 +1,7 @@ GitHub ------ -[![Build Status](https://travis-ci.org/phadej/github.svg?branch=master)](https://travis-ci.org/phadej/github) +[![Haskell-CI](https://github.com/haskell-github/github/actions/workflows/haskell-ci.yml/badge.svg)](https://github.com/haskell-github/github/actions/workflows/haskell-ci.yml) [![Hackage](https://img.shields.io/hackage/v/github.svg)][hackage] The GitHub API v3 for Haskell. @@ -30,7 +30,7 @@ Example Usage ============= See the samples in the -[samples/](https://github.com/fpco/github/tree/master/samples) directory. +[samples/](https://github.com/haskell-github/github/tree/master/samples) directory. Note: some samples might be outdated. @@ -51,7 +51,7 @@ you want. You must call the function using IO goodness, then dispatch on the possible error message. Here's an example from the samples: Many function have samples under -[`samples/`](https://github.com/phadej/github/tree/master/samples) directory. +[`samples/`](https://github.com/haskell-github/github/tree/master/samples) directory. ```hs {-# LANGUAGE NoImplicitPrelude #-} @@ -77,21 +77,11 @@ formatUser :: GitHub.SimpleUser -> Text formatUser = GitHub.untagName . GitHub.simpleUserLogin ``` -Test setup -========== - -To run integration part of tests, you'll need [github access token](https://github.com/settings/tokens/new) -Token is needed, because unauthorised access is highly limited. -It's enough to add only basic read access for public information. - -With `travis encrypt --org --repo yournick/github "GITHUB_TOKEN=yourtoken"` command you get a secret, -you can use in your travis setup to run the test-suite there. - Contributions ============= Please see -[CONTRIBUTING.md](https://github.com/fpco/github/blob/master/CONTRIBUTING.md) +[CONTRIBUTING.md](https://github.com/haskell-github/github/blob/master/CONTRIBUTING.md) for details on how you can help. Copyright From 86ab6944b26b346ca4d4490a30b241cd8c42b19a Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Tue, 19 Apr 2022 14:18:10 +0200 Subject: [PATCH 446/510] Close #355: comment that haddocks only build from GHC 8.6 --- cabal.haskell-ci | 1 + 1 file changed, 1 insertion(+) diff --git a/cabal.haskell-ci b/cabal.haskell-ci index bcb8a5d9..ddf7ff7b 100644 --- a/cabal.haskell-ci +++ b/cabal.haskell-ci @@ -1,2 +1,3 @@ branches: master haddock: >=8.6 + -- See PR #355: haddocks for GADT constructor arguments only supported from GHC 8.6 From 4c922eb3edf82473cc78dc9b85911cbd8d4610e5 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Tue, 19 Apr 2022 17:16:42 +0200 Subject: [PATCH 447/510] Update `CreateIssue.hs` to new request model and OAuth (#477) * Fix compiler errors * If there are no labels, than the output should be an empty array. * Move formatUser to own function * Remove empty line * Update CreateIssue.hs to request model & OAuth; add cabal entry (#195) Can be run as follows: samples/$ GITHUB_TOKEN=<> cabal run github-create-issue * Drop testing with GHC-7.8.4 Drop building `samples` with GHC-7.8 because `System.Exit.die` is only available from GHC 7.10. * Restore testing with GHC-7.8.4 except for samples Co-authored-by: Amitaibu --- .github/workflows/haskell-ci.yml | 26 ++++++------- cabal.haskell-ci | 1 + github.cabal | 4 +- samples/Issues/CreateIssue.hs | 67 +++++++++++++++++++++++--------- samples/github-samples.cabal | 18 ++++++--- 5 files changed, 77 insertions(+), 39 deletions(-) diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index 463233e7..bbd13145 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -8,9 +8,9 @@ # # For more information, see https://github.com/haskell-CI/haskell-ci # -# version: 0.13.20211111 +# version: 0.14.3.20220416 # -# REGENDATA ("0.13.20211111",["--config=cabal.haskell-ci","github","cabal.project"]) +# REGENDATA ("0.14.3.20220416",["--config=cabal.haskell-ci","github","cabal.project"]) # name: Haskell-CI on: @@ -32,15 +32,15 @@ jobs: strategy: matrix: include: - - compiler: ghc-9.2.1 + - compiler: ghc-9.2.2 compilerKind: ghc - compilerVersion: 9.2.1 + compilerVersion: 9.2.2 setup-method: ghcup allow-failure: false - - compiler: ghc-9.0.1 + - compiler: ghc-9.0.2 compilerKind: ghc - compilerVersion: 9.0.1 - setup-method: hvr-ppa + compilerVersion: 9.0.2 + setup-method: ghcup allow-failure: false - compiler: ghc-8.10.7 compilerKind: ghc @@ -90,7 +90,7 @@ jobs: apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5 if [ "${{ matrix.setup-method }}" = ghcup ]; then mkdir -p "$HOME/.ghcup/bin" - curl -sL https://downloads.haskell.org/ghcup/0.1.17.3/x86_64-linux-ghcup-0.1.17.3 > "$HOME/.ghcup/bin/ghcup" + curl -sL https://downloads.haskell.org/ghcup/0.1.17.5/x86_64-linux-ghcup-0.1.17.5 > "$HOME/.ghcup/bin/ghcup" chmod a+x "$HOME/.ghcup/bin/ghcup" "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0 @@ -99,7 +99,7 @@ jobs: apt-get update apt-get install -y "$HCNAME" mkdir -p "$HOME/.ghcup/bin" - curl -sL https://downloads.haskell.org/ghcup/0.1.17.3/x86_64-linux-ghcup-0.1.17.3 > "$HOME/.ghcup/bin/ghcup" + curl -sL https://downloads.haskell.org/ghcup/0.1.17.5/x86_64-linux-ghcup-0.1.17.5 > "$HOME/.ghcup/bin/ghcup" chmod a+x "$HOME/.ghcup/bin/ghcup" "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0 fi @@ -191,7 +191,7 @@ jobs: run: | touch cabal.project echo "packages: $GITHUB_WORKSPACE/source/." >> cabal.project - echo "packages: $GITHUB_WORKSPACE/source/samples" >> cabal.project + if [ $((HCNUMVER >= 71000)) -ne 0 ] ; then echo "packages: $GITHUB_WORKSPACE/source/samples" >> cabal.project ; fi cat cabal.project - name: sdist run: | @@ -211,7 +211,7 @@ jobs: touch cabal.project touch cabal.project.local echo "packages: ${PKGDIR_github}" >> cabal.project - echo "packages: ${PKGDIR_github_samples}" >> cabal.project + if [ $((HCNUMVER >= 71000)) -ne 0 ] ; then echo "packages: ${PKGDIR_github_samples}" >> cabal.project ; fi if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo "package github" >> cabal.project ; fi if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods" >> cabal.project ; fi if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo "package github-samples" >> cabal.project ; fi @@ -256,8 +256,8 @@ jobs: run: | cd ${PKGDIR_github} || false ${CABAL} -vnormal check - cd ${PKGDIR_github_samples} || false - ${CABAL} -vnormal check + if [ $((HCNUMVER >= 71000)) -ne 0 ] ; then cd ${PKGDIR_github_samples} || false ; fi + if [ $((HCNUMVER >= 71000)) -ne 0 ] ; then ${CABAL} -vnormal check ; fi - name: haddock run: | if [ $((HCNUMVER >= 80600)) -ne 0 ] ; then $CABAL v2-haddock $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all ; fi diff --git a/cabal.haskell-ci b/cabal.haskell-ci index ddf7ff7b..eb8a2be2 100644 --- a/cabal.haskell-ci +++ b/cabal.haskell-ci @@ -1,3 +1,4 @@ branches: master haddock: >=8.6 -- See PR #355: haddocks for GADT constructor arguments only supported from GHC 8.6 +jobs-selection: any diff --git a/github.cabal b/github.cabal index be54e398..04cb2c9a 100644 --- a/github.cabal +++ b/github.cabal @@ -38,8 +38,8 @@ tested-with: || ==8.6.5 || ==8.8.4 || ==8.10.7 - || ==9.0.1 - || ==9.2.1 + || ==9.0.2 + || ==9.2.2 extra-source-files: README.md diff --git a/samples/Issues/CreateIssue.hs b/samples/Issues/CreateIssue.hs index 296013f5..6d930c93 100644 --- a/samples/Issues/CreateIssue.hs +++ b/samples/Issues/CreateIssue.hs @@ -1,22 +1,53 @@ +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} -module CreateIssue where -import qualified Github.Auth as Github -import qualified Github.Issues as Github +import Data.String (fromString) +import qualified Data.Text as Text (unpack) +import qualified Data.Vector as Vector (fromList) +import qualified GitHub.Auth as GitHub +import qualified GitHub.Data.Issues as GitHub +import qualified GitHub.Endpoints.Issues as GitHub +import qualified GitHub.Request as GitHub + +import System.Environment (lookupEnv) +import qualified System.Exit as Exit (die) + +self :: String +self = "github-create-issue" + +main :: IO () main = do - let auth = Github.BasicAuth "user" "password" - newiss = (Github.newIssue "A new issue") { - Github.newIssueBody = Just "Issue description text goes here" + token <- lookupEnv "GITHUB_TOKEN" >>= \case + Nothing -> die "variable GITHUB_TOKEN not set" + Just token -> return $ fromString token + + let auth = GitHub.OAuth token + newiss = (GitHub.newIssue "A new issue") + { GitHub.newIssueBody = Just "Issue description text goes here" + , GitHub.newIssueLabels = Just $ Vector.fromList ["foo", "bar", "baz"] } - possibleIssue <- Github.createIssue auth "thoughtbot" "paperclip" newiss - putStrLn $ either (\e -> "Error: " ++ show e) - formatIssue - possibleIssue - -formatIssue issue = - (Github.githubOwnerLogin $ Github.issueUser issue) ++ - " opened this issue " ++ - (show $ Github.fromDate $ Github.issueCreatedAt issue) ++ "\n" ++ - (Github.issueState issue) ++ " with " ++ - (show $ Github.issueComments issue) ++ " comments" ++ "\n\n" ++ - (Github.issueTitle issue) + request = GitHub.createIssueR "haskell-github" "playground" newiss + + GitHub.github auth request >>= \case + Left err -> die $ show err + Right issue -> putStrLn $ formatIssue issue + +die :: String -> IO a +die msg = Exit.die $ concat [ self, ": Error: ", msg ] + +formatIssue :: GitHub.Issue -> String +formatIssue issue = concat + [ formatUser issue + , " opened this issue " + , show $ GitHub.issueCreatedAt issue + , "\n" + , show $ GitHub.issueState issue + , " with " + , show $ GitHub.issueComments issue + , " comments\n\n" + , Text.unpack $ GitHub.issueTitle issue + ] + +formatUser :: GitHub.Issue -> String +formatUser issue = + Text.unpack . GitHub.untagName . GitHub.simpleUserLogin $ GitHub.issueUser issue diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index f1ff2045..d71cd143 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -9,16 +9,15 @@ maintainer: Oleg Grenrus description: Various samples of github package build-type: Simple tested-with: - GHC ==7.8.4 - || ==7.10.3 + GHC ==7.10.3 || ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.4 || ==8.10.7 - || ==9.0.1 - || ==9.2.1 + || ==9.0.2 + || ==9.2.2 library hs-source-dirs: src @@ -50,9 +49,11 @@ executable github-operational common deps default-language: Haskell2010 - ghc-options: -Wall + ghc-options: + -Wall + -threaded build-depends: - , base >=4.7 && <5 + , base >=4.8 && <5 , base-compat-batteries , base64-bytestring , github @@ -70,6 +71,11 @@ executable github-create-deploy-key main-is: CreateDeployKey.hs hs-source-dirs: Repos/DeployKeys +executable github-create-issue + import: deps + main-is: CreateIssue.hs + hs-source-dirs: Issues + -- executable github-delete-deploy-key -- import: deps -- main-is: DeleteDeployKey.hs From 59967287df3128fa93a9a6edc95d1b3911e1e1ec Mon Sep 17 00:00:00 2001 From: Owen Shepherd <414owen@gmail.com> Date: Fri, 29 Apr 2022 13:32:32 +0100 Subject: [PATCH 448/510] Add unwatch request (#473) - Add unsubscribe request - Add unwatch request sample - Add Unwatch sample to github-samples.cabal --- samples/Repos/Watching/Unwatch.hs | 17 +++++++++++++++++ samples/github-samples.cabal | 6 ++++++ src/GitHub.hs | 2 +- src/GitHub/Endpoints/Activity/Watching.hs | 7 +++++++ 4 files changed, 31 insertions(+), 1 deletion(-) create mode 100644 samples/Repos/Watching/Unwatch.hs diff --git a/samples/Repos/Watching/Unwatch.hs b/samples/Repos/Watching/Unwatch.hs new file mode 100644 index 00000000..42dc28a8 --- /dev/null +++ b/samples/Repos/Watching/Unwatch.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Main where + +import qualified GitHub as GH +import qualified Data.Text as T +import qualified Data.Text.IO as T + +main :: IO () +main = do + let auth = GH.BasicAuth "" "" + owner = "haskell-github" + repo = "github" + result <- GH.github auth GH.unwatchRepoR (GH.mkOwnerName owner) (GH.mkRepoName repo) + case result of + Left err -> putStrLn $ "Error: " ++ show err + Right () -> T.putStrLn $ T.concat ["No longer watching: ", owner, "/", repo] diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index d71cd143..1182fdf4 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -166,6 +166,12 @@ executable github-teaminfo-for main-is: TeamInfoFor.hs hs-source-dirs: Teams +executable github-unwatch-repo + import: deps + main-is: Unwatch.hs + ghc-options: -Wall -threaded + hs-source-dirs: Repos/Watching + -- executable github-create-public-ssh-key -- import: deps -- main-is: CreatePublicSSHKey.hs diff --git a/src/GitHub.hs b/src/GitHub.hs index e00a53cb..da5e9f2b 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -52,9 +52,9 @@ module GitHub ( -- -- * Query a Repository Subscription -- * Set a Repository Subscription - -- * Delete a Repository Subscription watchersForR, reposWatchedByR, + unwatchRepoR, -- * Gists -- | See diff --git a/src/GitHub/Endpoints/Activity/Watching.hs b/src/GitHub/Endpoints/Activity/Watching.hs index cd58b44f..92b7829d 100644 --- a/src/GitHub/Endpoints/Activity/Watching.hs +++ b/src/GitHub/Endpoints/Activity/Watching.hs @@ -8,6 +8,7 @@ module GitHub.Endpoints.Activity.Watching ( watchersForR, reposWatchedByR, + unwatchRepoR, module GitHub.Data, ) where @@ -27,3 +28,9 @@ watchersForR user repo limit = reposWatchedByR :: Name Owner -> FetchCount -> Request k (Vector Repo) reposWatchedByR user = pagedQuery ["users", toPathPart user, "subscriptions"] [] + +-- | Stop watching repository. +-- See +unwatchRepoR :: Name Owner -> Name Repo -> Request 'RW () +unwatchRepoR owner repo = + command Delete ["repos", toPathPart owner, toPathPart repo, "subscription"] mempty From 83acdf8f4c7d525c896e9d12494be65a628007c3 Mon Sep 17 00:00:00 2001 From: Owen Shepherd Date: Fri, 29 Apr 2022 20:49:41 +0100 Subject: [PATCH 449/510] Make searches paginated (#474) Previously, searches only returned the first thirty results, and there was no way to access page two. Note that this is a breaking API change. - Add paginated searches - Update SearchCode sample to use pagination - Update SearchIssues sample to use pagination - Update SearchRepos sample to use pagination --- samples/Search/SearchCode.hs | 39 ++++++++++---------- samples/Search/SearchIssues.hs | 37 ++++++++++--------- samples/Search/SearchRepos.hs | 57 +++++++++++++++-------------- samples/github-samples.cabal | 19 ++++++++++ spec/GitHub/SearchSpec.hs | 6 ++-- src/GitHub/Data/Repos.hs | 65 ++++++++++++++++++++++++++++++++++ src/GitHub/Data/Search.hs | 24 ++++++++----- src/GitHub/Endpoints/Search.hs | 16 ++++----- 8 files changed, 180 insertions(+), 83 deletions(-) diff --git a/samples/Search/SearchCode.hs b/samples/Search/SearchCode.hs index 68a73c96..c632e2ae 100644 --- a/samples/Search/SearchCode.hs +++ b/samples/Search/SearchCode.hs @@ -1,34 +1,33 @@ {-# LANGUAGE OverloadedStrings #-} -module SearchCode where -import qualified Github.Search as Github -import qualified Github.Data as Github -import Control.Monad (forM,forM_) -import Data.Maybe (fromMaybe) +module Main where + +import qualified GitHub +import Control.Monad (forM_) import Data.List (intercalate) +import qualified Data.Text as T +main :: IO () main = do - let query = "q=Code repo:jwiegley/github&per_page=100" - let auth = Nothing - result <- Github.searchCode' auth query + let query = "Code repo:haskell-github/github" + result <- GitHub.github' GitHub.searchCodeR query 1000 case result of Left e -> putStrLn $ "Error: " ++ show e - Right r -> do forM_ (Github.searchCodeCodes r) (\r -> do - putStrLn $ formatCode r - putStrLn "" - ) - putStrLn $ "Count: " ++ show n ++ " matches for the query: \"" ++ query ++ "\"" - where n = Github.searchCodeTotalCount r + Right r -> do + forM_ (GitHub.searchResultResults r) $ \r -> do + putStrLn $ formatCode r + putStrLn "" + putStrLn $ "Count: " ++ show (GitHub.searchResultTotalCount r) + ++ " matches for the query: \"" ++ T.unpack query ++ "\"" -formatCode :: Github.Code -> String +formatCode :: GitHub.Code -> String formatCode r = - let fields = [ ("Name", Github.codeName) - ,("Path", Github.codePath) - ,("Sha", Github.codeSha) - ,("URL", Github.codeHtmlUrl) + let fields = [ ("Name", show . GitHub.codeName) + , ("Path", show . GitHub.codePath) + , ("Sha", show . GitHub.codeSha) + , ("URL", show . GitHub.codeHtmlUrl) ] in intercalate "\n" $ map fmt fields where fmt (s,f) = fill 12 (s ++ ":") ++ " " ++ f r fill n s = s ++ replicate n' ' ' where n' = max 0 (n - length s) - diff --git a/samples/Search/SearchIssues.hs b/samples/Search/SearchIssues.hs index 9b86ac22..288aef73 100644 --- a/samples/Search/SearchIssues.hs +++ b/samples/Search/SearchIssues.hs @@ -1,26 +1,29 @@ {-# LANGUAGE OverloadedStrings #-} -module SearchIssues where +module Main where -import qualified Github.Search as Github +import qualified GitHub +import qualified Data.Text as T import Control.Monad (forM_) +import Data.Monoid ((<>)) +main :: IO () main = do - let query = "q=build%20repo%3Aphadej%2Fgithub&per_page=100" - let auth = Nothing - result <- Github.searchIssues' auth query + let query = "build repo:haskell-github/github" + result <- GitHub.github' GitHub.searchIssuesR query 1000 case result of Left e -> putStrLn $ "Error: " ++ show e - Right r -> do forM_ (Github.searchIssuesIssues r) (\i -> do - putStrLn $ formatIssue i - putStrLn "" - ) - putStrLn $ "Count: " ++ show n ++ " build issues" - where n = Github.searchIssuesTotalCount r + Right r -> do + forM_ (GitHub.searchResultResults r) $ \r -> do + putStrLn $ formatIssue r + putStrLn "" + putStrLn $ "Count: " ++ show (GitHub.searchResultTotalCount r) + ++ " matches for the query: \"" ++ T.unpack query ++ "\"" +formatIssue :: GitHub.Issue -> String formatIssue issue = - (Github.githubOwnerLogin $ Github.issueUser issue) ++ - " opened this issue " ++ - (show $ Github.fromDate $ Github.issueCreatedAt issue) ++ "\n" ++ - (Github.issueState issue) ++ " with " ++ - (show $ Github.issueComments issue) ++ " comments" ++ "\n\n" ++ - (Github.issueTitle issue) + (show $ GitHub.issueUser issue) <> + " opened this issue " <> + (show $ GitHub.issueCreatedAt issue) <> "\n" <> + (show $ GitHub.issueState issue) <> " with " <> + (show $ GitHub.issueComments issue) <> " comments" <> "\n\n" <> + (T.unpack $ GitHub.issueTitle issue) diff --git a/samples/Search/SearchRepos.hs b/samples/Search/SearchRepos.hs index ade7f784..0a558b7e 100644 --- a/samples/Search/SearchRepos.hs +++ b/samples/Search/SearchRepos.hs @@ -1,50 +1,52 @@ {-# LANGUAGE OverloadedStrings #-} -module SearchRepos where +module Main where -import qualified Github.Search as Github -import qualified Github.Data as Github -import Control.Monad (forM,forM_) +import qualified GitHub +import Control.Monad (forM_) import Data.Maybe (fromMaybe) +import Data.Monoid ((<>)) import Data.List (intercalate) import System.Environment (getArgs) import Text.Printf (printf) import Data.Time.Clock (getCurrentTime, UTCTime(..)) -import Data.Time.LocalTime (utc,utcToLocalTime,localDay,localTimeOfDay,TimeOfDay(..)) +import Data.Time.LocalTime (utc,utcToLocalTime,localDay) import Data.Time.Calendar (toGregorian) +import Data.Text (Text) +import qualified Data.Text as T +main :: IO () main = do args <- getArgs date <- case args of - (x:_) -> return x - otherwise -> today - let query = "q=language%3Ahaskell created%3A>" ++ date ++ "&per_page=100" - let auth = Nothing - result <- Github.searchRepos' auth query + (x:_) -> return $ T.pack x + _ -> today + let query = ("language:haskell created:>" <> date) :: Text + result <- GitHub.github' GitHub.searchReposR query 1000 case result of Left e -> putStrLn $ "Error: " ++ show e - Right r -> do forM_ (Github.searchReposRepos r) (\r -> do - putStrLn $ formatRepo r - putStrLn "" - ) - putStrLn $ "Count: " ++ show n ++ " Haskell repos created since " ++ date - where n = Github.searchReposTotalCount r + Right r -> do + forM_ (GitHub.searchResultResults r) $ \r -> do + putStrLn $ formatRepo r + putStrLn "" + putStrLn $ "Count: " ++ show (GitHub.searchResultTotalCount r) + ++ " Haskell repos created since " ++ T.unpack date -- | return today (in UTC) formatted as YYYY-MM-DD -today :: IO String +today :: IO Text today = do now <- getCurrentTime let day = localDay $ utcToLocalTime utc now (y,m,d) = toGregorian day - in return $ printf "%d-%02d-%02d" y m d + in return $ T.pack $ printf "%d-%02d-%02d" y m d -formatRepo :: Github.Repo -> String +formatRepo :: GitHub.Repo -> String formatRepo r = - let fields = [ ("Name", Github.repoName) - ,("URL", Github.repoHtmlUrl) - ,("Description", orEmpty . Github.repoDescription) - ,("Created-At", formatMaybeDate . Github.repoCreatedAt) - ,("Pushed-At", formatMaybeDate . Github.repoPushedAt) - ,("Stars", show . Github.repoStargazersCount) + let fields = [ ("Name", show . GitHub.repoName) + ,("URL", show . GitHub.repoHtmlUrl) + ,("Description", show . orEmpty . GitHub.repoDescription) + ,("Created-At", formatMaybeDate . GitHub.repoCreatedAt) + ,("Pushed-At", formatMaybeDate . GitHub.repoPushedAt) + ,("Stars", show . GitHub.repoStargazersCount) ] in intercalate "\n" $ map fmt fields where fmt (s,f) = fill 12 (s ++ ":") ++ " " ++ f r @@ -52,5 +54,6 @@ formatRepo r = fill n s = s ++ replicate n' ' ' where n' = max 0 (n - length s) -formatMaybeDate = maybe "???" formatDate -formatDate = show . Github.fromDate + +formatMaybeDate :: Maybe UTCTime -> String +formatMaybeDate = maybe "???" show diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index 1182fdf4..43b5ac3c 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -156,6 +156,25 @@ executable github-show-user-2 main-is: ShowUser2.hs hs-source-dirs: Users +executable github-search-code + import: deps + ghc-options: -Wall -threaded + main-is: SearchCode.hs + hs-source-dirs: Search + +executable github-search-issues + import: deps + ghc-options: -Wall -threaded + main-is: SearchIssues.hs + hs-source-dirs: Search + +executable github-search-repos + import: deps + ghc-options: -Wall -threaded + main-is: SearchRepos.hs + hs-source-dirs: Search + build-depends: time + -- executable github-team-membership-info-for -- import: deps -- main-is: TeamMembershipInfoFor.hs diff --git a/spec/GitHub/SearchSpec.hs b/spec/GitHub/SearchSpec.hs index 5cc5a15f..f82a2051 100644 --- a/spec/GitHub/SearchSpec.hs +++ b/spec/GitHub/SearchSpec.hs @@ -18,7 +18,7 @@ import GitHub (github) import GitHub.Data (Auth (..), Issue (..), IssueNumber (..), IssueState (..), SimpleUser (..), User, mkId) -import GitHub.Endpoints.Search (SearchResult (..), searchIssuesR, searchUsersR) +import GitHub.Endpoints.Search (SearchResult' (..), SearchResult, searchIssuesR, searchUsersR) fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b @@ -55,13 +55,13 @@ spec = do it "performs an issue search via the API" $ withAuth $ \auth -> do let query = "Decouple in:title repo:phadej/github created:<=2015-12-01" - issues <- searchResultResults . fromRightS <$> github auth searchIssuesR query + issues <- fmap (searchResultResults . fromRightS) <$> github auth $ searchIssuesR query 5 length issues `shouldBe` 1 issueId (V.head issues) `shouldBe` mkId (Proxy :: Proxy Issue) 119694665 describe "searchUsers" $ it "performs a user search via the API" $ withAuth $ \auth -> do let query = "oleg.grenrus@iki.fi created:<2020-01-01" - users <- searchResultResults . fromRightS <$> github auth searchUsersR query + users <- fmap (searchResultResults . fromRightS) <$> github auth $ searchUsersR query 5 length users `shouldBe` 1 simpleUserId (V.head users) `shouldBe` mkId (Proxy :: Proxy User) 51087 diff --git a/src/GitHub/Data/Repos.hs b/src/GitHub/Data/Repos.hs index 0019b173..63779d77 100644 --- a/src/GitHub/Data/Repos.hs +++ b/src/GitHub/Data/Repos.hs @@ -68,6 +68,41 @@ data Repo = Repo instance NFData Repo where rnf = genericRnf instance Binary Repo +data CodeSearchRepo = CodeSearchRepo + { codeSearchRepoId :: !(Id Repo) + , codeSearchRepoName :: !(Name Repo) + , codeSearchRepoOwner :: !SimpleOwner + , codeSearchRepoPrivate :: !Bool + , codeSearchRepoHtmlUrl :: !URL + , codeSearchRepoDescription :: !(Maybe Text) + , codeSearchRepoFork :: !(Maybe Bool) + , codeSearchRepoUrl :: !URL + , codeSearchRepoGitUrl :: !(Maybe URL) + , codeSearchRepoSshUrl :: !(Maybe URL) + , codeSearchRepoCloneUrl :: !(Maybe URL) + , codeSearchRepoHooksUrl :: !URL + , codeSearchRepoSvnUrl :: !(Maybe URL) + , codeSearchRepoHomepage :: !(Maybe Text) + , codeSearchRepoLanguage :: !(Maybe Language) + , codeSearchRepoSize :: !(Maybe Int) + , codeSearchRepoDefaultBranch :: !(Maybe Text) + , codeSearchRepoHasIssues :: !(Maybe Bool) + , codeSearchRepoHasProjects :: !(Maybe Bool) + , codeSearchRepoHasWiki :: !(Maybe Bool) + , codeSearchRepoHasPages :: !(Maybe Bool) + , codeSearchRepoHasDownloads :: !(Maybe Bool) + , codeSearchRepoArchived :: !Bool + , codeSearchRepoDisabled :: !Bool + , codeSearchRepoPushedAt :: !(Maybe UTCTime) -- ^ this is Nothing for new repositories + , codeSearchRepoCreatedAt :: !(Maybe UTCTime) + , codeSearchRepoUpdatedAt :: !(Maybe UTCTime) + , codeSearchRepoPermissions :: !(Maybe RepoPermissions) -- ^ Repository permissions as they relate to the authenticated user. + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData CodeSearchRepo where rnf = genericRnf +instance Binary CodeSearchRepo + -- | Repository permissions, as they relate to the authenticated user. -- -- Returned by for example 'GitHub.Endpoints.Repos.currentUserReposR' @@ -230,6 +265,36 @@ instance FromJSON Repo where <*> o .:? "updated_at" <*> o .:? "permissions" +instance FromJSON CodeSearchRepo where + parseJSON = withObject "Repo" $ \o -> CodeSearchRepo <$> o .: "id" + <*> o .: "name" + <*> o .: "owner" + <*> o .: "private" + <*> o .: "html_url" + <*> o .:? "description" + <*> o .: "fork" + <*> o .: "url" + <*> o .:? "git_url" + <*> o .:? "ssh_url" + <*> o .:? "clone_url" + <*> o .: "hooks_url" + <*> o .:? "svn_url" + <*> o .:? "homepage" + <*> o .:? "language" + <*> o .:? "size" + <*> o .:? "default_branch" + <*> o .:? "has_issues" + <*> o .:? "has_projects" + <*> o .:? "has_wiki" + <*> o .:? "has_pages" + <*> o .:? "has_downloads" + <*> o .:? "archived" .!= False + <*> o .:? "disabled" .!= False + <*> o .:? "pushed_at" + <*> o .:? "created_at" + <*> o .:? "updated_at" + <*> o .:? "permissions" + instance ToJSON NewRepo where toJSON (NewRepo { newRepoName = name , newRepoDescription = description diff --git a/src/GitHub/Data/Search.hs b/src/GitHub/Data/Search.hs index cfef5ca1..951d1c83 100644 --- a/src/GitHub/Data/Search.hs +++ b/src/GitHub/Data/Search.hs @@ -5,26 +5,34 @@ -- module GitHub.Data.Search where -import GitHub.Data.Repos (Repo) +import GitHub.Data.Repos (CodeSearchRepo) import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () import qualified Data.Vector as V -data SearchResult entity = SearchResult +data SearchResult' entities = SearchResult { searchResultTotalCount :: !Int - , searchResultResults :: !(Vector entity) + , searchResultResults :: !entities } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData entity => NFData (SearchResult entity) where rnf = genericRnf -instance Binary entity => Binary (SearchResult entity) +type SearchResult entity = SearchResult' (V.Vector entity) -instance FromJSON entity => FromJSON (SearchResult entity) where +instance NFData entities => NFData (SearchResult' entities) where rnf = genericRnf +instance Binary entities => Binary (SearchResult' entities) + +instance (Monoid entities, FromJSON entities) => FromJSON (SearchResult' entities) where parseJSON = withObject "SearchResult" $ \o -> SearchResult <$> o .: "total_count" - <*> o .:? "items" .!= V.empty + <*> o .:? "items" .!= mempty + +instance Semigroup res => Semigroup (SearchResult' res) where + (SearchResult count res) <> (SearchResult count' res') = SearchResult (max count count') (res <> res') + +instance Foldable SearchResult' where + foldMap f (SearchResult count results) = f results data Code = Code { codeName :: !Text @@ -33,7 +41,7 @@ data Code = Code , codeUrl :: !URL , codeGitUrl :: !URL , codeHtmlUrl :: !URL - , codeRepo :: !Repo + , codeRepo :: !CodeSearchRepo } deriving (Show, Data, Typeable, Eq, Ord, Generic) diff --git a/src/GitHub/Endpoints/Search.hs b/src/GitHub/Endpoints/Search.hs index 3fb50e85..36b8c414 100644 --- a/src/GitHub/Endpoints/Search.hs +++ b/src/GitHub/Endpoints/Search.hs @@ -21,24 +21,24 @@ import qualified Data.Text.Encoding as TE -- | Search repositories. -- See -searchReposR :: Text -> Request k (SearchResult Repo) +searchReposR :: Text -> FetchCount -> Request k (SearchResult Repo) searchReposR searchString = - query ["search", "repositories"] [("q", Just $ TE.encodeUtf8 searchString)] + PagedQuery ["search", "repositories"] [("q", Just $ TE.encodeUtf8 searchString)] -- | Search code. -- See -searchCodeR :: Text -> Request k (SearchResult Code) +searchCodeR :: Text -> FetchCount -> Request k (SearchResult Code) searchCodeR searchString = - query ["search", "code"] [("q", Just $ TE.encodeUtf8 searchString)] + PagedQuery ["search", "code"] [("q", Just $ TE.encodeUtf8 searchString)] -- | Search issues. -- See -searchIssuesR :: Text -> Request k (SearchResult Issue) +searchIssuesR :: Text -> FetchCount -> Request k (SearchResult Issue) searchIssuesR searchString = - query ["search", "issues"] [("q", Just $ TE.encodeUtf8 searchString)] + PagedQuery ["search", "issues"] [("q", Just $ TE.encodeUtf8 searchString)] -- | Search users. -- See -searchUsersR :: Text -> Request k (SearchResult SimpleUser) +searchUsersR :: Text -> FetchCount -> Request k (SearchResult SimpleUser) searchUsersR searchString = - query ["search", "users"] [("q", Just $ TE.encodeUtf8 searchString)] + PagedQuery ["search", "users"] [("q", Just $ TE.encodeUtf8 searchString)] From d07a9f992b3c7afb1429683198cb3045e530dc2b Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Tue, 19 Apr 2022 17:58:38 +0200 Subject: [PATCH 450/510] Fix whitespace in {*hs, *.md} files --- CHANGELOG.md | 6 +++--- samples/GitData/References/GitCreateReference.hs | 2 +- samples/Issues/IssueReport/Issues.hs | 8 ++++---- samples/Issues/IssueReport/IssuesEnterprise.hs | 8 ++++---- samples/Issues/IssueReport/Report.hs | 2 +- samples/Repos/Commits/GitShow.hs | 2 +- samples/Repos/DeployKeys/ShowDeployKey.hs | 1 - samples/Search/SearchCode.hs | 2 +- samples/Search/SearchRepos.hs | 2 +- samples/Users/Followers/ListFollowers.hs | 2 +- samples/Users/Followers/ListFollowing.hs | 2 +- spec/GitHub/ActivitySpec.hs | 2 +- spec/GitHub/EventsSpec.hs | 2 +- src/GitHub/Data/Events.hs | 4 ++-- 14 files changed, 22 insertions(+), 23 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index eddba7a7..10cc9b18 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -6,7 +6,7 @@ [#455](https://github.com/phadej/github/pull/455) - Update RepoWebhookEvent [#461](https://github.com/phadej/github/pull/461) -- PullRequest Reviews may not have submitted_at field +- PullRequest Reviews may not have submitted_at field [#450](https://github.com/phadej/github/pull/450) ## Changes for 0.26 @@ -23,7 +23,7 @@ [#417](https://github.com/phadej/github/pull/417) - Add deleteReference endpoint [#388](https://github.com/phadej/github/pull/388) - + ## Changes for 0.25 - Add `executeRequestWithMgrAndRes` @@ -145,7 +145,7 @@ This reduces symbol bloat in the library. [#307](https://github.com/phadej/github/pull/307) - Make "repo" in PullRequestCommit nullable (repository can be gone) [#311](https://github.com/phadej/github/pull/311) -- Add read-only emails endpoint +- Add read-only emails endpoint [#313](https://github.com/phadej/github/pull/313) - Organisation membership API [#312](https://github.com/phadej/github/pull/312) diff --git a/samples/GitData/References/GitCreateReference.hs b/samples/GitData/References/GitCreateReference.hs index bf3d15b0..e56e1a2a 100644 --- a/samples/GitData/References/GitCreateReference.hs +++ b/samples/GitData/References/GitCreateReference.hs @@ -13,7 +13,7 @@ main = do case newlyCreatedGitRef of (Left err) -> putStrLn $ "Error: " ++ show err (Right newRef) -> putStrLn . formatReference $ newRef - + formatReference :: GitReference -> String formatReference ref = (gitObjectSha $ gitReferenceObject ref) ++ "\t" ++ (gitReferenceRef ref) diff --git a/samples/Issues/IssueReport/Issues.hs b/samples/Issues/IssueReport/Issues.hs index 14ce129c..da2fb1ba 100644 --- a/samples/Issues/IssueReport/Issues.hs +++ b/samples/Issues/IssueReport/Issues.hs @@ -18,12 +18,12 @@ mkIssue (Issue n t h) = hsep [ fill 5 (text (show h))] vissues :: ([Doc], [Doc], [Doc]) -> Doc -vissues (x, y, z) = hsep [(vcat x), align (vcat y), align (vcat z)] +vissues (x, y, z) = hsep [(vcat x), align (vcat y), align (vcat z)] mkDoc :: Report -> Doc mkDoc (Report issues total) = vsep [ text "Report for the milestone", - (vsep . map mkIssue) issues, + (vsep . map mkIssue) issues, text ("Total hours : " ++ (show total) ++" hours") ] @@ -31,7 +31,7 @@ mkFullDoc :: [Github.Issue] -> Doc mkFullDoc = mkDoc . prepareReport -- The public repo is used as private are quite sensitive for this report --- +-- -- The main idea is to use labels like 1h, 2h etc for man-hour estimation of issues -- on private repos for development "on hire" -- @@ -43,4 +43,4 @@ main = do possibleIssues <- Github.issuesForRepo' auth "paulrzcz" "hquantlib" limitations case possibleIssues of (Left err) -> putStrLn $ "Error: " ++ show err - (Right issues) -> putDoc $ mkFullDoc issues + (Right issues) -> putDoc $ mkFullDoc issues diff --git a/samples/Issues/IssueReport/IssuesEnterprise.hs b/samples/Issues/IssueReport/IssuesEnterprise.hs index 6b9f899c..7b2c2531 100644 --- a/samples/Issues/IssueReport/IssuesEnterprise.hs +++ b/samples/Issues/IssueReport/IssuesEnterprise.hs @@ -20,12 +20,12 @@ mkIssue (Issue n t h) = hsep [ fill 5 (text (show h))] vissues :: ([Doc], [Doc], [Doc]) -> Doc -vissues (x, y, z) = hsep [(vcat x), align (vcat y), align (vcat z)] +vissues (x, y, z) = hsep [(vcat x), align (vcat y), align (vcat z)] mkDoc :: Report -> Doc mkDoc (Report issues total) = vsep [ text "Report for the milestone", - (vsep . map mkIssue) issues, + (vsep . map mkIssue) issues, text ("Total hours : " ++ (show total) ++" hours") ] @@ -33,7 +33,7 @@ mkFullDoc :: [Github.Issue] -> Doc mkFullDoc = mkDoc . prepareReport -- The public repo is used as private are quite sensitive for this report --- +-- -- The main idea is to use labels like 1h, 2h etc for man-hour estimation of issues -- on private repos for development "on hire" -- @@ -45,4 +45,4 @@ main = do possibleIssues <- Github.issuesForRepo' auth "paulrzcz" "hquantlib" limitations case possibleIssues of (Left err) -> putStrLn $ "Error: " ++ show err - (Right issues) -> putDoc $ mkFullDoc issues + (Right issues) -> putDoc $ mkFullDoc issues diff --git a/samples/Issues/IssueReport/Report.hs b/samples/Issues/IssueReport/Report.hs index 307bba95..76abe4f8 100644 --- a/samples/Issues/IssueReport/Report.hs +++ b/samples/Issues/IssueReport/Report.hs @@ -45,7 +45,7 @@ sumUp = foldl s 0.0 s z (Just x) = z+x toNames :: [Github.IssueLabel] -> [Maybe Double] -toNames = map (toValue . Github.labelName) +toNames = map (toValue . Github.labelName) isValue :: String -> Bool isValue label = (label =~ ("^[0-9]h" :: String)) :: Bool diff --git a/samples/Repos/Commits/GitShow.hs b/samples/Repos/Commits/GitShow.hs index b913cb47..9b5ab8a2 100644 --- a/samples/Repos/Commits/GitShow.hs +++ b/samples/Repos/Commits/GitShow.hs @@ -18,7 +18,7 @@ formatCommit commit = patches where author = Github.gitCommitAuthor gitCommit gitCommit = Github.commitGitCommit commit - patches = + patches = intercalate "\n" $ map Github.filePatch $ Github.commitFiles commit formatAuthor :: Github.GitUser -> String diff --git a/samples/Repos/DeployKeys/ShowDeployKey.hs b/samples/Repos/DeployKeys/ShowDeployKey.hs index 48e06b94..6df4d11c 100644 --- a/samples/Repos/DeployKeys/ShowDeployKey.hs +++ b/samples/Repos/DeployKeys/ShowDeployKey.hs @@ -17,4 +17,3 @@ main = do formatRepoDeployKey :: DK.RepoDeployKey -> String formatRepoDeployKey = show - diff --git a/samples/Search/SearchCode.hs b/samples/Search/SearchCode.hs index c632e2ae..f5b472cb 100644 --- a/samples/Search/SearchCode.hs +++ b/samples/Search/SearchCode.hs @@ -30,4 +30,4 @@ formatCode r = in intercalate "\n" $ map fmt fields where fmt (s,f) = fill 12 (s ++ ":") ++ " " ++ f r fill n s = s ++ replicate n' ' ' - where n' = max 0 (n - length s) + where n' = max 0 (n - length s) diff --git a/samples/Search/SearchRepos.hs b/samples/Search/SearchRepos.hs index 0a558b7e..e09c2bfc 100644 --- a/samples/Search/SearchRepos.hs +++ b/samples/Search/SearchRepos.hs @@ -52,7 +52,7 @@ formatRepo r = where fmt (s,f) = fill 12 (s ++ ":") ++ " " ++ f r orEmpty = fromMaybe "" fill n s = s ++ replicate n' ' ' - where n' = max 0 (n - length s) + where n' = max 0 (n - length s) formatMaybeDate :: Maybe UTCTime -> String diff --git a/samples/Users/Followers/ListFollowers.hs b/samples/Users/Followers/ListFollowers.hs index a5ef346c..dc5df3fe 100644 --- a/samples/Users/Followers/ListFollowers.hs +++ b/samples/Users/Followers/ListFollowers.hs @@ -9,7 +9,7 @@ import qualified GitHub main :: IO () main = do auth <- getAuth - possibleUsers <- GitHub.executeRequestMaybe auth $ GitHub.usersFollowingR "mike-burns" GitHub.FetchAll + possibleUsers <- GitHub.executeRequestMaybe auth $ GitHub.usersFollowingR "mike-burns" GitHub.FetchAll putStrLn $ either (("Error: " <>) . tshow) (foldMap ((<> "\n") . formatUser)) possibleUsers diff --git a/samples/Users/Followers/ListFollowing.hs b/samples/Users/Followers/ListFollowing.hs index 171f2fba..81953aee 100644 --- a/samples/Users/Followers/ListFollowing.hs +++ b/samples/Users/Followers/ListFollowing.hs @@ -9,7 +9,7 @@ import qualified GitHub main :: IO () main = do auth <- getAuth - possibleUsers <- GitHub.executeRequestMaybe auth $ GitHub.usersFollowedByR "mike-burns" GitHub.FetchAll + possibleUsers <- GitHub.executeRequestMaybe auth $ GitHub.usersFollowedByR "mike-burns" GitHub.FetchAll putStrLn $ either (("Error: " <>) . tshow) (foldMap ((<> "\n") . formatUser)) possibleUsers diff --git a/spec/GitHub/ActivitySpec.hs b/spec/GitHub/ActivitySpec.hs index 1f3c82c3..73b044a0 100644 --- a/spec/GitHub/ActivitySpec.hs +++ b/spec/GitHub/ActivitySpec.hs @@ -30,7 +30,7 @@ spec :: Spec spec = do describe "watchersForR" $ do it "works" $ withAuth $ \auth -> do - cs <- executeRequest auth $ watchersForR "phadej" "github" GitHub.FetchAll + cs <- executeRequest auth $ watchersForR "phadej" "github" GitHub.FetchAll cs `shouldSatisfy` isRight V.length (fromRightS cs) `shouldSatisfy` (> 10) describe "myStarredR" $ do diff --git a/spec/GitHub/EventsSpec.hs b/spec/GitHub/EventsSpec.hs index 93f613b1..ae51a1a2 100644 --- a/spec/GitHub/EventsSpec.hs +++ b/spec/GitHub/EventsSpec.hs @@ -29,7 +29,7 @@ spec = do it "returns non empty list of events" $ shouldSucceed $ GitHub.repositoryEventsR "phadej" "github" 1 describe "userEventsR" $ do - it "returns non empty list of events" $ shouldSucceed $ GitHub.userEventsR "phadej" 1 + it "returns non empty list of events" $ shouldSucceed $ GitHub.userEventsR "phadej" 1 where shouldSucceed f = withAuth $ \auth -> do cs <- GitHub.executeRequest auth $ f cs `shouldSatisfy` isRight diff --git a/src/GitHub/Data/Events.hs b/src/GitHub/Data/Events.hs index 8ec6a22d..d7b34528 100644 --- a/src/GitHub/Data/Events.hs +++ b/src/GitHub/Data/Events.hs @@ -23,10 +23,10 @@ data Event = Event deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Event where rnf = genericRnf -instance Binary Event +instance Binary Event instance FromJSON Event where - parseJSON = withObject "Event" $ \obj -> Event + parseJSON = withObject "Event" $ \obj -> Event -- <$> obj .: "id" <$> obj .: "actor" <*> obj .: "created_at" From 9d0f1bee5fe58f7d349bc23ec29d19f6cde0930d Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Tue, 19 Apr 2022 18:07:31 +0200 Subject: [PATCH 451/510] fix-whitespace configuration file Fix whitespace violations in files as defined by fix-whitespace.yaml via $ fix-whitespace --- fix-whitespace.yaml | 61 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 61 insertions(+) create mode 100644 fix-whitespace.yaml diff --git a/fix-whitespace.yaml b/fix-whitespace.yaml new file mode 100644 index 00000000..80795e01 --- /dev/null +++ b/fix-whitespace.yaml @@ -0,0 +1,61 @@ +# This file contains the project-specific settings for `fix-whitespace` +# +# (get it with `cabal install fix-whitespace`) +# +# a tiny, but useful tool to: +# +# * Remove trailing whitespace. +# * Remove trailing lines containing nothing but whitespace. +# * Ensure that the file ends in a newline character. +# +# By default, fix-whitespace checks every directory under the current working +# directory but no files. This program should be placed under a text-based +# project. +# +# For directories, +# +# 1) excluded-dirs is a black-list of directories, +# 2) included-dirs is a white-list of excluded-dirs +# +# For files, +# +# 3) included-files is a white-list of files, +# 4) excluded-files is a black-list of included-files. +# +# The extended glob pattern can be used to specify file/direcotory names. +# For details, see http://hackage.haskell.org/package/filemanip-0.3.6.3/docs/System-FilePath-GlobPattern.html +# + +excluded-dirs: + - .git + - .stack-work + - "dist*" + - fixtures + +included-dirs: + +# Every matched filename is included unless it is matched by excluded-files. +included-files: + - .authorspellings + - .gitignore + - LICENSE + - cabal.haskell-ci + - cabal.project + - cabal.project.local + - "*.cabal" + - "*.css" + - "*.example" + - "*.hs" + - "*.hs-boot" + - "*.html" + - "*.js" + - "*.json" + - "*.lhs" + - "*.md" + - "*.rst" + - "*.sh" + - "*.txt" + - "*.yaml" + - "*.yml" + +excluded-files: From 90a70c3722dfdd4f916d3ab3616f292953a8f664 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Tue, 19 Apr 2022 18:28:19 +0200 Subject: [PATCH 452/510] CHANGELOG & .cabal: move phadej -> haskell-github Also: cosmetical fixes --- CHANGELOG.md | 208 +++++++++++++++++++++++++-------------------------- github.cabal | 6 +- 2 files changed, 107 insertions(+), 107 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 10cc9b18..b7bcbc47 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,49 +1,49 @@ ## Changes for 0.27 -- Add vector of SimpleTeam in "requested_teams" field of PullRequest - [#453](https://github.com/phadej/github/pull/453) +- Add vector of `SimpleTeam` in "requested_teams" field of `PullRequest` + [#453](https://github.com/haskell-github/github/pull/453) - Add endpoint to create gist - [#455](https://github.com/phadej/github/pull/455) -- Update RepoWebhookEvent - [#461](https://github.com/phadej/github/pull/461) -- PullRequest Reviews may not have submitted_at field - [#450](https://github.com/phadej/github/pull/450) + [#455](https://github.com/haskell-github/github/pull/455) +- Update `RepoWebhookEvent` + [#461](https://github.com/haskell-github/github/pull/461) +- `PullRequest` Reviews may not have submitted_at field + [#450](https://github.com/haskell-github/github/pull/450) ## Changes for 0.26 -- Generalize PagedQuery to allow its reuse by preview github APIs - [#439](https://github.com/phadej/github/pull/439) +- Generalize `PagedQuery` to allow its reuse by preview github APIs + [#439](https://github.com/haskell-github/github/pull/439) - Add endpoint for listing organizations outside collaborators - [#445](https://github.com/phadej/github/pull/445) + [#445](https://github.com/haskell-github/github/pull/445) - Add endpoint for users search - [#444](https://github.com/phadej/github/pull/444) -- Make repoWebhookResponseStatus optional - [#436](https://github.com/phadej/github/pull/436) + [#444](https://github.com/haskell-github/github/pull/444) +- Make `repoWebhookResponseStatus` optional + [#436](https://github.com/haskell-github/github/pull/436) - Teams improvements - [#417](https://github.com/phadej/github/pull/417) -- Add deleteReference endpoint - [#388](https://github.com/phadej/github/pull/388) + [#417](https://github.com/haskell-github/github/pull/417) +- Add `deleteReference` endpoint + [#388](https://github.com/haskell-github/github/pull/388) ## Changes for 0.25 - Add `executeRequestWithMgrAndRes` - [#421](https://github.com/phadej/github/pull/421) + [#421](https://github.com/haskell-github/github/pull/421) - Add `limitsFromHttpResponse` - [#421](https://github.com/phadej/github/pull/421) + [#421](https://github.com/haskell-github/github/pull/421) - Add label descriptions - [#418](https://github.com/phadej/github/pull/418) + [#418](https://github.com/haskell-github/github/pull/418) - Add "draft" option to mergeable state - [#431](https://github.com/phadej/github/pull/431) -- Use IssueNumber in editIssueR and issueR - [#429](https://github.com/phadej/github/pull/429) + [#431](https://github.com/haskell-github/github/pull/431) +- Use `IssueNumber` in `editIssueR` and `issueR` + [#429](https://github.com/haskell-github/github/pull/429) - Manage orgs in GitHub Enterprise - [#420](https://github.com/phadej/github/pull/420) + [#420](https://github.com/haskell-github/github/pull/420) - Add support for collaborator permission endpoint - [#425](https://github.com/phadej/github/pull/425) + [#425](https://github.com/haskell-github/github/pull/425) - Add support for the comment reply endpoint - [#424](https://github.com/phadej/github/pull/424) + [#424](https://github.com/haskell-github/github/pull/424) - Organise exports in `GitHub` - [#430](https://github.com/phadej/github/pull/430) + [#430](https://github.com/haskell-github/github/pull/430) ## Changes for 0.24 @@ -53,122 +53,122 @@ into `... -> IO (Either Error res)` (i.e. n-ary `executeRequest`). With that in place drop `.. -> IO (Either Error res)` functions. This reduces symbol bloat in the library. -[#415](https://github.com/phadej/github/pull/415) +[#415](https://github.com/haskell-github/github/pull/415) - Remove double `withOpenSSL` - [#414](https://github.com/phadej/github/pull/414) + [#414](https://github.com/haskell-github/github/pull/414) - Pull requests reviews API uses issue number - [#409](https://github.com/phadej/github/pull/409) + [#409](https://github.com/haskell-github/github/pull/409) - Update `Repo`, `NewRepo` and `EditRepo` data types - [#407](https://github.com/phadej/github/pull/407) + [#407](https://github.com/haskell-github/github/pull/407) ## Changes for 0.23 - Escape URI paths - [#404](https://github.com/phadej/github/pull/404) -- Add OwnerBot to OwnerType - [#399](https://github.com/phadej/github/pull/399) -- Make File.fileSha optional - [#392](https://github.com/phadej/github/pull/392) + [#404](https://github.com/haskell-github/github/pull/404) +- Add `OwnerBot` to `OwnerType` + [#399](https://github.com/haskell-github/github/pull/399) +- Make `File.fileSha` optional + [#392](https://github.com/haskell-github/github/pull/392) - Update User-Agent to contain up to date version - [#403](https://github.com/phadej/github/pull/403) - [#394](https://github.com/phadej/github/pull/394) + [#403](https://github.com/haskell-github/github/pull/403) + [#394](https://github.com/haskell-github/github/pull/394) ## Changes for 0.22 - Type-class for various auth methods - [#365](https://github.com/phadej/github/pull/365) + [#365](https://github.com/haskell-github/github/pull/365) - Throw on non-200 responses - [#350](https://github.com/phadej/github/pull/350) + [#350](https://github.com/haskell-github/github/pull/350) - Add extension point for (preview) media types - [#370](https://github.com/phadej/github/pull/370) + [#370](https://github.com/haskell-github/github/pull/370) - Add missing webhook event types - [#359](https://github.com/phadej/github/pull/359) + [#359](https://github.com/haskell-github/github/pull/359) - Add invitation endpoint - [#360](https://github.com/phadej/github/pull/360) + [#360](https://github.com/haskell-github/github/pull/360) - Add notifications endpoints - [#324](https://github.com/phadej/github/pull/324) + [#324](https://github.com/haskell-github/github/pull/324) - Add ssh keys endpoints - [#363](https://github.com/phadej/github/pull/365) + [#363](https://github.com/haskell-github/github/pull/365) - Case insensitive enum parsing - [#373](https://github.com/phadej/github/pull/373) + [#373](https://github.com/haskell-github/github/pull/373) - Don't try parse unitary responses - [#377](https://github.com/phadej/github/issues/377) + [#377](https://github.com/haskell-github/github/issues/377) - Update dependencies - [#364](https://github.com/phadej/github/pull/364) - [#368](https://github.com/phadej/github/pull/368) - [#369](https://github.com/phadej/github/pull/369) + [#364](https://github.com/haskell-github/github/pull/364) + [#368](https://github.com/haskell-github/github/pull/368) + [#369](https://github.com/haskell-github/github/pull/369) - Documentation improvements - [#357](https://github.com/phadej/github/pull/357) + [#357](https://github.com/haskell-github/github/pull/357) ## Changes for 0.21 - Refactor `Request` type. - [#349](https://github.com/phadej/github/pull/349) + [#349](https://github.com/haskell-github/github/pull/349) - Allow `http-client-0.6` - [#344](https://github.com/phadej/github/pull/344) + [#344](https://github.com/haskell-github/github/pull/344) - Change to use `cryptohash-sha1` (`cryptohash` was used before) -- Add Create milestone endponts - [#337](https://github.com/phadej/github/pull/337) -- Make fileBlobUrl and fileRawUrl are optional - [#339](https://github.com/phadej/github/issues/339) - [#340](https://github.com/phadej/github/pull/340) -- Add organizationsR to request user organizations - [#345](https://github.com/phadej/github/pull/345) -- Add updateMilestoneR, deleteMilestoneR - [#338](https://github.com/phadej/github/pull/338) -- Allow multiple assignees in NewIssue and EditIssue - [#336](https://github.com/phadej/github/pull/336) +- Add Create milestone endpoints + [#337](https://github.com/haskell-github/github/pull/337) +- Make `fileBlobUrl` and `fileRawUrl` optional + [#339](https://github.com/haskell-github/github/issues/339) + [#340](https://github.com/haskell-github/github/pull/340) +- Add `organizationsR` to request user organizations + [#345](https://github.com/haskell-github/github/pull/345) +- Add `updateMilestoneR`, `deleteMilestoneR` + [#338](https://github.com/haskell-github/github/pull/338) +- Allow multiple assignees in `NewIssue` and `EditIssue` + [#336](https://github.com/haskell-github/github/pull/336) - Add `pullRequestPatchR` and `pullRequestDiffR` - [#325](https://github.com/phadej/github/pull/325) + [#325](https://github.com/haskell-github/github/pull/325) ## Changes for 0.20 - Add ratelimit endpoint - [#315](https://github.com/phadej/github/pull/315) + [#315](https://github.com/haskell-github/github/pull/315) - Add some deployment endoints - [#330](https://github.com/phadej/github/pull/330) + [#330](https://github.com/haskell-github/github/pull/330) - Add webhook installation events - [#329](https://github.com/phadej/github/pull/330) -- Tigthen lower bounds (also remove aeson-compat dep) - [#332](https://github.com/phadej/github/pull/332) + [#329](https://github.com/haskell-github/github/pull/330) +- Tighten lower bounds (also remove `aeson-compat` dep) + [#332](https://github.com/haskell-github/github/pull/332) ## Changes for 0.19 - Fix issue event type enumeration - [#301](https://github.com/phadej/github/issues/301) -- Include label info in `IssseEvent` - [#302](https://github.com/phadej/github/issues/302) + [#301](https://github.com/haskell-github/github/issues/301) +- Include label info in `IssueEvent` + [#302](https://github.com/haskell-github/github/issues/302) - Fix `ShowRepo` example - [#306](https://github.com/phadej/github/pull/306) + [#306](https://github.com/haskell-github/github/pull/306) - Add "Get archive link" API - [#307](https://github.com/phadej/github/pull/307) -- Make "repo" in PullRequestCommit nullable (repository can be gone) - [#311](https://github.com/phadej/github/pull/311) + [#307](https://github.com/haskell-github/github/pull/307) +- Make "repo" in `PullRequestCommit` nullable (repository can be gone) + [#311](https://github.com/haskell-github/github/pull/311) - Add read-only emails endpoint - [#313](https://github.com/phadej/github/pull/313) + [#313](https://github.com/haskell-github/github/pull/313) - Organisation membership API - [#312](https://github.com/phadej/github/pull/312) -- Fix isPullRequestMerged and other boolean responses - [#312](https://github.com/phadej/github/pull/312) + [#312](https://github.com/haskell-github/github/pull/312) +- Fix `isPullRequestMerged` and other boolean responses + [#312](https://github.com/haskell-github/github/pull/312) - Add `behind` pull request mergeable state - [#308](https://github.com/phadej/github/pull/308) + [#308](https://github.com/haskell-github/github/pull/308) - Add list organisation invitations endpoint ## Changes for 0.18 - Endpoints for deleting issue comments. - [#294](https://github.com/phadej/github/pull/294) + [#294](https://github.com/haskell-github/github/pull/294) - Endpoints for (un)starring gists. - [#296](https://github.com/phadej/github/pull/296) + [#296](https://github.com/haskell-github/github/pull/296) - Add `archived` field to `Repo`. - [#298](https://github.com/phadej/github/pull/298) + [#298](https://github.com/haskell-github/github/pull/298) - Update dependencies. - [#295](https://github.com/phadej/github/pull/295) + [#295](https://github.com/haskell-github/github/pull/295) - Add Statuses endpoints. - [#268](https://github.com/phadej/github/pull/268) + [#268](https://github.com/haskell-github/github/pull/268) - Add requested reviewers field to pull request records. - [#292](https://github.com/phadej/github/pull/292) + [#292](https://github.com/haskell-github/github/pull/292) ## Changes for 0.17.0 @@ -184,7 +184,7 @@ This reduces symbol bloat in the library. - Supports newest versions of dependencies - user events - release endpoints -- forkExistingRepo +- `forkExistingRepo` ## Changes for 0.15.0 @@ -197,16 +197,16 @@ This reduces symbol bloat in the library. - Add `HeaderQuery` to `Request` - Add `Hashable Auth` instance - Add `mkUserId`, `mkUserName`, `fromUserId`, `fromOrganizationId` -- Add 'userIssuesR' -- Add 'organizationIssuesR' +- Add `userIssuesR` +- Add `organizationIssuesR` - Make `teamName :: Text` amnd `teamSlug :: Name Team` in both: `Team` and `SimpleTeam` -- Refactor 'Request' structure +- Refactor `Request` structure - Added multiple issue assignees - Preliminary support for repository events: `repositoryEventsR` - Support for adding repository permissions to the team -- Remove 'simpleUserType', it was always the same. +- Remove `simpleUserType`, it was always the same. -See [git commit summary](https://github.com/phadej/github/compare/v0.14.1...v0.15.0) +See [git commit summary](https://github.com/haskell-github/github/compare/v0.14.1...v0.15.0) ## Changes for 0.14.1 @@ -229,23 +229,23 @@ Large API changes: ## Changes for 0.5.0: -* OAuth. +* `OAuth`. * New function: `Github.Repos.organizationRepo`, to get the repo for a specific organization. * Introduce a new `newRepoAutoInit` flag to `NewRepo`, for whether to initialize a repo while creating it. -* Relax the attoparsec version requirements. +* Relax the `attoparsec` version requirements. * The above by [John Wiegley](https://github.com/jwiegley). ## Changes for 0.4.1: -* Stop using the uri package. -* Use aeson version 0.6.1.0. -* Use attoparsec version 0.10.3.0. -* Use http-conduit over 1.8. -* Use unordered-containers between 0.2 and 0.3. +* Stop using the `uri` package. +* Use `aeson` version 0.6.1.0. +* Use `attoparsec` version 0.10.3.0. +* Use `http-conduit` over 1.8. +* Use `unordered-containers` between 0.2 and 0.3. ## Changes for 0.4.0: -* Use http-conduit version 1.4.1.10. +* Use `http-conduit` version 1.4.1.10. ## Changes for 0.3.0: @@ -259,13 +259,13 @@ Large API changes: ## Changes for 0.2.1: -* Expand the unordered-containers dependency to anything in 0.1.x . +* Expand the `unordered-containers` dependency to anything in 0.1.x . ## Changes for 0.2.0: * `milestoneDueOn` and `repoLanguage` are now `Maybe` types. -* Introduce `GithubOwner` as the sum type for a `GithubUser` or `GithubOrganization`. Everything that once produced a `GithubUser` now produces a `GithubOwner`. All record accessors have changed their names -* Similar to `GithubOwner`, introduce `DetailedOwner`, which can be a `DetailedUser` or a `DetailedOrganization`. All record accessors have changed their names +* Introduce `GithubOwner` as the sum type for a `GithubUser` or `GithubOrganization`. Everything that once produced a `GithubUser` now produces a `GithubOwner`. All record accessors have changed their names. +* Similar to `GithubOwner`, introduce `DetailedOwner`, which can be a `DetailedUser` or a `DetailedOrganization`. All record accessors have changed their names. * An `HTTPConnectionError` now composes `SomeException` instead of `IOException`. All exceptions raised by the underlying http-conduit library are encapulated there. * The `githubIssueClosedBy` function now produces a `Maybe GithubOwner`. * Remove the Blobs API, as it is broken upstream. diff --git a/github.cabal b/github.cabal index 04cb2c9a..670a3d2d 100644 --- a/github.cabal +++ b/github.cabal @@ -18,13 +18,13 @@ description: > possibleUser <- GH.github' GH.userInfoForR "phadej" > print possibleUser . - For more of an overview please see the README: + For more of an overview please see the README: license: BSD3 license-file: LICENSE author: Mike Burns, John Wiegley, Oleg Grenrus maintainer: Oleg Grenrus -homepage: https://github.com/phadej/github +homepage: https://github.com/haskell-github/github build-type: Simple copyright: Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016-2021 Oleg Grenrus @@ -48,7 +48,7 @@ extra-source-files: source-repository head type: git - location: git://github.com/phadej/github.git + location: git://github.com/haskell-github/github.git flag openssl description: "Use http-client-openssl" From 00a166f286fa296d14fb1a5f74cb0b6ed464a532 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Tue, 19 Apr 2022 18:30:01 +0200 Subject: [PATCH 453/510] CONTRIBUTING: add testing requirement --- CONTRIBUTING.md | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index 8bb941ef..dc10c361 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -15,13 +15,24 @@ For example: ```haskell -- | Get your current rate limit status. --- +-- rateLimitR :: Request k RateLimit rateLimitR = query ["rate_limit"] [] ``` Also re-export endpoints from the top `GitHub` module. *Note:* only `R` variants, not `IO`. +Testing +------- + +When adding new functionality, cover it by a test case in: + + spec/ + +or a demonstration added to: + + samples/github-samples.cabal + Miscellaneous ------------- From ebf466438a61297c6a38f725edb7ec1f4b950804 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Sat, 30 Apr 2022 09:08:50 +0200 Subject: [PATCH 454/510] CHANGELOG: add release dates and authors --- CHANGELOG.md | 62 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 62 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index b7bcbc47..1f45068e 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,7 @@ ## Changes for 0.27 +_2021-10-10, Oleg Grenrus_ + - Add vector of `SimpleTeam` in "requested_teams" field of `PullRequest` [#453](https://github.com/haskell-github/github/pull/453) - Add endpoint to create gist @@ -11,6 +13,8 @@ ## Changes for 0.26 +_2020-05-26, Oleg Grenrus_ + - Generalize `PagedQuery` to allow its reuse by preview github APIs [#439](https://github.com/haskell-github/github/pull/439) - Add endpoint for listing organizations outside collaborators @@ -26,6 +30,8 @@ ## Changes for 0.25 +_2020-02-18, Oleg Grenrus_ + - Add `executeRequestWithMgrAndRes` [#421](https://github.com/haskell-github/github/pull/421) - Add `limitsFromHttpResponse` @@ -47,6 +53,8 @@ ## Changes for 0.24 +_2019-11-27, Oleg Grenrus_ + **Major change**: Introduce `github` n-ary combinator to hoist `... -> Request rw res` into `... -> IO (Either Error res)` (i.e. n-ary `executeRequest`). @@ -64,6 +72,8 @@ This reduces symbol bloat in the library. ## Changes for 0.23 +_2019-10-01, Oleg Grenrus_ + - Escape URI paths [#404](https://github.com/haskell-github/github/pull/404) - Add `OwnerBot` to `OwnerType` @@ -76,6 +86,8 @@ This reduces symbol bloat in the library. ## Changes for 0.22 +_2019-05-31, Oleg Grenrus_ + - Type-class for various auth methods [#365](https://github.com/haskell-github/github/pull/365) - Throw on non-200 responses @@ -103,6 +115,8 @@ This reduces symbol bloat in the library. ## Changes for 0.21 +_2019-02-18, Oleg Grenrus_ + - Refactor `Request` type. [#349](https://github.com/haskell-github/github/pull/349) - Allow `http-client-0.6` @@ -124,6 +138,8 @@ This reduces symbol bloat in the library. ## Changes for 0.20 +_2018-09-26, Oleg Grenrus_ + - Add ratelimit endpoint [#315](https://github.com/haskell-github/github/pull/315) - Add some deployment endoints @@ -135,6 +151,8 @@ This reduces symbol bloat in the library. ## Changes for 0.19 +_2018-02-19, Oleg Grenrus_ + - Fix issue event type enumeration [#301](https://github.com/haskell-github/github/issues/301) - Include label info in `IssueEvent` @@ -157,6 +175,8 @@ This reduces symbol bloat in the library. ## Changes for 0.18 +_2017-11-10, Oleg Grenrus_ + - Endpoints for deleting issue comments. [#294](https://github.com/haskell-github/github/pull/294) - Endpoints for (un)starring gists. @@ -172,6 +192,8 @@ This reduces symbol bloat in the library. ## Changes for 0.17.0 +_2017-09-26, Oleg Grenrus_ + - Add `Ord Request` instance - Repository contents - Repository starring endpoints @@ -179,6 +201,8 @@ This reduces symbol bloat in the library. ## Changes for 0.16.0 +_2017-07-24, Oleg Grenrus_ + - Add support for `mergeable_state = "blocked".` - Fix HTTP status code of merge PR - Supports newest versions of dependencies @@ -188,6 +212,8 @@ This reduces symbol bloat in the library. ## Changes for 0.15.0 +_2016-11-04, Oleg Grenrus_ + - Reworked `PullRequest` (notably `pullRequestsFor`) - Reworked PR and Issue filtering - GHC-8.0.1 support @@ -210,6 +236,8 @@ See [git commit summary](https://github.com/haskell-github/github/compare/v0.14. ## Changes for 0.14.1 +_2016-02-02, Oleg Grenrus_ + - Add `membersOfWithR`, `listTeamMembersR` - Add related enums: `OrgMemberFilter`, `OrgMemberRole`, `TeamMemberRole` - Add `Enum` and `Bounded` instances to `Privacy`, `Permission`, @@ -218,6 +246,8 @@ See [git commit summary](https://github.com/haskell-github/github/compare/v0.14. ## Changes for 0.14.0 +_2016-01-25, Oleg Grenrus_ + Large API changes: - Use `Text` and `Vector` in place of `String` and `[]`. @@ -227,8 +257,30 @@ Large API changes: - Add `Binary` instances for all data - `GithubOwner` is a `newtype` of `Either User Organization`. There's still `SimpleOwner`. +## Releases without changelog + +| Version | Date | Uploader | +|---|---|---| +| __0.13.2__ | _2015-04-26_ | _John Wiegley_ | +| __0.13.1__ | _2014-12-01_ | _César López-Natarén_ | +| __0.13__ | _2014-11-09_ | _César López-Natarén_ | +| __0.12__ | _2014-11-09_ | _César López-Natarén_ | +| __0.11.1__ | _2014-09-07_ | _César López-Natarén_ | +| __0.11.0__ | _2014-08-25_ | _César López-Natarén_ | +| __0.10.0__ | _2014-08-18_ | _César López-Natarén_ | +| __0.9__ | _2014-07-31_ | _John Wiegley_ | +| __0.8__ | _2014-05-02_ | _John Wiegley_ | +| __0.7.4__ | _2014-01-22_ | _John Wiegley_ | +| __0.7.3__ | _2013-12-21_ | _John Wiegley_ | +| __0.7.2__ | _2013-12-02_ | _John Wiegley_ | +| __0.7.1__ | _2013-08-08_ | _John Wiegley_ | +| __0.7.0__ | _2013-04-26_ | _John Wiegley_ | +| __0.6.0__ | _2013-04-12_ | _John Wiegley_ | + ## Changes for 0.5.0: +_2013-02-05, Mike Burns_ + * `OAuth`. * New function: `Github.Repos.organizationRepo`, to get the repo for a specific organization. * Introduce a new `newRepoAutoInit` flag to `NewRepo`, for whether to initialize a repo while creating it. @@ -237,6 +289,8 @@ Large API changes: ## Changes for 0.4.1: +_2013-01-14, Mike Burns_ + * Stop using the `uri` package. * Use `aeson` version 0.6.1.0. * Use `attoparsec` version 0.10.3.0. @@ -245,10 +299,14 @@ Large API changes: ## Changes for 0.4.0: +_2012-06-26, Mike Burns_ + * Use `http-conduit` version 1.4.1.10. ## Changes for 0.3.0: +_2012-06-10, Mike Burns_ + * Re-instantiate the Blobs API. * `repoDescription1` and `repoPushedAt` are a `Maybe GithubDate`. * Add `deleteRepo`, `editRepo`, and `createRepo`. @@ -259,10 +317,14 @@ Large API changes: ## Changes for 0.2.1: +_2012-02-16, Mike Burns_ + * Expand the `unordered-containers` dependency to anything in 0.1.x . ## Changes for 0.2.0: +_2012-02-15, Mike Burns_ + * `milestoneDueOn` and `repoLanguage` are now `Maybe` types. * Introduce `GithubOwner` as the sum type for a `GithubUser` or `GithubOrganization`. Everything that once produced a `GithubUser` now produces a `GithubOwner`. All record accessors have changed their names. * Similar to `GithubOwner`, introduce `DetailedOwner`, which can be a `DetailedUser` or a `DetailedOrganization`. All record accessors have changed their names. From cbd8d2b6fa33eace60a3a3accbed3823f9e70564 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Sat, 30 Apr 2022 09:44:05 +0200 Subject: [PATCH 455/510] Allow text-2.0 --- cabal.project | 8 ++------ github.cabal | 2 +- 2 files changed, 3 insertions(+), 7 deletions(-) diff --git a/cabal.project b/cabal.project index b9ac7eb6..3e6d3d45 100644 --- a/cabal.project +++ b/cabal.project @@ -4,12 +4,8 @@ packages: samples optimization: False tests: True -constraints: hashable >=1.3 -constraints: semigroups ^>=0.19 - constraints: github +openssl constraints: github-samples +openssl -allow-newer: deepseq-generics-0.2.0.0:base -allow-newer: deepseq-generics-0.2.0.0:ghc-prim -allow-newer: HsOpenSSL:bytestring +constraints: text >=2 +allow-newer: *:text diff --git a/github.cabal b/github.cabal index 670a3d2d..868629d4 100644 --- a/github.cabal +++ b/github.cabal @@ -171,7 +171,7 @@ library , containers >=0.5.5.1 && <0.7 , deepseq >=1.3.0.2 && <1.5 , mtl >=2.1.3.1 && <2.2 || >=2.2.1 && <2.3 - , text >=1.2.0.6 && <1.3 + , text >=1.2.0.6 && <2.1 , time-compat >=1.9.2.2 && <1.10 , transformers >=0.3.0.0 && <0.6 From f371051bce54b702268029dff6a9a03783f11c91 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Sat, 30 Apr 2022 10:19:22 +0200 Subject: [PATCH 456/510] Use repo haskell-github/github in specs and samples Repo moved from phadej/github. --- samples/Activity/Starring/StarRepo.hs | 2 +- samples/Activity/Starring/UnstarRepo.hs | 2 +- samples/Operational/Operational.hs | 2 +- spec/GitHub/ActivitySpec.hs | 2 +- spec/GitHub/CommitsSpec.hs | 8 ++++---- spec/GitHub/EventsSpec.hs | 2 +- spec/GitHub/IssuesSpec.hs | 4 ++-- spec/GitHub/PullRequestReviewsSpec.hs | 2 +- spec/GitHub/PullRequestsSpec.hs | 8 ++++---- spec/GitHub/ReposSpec.hs | 6 +++--- spec/GitHub/SearchSpec.hs | 2 +- spec/GitHub/UsersSpec.hs | 2 +- 12 files changed, 21 insertions(+), 21 deletions(-) diff --git a/samples/Activity/Starring/StarRepo.hs b/samples/Activity/Starring/StarRepo.hs index 452aaf7b..1174c380 100644 --- a/samples/Activity/Starring/StarRepo.hs +++ b/samples/Activity/Starring/StarRepo.hs @@ -8,7 +8,7 @@ import qualified Data.Text.IO as T main :: IO () main = do - let owner = "phadej" + let owner = "haskell-github" repo = "github" result <- GH.starRepo (GH.OAuth "your-token") (GH.mkOwnerName owner) (GH.mkRepoName repo) diff --git a/samples/Activity/Starring/UnstarRepo.hs b/samples/Activity/Starring/UnstarRepo.hs index 29d68dd1..3ecfe196 100644 --- a/samples/Activity/Starring/UnstarRepo.hs +++ b/samples/Activity/Starring/UnstarRepo.hs @@ -8,7 +8,7 @@ import qualified Data.Text.IO as T main :: IO () main = do - let owner = "phadej" + let owner = "haskell-github" repo = "github" result <- GH.unstarRepo (GH.OAuth "your-token") (GH.mkOwnerName owner) (GH.mkRepoName repo) diff --git a/samples/Operational/Operational.hs b/samples/Operational/Operational.hs index 4e669ff4..cbfc9fb4 100644 --- a/samples/Operational/Operational.hs +++ b/samples/Operational/Operational.hs @@ -47,7 +47,7 @@ main = GH.withOpenSSL $ do script :: Program R (GH.Owner, GH.Limits) script = do - repo <- githubRequest $ GH.repositoryR "phadej" "github" + repo <- githubRequest $ GH.repositoryR "haskell-github" "github" owner <- githubRequest $ GH.ownerInfoForR (GH.simpleOwnerLogin . GH.repoOwner $ repo) rl <- githubRequest GH.rateLimitR return (owner, GH.rateLimitCore rl) diff --git a/spec/GitHub/ActivitySpec.hs b/spec/GitHub/ActivitySpec.hs index 73b044a0..43b3c234 100644 --- a/spec/GitHub/ActivitySpec.hs +++ b/spec/GitHub/ActivitySpec.hs @@ -30,7 +30,7 @@ spec :: Spec spec = do describe "watchersForR" $ do it "works" $ withAuth $ \auth -> do - cs <- executeRequest auth $ watchersForR "phadej" "github" GitHub.FetchAll + cs <- executeRequest auth $ watchersForR "haskell-github" "github" GitHub.FetchAll cs `shouldSatisfy` isRight V.length (fromRightS cs) `shouldSatisfy` (> 10) describe "myStarredR" $ do diff --git a/spec/GitHub/CommitsSpec.hs b/spec/GitHub/CommitsSpec.hs index 5bf2d6a0..97f8c386 100644 --- a/spec/GitHub/CommitsSpec.hs +++ b/spec/GitHub/CommitsSpec.hs @@ -30,13 +30,13 @@ spec :: Spec spec = do describe "commitsFor" $ do it "works" $ withAuth $ \auth -> do - cs <- github auth commitsForR "phadej" "github" FetchAll + cs <- github auth commitsForR "haskell-github" "github" FetchAll cs `shouldSatisfy` isRight V.length (fromRightS cs) `shouldSatisfy` (> 300) -- Page size is 30, so we get 60 commits it "limits the response" $ withAuth $ \auth -> do - cs <- github auth commitsForR "phadej" "github" (FetchAtLeast 40) + cs <- github auth commitsForR "haskell-github" "github" (FetchAtLeast 40) cs `shouldSatisfy` isRight let cs' = fromRightS cs V.length cs' `shouldSatisfy` (< 70) @@ -45,12 +45,12 @@ spec = do describe "diff" $ do it "works" $ withAuth $ \auth -> do - cs <- github auth commitsForR "phadej" "github" (FetchAtLeast 30) + cs <- github auth commitsForR "haskell-github" "github" (FetchAtLeast 30) cs `shouldSatisfy` isRight let commits = take 10 . V.toList . fromRightS $ cs let pairs = zip commits $ drop 1 commits forM_ pairs $ \(a, b) -> do - d <- github auth diffR "phadej" "github" (commitSha a) (commitSha b) + d <- github auth diffR "haskell-github" "github" (commitSha a) (commitSha b) d `shouldSatisfy` isRight it "issue #155" $ withAuth $ \auth -> do diff --git a/spec/GitHub/EventsSpec.hs b/spec/GitHub/EventsSpec.hs index ae51a1a2..fee7f50e 100644 --- a/spec/GitHub/EventsSpec.hs +++ b/spec/GitHub/EventsSpec.hs @@ -27,7 +27,7 @@ spec :: Spec spec = do describe "repositoryEventsR" $ do it "returns non empty list of events" $ shouldSucceed $ - GitHub.repositoryEventsR "phadej" "github" 1 + GitHub.repositoryEventsR "haskell-github" "github" 1 describe "userEventsR" $ do it "returns non empty list of events" $ shouldSucceed $ GitHub.userEventsR "phadej" 1 where shouldSucceed f = withAuth $ \auth -> do diff --git a/spec/GitHub/IssuesSpec.hs b/spec/GitHub/IssuesSpec.hs index 2ed08278..2a7f5e7b 100644 --- a/spec/GitHub/IssuesSpec.hs +++ b/spec/GitHub/IssuesSpec.hs @@ -41,10 +41,10 @@ spec = do describe "issueR" $ do it "fetches issue #428" $ withAuth $ \auth -> do resIss <- GitHub.executeRequest auth $ - GitHub.issueR "phadej" "github" (GitHub.IssueNumber 428) + GitHub.issueR "haskell-github" "github" (GitHub.IssueNumber 428) resIss `shouldSatisfy` isRight where repos = [ ("thoughtbot", "paperclip") - , ("phadej", "github") + , ("haskell-github", "github") ] diff --git a/spec/GitHub/PullRequestReviewsSpec.hs b/spec/GitHub/PullRequestReviewsSpec.hs index 8721efc9..1aed07e4 100644 --- a/spec/GitHub/PullRequestReviewsSpec.hs +++ b/spec/GitHub/PullRequestReviewsSpec.hs @@ -29,4 +29,4 @@ spec = do cs `shouldSatisfy` isRight where prs = - [("phadej", "github", IssueNumber 268)] + [("haskell-github", "github", IssueNumber 268)] diff --git a/spec/GitHub/PullRequestsSpec.hs b/spec/GitHub/PullRequestsSpec.hs index 7a49bc97..05945d01 100644 --- a/spec/GitHub/PullRequestsSpec.hs +++ b/spec/GitHub/PullRequestsSpec.hs @@ -47,7 +47,7 @@ spec = do describe "pullRequestPatchR" $ it "works" $ withAuth $ \auth -> do Right patch <- GH.executeRequest auth $ - GH.pullRequestPatchR "phadej" "github" (GH.IssueNumber 349) + GH.pullRequestPatchR "haskell-github" "github" (GH.IssueNumber 349) head (LBS8.lines patch) `shouldBe` "From c0e4ad33811be82e1f72ee76116345c681703103 Mon Sep 17 00:00:00 2001" describe "decoding pull request payloads" $ do @@ -74,21 +74,21 @@ spec = do describe "checking if a pull request is merged" $ do it "works" $ withAuth $ \auth -> do - b <- GH.executeRequest auth $ GH.isPullRequestMergedR "phadej" "github" (GH.IssueNumber 14) + b <- GH.executeRequest auth $ GH.isPullRequestMergedR "haskell-github" "github" (GH.IssueNumber 14) b `shouldSatisfy` isRight fromRightS b `shouldBe` True describe "Draft Pull Request" $ do it "works" $ withAuth $ \auth -> do cs <- GH.executeRequest auth $ - draftPullRequestsForR "phadej" "github" opts GH.FetchAll + draftPullRequestsForR "haskell-github" "github" opts GH.FetchAll cs `shouldSatisfy` isRight where repos = [ ("thoughtbot", "paperclip") - , ("phadej", "github") + , ("haskell-github", "github") ] opts = GH.stateClosed diff --git a/spec/GitHub/ReposSpec.hs b/spec/GitHub/ReposSpec.hs index a08ca00d..45c32415 100644 --- a/spec/GitHub/ReposSpec.hs +++ b/spec/GitHub/ReposSpec.hs @@ -29,10 +29,10 @@ spec :: Spec spec = do describe "repositoryR" $ do it "works" $ withAuth $ \auth -> do - er <- github auth repositoryR "phadej" "github" + er <- github auth repositoryR "haskell-github" "github" er `shouldSatisfy` isRight let Right r = er - -- https://github.com/phadej/github/pull/219 + -- https://github.com/haskell-github/github/pull/219 repoDefaultBranch r `shouldBe` Just "master" describe "currentUserRepos" $ do @@ -47,6 +47,6 @@ spec = do describe "languagesFor'" $ do it "works" $ withAuth $ \auth -> do - ls <- github auth languagesForR "phadej" "github" + ls <- github auth languagesForR "haskell-github" "github" ls `shouldSatisfy` isRight fromRightS ls `shouldSatisfy` HM.member "Haskell" diff --git a/spec/GitHub/SearchSpec.hs b/spec/GitHub/SearchSpec.hs index f82a2051..23c6b7a9 100644 --- a/spec/GitHub/SearchSpec.hs +++ b/spec/GitHub/SearchSpec.hs @@ -54,7 +54,7 @@ spec = do issueState issue2 `shouldBe` StateOpen it "performs an issue search via the API" $ withAuth $ \auth -> do - let query = "Decouple in:title repo:phadej/github created:<=2015-12-01" + let query = "Decouple in:title repo:haskell-github/github created:<=2015-12-01" issues <- fmap (searchResultResults . fromRightS) <$> github auth $ searchIssuesR query 5 length issues `shouldBe` 1 issueId (V.head issues) `shouldBe` mkId (Proxy :: Proxy Issue) 119694665 diff --git a/spec/GitHub/UsersSpec.hs b/spec/GitHub/UsersSpec.hs index abb2a882..0b1913f5 100644 --- a/spec/GitHub/UsersSpec.hs +++ b/spec/GitHub/UsersSpec.hs @@ -67,7 +67,7 @@ spec = do (userLogin . fromLeftS . fromOwner . fromRightS $ b) `shouldBe` "phadej" describe "userInfoCurrentR" $ do - it "returns information about the autenticated user" $ withAuth $ \auth -> do + it "returns information about the authenticated user" $ withAuth $ \auth -> do userInfo <- github auth userInfoCurrentR userInfo `shouldSatisfy` isRight From 8b282c729db67e9c273785d3a6ff093eb2f89347 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Sat, 30 Apr 2022 10:37:38 +0200 Subject: [PATCH 457/510] Fix warning introduced by #474 --- src/GitHub/Data/Search.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/GitHub/Data/Search.hs b/src/GitHub/Data/Search.hs index 951d1c83..96b9f2c8 100644 --- a/src/GitHub/Data/Search.hs +++ b/src/GitHub/Data/Search.hs @@ -32,7 +32,7 @@ instance Semigroup res => Semigroup (SearchResult' res) where (SearchResult count res) <> (SearchResult count' res') = SearchResult (max count count') (res <> res') instance Foldable SearchResult' where - foldMap f (SearchResult count results) = f results + foldMap f (SearchResult _count results) = f results data Code = Code { codeName :: !Text From e63d4ac814c0e074ca32067a249e79b6f0928546 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Sat, 30 Apr 2022 11:10:18 +0200 Subject: [PATCH 458/510] README: link to github-rest (alternative solution) --- README.md | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index 18313f24..8deb6bf1 100644 --- a/README.md +++ b/README.md @@ -16,14 +16,13 @@ Installation In your project's cabal file: ```cabal --- Packages needed in order to build this package. Build-depends: github ``` Or from the command line: ```sh -cabal install github +cabal v1-install github ``` Example Usage @@ -94,3 +93,11 @@ Copyright 2016-2019 Oleg Grenrus. Available under the BSD 3-clause license. [hackage]: http://hackage.haskell.org/package/github "Hackage" + +Alternative +=========== + +Library [`github-rest`](https://hackage.haskell.org/package/github-rest) +also provides an interface to the GitHub API. +It compares itself to `github` here: +https://github.com/LeapYear/github-rest#comparison-to-other-libraries From d9ac0c7ffbcc720a24d06f0a96ea4e3891316d1a Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Sat, 30 Apr 2022 10:30:06 +0200 Subject: [PATCH 459/510] Bump to 0.28; CHANGELOG for v0.28 --- CHANGELOG.md | 27 +++++++++++++++++++++++++++ README.md | 2 +- github.cabal | 4 ++-- 3 files changed, 30 insertions(+), 3 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 1f45068e..f5bdfaaf 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,30 @@ +## Changes for 0.28 + +_2022-04-30, Andreas Abel, Valborg edition_ + +Tested with GHC 7.8 - 9.2.2 + +- Add constructors to `IssueRepoMod` that allow filtering issues by + milestone, assignee, creator, mentioned user: + `GitHub.Data.Options.options{Milestone,Assignee,Creator,Mentioned}` + (PR [#470](https://github.com/haskell-github/github/pull/470)) + +- Add permissions field to `Repo`. + This adds record `RepoPermissions` and field `Repo.repoPermissions` + in module `GitHub.Data.Repos`. + (PR [#476](https://github.com/haskell-github/github/pull/476)) + +- Add unwatch request `GitHub.Endpoints.Activity.Watching.unwatchRepoR` + (PR [#473](https://github.com/haskell-github/github/pull/473)) + +Breaking change: + +- Make searches paginated + (PR [#474](https://github.com/haskell-github/github/pull/474)): + * Adds record `GitHub.Data.Repos.CodeSearchRepo`. + * Adds argument `FetchCount` + to `GitHub.Endpoints.Search.search{Repos,Code,Issues,Users}R`. + ## Changes for 0.27 _2021-10-10, Oleg Grenrus_ diff --git a/README.md b/README.md index 8deb6bf1..6203a7b5 100644 --- a/README.md +++ b/README.md @@ -39,7 +39,7 @@ Documentation For details see the reference [documentation on Hackage][hackage]. Each module lines up with the hierarchy of -[documentation from the GitHub API](http://developer.github.com/v3/). +[documentation from the GitHub API](https://docs.github.com/en/rest). Request functions (ending with `R`) construct a data type which can be executed in `IO` by `executeRequest` functions. They are all listed in the root `GitHub` diff --git a/github.cabal b/github.cabal index 868629d4..b00fa5ef 100644 --- a/github.cabal +++ b/github.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: github -version: 0.27.1 +version: 0.28 synopsis: Access to the GitHub API, v3. category: Network description: @@ -23,7 +23,7 @@ description: license: BSD3 license-file: LICENSE author: Mike Burns, John Wiegley, Oleg Grenrus -maintainer: Oleg Grenrus +maintainer: Andreas Abel homepage: https://github.com/haskell-github/github build-type: Simple copyright: From 9aa9839a2a1e5e80e9b6d6f61c8288675a1ecede Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Sun, 22 May 2022 16:36:45 +0200 Subject: [PATCH 460/510] Relax upper bounds: hspec(-discover), mtl, transformers --- github.cabal | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/github.cabal b/github.cabal index b00fa5ef..2bfb954e 100644 --- a/github.cabal +++ b/github.cabal @@ -170,10 +170,10 @@ library , bytestring >=0.10.4.0 && <0.12 , containers >=0.5.5.1 && <0.7 , deepseq >=1.3.0.2 && <1.5 - , mtl >=2.1.3.1 && <2.2 || >=2.2.1 && <2.3 + , mtl >=2.1.3.1 && <2.2 || >=2.2.1 && <2.4 , text >=1.2.0.6 && <2.1 , time-compat >=1.9.2.2 && <1.10 - , transformers >=0.3.0.0 && <0.6 + , transformers >=0.3.0.0 && <0.7 -- other packages build-depends: @@ -216,7 +216,7 @@ test-suite github-test hs-source-dirs: spec main-is: Spec.hs ghc-options: -Wall -threaded - build-tool-depends: hspec-discover:hspec-discover >=2.7.1 && <2.10 + build-tool-depends: hspec-discover:hspec-discover >=2.7.1 && <2.11 other-extensions: TemplateHaskell other-modules: GitHub.ActivitySpec @@ -241,7 +241,7 @@ test-suite github-test , bytestring , file-embed , github - , hspec >=2.6.1 && <2.10 + , hspec >=2.6.1 && <2.11 , tagged , text , unordered-containers From 7107546062e39348f187d54ce060e0fcb9c1437d Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Sun, 22 May 2022 16:55:32 +0200 Subject: [PATCH 461/510] Update Haskell-CI Tried to add constraint-set for mtl-2.3 / transformers-0.6 but time isn't ripe for this yet (some deps do not allow mtl-2.3). --- .github/workflows/haskell-ci.yml | 13 ++++--------- cabal.haskell-ci | 9 +++++++++ cabal.project | 4 ++-- 3 files changed, 15 insertions(+), 11 deletions(-) diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index bbd13145..58b17373 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -8,9 +8,9 @@ # # For more information, see https://github.com/haskell-CI/haskell-ci # -# version: 0.14.3.20220416 +# version: 0.15.20220504 # -# REGENDATA ("0.14.3.20220416",["--config=cabal.haskell-ci","github","cabal.project"]) +# REGENDATA ("0.15.20220504",["--config=cabal.haskell-ci","github","cabal.project"]) # name: Haskell-CI on: @@ -23,7 +23,7 @@ on: jobs: linux: name: Haskell-CI - Linux - ${{ matrix.compiler }} - runs-on: ubuntu-18.04 + runs-on: ubuntu-20.04 timeout-minutes: 60 container: @@ -217,13 +217,8 @@ jobs: if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo "package github-samples" >> cabal.project ; fi if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods" >> cabal.project ; fi cat >> cabal.project <=1.3 - constraints: semigroups ^>=0.19 constraints: github +openssl constraints: github-samples +openssl - allow-newer: deepseq-generics-0.2.0.0:base - allow-newer: deepseq-generics-0.2.0.0:ghc-prim - allow-newer: HsOpenSSL:bytestring optimization: False EOF $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: $_ installed\n" unless /^(github|github-samples)$/; }' >> cabal.project.local @@ -260,7 +255,7 @@ jobs: if [ $((HCNUMVER >= 71000)) -ne 0 ] ; then ${CABAL} -vnormal check ; fi - name: haddock run: | - if [ $((HCNUMVER >= 80600)) -ne 0 ] ; then $CABAL v2-haddock $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all ; fi + if [ $((HCNUMVER >= 80600)) -ne 0 ] ; then $CABAL v2-haddock --haddock-all $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all ; fi - name: unconstrained build run: | rm -f cabal.project.local diff --git a/cabal.haskell-ci b/cabal.haskell-ci index eb8a2be2..a937b18a 100644 --- a/cabal.haskell-ci +++ b/cabal.haskell-ci @@ -2,3 +2,12 @@ branches: master haddock: >=8.6 -- See PR #355: haddocks for GADT constructor arguments only supported from GHC 8.6 jobs-selection: any + +-- Some dependencies do not allow mtl-2.3 yet, so this doesn't pass yet: +-- constraint-set mtl-2.3 +-- ghc: >= 8.6 +-- constraints: mtl >= 2.3, transformers >= 0.6 + +-- constraint-set text-2.0 +-- constraints: text >= 2.0 +-- allow-newer: *:text -- allow-newer not supported \ No newline at end of file diff --git a/cabal.project b/cabal.project index 3e6d3d45..4b4ee992 100644 --- a/cabal.project +++ b/cabal.project @@ -7,5 +7,5 @@ tests: True constraints: github +openssl constraints: github-samples +openssl -constraints: text >=2 -allow-newer: *:text +-- constraints: text >=2 +-- allow-newer: *:text From 2425a1576d2a1f9f954f18a1e2d9d20c95ef0a4c Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Sat, 28 May 2022 18:43:32 +0200 Subject: [PATCH 462/510] Drop unused dependency vector-instances --- github.cabal | 4 ++-- src/GitHub/Internal/Prelude.hs | 1 - 2 files changed, 2 insertions(+), 3 deletions(-) diff --git a/github.cabal b/github.cabal index 2bfb954e..0d8d45e9 100644 --- a/github.cabal +++ b/github.cabal @@ -40,6 +40,7 @@ tested-with: || ==8.10.7 || ==9.0.2 || ==9.2.2 + || ==9.4.1 extra-source-files: README.md @@ -165,7 +166,7 @@ library -- Packages bundles with GHC, mtl and text are also here build-depends: - base >=4.7 && <4.17 + base >=4.7 && <5 , binary >=0.7.1.0 && <0.11 , bytestring >=0.10.4.0 && <0.12 , containers >=0.5.5.1 && <0.7 @@ -194,7 +195,6 @@ library , transformers-compat >=0.6.5 && <0.8 , unordered-containers >=0.2.10.0 && <0.3 , vector >=0.12.0.1 && <0.13 - , vector-instances >=3.4 && <3.5 if flag(openssl) build-depends: diff --git a/src/GitHub/Internal/Prelude.hs b/src/GitHub/Internal/Prelude.hs index 2ac8633c..1994abac 100644 --- a/src/GitHub/Internal/Prelude.hs +++ b/src/GitHub/Internal/Prelude.hs @@ -57,6 +57,5 @@ import Data.Text (Text, pack, unpack) import Data.Time.Compat (UTCTime) import Data.Time.ISO8601 (formatISO8601) import Data.Vector (Vector) -import Data.Vector.Instances () import GHC.Generics (Generic) import Prelude.Compat From d9fce57138ff5db8e2500b21caa76b363e524696 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Sat, 28 May 2022 19:46:56 +0200 Subject: [PATCH 463/510] Haskell-CI: include 9.4 alpha --- .github/workflows/haskell-ci.yml | 42 +++++++++++++++++++++++--------- 1 file changed, 31 insertions(+), 11 deletions(-) diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index 58b17373..9c414512 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -8,9 +8,9 @@ # # For more information, see https://github.com/haskell-CI/haskell-ci # -# version: 0.15.20220504 +# version: 0.15.20220525 # -# REGENDATA ("0.15.20220504",["--config=cabal.haskell-ci","github","cabal.project"]) +# REGENDATA ("0.15.20220525",["--config=cabal.haskell-ci","github","cabal.project"]) # name: Haskell-CI on: @@ -32,6 +32,11 @@ jobs: strategy: matrix: include: + - compiler: ghc-9.4.0.20220501 + compilerKind: ghc + compilerVersion: 9.4.0.20220501 + setup-method: ghcup + allow-failure: true - compiler: ghc-9.2.2 compilerKind: ghc compilerVersion: 9.2.2 @@ -90,8 +95,9 @@ jobs: apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5 if [ "${{ matrix.setup-method }}" = ghcup ]; then mkdir -p "$HOME/.ghcup/bin" - curl -sL https://downloads.haskell.org/ghcup/0.1.17.5/x86_64-linux-ghcup-0.1.17.5 > "$HOME/.ghcup/bin/ghcup" + curl -sL https://downloads.haskell.org/ghcup/0.1.17.8/x86_64-linux-ghcup-0.1.17.8 > "$HOME/.ghcup/bin/ghcup" chmod a+x "$HOME/.ghcup/bin/ghcup" + if $HEADHACKAGE; then "$HOME/.ghcup/bin/ghcup" config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml; fi "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0 else @@ -99,7 +105,7 @@ jobs: apt-get update apt-get install -y "$HCNAME" mkdir -p "$HOME/.ghcup/bin" - curl -sL https://downloads.haskell.org/ghcup/0.1.17.5/x86_64-linux-ghcup-0.1.17.5 > "$HOME/.ghcup/bin/ghcup" + curl -sL https://downloads.haskell.org/ghcup/0.1.17.8/x86_64-linux-ghcup-0.1.17.8 > "$HOME/.ghcup/bin/ghcup" chmod a+x "$HOME/.ghcup/bin/ghcup" "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0 fi @@ -132,7 +138,7 @@ jobs: echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV" echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV" echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV" - echo "HEADHACKAGE=false" >> "$GITHUB_ENV" + if [ $((HCNUMVER >= 90400)) -ne 0 ] ; then echo "HEADHACKAGE=true" >> "$GITHUB_ENV" ; else echo "HEADHACKAGE=false" >> "$GITHUB_ENV" ; fi echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV" echo "GHCJSARITH=0" >> "$GITHUB_ENV" env: @@ -161,6 +167,17 @@ jobs: repository hackage.haskell.org url: http://hackage.haskell.org/ EOF + if $HEADHACKAGE; then + cat >> $CABAL_CONFIG <> $CABAL_CONFIG <> cabal.project - if [ $((HCNUMVER >= 71000)) -ne 0 ] ; then echo "packages: $GITHUB_WORKSPACE/source/samples" >> cabal.project ; fi + if [ $((HCNUMVER >= 71000 && HCNUMVER < 90400)) -ne 0 ] ; then echo "packages: $GITHUB_WORKSPACE/source/samples" >> cabal.project ; fi cat cabal.project - name: sdist run: | @@ -211,16 +228,19 @@ jobs: touch cabal.project touch cabal.project.local echo "packages: ${PKGDIR_github}" >> cabal.project - if [ $((HCNUMVER >= 71000)) -ne 0 ] ; then echo "packages: ${PKGDIR_github_samples}" >> cabal.project ; fi + if [ $((HCNUMVER >= 71000 && HCNUMVER < 90400)) -ne 0 ] ; then echo "packages: ${PKGDIR_github_samples}" >> cabal.project ; fi if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo "package github" >> cabal.project ; fi if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods" >> cabal.project ; fi - if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo "package github-samples" >> cabal.project ; fi - if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods" >> cabal.project ; fi + if [ $((HCNUMVER >= 80200 && HCNUMVER < 90400)) -ne 0 ] ; then echo "package github-samples" >> cabal.project ; fi + if [ $((HCNUMVER >= 80200 && HCNUMVER < 90400)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods" >> cabal.project ; fi cat >> cabal.project <> cabal.project + fi $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: $_ installed\n" unless /^(github|github-samples)$/; }' >> cabal.project.local cat cabal.project cat cabal.project.local @@ -251,8 +271,8 @@ jobs: run: | cd ${PKGDIR_github} || false ${CABAL} -vnormal check - if [ $((HCNUMVER >= 71000)) -ne 0 ] ; then cd ${PKGDIR_github_samples} || false ; fi - if [ $((HCNUMVER >= 71000)) -ne 0 ] ; then ${CABAL} -vnormal check ; fi + if [ $((HCNUMVER >= 71000 && HCNUMVER < 90400)) -ne 0 ] ; then cd ${PKGDIR_github_samples} || false ; fi + if [ $((HCNUMVER >= 71000 && HCNUMVER < 90400)) -ne 0 ] ; then ${CABAL} -vnormal check ; fi - name: haddock run: | if [ $((HCNUMVER >= 80600)) -ne 0 ] ; then $CABAL v2-haddock --haddock-all $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all ; fi From 299ad10ea23d9df5819f5e64dec9dd664ba74bb7 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Sat, 28 May 2022 19:56:22 +0200 Subject: [PATCH 464/510] LANGUAGE TypeOperators for GHC 9.4 --- github.cabal | 1 + 1 file changed, 1 insertion(+) diff --git a/github.cabal b/github.cabal index 0d8d45e9..e02094c6 100644 --- a/github.cabal +++ b/github.cabal @@ -72,6 +72,7 @@ library DeriveGeneric OverloadedStrings ScopedTypeVariables + TypeOperators other-extensions: CPP From 01c115466d0fe0b879dd16d85d3a730a4142eaae Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Thu, 16 Jun 2022 11:47:58 +0200 Subject: [PATCH 465/510] Allow aeson-2.1 --- github.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/github.cabal b/github.cabal index e02094c6..f10beef5 100644 --- a/github.cabal +++ b/github.cabal @@ -179,7 +179,7 @@ library -- other packages build-depends: - aeson >=1.4.0.0 && <1.6 || >=2.0.1.0 && <2.1 + aeson >=1.4.0.0 && <1.6 || >=2.0.1.0 && <2.2 , base-compat >=0.11.1 && <0.13 , base16-bytestring >=0.1.1.6 && <1.1 , binary-instances >=1 && <1.1 From ae33fd36a982b3d5ef55fed4d643910ecd96a984 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Sat, 23 Jul 2022 10:50:07 +0200 Subject: [PATCH 466/510] Haskell-CI: bump to 9.2.3 --- .github/workflows/haskell-ci.yml | 35 +++++++++++++++++--------------- cabal.haskell-ci | 2 +- github.cabal | 22 ++++++++++---------- samples/github-samples.cabal | 22 +++++++++++--------- 4 files changed, 43 insertions(+), 38 deletions(-) diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index 9c414512..ff536274 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -8,18 +8,20 @@ # # For more information, see https://github.com/haskell-CI/haskell-ci # -# version: 0.15.20220525 +# version: 0.15.20220710 # -# REGENDATA ("0.15.20220525",["--config=cabal.haskell-ci","github","cabal.project"]) +# REGENDATA ("0.15.20220710",["--config=cabal.haskell-ci","github","cabal.project"]) # name: Haskell-CI on: push: branches: - master + - ci* pull_request: branches: - master + - ci* jobs: linux: name: Haskell-CI - Linux - ${{ matrix.compiler }} @@ -32,14 +34,14 @@ jobs: strategy: matrix: include: - - compiler: ghc-9.4.0.20220501 + - compiler: ghc-9.4.0.20220623 compilerKind: ghc - compilerVersion: 9.4.0.20220501 + compilerVersion: 9.4.0.20220623 setup-method: ghcup allow-failure: true - - compiler: ghc-9.2.2 + - compiler: ghc-9.2.3 compilerKind: ghc - compilerVersion: 9.2.2 + compilerVersion: 9.2.3 setup-method: ghcup allow-failure: false - compiler: ghc-9.0.2 @@ -97,9 +99,9 @@ jobs: mkdir -p "$HOME/.ghcup/bin" curl -sL https://downloads.haskell.org/ghcup/0.1.17.8/x86_64-linux-ghcup-0.1.17.8 > "$HOME/.ghcup/bin/ghcup" chmod a+x "$HOME/.ghcup/bin/ghcup" - if $HEADHACKAGE; then "$HOME/.ghcup/bin/ghcup" config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml; fi - "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" - "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0 + "$HOME/.ghcup/bin/ghcup" config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml; + "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false) + "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false) else apt-add-repository -y 'ppa:hvr/ghc' apt-get update @@ -107,7 +109,7 @@ jobs: mkdir -p "$HOME/.ghcup/bin" curl -sL https://downloads.haskell.org/ghcup/0.1.17.8/x86_64-linux-ghcup-0.1.17.8 > "$HOME/.ghcup/bin/ghcup" chmod a+x "$HOME/.ghcup/bin/ghcup" - "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0 + "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false) fi env: HCKIND: ${{ matrix.compilerKind }} @@ -176,6 +178,7 @@ jobs: 26021a13b401500c8eb2761ca95c61f2d625bfef951b939a8124ed12ecf07329 f76d08be13e9a61a377a85e2fb63f4c5435d40f8feb3e12eb05905edb8cdea89 key-threshold: 3 + active-repositories: hackage.haskell.org, head.hackage.ghc.haskell.org:override EOF fi cat >> $CABAL_CONFIG <> cabal.project - if [ $((HCNUMVER >= 71000 && HCNUMVER < 90400)) -ne 0 ] ; then echo "packages: $GITHUB_WORKSPACE/source/samples" >> cabal.project ; fi + if [ $((HCNUMVER >= 71000)) -ne 0 ] ; then echo "packages: $GITHUB_WORKSPACE/source/samples" >> cabal.project ; fi cat cabal.project - name: sdist run: | @@ -228,11 +231,11 @@ jobs: touch cabal.project touch cabal.project.local echo "packages: ${PKGDIR_github}" >> cabal.project - if [ $((HCNUMVER >= 71000 && HCNUMVER < 90400)) -ne 0 ] ; then echo "packages: ${PKGDIR_github_samples}" >> cabal.project ; fi + if [ $((HCNUMVER >= 71000)) -ne 0 ] ; then echo "packages: ${PKGDIR_github_samples}" >> cabal.project ; fi if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo "package github" >> cabal.project ; fi if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods" >> cabal.project ; fi - if [ $((HCNUMVER >= 80200 && HCNUMVER < 90400)) -ne 0 ] ; then echo "package github-samples" >> cabal.project ; fi - if [ $((HCNUMVER >= 80200 && HCNUMVER < 90400)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods" >> cabal.project ; fi + if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo "package github-samples" >> cabal.project ; fi + if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods" >> cabal.project ; fi cat >> cabal.project <= 71000 && HCNUMVER < 90400)) -ne 0 ] ; then cd ${PKGDIR_github_samples} || false ; fi - if [ $((HCNUMVER >= 71000 && HCNUMVER < 90400)) -ne 0 ] ; then ${CABAL} -vnormal check ; fi + if [ $((HCNUMVER >= 71000)) -ne 0 ] ; then cd ${PKGDIR_github_samples} || false ; fi + if [ $((HCNUMVER >= 71000)) -ne 0 ] ; then ${CABAL} -vnormal check ; fi - name: haddock run: | if [ $((HCNUMVER >= 80600)) -ne 0 ] ; then $CABAL v2-haddock --haddock-all $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all ; fi diff --git a/cabal.haskell-ci b/cabal.haskell-ci index a937b18a..a3ce9738 100644 --- a/cabal.haskell-ci +++ b/cabal.haskell-ci @@ -1,4 +1,4 @@ -branches: master +branches: master ci* haddock: >=8.6 -- See PR #355: haddocks for GADT constructor arguments only supported from GHC 8.6 jobs-selection: any diff --git a/github.cabal b/github.cabal index f10beef5..a1fa6a11 100644 --- a/github.cabal +++ b/github.cabal @@ -30,17 +30,17 @@ copyright: Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016-2021 Oleg Grenrus tested-with: - GHC ==7.8.4 - || ==7.10.3 - || ==8.0.2 - || ==8.2.2 - || ==8.4.4 - || ==8.6.5 - || ==8.8.4 - || ==8.10.7 - || ==9.0.2 - || ==9.2.2 - || ==9.4.1 + GHC == 9.4.1 + GHC == 9.2.3 + GHC == 9.0.2 + GHC == 8.10.7 + GHC == 8.8.4 + GHC == 8.6.5 + GHC == 8.4.4 + GHC == 8.2.2 + GHC == 8.0.2 + GHC == 7.10.3 + GHC == 7.8.4 extra-source-files: README.md diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index 43b5ac3c..9efe9889 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -5,19 +5,21 @@ category: Examples synopsis: Samples for github package license: BSD-3-Clause license-file: LICENSE -maintainer: Oleg Grenrus +maintainer: Andreas Abel description: Various samples of github package build-type: Simple + tested-with: - GHC ==7.10.3 - || ==8.0.2 - || ==8.2.2 - || ==8.4.4 - || ==8.6.5 - || ==8.8.4 - || ==8.10.7 - || ==9.0.2 - || ==9.2.2 + GHC == 9.4.1 + GHC == 9.2.3 + GHC == 9.0.2 + GHC == 8.10.7 + GHC == 8.8.4 + GHC == 8.6.5 + GHC == 8.4.4 + GHC == 8.2.2 + GHC == 8.0.2 + GHC == 7.10.3 library hs-source-dirs: src From bdae4911d698a107f19ceb54751733baa66f84f3 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Sat, 23 Jul 2022 10:50:53 +0200 Subject: [PATCH 467/510] Fix #485: allow vector-0.13 --- github.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/github.cabal b/github.cabal index a1fa6a11..3fe795d7 100644 --- a/github.cabal +++ b/github.cabal @@ -195,7 +195,7 @@ library , tagged >=0.8.5 && <0.9 , transformers-compat >=0.6.5 && <0.8 , unordered-containers >=0.2.10.0 && <0.3 - , vector >=0.12.0.1 && <0.13 + , vector >=0.12.0.1 && <0.14 if flag(openssl) build-depends: From 5c897573216503d5cc8ac7b73a60e4c18dbf9c4b Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Sat, 23 Jul 2022 10:51:23 +0200 Subject: [PATCH 468/510] Bump to 0.28.0.1 and CHANGELOG --- CHANGELOG.md | 9 +++++++++ github.cabal | 2 +- 2 files changed, 10 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index f5bdfaaf..f402d4d1 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,12 @@ +## Changes for 0.28.0.1 + +_2022-07-23, Andreas Abel_ + +Tested with GHC 7.8 - 9.4.1 alpha3 + +- Drop unused dependency `vector-instances`. +- Allow latest: `aeson-2.1`, `mtl-2.3`, `vector-0.13`, `transformers-0.6`. + ## Changes for 0.28 _2022-04-30, Andreas Abel, Valborg edition_ diff --git a/github.cabal b/github.cabal index 3fe795d7..56a062f7 100644 --- a/github.cabal +++ b/github.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: github -version: 0.28 +version: 0.28.0.1 synopsis: Access to the GitHub API, v3. category: Network description: From 28c74236049f7ae820e47d9c095648cd83ba0e0c Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Mon, 24 Oct 2022 19:49:06 +0200 Subject: [PATCH 469/510] Bump CI to 9.4.2 --- .github/workflows/haskell-ci.yml | 36 +++++++++----------------------- github.cabal | 4 ++-- samples/github-samples.cabal | 4 ++-- 3 files changed, 14 insertions(+), 30 deletions(-) diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index ff536274..f141f271 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -8,9 +8,9 @@ # # For more information, see https://github.com/haskell-CI/haskell-ci # -# version: 0.15.20220710 +# version: 0.15.20221009 # -# REGENDATA ("0.15.20220710",["--config=cabal.haskell-ci","github","cabal.project"]) +# REGENDATA ("0.15.20221009",["--config=cabal.haskell-ci","github","cabal.project"]) # name: Haskell-CI on: @@ -34,14 +34,14 @@ jobs: strategy: matrix: include: - - compiler: ghc-9.4.0.20220623 + - compiler: ghc-9.4.2 compilerKind: ghc - compilerVersion: 9.4.0.20220623 + compilerVersion: 9.4.2 setup-method: ghcup - allow-failure: true - - compiler: ghc-9.2.3 + allow-failure: false + - compiler: ghc-9.2.4 compilerKind: ghc - compilerVersion: 9.2.3 + compilerVersion: 9.2.4 setup-method: ghcup allow-failure: false - compiler: ghc-9.0.2 @@ -97,9 +97,8 @@ jobs: apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5 if [ "${{ matrix.setup-method }}" = ghcup ]; then mkdir -p "$HOME/.ghcup/bin" - curl -sL https://downloads.haskell.org/ghcup/0.1.17.8/x86_64-linux-ghcup-0.1.17.8 > "$HOME/.ghcup/bin/ghcup" + curl -sL https://downloads.haskell.org/ghcup/0.1.18.0/x86_64-linux-ghcup-0.1.18.0 > "$HOME/.ghcup/bin/ghcup" chmod a+x "$HOME/.ghcup/bin/ghcup" - "$HOME/.ghcup/bin/ghcup" config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml; "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false) "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false) else @@ -107,7 +106,7 @@ jobs: apt-get update apt-get install -y "$HCNAME" mkdir -p "$HOME/.ghcup/bin" - curl -sL https://downloads.haskell.org/ghcup/0.1.17.8/x86_64-linux-ghcup-0.1.17.8 > "$HOME/.ghcup/bin/ghcup" + curl -sL https://downloads.haskell.org/ghcup/0.1.18.0/x86_64-linux-ghcup-0.1.18.0 > "$HOME/.ghcup/bin/ghcup" chmod a+x "$HOME/.ghcup/bin/ghcup" "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false) fi @@ -140,7 +139,7 @@ jobs: echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV" echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV" echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV" - if [ $((HCNUMVER >= 90400)) -ne 0 ] ; then echo "HEADHACKAGE=true" >> "$GITHUB_ENV" ; else echo "HEADHACKAGE=false" >> "$GITHUB_ENV" ; fi + echo "HEADHACKAGE=false" >> "$GITHUB_ENV" echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV" echo "GHCJSARITH=0" >> "$GITHUB_ENV" env: @@ -169,18 +168,6 @@ jobs: repository hackage.haskell.org url: http://hackage.haskell.org/ EOF - if $HEADHACKAGE; then - cat >> $CABAL_CONFIG <> $CABAL_CONFIG <> cabal.project - fi $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: $_ installed\n" unless /^(github|github-samples)$/; }' >> cabal.project.local cat cabal.project cat cabal.project.local diff --git a/github.cabal b/github.cabal index 56a062f7..b500a190 100644 --- a/github.cabal +++ b/github.cabal @@ -30,8 +30,8 @@ copyright: Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016-2021 Oleg Grenrus tested-with: - GHC == 9.4.1 - GHC == 9.2.3 + GHC == 9.4.2 + GHC == 9.2.4 GHC == 9.0.2 GHC == 8.10.7 GHC == 8.8.4 diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index 9efe9889..d95d5a8e 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -10,8 +10,8 @@ description: Various samples of github package build-type: Simple tested-with: - GHC == 9.4.1 - GHC == 9.2.3 + GHC == 9.4.2 + GHC == 9.2.4 GHC == 9.0.2 GHC == 8.10.7 GHC == 8.8.4 From ed296cb891d9d41b81bc3a292432e2c55cc014dc Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Sun, 19 Feb 2023 21:07:19 +0100 Subject: [PATCH 470/510] Bump CI to GHC 9.6.0 (#491) No code changes needed for GHC 9.6. --- .github/workflows/haskell-ci.yml | 59 ++++++++++++++++++++++++-------- cabal.project | 1 + github.cabal | 5 +-- samples/github-samples.cabal | 5 +-- 4 files changed, 51 insertions(+), 19 deletions(-) diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index f141f271..ea1a4e23 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -8,9 +8,9 @@ # # For more information, see https://github.com/haskell-CI/haskell-ci # -# version: 0.15.20221009 +# version: 0.15.20230217 # -# REGENDATA ("0.15.20221009",["--config=cabal.haskell-ci","github","cabal.project"]) +# REGENDATA ("0.15.20230217",["--config=cabal.haskell-ci","github","cabal.project"]) # name: Haskell-CI on: @@ -34,14 +34,19 @@ jobs: strategy: matrix: include: - - compiler: ghc-9.4.2 + - compiler: ghc-9.6.0.20230210 compilerKind: ghc - compilerVersion: 9.4.2 + compilerVersion: 9.6.0.20230210 + setup-method: ghcup + allow-failure: true + - compiler: ghc-9.4.4 + compilerKind: ghc + compilerVersion: 9.4.4 setup-method: ghcup allow-failure: false - - compiler: ghc-9.2.4 + - compiler: ghc-9.2.6 compilerKind: ghc - compilerVersion: 9.2.4 + compilerVersion: 9.2.6 setup-method: ghcup allow-failure: false - compiler: ghc-9.0.2 @@ -99,8 +104,9 @@ jobs: mkdir -p "$HOME/.ghcup/bin" curl -sL https://downloads.haskell.org/ghcup/0.1.18.0/x86_64-linux-ghcup-0.1.18.0 > "$HOME/.ghcup/bin/ghcup" chmod a+x "$HOME/.ghcup/bin/ghcup" + "$HOME/.ghcup/bin/ghcup" config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml; "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false) - "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false) + "$HOME/.ghcup/bin/ghcup" install cabal 3.9.0.0 || (cat "$HOME"/.ghcup/logs/*.* && false) else apt-add-repository -y 'ppa:hvr/ghc' apt-get update @@ -108,7 +114,8 @@ jobs: mkdir -p "$HOME/.ghcup/bin" curl -sL https://downloads.haskell.org/ghcup/0.1.18.0/x86_64-linux-ghcup-0.1.18.0 > "$HOME/.ghcup/bin/ghcup" chmod a+x "$HOME/.ghcup/bin/ghcup" - "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false) + "$HOME/.ghcup/bin/ghcup" config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml; + "$HOME/.ghcup/bin/ghcup" install cabal 3.9.0.0 || (cat "$HOME"/.ghcup/logs/*.* && false) fi env: HCKIND: ${{ matrix.compilerKind }} @@ -126,20 +133,20 @@ jobs: echo "HC=$HC" >> "$GITHUB_ENV" echo "HCPKG=$HOME/.ghcup/bin/$HCKIND-pkg-$HCVER" >> "$GITHUB_ENV" echo "HADDOCK=$HOME/.ghcup/bin/haddock-$HCVER" >> "$GITHUB_ENV" - echo "CABAL=$HOME/.ghcup/bin/cabal-3.6.2.0 -vnormal+nowrap" >> "$GITHUB_ENV" + echo "CABAL=$HOME/.ghcup/bin/cabal-3.9.0.0 -vnormal+nowrap" >> "$GITHUB_ENV" else HC=$HCDIR/bin/$HCKIND echo "HC=$HC" >> "$GITHUB_ENV" echo "HCPKG=$HCDIR/bin/$HCKIND-pkg" >> "$GITHUB_ENV" echo "HADDOCK=$HCDIR/bin/haddock" >> "$GITHUB_ENV" - echo "CABAL=$HOME/.ghcup/bin/cabal-3.6.2.0 -vnormal+nowrap" >> "$GITHUB_ENV" + echo "CABAL=$HOME/.ghcup/bin/cabal-3.9.0.0 -vnormal+nowrap" >> "$GITHUB_ENV" fi HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))') echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV" echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV" echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV" - echo "HEADHACKAGE=false" >> "$GITHUB_ENV" + if [ $((HCNUMVER >= 90600)) -ne 0 ] ; then echo "HEADHACKAGE=true" >> "$GITHUB_ENV" ; else echo "HEADHACKAGE=false" >> "$GITHUB_ENV" ; fi echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV" echo "GHCJSARITH=0" >> "$GITHUB_ENV" env: @@ -168,6 +175,18 @@ jobs: repository hackage.haskell.org url: http://hackage.haskell.org/ EOF + if $HEADHACKAGE; then + cat >> $CABAL_CONFIG <> $CABAL_CONFIG <> cabal.project <> cabal.project + fi $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: $_ installed\n" unless /^(github|github-samples)$/; }' >> cabal.project.local cat cabal.project cat cabal.project.local @@ -235,8 +258,8 @@ jobs: run: | $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all cabal-plan - - name: cache - uses: actions/cache@v2 + - name: restore cache + uses: actions/cache/restore@v3 with: key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }} path: ~/.cabal/store @@ -262,8 +285,14 @@ jobs: if [ $((HCNUMVER >= 71000)) -ne 0 ] ; then ${CABAL} -vnormal check ; fi - name: haddock run: | - if [ $((HCNUMVER >= 80600)) -ne 0 ] ; then $CABAL v2-haddock --haddock-all $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all ; fi + if [ $((HCNUMVER >= 80600)) -ne 0 ] ; then $CABAL v2-haddock --disable-documentation --haddock-all $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all ; fi - name: unconstrained build run: | rm -f cabal.project.local $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all + - name: save cache + uses: actions/cache/save@v3 + if: always() + with: + key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }} + path: ~/.cabal/store diff --git a/cabal.project b/cabal.project index 4b4ee992..ed0996f6 100644 --- a/cabal.project +++ b/cabal.project @@ -6,6 +6,7 @@ tests: True constraints: github +openssl constraints: github-samples +openssl +constraints: operational -buildExamples -- constraints: text >=2 -- allow-newer: *:text diff --git a/github.cabal b/github.cabal index b500a190..c7f85389 100644 --- a/github.cabal +++ b/github.cabal @@ -30,8 +30,9 @@ copyright: Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016-2021 Oleg Grenrus tested-with: - GHC == 9.4.2 - GHC == 9.2.4 + GHC == 9.6.0 + GHC == 9.4.4 + GHC == 9.2.6 GHC == 9.0.2 GHC == 8.10.7 GHC == 8.8.4 diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index d95d5a8e..72fe6368 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -10,8 +10,9 @@ description: Various samples of github package build-type: Simple tested-with: - GHC == 9.4.2 - GHC == 9.2.4 + GHC == 9.6.0 + GHC == 9.4.4 + GHC == 9.2.6 GHC == 9.0.2 GHC == 8.10.7 GHC == 8.8.4 From a6a312601cad1843e418ce14d34c5099b54a41d0 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Sun, 12 Mar 2023 19:05:51 +0100 Subject: [PATCH 471/510] v0.28.0.1 Revision 1: Allow base-compat-0.13 --- github.cabal | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/github.cabal b/github.cabal index c7f85389..5f1c7eea 100644 --- a/github.cabal +++ b/github.cabal @@ -1,6 +1,7 @@ cabal-version: >=1.10 name: github version: 0.28.0.1 +x-revision: 1 synopsis: Access to the GitHub API, v3. category: Network description: @@ -181,7 +182,7 @@ library -- other packages build-depends: aeson >=1.4.0.0 && <1.6 || >=2.0.1.0 && <2.2 - , base-compat >=0.11.1 && <0.13 + , base-compat >=0.11.1 && <0.14 , base16-bytestring >=0.1.1.6 && <1.1 , binary-instances >=1 && <1.1 , cryptohash-sha1 >=0.11.100.1 && <0.12 From 9944c53927b5ee5757de0b91888713f2c8f9e031 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Sun, 23 Apr 2023 19:50:33 +0200 Subject: [PATCH 472/510] Update badges --- README.md | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index 6203a7b5..3ead9b24 100644 --- a/README.md +++ b/README.md @@ -1,8 +1,10 @@ GitHub ------ +[![Hackage version](https://img.shields.io/hackage/v/github.svg?label=Hackage&color=informational)](http://hackage.haskell.org/package/github) +[![github on Stackage Nightly](https://stackage.org/package/github/badge/nightly)](https://stackage.org/nightly/package/github) +[![Stackage LTS version](https://www.stackage.org/package/github/badge/lts?label=Stackage)](https://www.stackage.org/package/github) [![Haskell-CI](https://github.com/haskell-github/github/actions/workflows/haskell-ci.yml/badge.svg)](https://github.com/haskell-github/github/actions/workflows/haskell-ci.yml) -[![Hackage](https://img.shields.io/hackage/v/github.svg)][hackage] The GitHub API v3 for Haskell. @@ -92,7 +94,7 @@ Copyright 2016-2019 Oleg Grenrus. Available under the BSD 3-clause license. -[hackage]: http://hackage.haskell.org/package/github "Hackage" +[hackage]: https://hackage.haskell.org/package/github "Hackage" Alternative =========== From f63f92c46b3980d06c87959009af21628d06e8a2 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Sun, 23 Apr 2023 19:44:20 +0200 Subject: [PATCH 473/510] Bump hspec to allow 2.11 --- .github/workflows/haskell-ci.yml | 49 +++++++++++--------------------- github.cabal | 12 ++++---- samples/github-samples.cabal | 4 +-- 3 files changed, 24 insertions(+), 41 deletions(-) diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index ea1a4e23..d4898756 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -8,9 +8,9 @@ # # For more information, see https://github.com/haskell-CI/haskell-ci # -# version: 0.15.20230217 +# version: 0.16 # -# REGENDATA ("0.15.20230217",["--config=cabal.haskell-ci","github","cabal.project"]) +# REGENDATA ("0.16",["--config=cabal.haskell-ci","github","cabal.project"]) # name: Haskell-CI on: @@ -34,19 +34,19 @@ jobs: strategy: matrix: include: - - compiler: ghc-9.6.0.20230210 + - compiler: ghc-9.6.1 compilerKind: ghc - compilerVersion: 9.6.0.20230210 + compilerVersion: 9.6.1 setup-method: ghcup - allow-failure: true + allow-failure: false - compiler: ghc-9.4.4 compilerKind: ghc compilerVersion: 9.4.4 setup-method: ghcup allow-failure: false - - compiler: ghc-9.2.6 + - compiler: ghc-9.2.7 compilerKind: ghc - compilerVersion: 9.2.6 + compilerVersion: 9.2.7 setup-method: ghcup allow-failure: false - compiler: ghc-9.0.2 @@ -102,20 +102,18 @@ jobs: apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5 if [ "${{ matrix.setup-method }}" = ghcup ]; then mkdir -p "$HOME/.ghcup/bin" - curl -sL https://downloads.haskell.org/ghcup/0.1.18.0/x86_64-linux-ghcup-0.1.18.0 > "$HOME/.ghcup/bin/ghcup" + curl -sL https://downloads.haskell.org/ghcup/0.1.19.2/x86_64-linux-ghcup-0.1.19.2 > "$HOME/.ghcup/bin/ghcup" chmod a+x "$HOME/.ghcup/bin/ghcup" - "$HOME/.ghcup/bin/ghcup" config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml; "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false) - "$HOME/.ghcup/bin/ghcup" install cabal 3.9.0.0 || (cat "$HOME"/.ghcup/logs/*.* && false) + "$HOME/.ghcup/bin/ghcup" install cabal 3.10.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false) else apt-add-repository -y 'ppa:hvr/ghc' apt-get update apt-get install -y "$HCNAME" mkdir -p "$HOME/.ghcup/bin" - curl -sL https://downloads.haskell.org/ghcup/0.1.18.0/x86_64-linux-ghcup-0.1.18.0 > "$HOME/.ghcup/bin/ghcup" + curl -sL https://downloads.haskell.org/ghcup/0.1.19.2/x86_64-linux-ghcup-0.1.19.2 > "$HOME/.ghcup/bin/ghcup" chmod a+x "$HOME/.ghcup/bin/ghcup" - "$HOME/.ghcup/bin/ghcup" config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml; - "$HOME/.ghcup/bin/ghcup" install cabal 3.9.0.0 || (cat "$HOME"/.ghcup/logs/*.* && false) + "$HOME/.ghcup/bin/ghcup" install cabal 3.10.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false) fi env: HCKIND: ${{ matrix.compilerKind }} @@ -133,20 +131,20 @@ jobs: echo "HC=$HC" >> "$GITHUB_ENV" echo "HCPKG=$HOME/.ghcup/bin/$HCKIND-pkg-$HCVER" >> "$GITHUB_ENV" echo "HADDOCK=$HOME/.ghcup/bin/haddock-$HCVER" >> "$GITHUB_ENV" - echo "CABAL=$HOME/.ghcup/bin/cabal-3.9.0.0 -vnormal+nowrap" >> "$GITHUB_ENV" + echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.1.0 -vnormal+nowrap" >> "$GITHUB_ENV" else HC=$HCDIR/bin/$HCKIND echo "HC=$HC" >> "$GITHUB_ENV" echo "HCPKG=$HCDIR/bin/$HCKIND-pkg" >> "$GITHUB_ENV" echo "HADDOCK=$HCDIR/bin/haddock" >> "$GITHUB_ENV" - echo "CABAL=$HOME/.ghcup/bin/cabal-3.9.0.0 -vnormal+nowrap" >> "$GITHUB_ENV" + echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.1.0 -vnormal+nowrap" >> "$GITHUB_ENV" fi HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))') echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV" echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV" echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV" - if [ $((HCNUMVER >= 90600)) -ne 0 ] ; then echo "HEADHACKAGE=true" >> "$GITHUB_ENV" ; else echo "HEADHACKAGE=false" >> "$GITHUB_ENV" ; fi + echo "HEADHACKAGE=false" >> "$GITHUB_ENV" echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV" echo "GHCJSARITH=0" >> "$GITHUB_ENV" env: @@ -175,18 +173,6 @@ jobs: repository hackage.haskell.org url: http://hackage.haskell.org/ EOF - if $HEADHACKAGE; then - cat >> $CABAL_CONFIG <> $CABAL_CONFIG < cabal-plan.xz - echo 'de73600b1836d3f55e32d80385acc055fd97f60eaa0ab68a755302685f5d81bc cabal-plan.xz' | sha256sum -c - + curl -sL https://github.com/haskell-hvr/cabal-plan/releases/download/v0.7.3.0/cabal-plan-0.7.3.0-x86_64-linux.xz > cabal-plan.xz + echo 'f62ccb2971567a5f638f2005ad3173dba14693a45154c1508645c52289714cb2 cabal-plan.xz' | sha256sum -c - xz -d < cabal-plan.xz > $HOME/.cabal/bin/cabal-plan rm -f cabal-plan.xz chmod a+x $HOME/.cabal/bin/cabal-plan @@ -248,9 +234,6 @@ jobs: constraints: operational -buildExamples optimization: False EOF - if $HEADHACKAGE; then - echo "allow-newer: $($HCPKG list --simple-output | sed -E 's/([a-zA-Z-]+)-[0-9.]+/*:\1,/g')" >> cabal.project - fi $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: $_ installed\n" unless /^(github|github-samples)$/; }' >> cabal.project.local cat cabal.project cat cabal.project.local diff --git a/github.cabal b/github.cabal index 5f1c7eea..6ecbaab9 100644 --- a/github.cabal +++ b/github.cabal @@ -1,7 +1,7 @@ cabal-version: >=1.10 name: github version: 0.28.0.1 -x-revision: 1 +x-revision: 2 synopsis: Access to the GitHub API, v3. category: Network description: @@ -31,9 +31,9 @@ copyright: Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016-2021 Oleg Grenrus tested-with: - GHC == 9.6.0 + GHC == 9.6.1 GHC == 9.4.4 - GHC == 9.2.6 + GHC == 9.2.7 GHC == 9.0.2 GHC == 8.10.7 GHC == 8.8.4 @@ -51,7 +51,7 @@ extra-source-files: source-repository head type: git - location: git://github.com/haskell-github/github.git + location: https://github.com/haskell-github/github.git flag openssl description: "Use http-client-openssl" @@ -219,7 +219,7 @@ test-suite github-test hs-source-dirs: spec main-is: Spec.hs ghc-options: -Wall -threaded - build-tool-depends: hspec-discover:hspec-discover >=2.7.1 && <2.11 + build-tool-depends: hspec-discover:hspec-discover >=2.7.1 && <2.12 other-extensions: TemplateHaskell other-modules: GitHub.ActivitySpec @@ -244,7 +244,7 @@ test-suite github-test , bytestring , file-embed , github - , hspec >=2.6.1 && <2.11 + , hspec >=2.6.1 && <2.12 , tagged , text , unordered-containers diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index 72fe6368..c758130e 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -10,9 +10,9 @@ description: Various samples of github package build-type: Simple tested-with: - GHC == 9.6.0 + GHC == 9.6.1 GHC == 9.4.4 - GHC == 9.2.6 + GHC == 9.2.7 GHC == 9.0.2 GHC == 8.10.7 GHC == 8.8.4 From 568ede6ed0460cf3c56009d6465ac729112f4ed1 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Fri, 23 Jun 2023 13:18:55 +0200 Subject: [PATCH 474/510] Bump Haskell CI to GHC 9.6.2 9.4.5 9.2.8 --- .github/workflows/haskell-ci.yml | 16 ++++++++-------- github.cabal | 6 +++--- samples/github-samples.cabal | 6 +++--- 3 files changed, 14 insertions(+), 14 deletions(-) diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index d4898756..7a5b1d89 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -8,9 +8,9 @@ # # For more information, see https://github.com/haskell-CI/haskell-ci # -# version: 0.16 +# version: 0.16.4 # -# REGENDATA ("0.16",["--config=cabal.haskell-ci","github","cabal.project"]) +# REGENDATA ("0.16.4",["--config=cabal.haskell-ci","github","cabal.project"]) # name: Haskell-CI on: @@ -34,19 +34,19 @@ jobs: strategy: matrix: include: - - compiler: ghc-9.6.1 + - compiler: ghc-9.6.2 compilerKind: ghc - compilerVersion: 9.6.1 + compilerVersion: 9.6.2 setup-method: ghcup allow-failure: false - - compiler: ghc-9.4.4 + - compiler: ghc-9.4.5 compilerKind: ghc - compilerVersion: 9.4.4 + compilerVersion: 9.4.5 setup-method: ghcup allow-failure: false - - compiler: ghc-9.2.7 + - compiler: ghc-9.2.8 compilerKind: ghc - compilerVersion: 9.2.7 + compilerVersion: 9.2.8 setup-method: ghcup allow-failure: false - compiler: ghc-9.0.2 diff --git a/github.cabal b/github.cabal index 6ecbaab9..34389c64 100644 --- a/github.cabal +++ b/github.cabal @@ -31,9 +31,9 @@ copyright: Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016-2021 Oleg Grenrus tested-with: - GHC == 9.6.1 - GHC == 9.4.4 - GHC == 9.2.7 + GHC == 9.6.2 + GHC == 9.4.5 + GHC == 9.2.8 GHC == 9.0.2 GHC == 8.10.7 GHC == 8.8.4 diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index c758130e..c76d6b14 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -10,9 +10,9 @@ description: Various samples of github package build-type: Simple tested-with: - GHC == 9.6.1 - GHC == 9.4.4 - GHC == 9.2.7 + GHC == 9.6.2 + GHC == 9.4.5 + GHC == 9.2.8 GHC == 9.0.2 GHC == 8.10.7 GHC == 8.8.4 From 445c8de7300b25b51a4c6850e9468dcb6bc7f534 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Fri, 23 Jun 2023 14:23:10 +0200 Subject: [PATCH 475/510] Resurrect samples/Issues/ShowRepoIssues This example wasn't ported to the new API. Now it is, with some ugly `show`s still. --- .github/workflows/haskell-ci.yml | 12 +++++----- samples/Issues/ShowRepoIssues.hs | 38 ++++++++++++++++++++------------ samples/github-samples.cabal | 11 +++++---- 3 files changed, 37 insertions(+), 24 deletions(-) diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index 7a5b1d89..b5d24eb9 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -203,7 +203,7 @@ jobs: run: | touch cabal.project echo "packages: $GITHUB_WORKSPACE/source/." >> cabal.project - if [ $((HCNUMVER >= 71000)) -ne 0 ] ; then echo "packages: $GITHUB_WORKSPACE/source/samples" >> cabal.project ; fi + if [ $((HCNUMVER >= 80400)) -ne 0 ] ; then echo "packages: $GITHUB_WORKSPACE/source/samples" >> cabal.project ; fi cat cabal.project - name: sdist run: | @@ -223,11 +223,11 @@ jobs: touch cabal.project touch cabal.project.local echo "packages: ${PKGDIR_github}" >> cabal.project - if [ $((HCNUMVER >= 71000)) -ne 0 ] ; then echo "packages: ${PKGDIR_github_samples}" >> cabal.project ; fi + if [ $((HCNUMVER >= 80400)) -ne 0 ] ; then echo "packages: ${PKGDIR_github_samples}" >> cabal.project ; fi if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo "package github" >> cabal.project ; fi if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods" >> cabal.project ; fi - if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo "package github-samples" >> cabal.project ; fi - if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods" >> cabal.project ; fi + if [ $((HCNUMVER >= 80400)) -ne 0 ] ; then echo "package github-samples" >> cabal.project ; fi + if [ $((HCNUMVER >= 80400)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods" >> cabal.project ; fi cat >> cabal.project <= 71000)) -ne 0 ] ; then cd ${PKGDIR_github_samples} || false ; fi - if [ $((HCNUMVER >= 71000)) -ne 0 ] ; then ${CABAL} -vnormal check ; fi + if [ $((HCNUMVER >= 80400)) -ne 0 ] ; then cd ${PKGDIR_github_samples} || false ; fi + if [ $((HCNUMVER >= 80400)) -ne 0 ] ; then ${CABAL} -vnormal check ; fi - name: haddock run: | if [ $((HCNUMVER >= 80600)) -ne 0 ] ; then $CABAL v2-haddock --disable-documentation --haddock-all $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all ; fi diff --git a/samples/Issues/ShowRepoIssues.hs b/samples/Issues/ShowRepoIssues.hs index b6f26e68..3bfaa4ba 100644 --- a/samples/Issues/ShowRepoIssues.hs +++ b/samples/Issues/ShowRepoIssues.hs @@ -1,21 +1,31 @@ -module ShowRepoIssue where +{-# LANGUAGE OverloadedStrings #-} -import qualified Github.Issues as Github +import qualified GitHub as Github import Data.List (intercalate) +import Data.Foldable (toList) +main :: IO () main = do - let limitations = [Github.OnlyClosed, Github.Mentions "mike-burns", Github.AssignedTo "jyurek"] - possibleIssues <- Github.issuesForRepo "thoughtbot" "paperclip" limitations + let filt = Github.stateClosed <> Github.optionsMentioned "mike-burns" <> Github.optionsAssignee "jyurek" + possibleIssues <- Github.github' $ Github.issuesForRepoR "thoughtbot" "paperclip" filt Github.FetchAll case possibleIssues of - (Left error) -> putStrLn $ "Error: " ++ show error - (Right issues) -> - putStrLn $ intercalate "\n\n" $ map formatIssue issues + Left err -> putStrLn $ "Error: " ++ show err + Right issues -> + putStrLn $ intercalate "\n\n" $ map formatIssue $ toList issues -formatIssue issue = - (Github.githubOwnerLogin $ Github.issueUser issue) ++ - " opened this issue " ++ - (show $ Github.fromDate $ Github.issueCreatedAt issue) ++ "\n" ++ - (Github.issueState issue) ++ " with " ++ - (show $ Github.issueComments issue) ++ " comments" ++ "\n\n" ++ - (Github.issueTitle issue) +formatIssue :: Github.Issue -> String +formatIssue issue = concat + [ show $ Github.simpleUserLogin $ Github.issueUser issue + , " opened this issue " + , show $ Github.issueCreatedAt issue + , ".\n" + + , "It is currently " + , show $ Github.issueState issue + , " with " + , show $ Github.issueComments issue + , " comments.\n\n" + + , show $ Github.issueTitle issue + ] diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index c76d6b14..c3c6813d 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -18,15 +18,13 @@ tested-with: GHC == 8.8.4 GHC == 8.6.5 GHC == 8.4.4 - GHC == 8.2.2 - GHC == 8.0.2 - GHC == 7.10.3 library hs-source-dirs: src ghc-options: -Wall build-depends: - , base >=4.7 && <5 + , base >=4.11 && <5 + -- require base-4.11 because then (<>) is in Prelude , base-compat-batteries , github , text @@ -149,6 +147,11 @@ executable github-list-team-current -- main-is: ShowDeployKey.hs -- hs-source-dirs: Repos/DeployKeys +executable github-show-repo-issues + import: deps + main-is: ShowRepoIssues.hs + hs-source-dirs: Issues + executable github-show-user import: deps main-is: ShowUser.hs From 723884baa49627fe24424c493ba4c6436df53492 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Fri, 23 Jun 2023 14:39:03 +0200 Subject: [PATCH 476/510] Parse `state_reason` (values: completed, not_planned, reopened) Added `issueStateReason` to `Issue`. --- CHANGELOG.md | 10 ++++++++++ github.cabal | 4 ++-- samples/Issues/ShowRepoIssues.hs | 25 ++++++++++++++++++------- src/GitHub/Data/Issues.hs | 4 +++- src/GitHub/Data/Options.hs | 25 +++++++++++++++++++++++++ 5 files changed, 58 insertions(+), 10 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index f402d4d1..1fa91d95 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,13 @@ +## Changes for 0.29 + +_2022-06-24, Andreas Abel, Midsommar edition_ + +- Add field `issueStateReason` of type `Maybe IssueStateReason` to `Issue` + with possible values `completed`, `not_planned` and `reopened` + (PR [#496](https://github.com/haskell-github/github/pull/496)). + +Tested with GHC 7.8 - 9.6.2 + ## Changes for 0.28.0.1 _2022-07-23, Andreas Abel_ diff --git a/github.cabal b/github.cabal index 34389c64..a0669042 100644 --- a/github.cabal +++ b/github.cabal @@ -1,7 +1,6 @@ cabal-version: >=1.10 name: github -version: 0.28.0.1 -x-revision: 2 +version: 0.29 synopsis: Access to the GitHub API, v3. category: Network description: @@ -72,6 +71,7 @@ library DataKinds DeriveDataTypeable DeriveGeneric + LambdaCase OverloadedStrings ScopedTypeVariables TypeOperators diff --git a/samples/Issues/ShowRepoIssues.hs b/samples/Issues/ShowRepoIssues.hs index 3bfaa4ba..5f54026b 100644 --- a/samples/Issues/ShowRepoIssues.hs +++ b/samples/Issues/ShowRepoIssues.hs @@ -1,17 +1,27 @@ +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} -import qualified GitHub as Github -import Data.List (intercalate) import Data.Foldable (toList) +import Data.List (intercalate) +import Data.Vector (Vector) + +import qualified GitHub as Github main :: IO () main = do let filt = Github.stateClosed <> Github.optionsMentioned "mike-burns" <> Github.optionsAssignee "jyurek" - possibleIssues <- Github.github' $ Github.issuesForRepoR "thoughtbot" "paperclip" filt Github.FetchAll - case possibleIssues of - Left err -> putStrLn $ "Error: " ++ show err - Right issues -> - putStrLn $ intercalate "\n\n" $ map formatIssue $ toList issues + printIssues =<< do + Github.github' $ Github.issuesForRepoR "thoughtbot" "paperclip" filt Github.FetchAll + + printIssues =<< do + Github.github' $ Github.issuesForRepoR "haskell-github" "playground" Github.stateClosed Github.FetchAll + +printIssues :: Either Github.Error (Vector Github.Issue) -> IO () +printIssues = \case + Left err -> + putStrLn $ "Error: " ++ show err + Right issues -> + putStrLn $ intercalate "\n\n" $ map formatIssue $ toList issues formatIssue :: Github.Issue -> String formatIssue issue = concat @@ -23,6 +33,7 @@ formatIssue issue = concat , "It is currently " , show $ Github.issueState issue + , maybe "" (\ r -> " with reason " ++ show r) $ Github.issueStateReason issue , " with " , show $ Github.issueComments issue , " comments.\n\n" diff --git a/src/GitHub/Data/Issues.hs b/src/GitHub/Data/Issues.hs index 6e98da8f..3ec17781 100644 --- a/src/GitHub/Data/Issues.hs +++ b/src/GitHub/Data/Issues.hs @@ -9,7 +9,7 @@ import GitHub.Data.Definitions import GitHub.Data.Id (Id) import GitHub.Data.Milestone (Milestone) import GitHub.Data.Name (Name) -import GitHub.Data.Options (IssueState) +import GitHub.Data.Options (IssueState, IssueStateReason) import GitHub.Data.PullRequests import GitHub.Data.URL (URL) import GitHub.Internal.Prelude @@ -36,6 +36,7 @@ data Issue = Issue , issueId :: !(Id Issue) , issueComments :: !Int , issueMilestone :: !(Maybe Milestone) + , issueStateReason :: !(Maybe IssueStateReason) } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -203,6 +204,7 @@ instance FromJSON Issue where <*> o .: "id" <*> o .: "comments" <*> o .:? "milestone" + <*> o .:? "state_reason" instance ToJSON NewIssue where toJSON (NewIssue t b a m ls) = object $ filter notNull diff --git a/src/GitHub/Data/Options.hs b/src/GitHub/Data/Options.hs index 24bc4369..5d27e0b1 100644 --- a/src/GitHub/Data/Options.hs +++ b/src/GitHub/Data/Options.hs @@ -50,6 +50,7 @@ module GitHub.Data.Options ( optionsAssignee, -- * Data IssueState (..), + IssueStateReason (..), MergeableState (..), -- * Internal HasState, @@ -94,6 +95,30 @@ instance FromJSON IssueState where instance NFData IssueState where rnf = genericRnf instance Binary IssueState +-- | 'GitHub.Data.Issues.Issue' state reason +data IssueStateReason + = StateReasonCompleted + | StateReasonNotPlanned + | StateReasonReopened + deriving + (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) + +instance ToJSON IssueStateReason where + toJSON = String . \case + StateReasonCompleted -> "completed" + StateReasonNotPlanned -> "not_planned" + StateReasonReopened -> "reopened" + +instance FromJSON IssueStateReason where + parseJSON = withText "IssueStateReason" $ \t -> case T.toLower t of + "completed" -> pure StateReasonCompleted + "not_planned" -> pure StateReasonNotPlanned + "reopened" -> pure StateReasonReopened + _ -> fail $ "Unknown IssueStateReason: " <> T.unpack t + +instance NFData IssueStateReason where rnf = genericRnf +instance Binary IssueStateReason + -- | 'GitHub.Data.PullRequests.PullRequest' mergeable_state data MergeableState = StateUnknown From a2739ee3821a41ccf0686ae4f797575ff74adb81 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Fri, 23 Jun 2023 16:57:41 +0200 Subject: [PATCH 477/510] Remove outdated maintainer from module headers --- src/GitHub.hs | 6 +----- src/GitHub/Auth.hs | 5 ----- src/GitHub/Data.hs | 6 ++---- src/GitHub/Data/Activities.hs | 6 ------ src/GitHub/Data/Comments.hs | 5 ----- src/GitHub/Data/Content.hs | 6 +----- src/GitHub/Data/Definitions.hs | 5 ----- src/GitHub/Data/Email.hs | 5 ----- src/GitHub/Data/Enterprise.hs | 5 +---- src/GitHub/Data/Enterprise/Organizations.hs | 5 ----- src/GitHub/Data/Events.hs | 6 +----- src/GitHub/Data/Gists.hs | 5 ----- src/GitHub/Data/GitData.hs | 5 ----- src/GitHub/Data/Id.hs | 5 ----- src/GitHub/Data/Invitation.hs | 5 ----- src/GitHub/Data/Issues.hs | 5 ----- src/GitHub/Data/Milestone.hs | 5 ----- src/GitHub/Data/Name.hs | 5 ----- src/GitHub/Data/Options.hs | 6 ++---- src/GitHub/Data/PullRequests.hs | 5 ----- src/GitHub/Data/RateLimit.hs | 5 ----- src/GitHub/Data/Repos.hs | 6 ++---- src/GitHub/Data/Request.hs | 6 +----- src/GitHub/Data/Search.hs | 5 ----- src/GitHub/Data/Teams.hs | 6 +----- src/GitHub/Data/URL.hs | 5 ----- src/GitHub/Data/Webhooks.hs | 5 ----- src/GitHub/Data/Webhooks/Validate.hs | 5 +---- src/GitHub/Endpoints/Activity/Events.hs | 5 +---- src/GitHub/Endpoints/Activity/Notifications.hs | 4 ---- src/GitHub/Endpoints/Activity/Starring.hs | 5 +---- src/GitHub/Endpoints/Activity/Watching.hs | 5 +---- src/GitHub/Endpoints/Enterprise/Organizations.hs | 5 +---- src/GitHub/Endpoints/Gists.hs | 5 +---- src/GitHub/Endpoints/Gists/Comments.hs | 5 +---- src/GitHub/Endpoints/GitData/Blobs.hs | 5 +---- src/GitHub/Endpoints/GitData/Commits.hs | 5 +---- src/GitHub/Endpoints/GitData/References.hs | 5 +---- src/GitHub/Endpoints/GitData/Trees.hs | 5 +---- src/GitHub/Endpoints/Issues.hs | 6 ++---- src/GitHub/Endpoints/Issues/Comments.hs | 5 +---- src/GitHub/Endpoints/Issues/Events.hs | 5 +---- src/GitHub/Endpoints/Issues/Labels.hs | 5 +---- src/GitHub/Endpoints/Issues/Milestones.hs | 5 +---- src/GitHub/Endpoints/Organizations.hs | 5 +---- src/GitHub/Endpoints/Organizations/Members.hs | 5 +---- src/GitHub/Endpoints/Organizations/OutsideCollaborators.hs | 5 +---- src/GitHub/Endpoints/Organizations/Teams.hs | 5 +---- src/GitHub/Endpoints/PullRequests.hs | 6 +----- src/GitHub/Endpoints/PullRequests/Comments.hs | 5 +---- src/GitHub/Endpoints/PullRequests/Reviews.hs | 5 +---- src/GitHub/Endpoints/RateLimit.hs | 5 +---- src/GitHub/Endpoints/Repos.hs | 5 +---- src/GitHub/Endpoints/Repos/Collaborators.hs | 5 +---- src/GitHub/Endpoints/Repos/Comments.hs | 6 ++---- src/GitHub/Endpoints/Repos/Commits.hs | 6 ++---- src/GitHub/Endpoints/Repos/Contents.hs | 5 +---- src/GitHub/Endpoints/Repos/Forks.hs | 5 +---- src/GitHub/Endpoints/Repos/Invitations.hs | 5 +---- src/GitHub/Endpoints/Repos/Statuses.hs | 5 +---- src/GitHub/Endpoints/Repos/Webhooks.hs | 5 +---- src/GitHub/Endpoints/Search.hs | 5 +---- src/GitHub/Endpoints/Users.hs | 5 +---- src/GitHub/Endpoints/Users/Emails.hs | 5 +---- src/GitHub/Endpoints/Users/Followers.hs | 5 +---- src/GitHub/Enterprise.hs | 6 +----- src/GitHub/Internal/Prelude.hs | 6 ++---- src/GitHub/Request.hs | 6 ++---- 68 files changed, 57 insertions(+), 298 deletions(-) diff --git a/src/GitHub.hs b/src/GitHub.hs index da5e9f2b..10e34602 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -1,8 +1,4 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- This module re-exports all request constructors and data definitions from -- this package. -- @@ -16,7 +12,7 @@ -- -- The missing endpoints lists show which endpoints we know are missing, there -- might be more. --- + module GitHub ( -- * Activity -- | See diff --git a/src/GitHub/Auth.hs b/src/GitHub/Auth.hs index 432b2486..ccc2415a 100644 --- a/src/GitHub/Auth.hs +++ b/src/GitHub/Auth.hs @@ -1,8 +1,3 @@ ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Auth ( Auth (..), AuthMethod, diff --git a/src/GitHub/Data.hs b/src/GitHub/Data.hs index 6b475d40..4d8748f8 100644 --- a/src/GitHub/Data.hs +++ b/src/GitHub/Data.hs @@ -1,10 +1,8 @@ {-# LANGUAGE CPP #-} ------------------------------------------------------------------------------ + -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- This module re-exports the @GitHub.Data.@ and "GitHub.Auth" submodules. + module GitHub.Data ( -- * Tagged types -- ** Name diff --git a/src/GitHub/Data/Activities.hs b/src/GitHub/Data/Activities.hs index d95d3a25..e03986dc 100644 --- a/src/GitHub/Data/Activities.hs +++ b/src/GitHub/Data/Activities.hs @@ -1,8 +1,3 @@ ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Data.Activities where import GitHub.Data.Id (Id, mkId) @@ -107,4 +102,3 @@ instance FromJSON Notification where <*> o .: "updated_at" <*> o .: "last_read_at" <*> o .: "url" - diff --git a/src/GitHub/Data/Comments.hs b/src/GitHub/Data/Comments.hs index cb52b04b..d4a9194d 100644 --- a/src/GitHub/Data/Comments.hs +++ b/src/GitHub/Data/Comments.hs @@ -1,8 +1,3 @@ ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Data.Comments where import GitHub.Data.Definitions diff --git a/src/GitHub/Data/Content.hs b/src/GitHub/Data/Content.hs index 7a4dca9b..d776c2b6 100644 --- a/src/GitHub/Data/Content.hs +++ b/src/GitHub/Data/Content.hs @@ -1,10 +1,6 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE CPP #-} ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- + module GitHub.Data.Content where import GitHub.Data.GitData diff --git a/src/GitHub/Data/Definitions.hs b/src/GitHub/Data/Definitions.hs index 0d56171b..73962f28 100644 --- a/src/GitHub/Data/Definitions.hs +++ b/src/GitHub/Data/Definitions.hs @@ -1,8 +1,3 @@ ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Data.Definitions where import GitHub.Internal.Prelude diff --git a/src/GitHub/Data/Email.hs b/src/GitHub/Data/Email.hs index d27237e5..9ff578b6 100644 --- a/src/GitHub/Data/Email.hs +++ b/src/GitHub/Data/Email.hs @@ -1,8 +1,3 @@ ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Data.Email where import GitHub.Internal.Prelude diff --git a/src/GitHub/Data/Enterprise.hs b/src/GitHub/Data/Enterprise.hs index 125a8d69..dd5b9337 100644 --- a/src/GitHub/Data/Enterprise.hs +++ b/src/GitHub/Data/Enterprise.hs @@ -1,9 +1,6 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- This module re-exports the @GitHub.Data.Enterprise.@ submodules. + module GitHub.Data.Enterprise ( -- * Module re-exports module GitHub.Data.Enterprise.Organizations, diff --git a/src/GitHub/Data/Enterprise/Organizations.hs b/src/GitHub/Data/Enterprise/Organizations.hs index 967cd718..9c48f386 100644 --- a/src/GitHub/Data/Enterprise/Organizations.hs +++ b/src/GitHub/Data/Enterprise/Organizations.hs @@ -1,8 +1,3 @@ ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Data.Enterprise.Organizations where import GitHub.Data.Definitions diff --git a/src/GitHub/Data/Events.hs b/src/GitHub/Data/Events.hs index d7b34528..db0e881a 100644 --- a/src/GitHub/Data/Events.hs +++ b/src/GitHub/Data/Events.hs @@ -1,8 +1,3 @@ ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Data.Events where import GitHub.Data.Definitions @@ -14,6 +9,7 @@ import Prelude () -- /TODO:/ -- -- * missing repo, org, payload, id +-- data Event = Event -- { eventId :: !(Id Event) -- id can be encoded as string. { eventActor :: !SimpleUser diff --git a/src/GitHub/Data/Gists.hs b/src/GitHub/Data/Gists.hs index b6d1b673..ab2e846d 100644 --- a/src/GitHub/Data/Gists.hs +++ b/src/GitHub/Data/Gists.hs @@ -1,8 +1,3 @@ ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Data.Gists where import GitHub.Data.Definitions diff --git a/src/GitHub/Data/GitData.hs b/src/GitHub/Data/GitData.hs index fa9973d1..95b47533 100644 --- a/src/GitHub/Data/GitData.hs +++ b/src/GitHub/Data/GitData.hs @@ -1,8 +1,3 @@ ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Data.GitData where import GitHub.Data.Definitions diff --git a/src/GitHub/Data/Id.hs b/src/GitHub/Data/Id.hs index e0dcfe27..ddbc9e25 100644 --- a/src/GitHub/Data/Id.hs +++ b/src/GitHub/Data/Id.hs @@ -1,8 +1,3 @@ ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Data.Id ( Id(..), mkId, diff --git a/src/GitHub/Data/Invitation.hs b/src/GitHub/Data/Invitation.hs index 894ce64f..1ea656f9 100644 --- a/src/GitHub/Data/Invitation.hs +++ b/src/GitHub/Data/Invitation.hs @@ -1,8 +1,3 @@ ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Data.Invitation where import GitHub.Data.Definitions diff --git a/src/GitHub/Data/Issues.hs b/src/GitHub/Data/Issues.hs index 3ec17781..191b342e 100644 --- a/src/GitHub/Data/Issues.hs +++ b/src/GitHub/Data/Issues.hs @@ -1,8 +1,3 @@ ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Data.Issues where import GitHub.Data.Definitions diff --git a/src/GitHub/Data/Milestone.hs b/src/GitHub/Data/Milestone.hs index a8db2864..385678d1 100644 --- a/src/GitHub/Data/Milestone.hs +++ b/src/GitHub/Data/Milestone.hs @@ -1,8 +1,3 @@ ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Data.Milestone where import GitHub.Data.Definitions diff --git a/src/GitHub/Data/Name.hs b/src/GitHub/Data/Name.hs index 35c12b0c..dbc09653 100644 --- a/src/GitHub/Data/Name.hs +++ b/src/GitHub/Data/Name.hs @@ -1,9 +1,4 @@ {-# LANGUAGE CPP #-} ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Data.Name ( Name(..), mkName, diff --git a/src/GitHub/Data/Options.hs b/src/GitHub/Data/Options.hs index 5d27e0b1..87c489a7 100644 --- a/src/GitHub/Data/Options.hs +++ b/src/GitHub/Data/Options.hs @@ -1,10 +1,8 @@ {-# LANGUAGE RecordWildCards #-} ------------------------------------------------------------------------------ + -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- Module with modifiers for pull requests' and issues' listings. + module GitHub.Data.Options ( -- * Common modifiers stateOpen, diff --git a/src/GitHub/Data/PullRequests.hs b/src/GitHub/Data/PullRequests.hs index 0075986a..79054b6a 100644 --- a/src/GitHub/Data/PullRequests.hs +++ b/src/GitHub/Data/PullRequests.hs @@ -1,8 +1,3 @@ ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Data.PullRequests ( SimplePullRequest(..), PullRequest(..), diff --git a/src/GitHub/Data/RateLimit.hs b/src/GitHub/Data/RateLimit.hs index 2ba008f0..2db078af 100644 --- a/src/GitHub/Data/RateLimit.hs +++ b/src/GitHub/Data/RateLimit.hs @@ -1,8 +1,3 @@ ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Data.RateLimit where import GitHub.Internal.Prelude diff --git a/src/GitHub/Data/Repos.hs b/src/GitHub/Data/Repos.hs index 63779d77..98c254c2 100644 --- a/src/GitHub/Data/Repos.hs +++ b/src/GitHub/Data/Repos.hs @@ -1,14 +1,12 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} #define UNSAFE 1 ------------------------------------------------------------------------------ + -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- This module also exports -- @'FromJSON' a => 'FromJSON' ('HM.HashMap' 'Language' a)@ -- orphan-ish instance for @aeson < 1@ + module GitHub.Data.Repos where import GitHub.Data.Definitions diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs index 4180a938..445c4223 100644 --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -3,11 +3,7 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE StandaloneDeriving #-} ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- + module GitHub.Data.Request ( -- * Request Request, diff --git a/src/GitHub/Data/Search.hs b/src/GitHub/Data/Search.hs index 96b9f2c8..b56067b0 100644 --- a/src/GitHub/Data/Search.hs +++ b/src/GitHub/Data/Search.hs @@ -1,8 +1,3 @@ ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Data.Search where import GitHub.Data.Repos (CodeSearchRepo) diff --git a/src/GitHub/Data/Teams.hs b/src/GitHub/Data/Teams.hs index 79ef9706..622370ae 100644 --- a/src/GitHub/Data/Teams.hs +++ b/src/GitHub/Data/Teams.hs @@ -2,11 +2,7 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- + module GitHub.Data.Teams where import GitHub.Data.Definitions diff --git a/src/GitHub/Data/URL.hs b/src/GitHub/Data/URL.hs index 9b29b673..d98703ae 100644 --- a/src/GitHub/Data/URL.hs +++ b/src/GitHub/Data/URL.hs @@ -1,8 +1,3 @@ ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Data.URL ( URL(..), getUrl, diff --git a/src/GitHub/Data/Webhooks.hs b/src/GitHub/Data/Webhooks.hs index 8ca2fe8e..143d8006 100644 --- a/src/GitHub/Data/Webhooks.hs +++ b/src/GitHub/Data/Webhooks.hs @@ -1,8 +1,3 @@ ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Data.Webhooks where import GitHub.Data.Id (Id) diff --git a/src/GitHub/Data/Webhooks/Validate.hs b/src/GitHub/Data/Webhooks/Validate.hs index a90d4e23..1ea7590b 100644 --- a/src/GitHub/Data/Webhooks/Validate.hs +++ b/src/GitHub/Data/Webhooks/Validate.hs @@ -1,10 +1,7 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- Verification of incomming webhook payloads, as described at -- + module GitHub.Data.Webhooks.Validate ( isValidPayload ) where diff --git a/src/GitHub/Endpoints/Activity/Events.hs b/src/GitHub/Endpoints/Activity/Events.hs index 8074ab2a..1b0676e9 100644 --- a/src/GitHub/Endpoints/Activity/Events.hs +++ b/src/GitHub/Endpoints/Activity/Events.hs @@ -1,9 +1,6 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The events API as described on . + module GitHub.Endpoints.Activity.Events ( -- * Events repositoryEventsR, diff --git a/src/GitHub/Endpoints/Activity/Notifications.hs b/src/GitHub/Endpoints/Activity/Notifications.hs index 7c246c54..7a900aa7 100644 --- a/src/GitHub/Endpoints/Activity/Notifications.hs +++ b/src/GitHub/Endpoints/Activity/Notifications.hs @@ -1,8 +1,4 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The repo watching API as described on -- . diff --git a/src/GitHub/Endpoints/Activity/Starring.hs b/src/GitHub/Endpoints/Activity/Starring.hs index be589db0..7d77057b 100644 --- a/src/GitHub/Endpoints/Activity/Starring.hs +++ b/src/GitHub/Endpoints/Activity/Starring.hs @@ -1,10 +1,7 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The repo starring API as described on -- . + module GitHub.Endpoints.Activity.Starring ( stargazersForR, reposStarredByR, diff --git a/src/GitHub/Endpoints/Activity/Watching.hs b/src/GitHub/Endpoints/Activity/Watching.hs index 92b7829d..3ad5954b 100644 --- a/src/GitHub/Endpoints/Activity/Watching.hs +++ b/src/GitHub/Endpoints/Activity/Watching.hs @@ -1,10 +1,7 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The repo watching API as described on -- . + module GitHub.Endpoints.Activity.Watching ( watchersForR, reposWatchedByR, diff --git a/src/GitHub/Endpoints/Enterprise/Organizations.hs b/src/GitHub/Endpoints/Enterprise/Organizations.hs index 589c3d35..1e71334f 100644 --- a/src/GitHub/Endpoints/Enterprise/Organizations.hs +++ b/src/GitHub/Endpoints/Enterprise/Organizations.hs @@ -1,9 +1,6 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The GitHub Enterprise orgs API as described on . + module GitHub.Endpoints.Enterprise.Organizations ( createOrganizationR, renameOrganizationR, diff --git a/src/GitHub/Endpoints/Gists.hs b/src/GitHub/Endpoints/Gists.hs index de8e6c20..da1fc194 100644 --- a/src/GitHub/Endpoints/Gists.hs +++ b/src/GitHub/Endpoints/Gists.hs @@ -1,9 +1,6 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The gists API as described at . + module GitHub.Endpoints.Gists ( gistsR, gistR, diff --git a/src/GitHub/Endpoints/Gists/Comments.hs b/src/GitHub/Endpoints/Gists/Comments.hs index d6a127dd..5234a63c 100644 --- a/src/GitHub/Endpoints/Gists/Comments.hs +++ b/src/GitHub/Endpoints/Gists/Comments.hs @@ -1,10 +1,7 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The loving comments people have left on Gists, described on -- . + module GitHub.Endpoints.Gists.Comments ( commentsOnR, gistCommentR, diff --git a/src/GitHub/Endpoints/GitData/Blobs.hs b/src/GitHub/Endpoints/GitData/Blobs.hs index 4c3c5f88..c7b39aea 100644 --- a/src/GitHub/Endpoints/GitData/Blobs.hs +++ b/src/GitHub/Endpoints/GitData/Blobs.hs @@ -1,10 +1,7 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The API for dealing with git blobs from Github repos, as described in -- . + module GitHub.Endpoints.GitData.Blobs ( blobR, module GitHub.Data, diff --git a/src/GitHub/Endpoints/GitData/Commits.hs b/src/GitHub/Endpoints/GitData/Commits.hs index 109ca87d..82a18bf3 100644 --- a/src/GitHub/Endpoints/GitData/Commits.hs +++ b/src/GitHub/Endpoints/GitData/Commits.hs @@ -1,10 +1,7 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The API for underlying git commits of a Github repo, as described on -- . + module GitHub.Endpoints.GitData.Commits ( gitCommitR, module GitHub.Data, diff --git a/src/GitHub/Endpoints/GitData/References.hs b/src/GitHub/Endpoints/GitData/References.hs index bf64657f..a1f10814 100644 --- a/src/GitHub/Endpoints/GitData/References.hs +++ b/src/GitHub/Endpoints/GitData/References.hs @@ -1,11 +1,8 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The underlying git references on a Github repo, exposed for the world to -- see. The git internals documentation will also prove handy for understanding -- these. API documentation at . + module GitHub.Endpoints.GitData.References ( referenceR, referencesR, diff --git a/src/GitHub/Endpoints/GitData/Trees.hs b/src/GitHub/Endpoints/GitData/Trees.hs index 434d8e95..4bdf389b 100644 --- a/src/GitHub/Endpoints/GitData/Trees.hs +++ b/src/GitHub/Endpoints/GitData/Trees.hs @@ -1,10 +1,7 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The underlying tree of SHA1s and files that make up a git repo. The API is -- described on . + module GitHub.Endpoints.GitData.Trees ( treeR, nestedTreeR, diff --git a/src/GitHub/Endpoints/Issues.hs b/src/GitHub/Endpoints/Issues.hs index f1980dbf..9cd7258f 100644 --- a/src/GitHub/Endpoints/Issues.hs +++ b/src/GitHub/Endpoints/Issues.hs @@ -1,10 +1,8 @@ {-# LANGUAGE CPP #-} ------------------------------------------------------------------------------ + -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The issues API as described on . + module GitHub.Endpoints.Issues ( currentUserIssuesR, organizationIssuesR, diff --git a/src/GitHub/Endpoints/Issues/Comments.hs b/src/GitHub/Endpoints/Issues/Comments.hs index 18550abc..0c307d3f 100644 --- a/src/GitHub/Endpoints/Issues/Comments.hs +++ b/src/GitHub/Endpoints/Issues/Comments.hs @@ -1,10 +1,7 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The Github issue comments API from -- . + module GitHub.Endpoints.Issues.Comments ( commentR, commentsR, diff --git a/src/GitHub/Endpoints/Issues/Events.hs b/src/GitHub/Endpoints/Issues/Events.hs index e69ed9fa..0639026c 100644 --- a/src/GitHub/Endpoints/Issues/Events.hs +++ b/src/GitHub/Endpoints/Issues/Events.hs @@ -1,10 +1,7 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The Github issue events API, which is described on -- + module GitHub.Endpoints.Issues.Events ( eventsForIssueR, eventsForRepoR, diff --git a/src/GitHub/Endpoints/Issues/Labels.hs b/src/GitHub/Endpoints/Issues/Labels.hs index 3d129e8c..bdf2319d 100644 --- a/src/GitHub/Endpoints/Issues/Labels.hs +++ b/src/GitHub/Endpoints/Issues/Labels.hs @@ -1,10 +1,7 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The API for dealing with labels on Github issues as described on -- . + module GitHub.Endpoints.Issues.Labels ( labelsOnRepoR, labelR, diff --git a/src/GitHub/Endpoints/Issues/Milestones.hs b/src/GitHub/Endpoints/Issues/Milestones.hs index 78b6531d..18d5d9d4 100644 --- a/src/GitHub/Endpoints/Issues/Milestones.hs +++ b/src/GitHub/Endpoints/Issues/Milestones.hs @@ -1,10 +1,7 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The milestones API as described on -- . + module GitHub.Endpoints.Issues.Milestones ( milestonesR, milestoneR, diff --git a/src/GitHub/Endpoints/Organizations.hs b/src/GitHub/Endpoints/Organizations.hs index 12844510..0cb3da47 100644 --- a/src/GitHub/Endpoints/Organizations.hs +++ b/src/GitHub/Endpoints/Organizations.hs @@ -1,9 +1,6 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The orgs API as described on . + module GitHub.Endpoints.Organizations ( publicOrganizationsForR, publicOrganizationR, diff --git a/src/GitHub/Endpoints/Organizations/Members.hs b/src/GitHub/Endpoints/Organizations/Members.hs index 26a8f4c4..84e52e43 100644 --- a/src/GitHub/Endpoints/Organizations/Members.hs +++ b/src/GitHub/Endpoints/Organizations/Members.hs @@ -1,10 +1,7 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The organization members API as described on -- . + module GitHub.Endpoints.Organizations.Members ( membersOfR, membersOfWithR, diff --git a/src/GitHub/Endpoints/Organizations/OutsideCollaborators.hs b/src/GitHub/Endpoints/Organizations/OutsideCollaborators.hs index 9bc392dd..dee42fcf 100644 --- a/src/GitHub/Endpoints/Organizations/OutsideCollaborators.hs +++ b/src/GitHub/Endpoints/Organizations/OutsideCollaborators.hs @@ -1,10 +1,7 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The organization members API as described on -- . + module GitHub.Endpoints.Organizations.OutsideCollaborators ( outsideCollaboratorsR, ) where diff --git a/src/GitHub/Endpoints/Organizations/Teams.hs b/src/GitHub/Endpoints/Organizations/Teams.hs index 189e68f7..af8c8b36 100644 --- a/src/GitHub/Endpoints/Organizations/Teams.hs +++ b/src/GitHub/Endpoints/Organizations/Teams.hs @@ -1,10 +1,7 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The Owner teams API as described on -- . + module GitHub.Endpoints.Organizations.Teams ( teamsOfR, teamInfoForR, diff --git a/src/GitHub/Endpoints/PullRequests.hs b/src/GitHub/Endpoints/PullRequests.hs index 7217e51b..5e5d6aac 100644 --- a/src/GitHub/Endpoints/PullRequests.hs +++ b/src/GitHub/Endpoints/PullRequests.hs @@ -1,10 +1,7 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The pull requests API as documented at -- . + module GitHub.Endpoints.PullRequests ( pullRequestsForR, pullRequestR, @@ -102,4 +99,3 @@ mergePullRequestR user repo prid commitMessage = buildCommitMessageMap :: Maybe Text -> Value buildCommitMessageMap (Just msg) = object ["commit_message" .= msg ] buildCommitMessageMap Nothing = object [] - diff --git a/src/GitHub/Endpoints/PullRequests/Comments.hs b/src/GitHub/Endpoints/PullRequests/Comments.hs index 9bb6fca2..e1117921 100644 --- a/src/GitHub/Endpoints/PullRequests/Comments.hs +++ b/src/GitHub/Endpoints/PullRequests/Comments.hs @@ -1,10 +1,7 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The pull request review comments API as described at -- . + module GitHub.Endpoints.PullRequests.Comments ( pullRequestCommentsR, pullRequestCommentR, diff --git a/src/GitHub/Endpoints/PullRequests/Reviews.hs b/src/GitHub/Endpoints/PullRequests/Reviews.hs index fe95d25b..e746e570 100644 --- a/src/GitHub/Endpoints/PullRequests/Reviews.hs +++ b/src/GitHub/Endpoints/PullRequests/Reviews.hs @@ -1,9 +1,6 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The reviews API as described on . + module GitHub.Endpoints.PullRequests.Reviews ( pullRequestReviewsR , pullRequestReviewR diff --git a/src/GitHub/Endpoints/RateLimit.hs b/src/GitHub/Endpoints/RateLimit.hs index 3bbe8c2f..8d559613 100644 --- a/src/GitHub/Endpoints/RateLimit.hs +++ b/src/GitHub/Endpoints/RateLimit.hs @@ -1,10 +1,7 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The Github RateLimit API, as described at -- . + module GitHub.Endpoints.RateLimit ( rateLimitR, module GitHub.Data, diff --git a/src/GitHub/Endpoints/Repos.hs b/src/GitHub/Endpoints/Repos.hs index b8c9d79d..85c8b639 100644 --- a/src/GitHub/Endpoints/Repos.hs +++ b/src/GitHub/Endpoints/Repos.hs @@ -1,10 +1,7 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The Github Repos API, as documented at -- + module GitHub.Endpoints.Repos ( -- * Querying repositories currentUserReposR, diff --git a/src/GitHub/Endpoints/Repos/Collaborators.hs b/src/GitHub/Endpoints/Repos/Collaborators.hs index 5322b36d..f587636d 100644 --- a/src/GitHub/Endpoints/Repos/Collaborators.hs +++ b/src/GitHub/Endpoints/Repos/Collaborators.hs @@ -1,10 +1,7 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The repo collaborators API as described on -- . + module GitHub.Endpoints.Repos.Collaborators ( collaboratorsOnR, collaboratorPermissionOnR, diff --git a/src/GitHub/Endpoints/Repos/Comments.hs b/src/GitHub/Endpoints/Repos/Comments.hs index 2b853c0e..371288e3 100644 --- a/src/GitHub/Endpoints/Repos/Comments.hs +++ b/src/GitHub/Endpoints/Repos/Comments.hs @@ -1,11 +1,9 @@ {-# LANGUAGE CPP #-} ------------------------------------------------------------------------------ + -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The repo commits API as described on -- . + module GitHub.Endpoints.Repos.Comments ( commentsForR, commitCommentsForR, diff --git a/src/GitHub/Endpoints/Repos/Commits.hs b/src/GitHub/Endpoints/Repos/Commits.hs index bfe0cc84..3a10e0a9 100644 --- a/src/GitHub/Endpoints/Repos/Commits.hs +++ b/src/GitHub/Endpoints/Repos/Commits.hs @@ -1,11 +1,9 @@ {-# LANGUAGE CPP #-} ------------------------------------------------------------------------------ + -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The repo commits API as described on -- . + module GitHub.Endpoints.Repos.Commits ( CommitQueryOption(..), commitsForR, diff --git a/src/GitHub/Endpoints/Repos/Contents.hs b/src/GitHub/Endpoints/Repos/Contents.hs index 55f48c99..00d2c632 100644 --- a/src/GitHub/Endpoints/Repos/Contents.hs +++ b/src/GitHub/Endpoints/Repos/Contents.hs @@ -1,10 +1,7 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The Github Repo Contents API, as documented at -- + module GitHub.Endpoints.Repos.Contents ( -- * Querying contents contentsForR, diff --git a/src/GitHub/Endpoints/Repos/Forks.hs b/src/GitHub/Endpoints/Repos/Forks.hs index f556e1f8..c9b56e30 100644 --- a/src/GitHub/Endpoints/Repos/Forks.hs +++ b/src/GitHub/Endpoints/Repos/Forks.hs @@ -1,10 +1,7 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- Hot forking action, as described at -- . + module GitHub.Endpoints.Repos.Forks ( forksForR, module GitHub.Data, diff --git a/src/GitHub/Endpoints/Repos/Invitations.hs b/src/GitHub/Endpoints/Repos/Invitations.hs index 68239961..066c7abc 100644 --- a/src/GitHub/Endpoints/Repos/Invitations.hs +++ b/src/GitHub/Endpoints/Repos/Invitations.hs @@ -1,10 +1,7 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The repo invitations API as described on -- . + module GitHub.Endpoints.Repos.Invitations ( listInvitationsOnR, listInvitationsForR, diff --git a/src/GitHub/Endpoints/Repos/Statuses.hs b/src/GitHub/Endpoints/Repos/Statuses.hs index 1c1f167d..93c4682f 100644 --- a/src/GitHub/Endpoints/Repos/Statuses.hs +++ b/src/GitHub/Endpoints/Repos/Statuses.hs @@ -1,10 +1,7 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The repo statuses API as described on -- . + module GitHub.Endpoints.Repos.Statuses ( createStatusR, statusesForR, diff --git a/src/GitHub/Endpoints/Repos/Webhooks.hs b/src/GitHub/Endpoints/Repos/Webhooks.hs index 8b828f30..402fb4af 100644 --- a/src/GitHub/Endpoints/Repos/Webhooks.hs +++ b/src/GitHub/Endpoints/Repos/Webhooks.hs @@ -1,11 +1,8 @@ - ----------------------------------------------------------------------------- -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The webhooks API, as described at -- -- + module GitHub.Endpoints.Repos.Webhooks ( -- * Querying repositories webhooksForR, diff --git a/src/GitHub/Endpoints/Search.hs b/src/GitHub/Endpoints/Search.hs index 36b8c414..06ddd373 100644 --- a/src/GitHub/Endpoints/Search.hs +++ b/src/GitHub/Endpoints/Search.hs @@ -1,10 +1,7 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The Github Search API, as described at -- . + module GitHub.Endpoints.Search( searchReposR, searchCodeR, diff --git a/src/GitHub/Endpoints/Users.hs b/src/GitHub/Endpoints/Users.hs index ef68bba6..85f5e68e 100644 --- a/src/GitHub/Endpoints/Users.hs +++ b/src/GitHub/Endpoints/Users.hs @@ -1,10 +1,7 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The Github Users API, as described at -- . + module GitHub.Endpoints.Users ( userInfoForR, ownerInfoForR, diff --git a/src/GitHub/Endpoints/Users/Emails.hs b/src/GitHub/Endpoints/Users/Emails.hs index 9ba76389..c9e42520 100644 --- a/src/GitHub/Endpoints/Users/Emails.hs +++ b/src/GitHub/Endpoints/Users/Emails.hs @@ -1,10 +1,7 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The user emails API as described on -- . + module GitHub.Endpoints.Users.Emails ( currentUserEmailsR, currentUserPublicEmailsR, diff --git a/src/GitHub/Endpoints/Users/Followers.hs b/src/GitHub/Endpoints/Users/Followers.hs index db58900f..13f8b494 100644 --- a/src/GitHub/Endpoints/Users/Followers.hs +++ b/src/GitHub/Endpoints/Users/Followers.hs @@ -1,10 +1,7 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The user followers API as described on -- . + module GitHub.Endpoints.Users.Followers ( usersFollowingR, usersFollowedByR, diff --git a/src/GitHub/Enterprise.hs b/src/GitHub/Enterprise.hs index bb64b7d7..d9474cd6 100644 --- a/src/GitHub/Enterprise.hs +++ b/src/GitHub/Enterprise.hs @@ -1,11 +1,7 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- This module re-exports all request constructors and data definitions for -- working with GitHub Enterprise. --- + module GitHub.Enterprise ( -- * Enterprise Admin -- | See diff --git a/src/GitHub/Internal/Prelude.hs b/src/GitHub/Internal/Prelude.hs index 1994abac..23eab9d0 100644 --- a/src/GitHub/Internal/Prelude.hs +++ b/src/GitHub/Internal/Prelude.hs @@ -1,11 +1,9 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE CPP #-} ------------------------------------------------------------------------------ + -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- This module may change between minor releases. Do not rely on its contents. + module GitHub.Internal.Prelude ( module Prelude.Compat, -- * Commonly used types diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index 2481deea..c5eb006c 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -6,11 +6,8 @@ {-# LANGUAGE KindSignatures #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE UndecidableInstances #-} ------------------------------------------------------------------------------ + -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- This module provides data types and helper methods, which makes possible -- to build alternative API request intepreters in addition to provided -- 'IO' functions. @@ -30,6 +27,7 @@ -- > -- | Lift request into Monad -- > githubRequest :: GH.Request 'False a -> GithubMonad a -- > githubRequest = singleton + module GitHub.Request ( -- * A convenient execution of requests github, From 08b16f77a2d84186f39d8f56b1beeffcccf30eaa Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Fri, 23 Jun 2023 17:01:18 +0200 Subject: [PATCH 478/510] More .gitignores --- .gitignore | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/.gitignore b/.gitignore index 452bddc6..93ce2741 100644 --- a/.gitignore +++ b/.gitignore @@ -1,6 +1,8 @@ .env dist dist-newstyle +/dist* +/tmp .ghc.environment.* *swp .cabal-sandbox @@ -10,7 +12,9 @@ cabal.sandbox.config *~ *.hi *.o +*.lock .stack-work run.sh src/hightlight.js src/style.css +TAGS From 69404f728e4351b8c8ebcf4206ac945cb11129a3 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Fri, 23 Jun 2023 17:47:57 +0200 Subject: [PATCH 479/510] GitHub.Internal.Prelude: simplify export list (remove duplication) --- src/GitHub/Internal/Prelude.hs | 73 +++++++++++----------------------- 1 file changed, 23 insertions(+), 50 deletions(-) diff --git a/src/GitHub/Internal/Prelude.hs b/src/GitHub/Internal/Prelude.hs index 23eab9d0..0419d934 100644 --- a/src/GitHub/Internal/Prelude.hs +++ b/src/GitHub/Internal/Prelude.hs @@ -4,56 +4,29 @@ -- | -- This module may change between minor releases. Do not rely on its contents. -module GitHub.Internal.Prelude ( - module Prelude.Compat, - -- * Commonly used types - UTCTime, - HashMap, - Text, pack, unpack, - Vector, - -- * Commonly used typeclasses - Binary, - Data, Typeable, - Generic, - Hashable(..), - IsString(..), - NFData(..), genericRnf, - Semigroup(..), - -- * Aeson - FromJSON(..), ToJSON(..), Value(..), Object, - emptyObject, - encode, - withText, withObject, (.:), (.:?), (.!=), (.=), object, typeMismatch, - -- * Control.Applicative - (<|>), - -- * Data.Maybe - catMaybes, - -- * Data.List - intercalate, toList, - -- * Data.Time.ISO8601 - formatISO8601, - ) where +module GitHub.Internal.Prelude ( module X ) where -import Control.Applicative ((<|>)) -import Control.DeepSeq (NFData (..)) -import Control.DeepSeq.Generics (genericRnf) -import Data.Aeson +import Control.Applicative as X ((<|>)) +import Control.DeepSeq as X (NFData (..)) +import Control.DeepSeq.Generics as X (genericRnf) +import Data.Aeson as X (FromJSON (..), Object, ToJSON (..), Value (..), encode, object, withObject, withText, (.!=), (.:), (.:?), (.=)) -import Data.Aeson.Types (emptyObject, typeMismatch) -import Data.Binary (Binary) -import Data.Binary.Instances () -import Data.Data (Data, Typeable) -import Data.Foldable (toList) -import Data.Hashable (Hashable (..)) -import Data.HashMap.Strict (HashMap) -import Data.List (intercalate) -import Data.Maybe (catMaybes) -import Data.Semigroup (Semigroup (..)) -import Data.String (IsString (..)) -import Data.Text (Text, pack, unpack) -import Data.Time.Compat (UTCTime) -import Data.Time.ISO8601 (formatISO8601) -import Data.Vector (Vector) -import GHC.Generics (Generic) -import Prelude.Compat +import Data.Aeson.Types as X (emptyObject, typeMismatch) +import Data.Binary as X (Binary) +import Data.Binary.Instances as X () +import Data.Data as X (Data, Typeable) +import Data.Foldable as X (toList) +import Data.Hashable as X (Hashable (..)) +import Data.HashMap.Strict as X (HashMap) +import Data.List as X (intercalate) +import Data.Maybe as X (catMaybes) +import Data.Semigroup as X (Semigroup (..)) +import Data.String as X (IsString (..)) +import Data.Text as X (Text, pack, unpack) +import Data.Time.Compat as X (UTCTime) +import Data.Time.ISO8601 as X (formatISO8601) +import Data.Vector as X (Vector) +import GHC.Generics as X (Generic) +import Prelude.Compat as X +import Data.Functor.Compat as X ((<&>)) From 5a26a8cfbfe4f00ceaf3a51d06a43d33cb39085e Mon Sep 17 00:00:00 2001 From: Oleg Nykolyn Date: Fri, 23 Jun 2023 22:46:03 -0700 Subject: [PATCH 480/510] Implement Actions API. (#459) New data structures and endpoints to access the GitHub Actions API. Commit squashed from the following commits: * Implement actions->artifacts API. * Up * Cleanup * Actions - cache. * Actions - artifacts and cache. * Secrets * Workflows. * WorkflowJobs. * WorkflowRuns. * Format * Artifacts QA. * Cache QA. * Secrets QA. * WorkflowJobs QA. * Workflows QA. * Format. * Drop slack-related files. * Format JSON * Support workflow name in workflowRunsForWorkflowR. * Support workflow name in Workflows.hs. * Fix * Fix * Do not parse pull requests from workflow runs. * Avoid parsing 'trigerring_actor', it is sometimes missing. * Fix workflow run conclusion parsing. * Whitespace and lexical changes only * Remove outdated maintainer from module headers * Whitespace: align code * Bump cabal-version to 2.4 for globbing * Cosmetics: use (<&>) * Restore upper bounds for openssl etc. in .cabal file * Whitespace * Add haddocks for WithTotalCount * Changelog for PR #459 --------- Co-authored-by: Andreas Abel --- .gitignore | 2 + CHANGELOG.md | 8 +- fixtures/actions/artifact.json | 19 + fixtures/actions/artifacts-list.json | 43 ++ fixtures/actions/cache-list.json | 14 + fixtures/actions/org-cache-usage.json | 4 + fixtures/actions/org-public-key.json | 4 + fixtures/actions/org-secrets-list.json | 18 + fixtures/actions/repo-cache-usage.json | 5 + .../selected-repositories-for-secret.json | 72 ++ fixtures/actions/workflow-job.json | 113 +++ fixtures/actions/workflow-list.json | 17 + fixtures/actions/workflow-runs-list.json | 665 ++++++++++++++++++ github.cabal | 32 +- spec/GitHub/Actions/ArtifactsSpec.hs | 66 ++ spec/GitHub/Actions/CacheSpec.hs | 53 ++ spec/GitHub/Actions/SecretsSpec.hs | 50 ++ spec/GitHub/Actions/WorkflowJobSpec.hs | 32 + spec/GitHub/Actions/WorkflowRunsSpec.hs | 32 + spec/GitHub/Actions/WorkflowSpec.hs | 32 + src/GitHub.hs | 76 ++ src/GitHub/Data.hs | 14 + src/GitHub/Data/Actions/Artifacts.hs | 76 ++ src/GitHub/Data/Actions/Cache.hs | 78 ++ src/GitHub/Data/Actions/Common.hs | 33 + src/GitHub/Data/Actions/Secrets.hs | 141 ++++ src/GitHub/Data/Actions/WorkflowJobs.hs | 98 +++ src/GitHub/Data/Actions/WorkflowRuns.hs | 91 +++ src/GitHub/Data/Actions/Workflows.hs | 62 ++ src/GitHub/Data/Options.hs | 271 +++++++ src/GitHub/Endpoints/Actions/Artifacts.hs | 61 ++ src/GitHub/Endpoints/Actions/Cache.hs | 66 ++ src/GitHub/Endpoints/Actions/Secrets.hs | 221 ++++++ src/GitHub/Endpoints/Actions/WorkflowJobs.hs | 58 ++ src/GitHub/Endpoints/Actions/WorkflowRuns.hs | 181 +++++ src/GitHub/Endpoints/Actions/Workflows.hs | 68 ++ 36 files changed, 2870 insertions(+), 6 deletions(-) create mode 100644 fixtures/actions/artifact.json create mode 100644 fixtures/actions/artifacts-list.json create mode 100644 fixtures/actions/cache-list.json create mode 100644 fixtures/actions/org-cache-usage.json create mode 100644 fixtures/actions/org-public-key.json create mode 100644 fixtures/actions/org-secrets-list.json create mode 100644 fixtures/actions/repo-cache-usage.json create mode 100644 fixtures/actions/selected-repositories-for-secret.json create mode 100644 fixtures/actions/workflow-job.json create mode 100644 fixtures/actions/workflow-list.json create mode 100644 fixtures/actions/workflow-runs-list.json create mode 100644 spec/GitHub/Actions/ArtifactsSpec.hs create mode 100644 spec/GitHub/Actions/CacheSpec.hs create mode 100644 spec/GitHub/Actions/SecretsSpec.hs create mode 100644 spec/GitHub/Actions/WorkflowJobSpec.hs create mode 100644 spec/GitHub/Actions/WorkflowRunsSpec.hs create mode 100644 spec/GitHub/Actions/WorkflowSpec.hs create mode 100644 src/GitHub/Data/Actions/Artifacts.hs create mode 100644 src/GitHub/Data/Actions/Cache.hs create mode 100644 src/GitHub/Data/Actions/Common.hs create mode 100644 src/GitHub/Data/Actions/Secrets.hs create mode 100644 src/GitHub/Data/Actions/WorkflowJobs.hs create mode 100644 src/GitHub/Data/Actions/WorkflowRuns.hs create mode 100644 src/GitHub/Data/Actions/Workflows.hs create mode 100644 src/GitHub/Endpoints/Actions/Artifacts.hs create mode 100644 src/GitHub/Endpoints/Actions/Cache.hs create mode 100644 src/GitHub/Endpoints/Actions/Secrets.hs create mode 100644 src/GitHub/Endpoints/Actions/WorkflowJobs.hs create mode 100644 src/GitHub/Endpoints/Actions/WorkflowRuns.hs create mode 100644 src/GitHub/Endpoints/Actions/Workflows.hs diff --git a/.gitignore b/.gitignore index 93ce2741..3a8f6f25 100644 --- a/.gitignore +++ b/.gitignore @@ -18,3 +18,5 @@ run.sh src/hightlight.js src/style.css TAGS +.DS_Store + diff --git a/CHANGELOG.md b/CHANGELOG.md index 1fa91d95..0926cfee 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,12 @@ ## Changes for 0.29 -_2022-06-24, Andreas Abel, Midsommar edition_ +_2023-06-24, Andreas Abel, Midsommar edition_ + +- Support for the GitHub Actions API + (PR [#459](https://github.com/haskell-github/github/pull/459)): + * New endpoint modules `GitHub.EndPoints.Actions.Artifacts`, `.Cache`, + `.Secrets`, `.Workflows`, `.WorkflowRuns`, `.WorkflowJobs`. + * Matching data structure modules `GitHub.Data.Actions.*`. - Add field `issueStateReason` of type `Maybe IssueStateReason` to `Issue` with possible values `completed`, `not_planned` and `reopened` diff --git a/fixtures/actions/artifact.json b/fixtures/actions/artifact.json new file mode 100644 index 00000000..cb06b454 --- /dev/null +++ b/fixtures/actions/artifact.json @@ -0,0 +1,19 @@ +{ + "id": 416767789, + "node_id": "MDg6QXJ0aWZhY3Q0MTY3Njc3ODk=", + "name": "dist-without-markdown", + "size_in_bytes": 42718, + "url": "https://api.github.com/repos/kote-test-org-actions/actions-api/actions/artifacts/416767789", + "archive_download_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/actions/artifacts/416767789/zip", + "expired": false, + "created_at": "2022-10-29T22:18:21Z", + "updated_at": "2022-10-29T22:18:23Z", + "expires_at": "2023-01-27T22:18:16Z", + "workflow_run": { + "id": 3353148947, + "repository_id": 559365297, + "head_repository_id": 559365297, + "head_branch": "main", + "head_sha": "601593ecb1d8a57a04700fdb445a28d4186b8954" + } +} diff --git a/fixtures/actions/artifacts-list.json b/fixtures/actions/artifacts-list.json new file mode 100644 index 00000000..2d03d803 --- /dev/null +++ b/fixtures/actions/artifacts-list.json @@ -0,0 +1,43 @@ +{ + "total_count": 23809, + "artifacts": [ + { + "id": 416737084, + "node_id": "MDg6QXJ0aWZhY3Q0MTY3MzcwODQ=", + "name": "doc-html", + "size_in_bytes": 61667543, + "url": "https://api.github.com/repos/python/cpython/actions/artifacts/416737084", + "archive_download_url": "https://api.github.com/repos/python/cpython/actions/artifacts/416737084/zip", + "expired": false, + "created_at": "2022-10-29T20:56:24Z", + "updated_at": "2022-10-29T20:56:25Z", + "expires_at": "2023-01-27T20:50:21Z", + "workflow_run": { + "id": 3352897496, + "repository_id": 81598961, + "head_repository_id": 101955313, + "head_branch": "backport-bfecff5-3.11", + "head_sha": "692cd77975413d71ff0951072df686e6f38711c8" + } + }, + { + "id": 416712612, + "node_id": "MDg6QXJ0aWZhY3Q0MTY3MTI2MTI=", + "name": "doc-html", + "size_in_bytes": 61217330, + "url": "https://api.github.com/repos/python/cpython/actions/artifacts/416712612", + "archive_download_url": "https://api.github.com/repos/python/cpython/actions/artifacts/416712612/zip", + "expired": false, + "created_at": "2022-10-29T19:53:19Z", + "updated_at": "2022-10-29T19:53:20Z", + "expires_at": "2023-01-27T19:49:12Z", + "workflow_run": { + "id": 3352724493, + "repository_id": 81598961, + "head_repository_id": 559335486, + "head_branch": "patch-1", + "head_sha": "62eb88a66d1d35f7701873d8b698a2f8d7e84fa5" + } + } + ] +} diff --git a/fixtures/actions/cache-list.json b/fixtures/actions/cache-list.json new file mode 100644 index 00000000..64cf3956 --- /dev/null +++ b/fixtures/actions/cache-list.json @@ -0,0 +1,14 @@ +{ + "total_count": 1, + "actions_caches": [ + { + "id": 1, + "ref": "refs/heads/main", + "key": "cache_key", + "version": "f5f850afdadd47730296d4ffa900de95f6bbafb75dc1e8475df1fa6ae79dcece", + "last_accessed_at": "2022-10-30T00:08:14.223333300Z", + "created_at": "2022-10-30T00:08:14.223333300Z", + "size_in_bytes": 26586 + } + ] +} diff --git a/fixtures/actions/org-cache-usage.json b/fixtures/actions/org-cache-usage.json new file mode 100644 index 00000000..99be4def --- /dev/null +++ b/fixtures/actions/org-cache-usage.json @@ -0,0 +1,4 @@ +{ + "total_active_caches_size_in_bytes": 26586, + "total_active_caches_count": 1 +} diff --git a/fixtures/actions/org-public-key.json b/fixtures/actions/org-public-key.json new file mode 100644 index 00000000..621c84eb --- /dev/null +++ b/fixtures/actions/org-public-key.json @@ -0,0 +1,4 @@ +{ + "key_id": "568250167242549743", + "key": "KHVvOxB765kjkShEgUu27QCzl5XxKz/L20V+KRsWf0w=" +} diff --git a/fixtures/actions/org-secrets-list.json b/fixtures/actions/org-secrets-list.json new file mode 100644 index 00000000..241a8737 --- /dev/null +++ b/fixtures/actions/org-secrets-list.json @@ -0,0 +1,18 @@ +{ + "total_count": 2, + "secrets": [ + { + "name": "TEST_SECRET", + "created_at": "2022-10-31T00:08:12Z", + "updated_at": "2022-10-31T00:08:12Z", + "visibility": "all" + }, + { + "name": "TEST_SELECTED", + "created_at": "2022-10-31T00:08:43Z", + "updated_at": "2022-10-31T00:08:43Z", + "visibility": "selected", + "selected_repositories_url": "https://api.github.com/orgs/kote-test-org-actions/actions/secrets/TEST_SELECTED/repositories" + } + ] +} diff --git a/fixtures/actions/repo-cache-usage.json b/fixtures/actions/repo-cache-usage.json new file mode 100644 index 00000000..bf8659be --- /dev/null +++ b/fixtures/actions/repo-cache-usage.json @@ -0,0 +1,5 @@ +{ + "full_name": "python/cpython", + "active_caches_size_in_bytes": 55000268087, + "active_caches_count": 171 +} diff --git a/fixtures/actions/selected-repositories-for-secret.json b/fixtures/actions/selected-repositories-for-secret.json new file mode 100644 index 00000000..71ce3d35 --- /dev/null +++ b/fixtures/actions/selected-repositories-for-secret.json @@ -0,0 +1,72 @@ +{ + "total_count": 1, + "repositories": [ + { + "id": 559365297, + "node_id": "R_kgDOIVc8sQ", + "name": "actions-api", + "full_name": "kote-test-org-actions/actions-api", + "private": true, + "owner": { + "login": "kote-test-org-actions", + "id": 116976977, + "node_id": "O_kgDOBvjtUQ", + "avatar_url": "https://avatars.githubusercontent.com/u/116976977?v=4", + "gravatar_id": "", + "url": "https://api.github.com/users/kote-test-org-actions", + "html_url": "https://github.com/kote-test-org-actions", + "followers_url": "https://api.github.com/users/kote-test-org-actions/followers", + "following_url": "https://api.github.com/users/kote-test-org-actions/following{/other_user}", + "gists_url": "https://api.github.com/users/kote-test-org-actions/gists{/gist_id}", + "starred_url": "https://api.github.com/users/kote-test-org-actions/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/kote-test-org-actions/subscriptions", + "organizations_url": "https://api.github.com/users/kote-test-org-actions/orgs", + "repos_url": "https://api.github.com/users/kote-test-org-actions/repos", + "events_url": "https://api.github.com/users/kote-test-org-actions/events{/privacy}", + "received_events_url": "https://api.github.com/users/kote-test-org-actions/received_events", + "type": "Organization", + "site_admin": false + }, + "html_url": "https://github.com/kote-test-org-actions/actions-api", + "description": null, + "fork": false, + "url": "https://api.github.com/repos/kote-test-org-actions/actions-api", + "forks_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/forks", + "keys_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/keys{/key_id}", + "collaborators_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/collaborators{/collaborator}", + "teams_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/teams", + "hooks_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/hooks", + "issue_events_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/issues/events{/number}", + "events_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/events", + "assignees_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/assignees{/user}", + "branches_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/branches{/branch}", + "tags_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/tags", + "blobs_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/blobs{/sha}", + "git_tags_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/tags{/sha}", + "git_refs_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/refs{/sha}", + "trees_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/trees{/sha}", + "statuses_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/statuses/{sha}", + "languages_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/languages", + "stargazers_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/stargazers", + "contributors_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/contributors", + "subscribers_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/subscribers", + "subscription_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/subscription", + "commits_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/commits{/sha}", + "git_commits_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/commits{/sha}", + "comments_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/comments{/number}", + "issue_comment_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/issues/comments{/number}", + "contents_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/contents/{+path}", + "compare_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/compare/{base}...{head}", + "merges_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/merges", + "archive_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/{archive_format}{/ref}", + "downloads_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/downloads", + "issues_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/issues{/number}", + "pulls_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/pulls{/number}", + "milestones_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/milestones{/number}", + "notifications_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/notifications{?since,all,participating}", + "labels_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/labels{/name}", + "releases_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/releases{/id}", + "deployments_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/deployments" + } + ] +} diff --git a/fixtures/actions/workflow-job.json b/fixtures/actions/workflow-job.json new file mode 100644 index 00000000..e8e35d0f --- /dev/null +++ b/fixtures/actions/workflow-job.json @@ -0,0 +1,113 @@ +{ + "id": 9183275828, + "run_id": 3353449941, + "run_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/actions/runs/3353449941", + "run_attempt": 1, + "node_id": "CR_kwDOIVc8sc8AAAACI12rNA", + "head_sha": "3156f684232a3adec5085c920d2006aca80f2798", + "url": "https://api.github.com/repos/kote-test-org-actions/actions-api/actions/jobs/9183275828", + "html_url": "https://github.com/kote-test-org-actions/actions-api/actions/runs/3353449941/jobs/5556228789", + "status": "completed", + "conclusion": "success", + "started_at": "2022-10-30T00:09:29Z", + "completed_at": "2022-10-30T00:09:49Z", + "name": "check-bats-version", + "steps": [ + { + "name": "Set up job", + "status": "completed", + "conclusion": "success", + "number": 1, + "started_at": "2022-10-29T17:09:29.000-07:00", + "completed_at": "2022-10-29T17:09:32.000-07:00" + }, + { + "name": "Run actions/checkout@v3", + "status": "completed", + "conclusion": "success", + "number": 2, + "started_at": "2022-10-29T17:09:32.000-07:00", + "completed_at": "2022-10-29T17:09:33.000-07:00" + }, + { + "name": "Run actions/setup-node@v3", + "status": "completed", + "conclusion": "success", + "number": 3, + "started_at": "2022-10-29T17:09:34.000-07:00", + "completed_at": "2022-10-29T17:09:39.000-07:00" + }, + { + "name": "Run npm install -g bats", + "status": "completed", + "conclusion": "success", + "number": 4, + "started_at": "2022-10-29T17:09:40.000-07:00", + "completed_at": "2022-10-29T17:09:42.000-07:00" + }, + { + "name": "Run bats -v", + "status": "completed", + "conclusion": "success", + "number": 5, + "started_at": "2022-10-29T17:09:42.000-07:00", + "completed_at": "2022-10-29T17:09:42.000-07:00" + }, + { + "name": "Archive Test", + "status": "completed", + "conclusion": "success", + "number": 6, + "started_at": "2022-10-29T17:09:42.000-07:00", + "completed_at": "2022-10-29T17:09:46.000-07:00" + }, + { + "name": "Cache", + "status": "completed", + "conclusion": "success", + "number": 7, + "started_at": "2022-10-29T17:09:46.000-07:00", + "completed_at": "2022-10-29T17:09:47.000-07:00" + }, + { + "name": "Post Cache", + "status": "completed", + "conclusion": "success", + "number": 12, + "started_at": "2022-10-29T17:09:49.000-07:00", + "completed_at": "2022-10-29T17:09:47.000-07:00" + }, + { + "name": "Post Run actions/setup-node@v3", + "status": "completed", + "conclusion": "success", + "number": 13, + "started_at": "2022-10-29T17:09:49.000-07:00", + "completed_at": "2022-10-29T17:09:49.000-07:00" + }, + { + "name": "Post Run actions/checkout@v3", + "status": "completed", + "conclusion": "success", + "number": 14, + "started_at": "2022-10-29T17:09:49.000-07:00", + "completed_at": "2022-10-29T17:09:49.000-07:00" + }, + { + "name": "Complete job", + "status": "completed", + "conclusion": "success", + "number": 15, + "started_at": "2022-10-29T17:09:47.000-07:00", + "completed_at": "2022-10-29T17:09:47.000-07:00" + } + ], + "check_run_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/check-runs/9183275828", + "labels": [ + "ubuntu-latest" + ], + "runner_id": 1, + "runner_name": "Hosted Agent", + "runner_group_id": 2, + "runner_group_name": "GitHub Actions" +} diff --git a/fixtures/actions/workflow-list.json b/fixtures/actions/workflow-list.json new file mode 100644 index 00000000..771dcd87 --- /dev/null +++ b/fixtures/actions/workflow-list.json @@ -0,0 +1,17 @@ +{ + "total_count": 1, + "workflows": [ + { + "id": 39065091, + "node_id": "W_kwDOIVc8sc4CVBYD", + "name": "learn-github-actions", + "path": ".github/workflows/make_artifact.yaml", + "state": "active", + "created_at": "2022-10-29T15:17:59.000-07:00", + "updated_at": "2022-10-29T15:17:59.000-07:00", + "url": "https://api.github.com/repos/kote-test-org-actions/actions-api/actions/workflows/39065091", + "html_url": "https://github.com/kote-test-org-actions/actions-api/blob/main/.github/workflows/make_artifact.yaml", + "badge_url": "https://github.com/kote-test-org-actions/actions-api/workflows/learn-github-actions/badge.svg" + } + ] +} diff --git a/fixtures/actions/workflow-runs-list.json b/fixtures/actions/workflow-runs-list.json new file mode 100644 index 00000000..edaf5c59 --- /dev/null +++ b/fixtures/actions/workflow-runs-list.json @@ -0,0 +1,665 @@ +{ + "total_count": 3, + "workflow_runs": [ + { + "id": 3353449941, + "name": "K0Te is learning GitHub Actions", + "node_id": "WFR_kwLOIVc8sc7H4ZXV", + "head_branch": "main", + "head_sha": "3156f684232a3adec5085c920d2006aca80f2798", + "path": ".github/workflows/make_artifact.yaml", + "display_title": "K0Te is learning GitHub Actions", + "run_number": 3, + "event": "push", + "status": "completed", + "conclusion": "success", + "workflow_id": 39065091, + "check_suite_id": 9030268154, + "check_suite_node_id": "CS_kwDOIVc8sc8AAAACGj70-g", + "url": "https://api.github.com/repos/kote-test-org-actions/actions-api/actions/runs/3353449941", + "html_url": "https://github.com/kote-test-org-actions/actions-api/actions/runs/3353449941", + "pull_requests": [], + "created_at": "2022-10-30T00:09:22Z", + "updated_at": "2022-10-30T00:09:50Z", + "actor": { + "login": "K0Te", + "id": 6162155, + "node_id": "MDQ6VXNlcjYxNjIxNTU=", + "avatar_url": "https://avatars.githubusercontent.com/u/6162155?v=4", + "gravatar_id": "", + "url": "https://api.github.com/users/K0Te", + "html_url": "https://github.com/K0Te", + "followers_url": "https://api.github.com/users/K0Te/followers", + "following_url": "https://api.github.com/users/K0Te/following{/other_user}", + "gists_url": "https://api.github.com/users/K0Te/gists{/gist_id}", + "starred_url": "https://api.github.com/users/K0Te/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/K0Te/subscriptions", + "organizations_url": "https://api.github.com/users/K0Te/orgs", + "repos_url": "https://api.github.com/users/K0Te/repos", + "events_url": "https://api.github.com/users/K0Te/events{/privacy}", + "received_events_url": "https://api.github.com/users/K0Te/received_events", + "type": "User", + "site_admin": false + }, + "run_attempt": 1, + "referenced_workflows": [], + "run_started_at": "2022-10-30T00:09:22Z", + "triggering_actor": { + "login": "K0Te", + "id": 6162155, + "node_id": "MDQ6VXNlcjYxNjIxNTU=", + "avatar_url": "https://avatars.githubusercontent.com/u/6162155?v=4", + "gravatar_id": "", + "url": "https://api.github.com/users/K0Te", + "html_url": "https://github.com/K0Te", + "followers_url": "https://api.github.com/users/K0Te/followers", + "following_url": "https://api.github.com/users/K0Te/following{/other_user}", + "gists_url": "https://api.github.com/users/K0Te/gists{/gist_id}", + "starred_url": "https://api.github.com/users/K0Te/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/K0Te/subscriptions", + "organizations_url": "https://api.github.com/users/K0Te/orgs", + "repos_url": "https://api.github.com/users/K0Te/repos", + "events_url": "https://api.github.com/users/K0Te/events{/privacy}", + "received_events_url": "https://api.github.com/users/K0Te/received_events", + "type": "User", + "site_admin": false + }, + "jobs_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/actions/runs/3353449941/jobs", + "logs_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/actions/runs/3353449941/logs", + "check_suite_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/check-suites/9030268154", + "artifacts_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/actions/runs/3353449941/artifacts", + "cancel_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/actions/runs/3353449941/cancel", + "rerun_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/actions/runs/3353449941/rerun", + "previous_attempt_url": null, + "workflow_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/actions/workflows/39065091", + "head_commit": { + "id": "3156f684232a3adec5085c920d2006aca80f2798", + "tree_id": "f51ba8632086ca7af92f5e58c1dc98df1c62d7ce", + "message": "up", + "timestamp": "2022-10-30T00:09:16Z", + "author": { + "name": "Oleg Nykolyn", + "email": "juravel2@gmail.com" + }, + "committer": { + "name": "Oleg Nykolyn", + "email": "juravel2@gmail.com" + } + }, + "repository": { + "id": 559365297, + "node_id": "R_kgDOIVc8sQ", + "name": "actions-api", + "full_name": "kote-test-org-actions/actions-api", + "private": true, + "owner": { + "login": "kote-test-org-actions", + "id": 116976977, + "node_id": "O_kgDOBvjtUQ", + "avatar_url": "https://avatars.githubusercontent.com/u/116976977?v=4", + "gravatar_id": "", + "url": "https://api.github.com/users/kote-test-org-actions", + "html_url": "https://github.com/kote-test-org-actions", + "followers_url": "https://api.github.com/users/kote-test-org-actions/followers", + "following_url": "https://api.github.com/users/kote-test-org-actions/following{/other_user}", + "gists_url": "https://api.github.com/users/kote-test-org-actions/gists{/gist_id}", + "starred_url": "https://api.github.com/users/kote-test-org-actions/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/kote-test-org-actions/subscriptions", + "organizations_url": "https://api.github.com/users/kote-test-org-actions/orgs", + "repos_url": "https://api.github.com/users/kote-test-org-actions/repos", + "events_url": "https://api.github.com/users/kote-test-org-actions/events{/privacy}", + "received_events_url": "https://api.github.com/users/kote-test-org-actions/received_events", + "type": "Organization", + "site_admin": false + }, + "html_url": "https://github.com/kote-test-org-actions/actions-api", + "description": null, + "fork": false, + "url": "https://api.github.com/repos/kote-test-org-actions/actions-api", + "forks_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/forks", + "keys_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/keys{/key_id}", + "collaborators_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/collaborators{/collaborator}", + "teams_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/teams", + "hooks_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/hooks", + "issue_events_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/issues/events{/number}", + "events_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/events", + "assignees_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/assignees{/user}", + "branches_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/branches{/branch}", + "tags_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/tags", + "blobs_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/blobs{/sha}", + "git_tags_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/tags{/sha}", + "git_refs_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/refs{/sha}", + "trees_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/trees{/sha}", + "statuses_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/statuses/{sha}", + "languages_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/languages", + "stargazers_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/stargazers", + "contributors_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/contributors", + "subscribers_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/subscribers", + "subscription_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/subscription", + "commits_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/commits{/sha}", + "git_commits_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/commits{/sha}", + "comments_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/comments{/number}", + "issue_comment_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/issues/comments{/number}", + "contents_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/contents/{+path}", + "compare_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/compare/{base}...{head}", + "merges_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/merges", + "archive_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/{archive_format}{/ref}", + "downloads_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/downloads", + "issues_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/issues{/number}", + "pulls_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/pulls{/number}", + "milestones_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/milestones{/number}", + "notifications_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/notifications{?since,all,participating}", + "labels_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/labels{/name}", + "releases_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/releases{/id}", + "deployments_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/deployments" + }, + "head_repository": { + "id": 559365297, + "node_id": "R_kgDOIVc8sQ", + "name": "actions-api", + "full_name": "kote-test-org-actions/actions-api", + "private": true, + "owner": { + "login": "kote-test-org-actions", + "id": 116976977, + "node_id": "O_kgDOBvjtUQ", + "avatar_url": "https://avatars.githubusercontent.com/u/116976977?v=4", + "gravatar_id": "", + "url": "https://api.github.com/users/kote-test-org-actions", + "html_url": "https://github.com/kote-test-org-actions", + "followers_url": "https://api.github.com/users/kote-test-org-actions/followers", + "following_url": "https://api.github.com/users/kote-test-org-actions/following{/other_user}", + "gists_url": "https://api.github.com/users/kote-test-org-actions/gists{/gist_id}", + "starred_url": "https://api.github.com/users/kote-test-org-actions/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/kote-test-org-actions/subscriptions", + "organizations_url": "https://api.github.com/users/kote-test-org-actions/orgs", + "repos_url": "https://api.github.com/users/kote-test-org-actions/repos", + "events_url": "https://api.github.com/users/kote-test-org-actions/events{/privacy}", + "received_events_url": "https://api.github.com/users/kote-test-org-actions/received_events", + "type": "Organization", + "site_admin": false + }, + "html_url": "https://github.com/kote-test-org-actions/actions-api", + "description": null, + "fork": false, + "url": "https://api.github.com/repos/kote-test-org-actions/actions-api", + "forks_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/forks", + "keys_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/keys{/key_id}", + "collaborators_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/collaborators{/collaborator}", + "teams_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/teams", + "hooks_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/hooks", + "issue_events_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/issues/events{/number}", + "events_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/events", + "assignees_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/assignees{/user}", + "branches_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/branches{/branch}", + "tags_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/tags", + "blobs_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/blobs{/sha}", + "git_tags_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/tags{/sha}", + "git_refs_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/refs{/sha}", + "trees_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/trees{/sha}", + "statuses_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/statuses/{sha}", + "languages_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/languages", + "stargazers_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/stargazers", + "contributors_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/contributors", + "subscribers_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/subscribers", + "subscription_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/subscription", + "commits_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/commits{/sha}", + "git_commits_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/commits{/sha}", + "comments_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/comments{/number}", + "issue_comment_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/issues/comments{/number}", + "contents_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/contents/{+path}", + "compare_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/compare/{base}...{head}", + "merges_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/merges", + "archive_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/{archive_format}{/ref}", + "downloads_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/downloads", + "issues_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/issues{/number}", + "pulls_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/pulls{/number}", + "milestones_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/milestones{/number}", + "notifications_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/notifications{?since,all,participating}", + "labels_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/labels{/name}", + "releases_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/releases{/id}", + "deployments_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/deployments" + } + }, + { + "id": 3353445625, + "name": "K0Te is learning GitHub Actions", + "node_id": "WFR_kwLOIVc8sc7H4YT5", + "head_branch": "main", + "head_sha": "2d2486b9aecb80bf916717f47f7c312431d3ceb6", + "path": ".github/workflows/make_artifact.yaml", + "display_title": "K0Te is learning GitHub Actions", + "run_number": 2, + "event": "push", + "status": "completed", + "conclusion": "success", + "workflow_id": 39065091, + "check_suite_id": 9030259685, + "check_suite_node_id": "CS_kwDOIVc8sc8AAAACGj7T5Q", + "url": "https://api.github.com/repos/kote-test-org-actions/actions-api/actions/runs/3353445625", + "html_url": "https://github.com/kote-test-org-actions/actions-api/actions/runs/3353445625", + "pull_requests": [], + "created_at": "2022-10-30T00:07:49Z", + "updated_at": "2022-10-30T00:08:19Z", + "actor": { + "login": "K0Te", + "id": 6162155, + "node_id": "MDQ6VXNlcjYxNjIxNTU=", + "avatar_url": "https://avatars.githubusercontent.com/u/6162155?v=4", + "gravatar_id": "", + "url": "https://api.github.com/users/K0Te", + "html_url": "https://github.com/K0Te", + "followers_url": "https://api.github.com/users/K0Te/followers", + "following_url": "https://api.github.com/users/K0Te/following{/other_user}", + "gists_url": "https://api.github.com/users/K0Te/gists{/gist_id}", + "starred_url": "https://api.github.com/users/K0Te/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/K0Te/subscriptions", + "organizations_url": "https://api.github.com/users/K0Te/orgs", + "repos_url": "https://api.github.com/users/K0Te/repos", + "events_url": "https://api.github.com/users/K0Te/events{/privacy}", + "received_events_url": "https://api.github.com/users/K0Te/received_events", + "type": "User", + "site_admin": false + }, + "run_attempt": 1, + "referenced_workflows": [], + "run_started_at": "2022-10-30T00:07:49Z", + "triggering_actor": { + "login": "K0Te", + "id": 6162155, + "node_id": "MDQ6VXNlcjYxNjIxNTU=", + "avatar_url": "https://avatars.githubusercontent.com/u/6162155?v=4", + "gravatar_id": "", + "url": "https://api.github.com/users/K0Te", + "html_url": "https://github.com/K0Te", + "followers_url": "https://api.github.com/users/K0Te/followers", + "following_url": "https://api.github.com/users/K0Te/following{/other_user}", + "gists_url": "https://api.github.com/users/K0Te/gists{/gist_id}", + "starred_url": "https://api.github.com/users/K0Te/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/K0Te/subscriptions", + "organizations_url": "https://api.github.com/users/K0Te/orgs", + "repos_url": "https://api.github.com/users/K0Te/repos", + "events_url": "https://api.github.com/users/K0Te/events{/privacy}", + "received_events_url": "https://api.github.com/users/K0Te/received_events", + "type": "User", + "site_admin": false + }, + "jobs_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/actions/runs/3353445625/jobs", + "logs_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/actions/runs/3353445625/logs", + "check_suite_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/check-suites/9030259685", + "artifacts_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/actions/runs/3353445625/artifacts", + "cancel_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/actions/runs/3353445625/cancel", + "rerun_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/actions/runs/3353445625/rerun", + "previous_attempt_url": null, + "workflow_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/actions/workflows/39065091", + "head_commit": { + "id": "2d2486b9aecb80bf916717f47f7c312431d3ceb6", + "tree_id": "21d858674ab650ea734b7efbf05442a21685d121", + "message": "up", + "timestamp": "2022-10-30T00:07:44Z", + "author": { + "name": "Oleg Nykolyn", + "email": "juravel2@gmail.com" + }, + "committer": { + "name": "Oleg Nykolyn", + "email": "juravel2@gmail.com" + } + }, + "repository": { + "id": 559365297, + "node_id": "R_kgDOIVc8sQ", + "name": "actions-api", + "full_name": "kote-test-org-actions/actions-api", + "private": true, + "owner": { + "login": "kote-test-org-actions", + "id": 116976977, + "node_id": "O_kgDOBvjtUQ", + "avatar_url": "https://avatars.githubusercontent.com/u/116976977?v=4", + "gravatar_id": "", + "url": "https://api.github.com/users/kote-test-org-actions", + "html_url": "https://github.com/kote-test-org-actions", + "followers_url": "https://api.github.com/users/kote-test-org-actions/followers", + "following_url": "https://api.github.com/users/kote-test-org-actions/following{/other_user}", + "gists_url": "https://api.github.com/users/kote-test-org-actions/gists{/gist_id}", + "starred_url": "https://api.github.com/users/kote-test-org-actions/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/kote-test-org-actions/subscriptions", + "organizations_url": "https://api.github.com/users/kote-test-org-actions/orgs", + "repos_url": "https://api.github.com/users/kote-test-org-actions/repos", + "events_url": "https://api.github.com/users/kote-test-org-actions/events{/privacy}", + "received_events_url": "https://api.github.com/users/kote-test-org-actions/received_events", + "type": "Organization", + "site_admin": false + }, + "html_url": "https://github.com/kote-test-org-actions/actions-api", + "description": null, + "fork": false, + "url": "https://api.github.com/repos/kote-test-org-actions/actions-api", + "forks_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/forks", + "keys_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/keys{/key_id}", + "collaborators_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/collaborators{/collaborator}", + "teams_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/teams", + "hooks_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/hooks", + "issue_events_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/issues/events{/number}", + "events_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/events", + "assignees_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/assignees{/user}", + "branches_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/branches{/branch}", + "tags_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/tags", + "blobs_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/blobs{/sha}", + "git_tags_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/tags{/sha}", + "git_refs_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/refs{/sha}", + "trees_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/trees{/sha}", + "statuses_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/statuses/{sha}", + "languages_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/languages", + "stargazers_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/stargazers", + "contributors_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/contributors", + "subscribers_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/subscribers", + "subscription_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/subscription", + "commits_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/commits{/sha}", + "git_commits_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/commits{/sha}", + "comments_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/comments{/number}", + "issue_comment_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/issues/comments{/number}", + "contents_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/contents/{+path}", + "compare_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/compare/{base}...{head}", + "merges_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/merges", + "archive_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/{archive_format}{/ref}", + "downloads_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/downloads", + "issues_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/issues{/number}", + "pulls_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/pulls{/number}", + "milestones_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/milestones{/number}", + "notifications_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/notifications{?since,all,participating}", + "labels_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/labels{/name}", + "releases_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/releases{/id}", + "deployments_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/deployments" + }, + "head_repository": { + "id": 559365297, + "node_id": "R_kgDOIVc8sQ", + "name": "actions-api", + "full_name": "kote-test-org-actions/actions-api", + "private": true, + "owner": { + "login": "kote-test-org-actions", + "id": 116976977, + "node_id": "O_kgDOBvjtUQ", + "avatar_url": "https://avatars.githubusercontent.com/u/116976977?v=4", + "gravatar_id": "", + "url": "https://api.github.com/users/kote-test-org-actions", + "html_url": "https://github.com/kote-test-org-actions", + "followers_url": "https://api.github.com/users/kote-test-org-actions/followers", + "following_url": "https://api.github.com/users/kote-test-org-actions/following{/other_user}", + "gists_url": "https://api.github.com/users/kote-test-org-actions/gists{/gist_id}", + "starred_url": "https://api.github.com/users/kote-test-org-actions/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/kote-test-org-actions/subscriptions", + "organizations_url": "https://api.github.com/users/kote-test-org-actions/orgs", + "repos_url": "https://api.github.com/users/kote-test-org-actions/repos", + "events_url": "https://api.github.com/users/kote-test-org-actions/events{/privacy}", + "received_events_url": "https://api.github.com/users/kote-test-org-actions/received_events", + "type": "Organization", + "site_admin": false + }, + "html_url": "https://github.com/kote-test-org-actions/actions-api", + "description": null, + "fork": false, + "url": "https://api.github.com/repos/kote-test-org-actions/actions-api", + "forks_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/forks", + "keys_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/keys{/key_id}", + "collaborators_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/collaborators{/collaborator}", + "teams_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/teams", + "hooks_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/hooks", + "issue_events_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/issues/events{/number}", + "events_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/events", + "assignees_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/assignees{/user}", + "branches_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/branches{/branch}", + "tags_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/tags", + "blobs_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/blobs{/sha}", + "git_tags_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/tags{/sha}", + "git_refs_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/refs{/sha}", + "trees_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/trees{/sha}", + "statuses_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/statuses/{sha}", + "languages_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/languages", + "stargazers_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/stargazers", + "contributors_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/contributors", + "subscribers_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/subscribers", + "subscription_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/subscription", + "commits_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/commits{/sha}", + "git_commits_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/commits{/sha}", + "comments_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/comments{/number}", + "issue_comment_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/issues/comments{/number}", + "contents_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/contents/{+path}", + "compare_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/compare/{base}...{head}", + "merges_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/merges", + "archive_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/{archive_format}{/ref}", + "downloads_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/downloads", + "issues_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/issues{/number}", + "pulls_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/pulls{/number}", + "milestones_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/milestones{/number}", + "notifications_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/notifications{?since,all,participating}", + "labels_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/labels{/name}", + "releases_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/releases{/id}", + "deployments_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/deployments" + } + }, + { + "id": 3353148947, + "name": "K0Te is learning GitHub Actions", + "node_id": "WFR_kwLOIVc8sc7H3P4T", + "head_branch": "main", + "head_sha": "601593ecb1d8a57a04700fdb445a28d4186b8954", + "path": ".github/workflows/make_artifact.yaml", + "display_title": "K0Te is learning GitHub Actions", + "run_number": 1, + "event": "push", + "status": "completed", + "conclusion": "success", + "workflow_id": 39065091, + "check_suite_id": 9029740591, + "check_suite_node_id": "CS_kwDOIVc8sc8AAAACGjboLw", + "url": "https://api.github.com/repos/kote-test-org-actions/actions-api/actions/runs/3353148947", + "html_url": "https://github.com/kote-test-org-actions/actions-api/actions/runs/3353148947", + "pull_requests": [], + "created_at": "2022-10-29T22:18:02Z", + "updated_at": "2022-10-29T22:18:22Z", + "actor": { + "login": "K0Te", + "id": 6162155, + "node_id": "MDQ6VXNlcjYxNjIxNTU=", + "avatar_url": "https://avatars.githubusercontent.com/u/6162155?v=4", + "gravatar_id": "", + "url": "https://api.github.com/users/K0Te", + "html_url": "https://github.com/K0Te", + "followers_url": "https://api.github.com/users/K0Te/followers", + "following_url": "https://api.github.com/users/K0Te/following{/other_user}", + "gists_url": "https://api.github.com/users/K0Te/gists{/gist_id}", + "starred_url": "https://api.github.com/users/K0Te/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/K0Te/subscriptions", + "organizations_url": "https://api.github.com/users/K0Te/orgs", + "repos_url": "https://api.github.com/users/K0Te/repos", + "events_url": "https://api.github.com/users/K0Te/events{/privacy}", + "received_events_url": "https://api.github.com/users/K0Te/received_events", + "type": "User", + "site_admin": false + }, + "run_attempt": 1, + "referenced_workflows": [], + "run_started_at": "2022-10-29T22:18:02Z", + "triggering_actor": { + "login": "K0Te", + "id": 6162155, + "node_id": "MDQ6VXNlcjYxNjIxNTU=", + "avatar_url": "https://avatars.githubusercontent.com/u/6162155?v=4", + "gravatar_id": "", + "url": "https://api.github.com/users/K0Te", + "html_url": "https://github.com/K0Te", + "followers_url": "https://api.github.com/users/K0Te/followers", + "following_url": "https://api.github.com/users/K0Te/following{/other_user}", + "gists_url": "https://api.github.com/users/K0Te/gists{/gist_id}", + "starred_url": "https://api.github.com/users/K0Te/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/K0Te/subscriptions", + "organizations_url": "https://api.github.com/users/K0Te/orgs", + "repos_url": "https://api.github.com/users/K0Te/repos", + "events_url": "https://api.github.com/users/K0Te/events{/privacy}", + "received_events_url": "https://api.github.com/users/K0Te/received_events", + "type": "User", + "site_admin": false + }, + "jobs_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/actions/runs/3353148947/jobs", + "logs_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/actions/runs/3353148947/logs", + "check_suite_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/check-suites/9029740591", + "artifacts_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/actions/runs/3353148947/artifacts", + "cancel_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/actions/runs/3353148947/cancel", + "rerun_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/actions/runs/3353148947/rerun", + "previous_attempt_url": null, + "workflow_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/actions/workflows/39065091", + "head_commit": { + "id": "601593ecb1d8a57a04700fdb445a28d4186b8954", + "tree_id": "7aa2d4e6f4e0ddb277fe2f35f7615651ee01c5a2", + "message": "test", + "timestamp": "2022-10-29T22:17:55Z", + "author": { + "name": "Oleg Nykolyn", + "email": "juravel2@gmail.com" + }, + "committer": { + "name": "Oleg Nykolyn", + "email": "juravel2@gmail.com" + } + }, + "repository": { + "id": 559365297, + "node_id": "R_kgDOIVc8sQ", + "name": "actions-api", + "full_name": "kote-test-org-actions/actions-api", + "private": true, + "owner": { + "login": "kote-test-org-actions", + "id": 116976977, + "node_id": "O_kgDOBvjtUQ", + "avatar_url": "https://avatars.githubusercontent.com/u/116976977?v=4", + "gravatar_id": "", + "url": "https://api.github.com/users/kote-test-org-actions", + "html_url": "https://github.com/kote-test-org-actions", + "followers_url": "https://api.github.com/users/kote-test-org-actions/followers", + "following_url": "https://api.github.com/users/kote-test-org-actions/following{/other_user}", + "gists_url": "https://api.github.com/users/kote-test-org-actions/gists{/gist_id}", + "starred_url": "https://api.github.com/users/kote-test-org-actions/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/kote-test-org-actions/subscriptions", + "organizations_url": "https://api.github.com/users/kote-test-org-actions/orgs", + "repos_url": "https://api.github.com/users/kote-test-org-actions/repos", + "events_url": "https://api.github.com/users/kote-test-org-actions/events{/privacy}", + "received_events_url": "https://api.github.com/users/kote-test-org-actions/received_events", + "type": "Organization", + "site_admin": false + }, + "html_url": "https://github.com/kote-test-org-actions/actions-api", + "description": null, + "fork": false, + "url": "https://api.github.com/repos/kote-test-org-actions/actions-api", + "forks_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/forks", + "keys_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/keys{/key_id}", + "collaborators_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/collaborators{/collaborator}", + "teams_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/teams", + "hooks_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/hooks", + "issue_events_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/issues/events{/number}", + "events_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/events", + "assignees_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/assignees{/user}", + "branches_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/branches{/branch}", + "tags_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/tags", + "blobs_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/blobs{/sha}", + "git_tags_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/tags{/sha}", + "git_refs_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/refs{/sha}", + "trees_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/trees{/sha}", + "statuses_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/statuses/{sha}", + "languages_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/languages", + "stargazers_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/stargazers", + "contributors_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/contributors", + "subscribers_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/subscribers", + "subscription_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/subscription", + "commits_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/commits{/sha}", + "git_commits_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/commits{/sha}", + "comments_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/comments{/number}", + "issue_comment_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/issues/comments{/number}", + "contents_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/contents/{+path}", + "compare_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/compare/{base}...{head}", + "merges_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/merges", + "archive_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/{archive_format}{/ref}", + "downloads_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/downloads", + "issues_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/issues{/number}", + "pulls_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/pulls{/number}", + "milestones_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/milestones{/number}", + "notifications_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/notifications{?since,all,participating}", + "labels_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/labels{/name}", + "releases_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/releases{/id}", + "deployments_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/deployments" + }, + "head_repository": { + "id": 559365297, + "node_id": "R_kgDOIVc8sQ", + "name": "actions-api", + "full_name": "kote-test-org-actions/actions-api", + "private": true, + "owner": { + "login": "kote-test-org-actions", + "id": 116976977, + "node_id": "O_kgDOBvjtUQ", + "avatar_url": "https://avatars.githubusercontent.com/u/116976977?v=4", + "gravatar_id": "", + "url": "https://api.github.com/users/kote-test-org-actions", + "html_url": "https://github.com/kote-test-org-actions", + "followers_url": "https://api.github.com/users/kote-test-org-actions/followers", + "following_url": "https://api.github.com/users/kote-test-org-actions/following{/other_user}", + "gists_url": "https://api.github.com/users/kote-test-org-actions/gists{/gist_id}", + "starred_url": "https://api.github.com/users/kote-test-org-actions/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/kote-test-org-actions/subscriptions", + "organizations_url": "https://api.github.com/users/kote-test-org-actions/orgs", + "repos_url": "https://api.github.com/users/kote-test-org-actions/repos", + "events_url": "https://api.github.com/users/kote-test-org-actions/events{/privacy}", + "received_events_url": "https://api.github.com/users/kote-test-org-actions/received_events", + "type": "Organization", + "site_admin": false + }, + "html_url": "https://github.com/kote-test-org-actions/actions-api", + "description": null, + "fork": false, + "url": "https://api.github.com/repos/kote-test-org-actions/actions-api", + "forks_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/forks", + "keys_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/keys{/key_id}", + "collaborators_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/collaborators{/collaborator}", + "teams_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/teams", + "hooks_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/hooks", + "issue_events_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/issues/events{/number}", + "events_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/events", + "assignees_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/assignees{/user}", + "branches_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/branches{/branch}", + "tags_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/tags", + "blobs_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/blobs{/sha}", + "git_tags_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/tags{/sha}", + "git_refs_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/refs{/sha}", + "trees_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/trees{/sha}", + "statuses_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/statuses/{sha}", + "languages_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/languages", + "stargazers_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/stargazers", + "contributors_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/contributors", + "subscribers_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/subscribers", + "subscription_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/subscription", + "commits_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/commits{/sha}", + "git_commits_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/commits{/sha}", + "comments_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/comments{/number}", + "issue_comment_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/issues/comments{/number}", + "contents_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/contents/{+path}", + "compare_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/compare/{base}...{head}", + "merges_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/merges", + "archive_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/{archive_format}{/ref}", + "downloads_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/downloads", + "issues_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/issues{/number}", + "pulls_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/pulls{/number}", + "milestones_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/milestones{/number}", + "notifications_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/notifications{?since,all,participating}", + "labels_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/labels{/name}", + "releases_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/releases{/id}", + "deployments_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/deployments" + } + } + ] +} diff --git a/github.cabal b/github.cabal index a0669042..5f94c430 100644 --- a/github.cabal +++ b/github.cabal @@ -1,4 +1,4 @@ -cabal-version: >=1.10 +cabal-version: 2.4 name: github version: 0.29 synopsis: Access to the GitHub API, v3. @@ -20,7 +20,7 @@ description: . For more of an overview please see the README: -license: BSD3 +license: BSD-3-Clause license-file: LICENSE author: Mike Burns, John Wiegley, Oleg Grenrus maintainer: Andreas Abel @@ -43,10 +43,12 @@ tested-with: GHC == 7.10.3 GHC == 7.8.4 -extra-source-files: +extra-doc-files: README.md CHANGELOG.md - fixtures/*.json + +extra-source-files: + fixtures/**/*.json source-repository head type: git @@ -89,6 +91,13 @@ library GitHub GitHub.Auth GitHub.Data + GitHub.Data.Actions.Common + GitHub.Data.Actions.Artifacts + GitHub.Data.Actions.Cache + GitHub.Data.Actions.Secrets + GitHub.Data.Actions.Workflows + GitHub.Data.Actions.WorkflowJobs + GitHub.Data.Actions.WorkflowRuns GitHub.Data.Activities GitHub.Data.Comments GitHub.Data.Content @@ -120,6 +129,12 @@ library GitHub.Data.URL GitHub.Data.Webhooks GitHub.Data.Webhooks.Validate + GitHub.Endpoints.Actions.Artifacts + GitHub.Endpoints.Actions.Cache + GitHub.Endpoints.Actions.Secrets + GitHub.Endpoints.Actions.Workflows + GitHub.Endpoints.Actions.WorkflowJobs + GitHub.Endpoints.Actions.WorkflowRuns GitHub.Endpoints.Activity.Events GitHub.Endpoints.Activity.Notifications GitHub.Endpoints.Activity.Starring @@ -165,7 +180,8 @@ library GitHub.Internal.Prelude GitHub.Request - other-modules: Paths_github + other-modules: Paths_github + autogen-modules: Paths_github -- Packages bundles with GHC, mtl and text are also here build-depends: @@ -222,6 +238,12 @@ test-suite github-test build-tool-depends: hspec-discover:hspec-discover >=2.7.1 && <2.12 other-extensions: TemplateHaskell other-modules: + GitHub.Actions.ArtifactsSpec + GitHub.Actions.CacheSpec + GitHub.Actions.SecretsSpec + GitHub.Actions.WorkflowJobSpec + GitHub.Actions.WorkflowRunsSpec + GitHub.Actions.WorkflowSpec GitHub.ActivitySpec GitHub.CommitsSpec GitHub.EventsSpec diff --git a/spec/GitHub/Actions/ArtifactsSpec.hs b/spec/GitHub/Actions/ArtifactsSpec.hs new file mode 100644 index 00000000..c3df8031 --- /dev/null +++ b/spec/GitHub/Actions/ArtifactsSpec.hs @@ -0,0 +1,66 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +module GitHub.Actions.ArtifactsSpec where + +import qualified GitHub as GH + +import Prelude () +import Prelude.Compat + +import Data.Aeson (eitherDecodeStrict) +import Data.ByteString (ByteString) +import Data.Either.Compat (isRight) +import Data.FileEmbed (embedFile) +import Data.Foldable (for_) +import Data.String (fromString) +import qualified Data.Vector as V +import System.Environment (lookupEnv) +import Test.Hspec + (Spec, describe, it, pendingWith, shouldBe, shouldSatisfy) + +fromRightS :: Show a => Either a b -> b +fromRightS (Right b) = b +fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a + +withAuth :: (GH.Auth -> IO ()) -> IO () +withAuth action = do + mtoken <- lookupEnv "GITHUB_TOKEN" + case mtoken of + Nothing -> pendingWith "no GITHUB_TOKEN" + Just token -> action (GH.OAuth $ fromString token) + +spec :: Spec +spec = do + describe "artifactsForR" $ do + it "works" $ withAuth $ \auth -> for_ repos $ \(owner, repo) -> do + cs <- GH.executeRequest auth $ + GH.artifactsForR owner repo mempty GH.FetchAll + cs `shouldSatisfy` isRight + + describe "decoding artifacts payloads" $ do + it "decodes artifacts list payload" $ do + GH.withTotalCountTotalCount artifactList `shouldBe` 23809 + V.length (GH.withTotalCountItems artifactList) `shouldBe` 2 + it "decodes signle artifact payload" $ do + GH.artifactName artifact `shouldBe` "dist-without-markdown" + GH.artifactWorkflowRunHeadSha (GH.artifactWorkflowRun artifact) `shouldBe` "601593ecb1d8a57a04700fdb445a28d4186b8954" + + where + repos = + [ ("thoughtbot", "paperclip") + , ("phadej", "github") + ] + + artifactList :: GH.WithTotalCount GH.Artifact + artifactList = + fromRightS (eitherDecodeStrict artifactsListPayload) + + artifact :: GH.Artifact + artifact = + fromRightS (eitherDecodeStrict artifactPayload) + + artifactsListPayload :: ByteString + artifactsListPayload = $(embedFile "fixtures/actions/artifacts-list.json") + + artifactPayload :: ByteString + artifactPayload = $(embedFile "fixtures/actions/artifact.json") diff --git a/spec/GitHub/Actions/CacheSpec.hs b/spec/GitHub/Actions/CacheSpec.hs new file mode 100644 index 00000000..c70596c3 --- /dev/null +++ b/spec/GitHub/Actions/CacheSpec.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +module GitHub.Actions.CacheSpec where + +import qualified GitHub as GH + +import Prelude () +import Prelude.Compat + +import Data.Aeson (eitherDecodeStrict) +import Data.ByteString (ByteString) +import Data.FileEmbed (embedFile) +import qualified Data.Vector as V +import Test.Hspec (Spec, describe, it, shouldBe) + +fromRightS :: Show a => Either a b -> b +fromRightS (Right b) = b +fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a + +spec :: Spec +spec = do + describe "decoding cache payloads" $ do + it "decodes cache list payload" $ do + V.length (GH.withTotalCountItems cacheList) `shouldBe` 1 + it "decodes cache usage for repo" $ do + GH.repositoryCacheUsageFullName repoCacheUsage `shouldBe` "python/cpython" + GH.repositoryCacheUsageActiveCachesSizeInBytes repoCacheUsage `shouldBe` 55000268087 + GH.repositoryCacheUsageActiveCachesCount repoCacheUsage `shouldBe` 171 + it "decodes cache usage for org" $ do + GH.organizationCacheUsageTotalActiveCachesSizeInBytes orgCacheUsage `shouldBe` 26586 + GH.organizationCacheUsageTotalActiveCachesCount orgCacheUsage `shouldBe` 1 + + where + cacheList :: GH.WithTotalCount GH.Cache + cacheList = + fromRightS (eitherDecodeStrict cacheListPayload) + + repoCacheUsage :: GH.RepositoryCacheUsage + repoCacheUsage = + fromRightS (eitherDecodeStrict repoCacheUsagePayload) + + orgCacheUsage :: GH.OrganizationCacheUsage + orgCacheUsage = + fromRightS (eitherDecodeStrict orgCacheUsagePayload) + + cacheListPayload :: ByteString + cacheListPayload = $(embedFile "fixtures/actions/cache-list.json") + + repoCacheUsagePayload :: ByteString + repoCacheUsagePayload = $(embedFile "fixtures/actions/repo-cache-usage.json") + + orgCacheUsagePayload :: ByteString + orgCacheUsagePayload = $(embedFile "fixtures/actions/org-cache-usage.json") diff --git a/spec/GitHub/Actions/SecretsSpec.hs b/spec/GitHub/Actions/SecretsSpec.hs new file mode 100644 index 00000000..e9e32fa0 --- /dev/null +++ b/spec/GitHub/Actions/SecretsSpec.hs @@ -0,0 +1,50 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +module GitHub.Actions.SecretsSpec where + +import qualified GitHub as GH + +import Prelude () +import Prelude.Compat + +import Data.Aeson (eitherDecodeStrict) +import Data.ByteString (ByteString) +import Data.FileEmbed (embedFile) +import qualified Data.Vector as V +import Test.Hspec (Spec, describe, it, shouldBe) + +fromRightS :: Show a => Either a b -> b +fromRightS (Right b) = b +fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a + +spec :: Spec +spec = do + describe "decoding secrets payloads" $ do + it "decodes selected repo list payload" $ do + V.length (GH.withTotalCountItems repoList) `shouldBe` 1 + it "decodes secret list payload" $ do + V.length (GH.withTotalCountItems orgSecretList) `shouldBe` 2 + it "decodes public key payload" $ do + GH.publicKeyId orgPublicKey `shouldBe` "568250167242549743" + + where + repoList :: GH.WithTotalCount GH.SelectedRepo + repoList = + fromRightS (eitherDecodeStrict repoListPayload) + + orgSecretList:: GH.WithTotalCount GH.OrganizationSecret + orgSecretList= + fromRightS (eitherDecodeStrict orgSecretListPayload) + + orgPublicKey:: GH.PublicKey + orgPublicKey= + fromRightS (eitherDecodeStrict orgPublicKeyPayload) + + repoListPayload :: ByteString + repoListPayload = $(embedFile "fixtures/actions/selected-repositories-for-secret.json") + + orgSecretListPayload :: ByteString + orgSecretListPayload = $(embedFile "fixtures/actions/org-secrets-list.json") + + orgPublicKeyPayload :: ByteString + orgPublicKeyPayload = $(embedFile "fixtures/actions/org-public-key.json") diff --git a/spec/GitHub/Actions/WorkflowJobSpec.hs b/spec/GitHub/Actions/WorkflowJobSpec.hs new file mode 100644 index 00000000..43334741 --- /dev/null +++ b/spec/GitHub/Actions/WorkflowJobSpec.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +module GitHub.Actions.WorkflowJobSpec where + +import qualified GitHub as GH +import GitHub.Data.Id + +import Prelude () +import Prelude.Compat + +import Data.Aeson (eitherDecodeStrict) +import Data.ByteString (ByteString) +import Data.FileEmbed (embedFile) +import Test.Hspec (Spec, describe, it, shouldBe) + +fromRightS :: Show a => Either a b -> b +fromRightS (Right b) = b +fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a + +spec :: Spec +spec = do + describe "decoding workflow jobs payloads" $ do + it "decodes workflow job" $ do + GH.jobId workflowJob `shouldBe` Id 9183275828 + + where + workflowJob:: GH.Job + workflowJob= + fromRightS (eitherDecodeStrict workflowJobPayload) + + workflowJobPayload :: ByteString + workflowJobPayload = $(embedFile "fixtures/actions/workflow-job.json") diff --git a/spec/GitHub/Actions/WorkflowRunsSpec.hs b/spec/GitHub/Actions/WorkflowRunsSpec.hs new file mode 100644 index 00000000..0a5643c9 --- /dev/null +++ b/spec/GitHub/Actions/WorkflowRunsSpec.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +module GitHub.Actions.WorkflowRunsSpec where + +import qualified GitHub as GH + +import Prelude () +import Prelude.Compat + +import Data.Aeson (eitherDecodeStrict) +import Data.ByteString (ByteString) +import Data.FileEmbed (embedFile) +import qualified Data.Vector as V +import Test.Hspec (Spec, describe, it, shouldBe) + +fromRightS :: Show a => Either a b -> b +fromRightS (Right b) = b +fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a + +spec :: Spec +spec = do + describe "decoding workflow runs payloads" $ do + it "decodes workflow runs list" $ do + V.length (GH.withTotalCountItems workflowRunsList) `shouldBe` 3 + + where + workflowRunsList:: GH.WithTotalCount GH.WorkflowRun + workflowRunsList = + fromRightS (eitherDecodeStrict workflowRunsPayload) + + workflowRunsPayload :: ByteString + workflowRunsPayload = $(embedFile "fixtures/actions/workflow-runs-list.json") diff --git a/spec/GitHub/Actions/WorkflowSpec.hs b/spec/GitHub/Actions/WorkflowSpec.hs new file mode 100644 index 00000000..71c2aaad --- /dev/null +++ b/spec/GitHub/Actions/WorkflowSpec.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +module GitHub.Actions.WorkflowSpec where + +import qualified GitHub as GH + +import Prelude () +import Prelude.Compat + +import Data.Aeson (eitherDecodeStrict) +import Data.ByteString (ByteString) +import Data.FileEmbed (embedFile) +import qualified Data.Vector as V +import Test.Hspec (Spec, describe, it, shouldBe) + +fromRightS :: Show a => Either a b -> b +fromRightS (Right b) = b +fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a + +spec :: Spec +spec = do + describe "decoding workflow payloads" $ do + it "decodes workflow list" $ do + V.length (GH.withTotalCountItems workflowList) `shouldBe` 1 + + where + workflowList:: GH.WithTotalCount GH.Workflow + workflowList = + fromRightS (eitherDecodeStrict workflowPayload) + + workflowPayload :: ByteString + workflowPayload = $(embedFile "fixtures/actions/workflow-list.json") diff --git a/src/GitHub.hs b/src/GitHub.hs index 10e34602..c3a3d88f 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -409,6 +409,76 @@ module GitHub ( -- | See rateLimitR, + -- ** Actions - artifacts + -- | See + artifactsForR, + artifactR, + deleteArtifactR, + downloadArtifactR, + artifactsForWorkflowRunR, + + -- ** Actions - cache + -- | See + cacheUsageOrganizationR, + cacheUsageByRepositoryR, + cacheUsageR, + cachesForRepoR, + deleteCacheR, + + -- ** Actions - secrets + -- | See + organizationSecretsR, + organizationPublicKeyR, + organizationSecretR, + setOrganizationSecretR, + deleteOrganizationSecretR, + organizationSelectedRepositoriesForSecretR, + setOrganizationSelectedRepositoriesForSecretR, + addOrganizationSelectedRepositoriesForSecretR, + removeOrganizationSelectedRepositoriesForSecretR, + repoSecretsR, + repoPublicKeyR, + repoSecretR, + setRepoSecretR, + deleteRepoSecretR, + environmentSecretsR, + environmentPublicKeyR, + environmentSecretR, + setEnvironmentSecretR, + deleteEnvironmentSecretR, + + -- ** Actions - workflow jobs + -- | See + jobR, + downloadJobLogsR, + jobsForWorkflowRunAttemptR, + jobsForWorkflowRunR, + + -- ** Actions - workflow runs + -- | See + reRunJobR, + workflowRunsR, + workflowRunR, + deleteWorkflowRunR, + workflowRunReviewHistoryR, + approveWorkflowRunR, + workflowRunAttemptR, + downloadWorkflowRunAttemptLogsR, + cancelWorkflowRunR, + downloadWorkflowRunLogsR, + deleteWorkflowRunLogsR, + reRunWorkflowR, + reRunFailedJobsR, + workflowRunsForWorkflowR, + + -- ** Actions - workflows + -- | See + repositoryWorkflowsR, + workflowR, + disableWorkflowR, + triggerWorkflowR, + enableWorkflowR, + -- * Data definitions module GitHub.Data, -- * Request handling @@ -416,6 +486,12 @@ module GitHub ( ) where import GitHub.Data +import GitHub.Endpoints.Actions.Artifacts +import GitHub.Endpoints.Actions.Cache +import GitHub.Endpoints.Actions.Secrets +import GitHub.Endpoints.Actions.WorkflowJobs +import GitHub.Endpoints.Actions.WorkflowRuns +import GitHub.Endpoints.Actions.Workflows import GitHub.Endpoints.Activity.Events import GitHub.Endpoints.Activity.Notifications import GitHub.Endpoints.Activity.Starring diff --git a/src/GitHub/Data.hs b/src/GitHub/Data.hs index 4d8748f8..20ebe7fd 100644 --- a/src/GitHub/Data.hs +++ b/src/GitHub/Data.hs @@ -32,6 +32,13 @@ module GitHub.Data ( IssueNumber (..), -- * Module re-exports module GitHub.Auth, + module GitHub.Data.Actions.Common, + module GitHub.Data.Actions.Artifacts, + module GitHub.Data.Actions.Cache, + module GitHub.Data.Actions.Secrets, + module GitHub.Data.Actions.Workflows, + module GitHub.Data.Actions.WorkflowJobs, + module GitHub.Data.Actions.WorkflowRuns, module GitHub.Data.Activities, module GitHub.Data.Comments, module GitHub.Data.Content, @@ -65,6 +72,13 @@ import GitHub.Internal.Prelude import Prelude () import GitHub.Auth +import GitHub.Data.Actions.Common +import GitHub.Data.Actions.Artifacts +import GitHub.Data.Actions.Secrets +import GitHub.Data.Actions.Cache +import GitHub.Data.Actions.Workflows +import GitHub.Data.Actions.WorkflowJobs +import GitHub.Data.Actions.WorkflowRuns import GitHub.Data.Activities import GitHub.Data.Comments import GitHub.Data.Content diff --git a/src/GitHub/Data/Actions/Artifacts.hs b/src/GitHub/Data/Actions/Artifacts.hs new file mode 100644 index 00000000..7b572d2b --- /dev/null +++ b/src/GitHub/Data/Actions/Artifacts.hs @@ -0,0 +1,76 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE KindSignatures #-} + +module GitHub.Data.Actions.Artifacts ( + Artifact(..), + ArtifactWorkflowRun(..), + ) where + +import GitHub.Data.Id (Id) +import GitHub.Data.URL (URL) +import GitHub.Internal.Prelude +import Prelude () + +import GitHub.Data.Actions.Common (WithTotalCount (WithTotalCount)) +import GitHub.Data.Actions.WorkflowRuns (WorkflowRun) +import GitHub.Data.Repos (Repo) + +------------------------------------------------------------------------------- +-- Artifact +------------------------------------------------------------------------------- + +data ArtifactWorkflowRun = ArtifactWorkflowRun + { artifactWorkflowRunWorkflowRunId :: !(Id WorkflowRun) + , artifactWorkflowRunRepositoryId :: !(Id Repo) + , artifactWorkflowRunHeadRepositoryId :: !(Id Repo) + , artifactWorkflowRunHeadBranch :: !Text + , artifactWorkflowRunHeadSha :: !Text + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +data Artifact = Artifact + { artifactArchiveDownloadUrl :: !URL + , artifactCreatedAt :: !UTCTime + , artifactExpired :: !Bool + , artifactExpiresAt :: !UTCTime + , artifactId :: !(Id Artifact) + , artifactName :: !Text + , artifactNodeId :: !Text + , artifactSizeInBytes :: !Int + , artifactUpdatedAt :: !UTCTime + , artifactUrl :: !URL + , artifactWorkflowRun :: !ArtifactWorkflowRun + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +------------------------------------------------------------------------------- +-- JSON instances +------------------------------------------------------------------------------- + +instance FromJSON ArtifactWorkflowRun where + parseJSON = withObject "ArtifactWorkflowRun" $ \o -> ArtifactWorkflowRun + <$> o .: "id" + <*> o .: "repository_id" + <*> o .: "head_repository_id" + <*> o .: "head_branch" + <*> o .: "head_sha" + +instance FromJSON Artifact where + parseJSON = withObject "Artifact" $ \o -> Artifact + <$> o .: "archive_download_url" + <*> o .: "created_at" + <*> o .: "expired" + <*> o .: "expires_at" + <*> o .: "id" + <*> o .: "name" + <*> o .: "node_id" + <*> o .: "size_in_bytes" + <*> o .: "updated_at" + <*> o .: "url" + <*> o .: "workflow_run" + +instance FromJSON (WithTotalCount Artifact) where + parseJSON = withObject "ArtifactList" $ \o -> WithTotalCount + <$> o .: "artifacts" + <*> o .: "total_count" diff --git a/src/GitHub/Data/Actions/Cache.hs b/src/GitHub/Data/Actions/Cache.hs new file mode 100644 index 00000000..a4f65a60 --- /dev/null +++ b/src/GitHub/Data/Actions/Cache.hs @@ -0,0 +1,78 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE KindSignatures #-} + +module GitHub.Data.Actions.Cache ( + Cache(..), + RepositoryCacheUsage(..), + OrganizationCacheUsage(..) + ) where + +import GitHub.Data.Id (Id) +import GitHub.Internal.Prelude +import Prelude () + +import GitHub.Data.Actions.Common (WithTotalCount (WithTotalCount)) + +------------------------------------------------------------------------------- +-- Cache +------------------------------------------------------------------------------- + +data Cache = Cache + { cacheId :: !(Id Cache) + , cacheRef :: !Text + , cacheKey :: !Text + , cacheVersion :: !Text + , cacheLastAccessedAt :: !UTCTime + , cacheCreatedAt :: !UTCTime + , cacheSizeInBytes :: !Int + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +data RepositoryCacheUsage = RepositoryCacheUsage + { repositoryCacheUsageFullName :: !Text + , repositoryCacheUsageActiveCachesSizeInBytes :: !Int + , repositoryCacheUsageActiveCachesCount :: !Int + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +data OrganizationCacheUsage = OrganizationCacheUsage + { organizationCacheUsageTotalActiveCachesSizeInBytes :: !Int + , organizationCacheUsageTotalActiveCachesCount :: !Int + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +------------------------------------------------------------------------------- +-- JSON instances +------------------------------------------------------------------------------- + +instance FromJSON Cache where + parseJSON = withObject "Cache" $ \o -> Cache + <$> o .: "id" + <*> o .: "ref" + <*> o .: "key" + <*> o .: "version" + <*> o .: "last_accessed_at" + <*> o .: "created_at" + <*> o .: "size_in_bytes" + +instance FromJSON (WithTotalCount Cache) where + parseJSON = withObject "CacheList" $ \o -> WithTotalCount + <$> o .: "actions_caches" + <*> o .: "total_count" + +instance FromJSON OrganizationCacheUsage where + parseJSON = withObject "OrganizationCacheUsage" $ \o -> OrganizationCacheUsage + <$> o .: "total_active_caches_size_in_bytes" + <*> o .: "total_active_caches_count" + +instance FromJSON RepositoryCacheUsage where + parseJSON = withObject "RepositoryCacheUsage" $ \o -> RepositoryCacheUsage + <$> o .: "full_name" + <*> o .: "active_caches_size_in_bytes" + <*> o .: "active_caches_count" + +instance FromJSON (WithTotalCount RepositoryCacheUsage) where + parseJSON = withObject "CacheUsageList" $ \o -> WithTotalCount + <$> o .: "repository_cache_usages" + <*> o .: "total_count" diff --git a/src/GitHub/Data/Actions/Common.hs b/src/GitHub/Data/Actions/Common.hs new file mode 100644 index 00000000..ed02b6f0 --- /dev/null +++ b/src/GitHub/Data/Actions/Common.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE KindSignatures #-} + +module GitHub.Data.Actions.Common ( + WithTotalCount(..), + ) where + +import GitHub.Internal.Prelude +import Prelude () + +------------------------------------------------------------------------------- +-- Common +------------------------------------------------------------------------------- + +-- | A page of a paginated response. +data WithTotalCount a = WithTotalCount + { withTotalCountItems :: !(Vector a) + -- ^ A snippet of the answer. + , withTotalCountTotalCount :: !Int + -- ^ The total size of the answer. + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +-- | Joining two pages of a paginated response. +-- The 'withTotalCountTotalCount' is assumed to be the same in both pages, +-- but this is not checked. +instance Semigroup (WithTotalCount a) where + WithTotalCount items1 count1 <> WithTotalCount items2 _ = + WithTotalCount (items1 <> items2) count1 + +instance Foldable WithTotalCount where + foldMap f (WithTotalCount items _) = foldMap f items diff --git a/src/GitHub/Data/Actions/Secrets.hs b/src/GitHub/Data/Actions/Secrets.hs new file mode 100644 index 00000000..c734ad89 --- /dev/null +++ b/src/GitHub/Data/Actions/Secrets.hs @@ -0,0 +1,141 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE RecordWildCards #-} + +module GitHub.Data.Actions.Secrets ( + OrganizationSecret(..), + PublicKey(..), + SetSecret(..), + SetRepoSecret(..), + SelectedRepo(..), + SetSelectedRepositories(..), + RepoSecret(..), + Environment(..), + ) where + +import GitHub.Data.Id (Id) +import GitHub.Internal.Prelude +import Prelude () + +import Data.Maybe (maybeToList) +import GitHub.Data.Actions.Common (WithTotalCount (WithTotalCount)) +import GitHub.Data.Name (Name) +import GitHub.Data.Repos (Repo) + +------------------------------------------------------------------------------- +-- Secret +------------------------------------------------------------------------------- + +data OrganizationSecret = OrganizationSecret + { organizationSecretName :: !(Name OrganizationSecret) + , organizationSecretCreatedAt :: !UTCTime + , organizationSecretUpdatedAt :: !UTCTime + , organizationSecretVisibility :: !Text + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +data PublicKey = PublicKey + { publicKeyId :: !Text + , publicKeyKey :: !Text + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +data SetSecret = SetSecret + { setSecretPublicKeyId :: !Text + , setSecretEncryptedValue :: !Text + , setSecretVisibility :: !Text + , setSecretSelectedRepositoryIds :: !(Maybe [Id Repo]) + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +data SetRepoSecret = SetRepoSecret + { setRepoSecretPublicKeyId :: !Text + , setRepoSecretEncryptedValue :: !Text + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +data SelectedRepo = SelectedRepo + { selectedRepoRepoId :: !(Id Repo) + , selectedRepoRepoName :: !(Name Repo) + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +data SetSelectedRepositories = SetSelectedRepositories + { setSelectedRepositoriesRepositoryIds :: ![Id Repo] + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +data RepoSecret = RepoSecret + { repoSecretName :: !(Name RepoSecret) + , repoSecretCreatedAt :: !UTCTime + , repoSecretUpdatedAt :: !UTCTime + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +-- TODO move somewhere else? +data Environment = Environment + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +------------------------------------------------------------------------------- +-- JSON instances +------------------------------------------------------------------------------- + +instance FromJSON OrganizationSecret where + parseJSON = withObject "Secret" $ \o -> OrganizationSecret + <$> o .: "name" + <*> o .: "created_at" + <*> o .: "updated_at" + <*> o .: "visibility" + +instance FromJSON (WithTotalCount OrganizationSecret) where + parseJSON = withObject "SecretList" $ \o -> WithTotalCount + <$> o .: "secrets" + <*> o .: "total_count" + +instance FromJSON PublicKey where + parseJSON = withObject "PublicKey" $ \o -> PublicKey + <$> o .: "key_id" + <*> o .: "key" + +instance FromJSON SelectedRepo where + parseJSON = withObject "SelectedRepo" $ \o -> SelectedRepo + <$> o .: "id" + <*> o .: "name" + +instance ToJSON SetSelectedRepositories where + toJSON SetSelectedRepositories{..} = + object + [ "selected_repository_ids" .= setSelectedRepositoriesRepositoryIds + ] + +instance ToJSON SetSecret where + toJSON SetSecret{..} = + object $ + [ "encrypted_value" .= setSecretEncryptedValue + , "key_id" .= setSecretPublicKeyId + , "visibility" .= setSecretVisibility + ] <> maybeToList (fmap ("selected_repository_ids" .=) setSecretSelectedRepositoryIds) + +instance ToJSON SetRepoSecret where + toJSON SetRepoSecret{..} = + object + [ "encrypted_value" .= setRepoSecretEncryptedValue + , "key_id" .= setRepoSecretPublicKeyId + ] + +instance FromJSON (WithTotalCount SelectedRepo) where + parseJSON = withObject "SelectedRepoList" $ \o -> WithTotalCount + <$> o .: "repositories" + <*> o .: "total_count" + +instance FromJSON RepoSecret where + parseJSON = withObject "RepoSecret" $ \o -> RepoSecret + <$> o .: "name" + <*> o .: "created_at" + <*> o .: "updated_at" + +instance FromJSON (WithTotalCount RepoSecret) where + parseJSON = withObject "RepoSecretList" $ \o -> WithTotalCount + <$> o .: "secrets" + <*> o .: "total_count" diff --git a/src/GitHub/Data/Actions/WorkflowJobs.hs b/src/GitHub/Data/Actions/WorkflowJobs.hs new file mode 100644 index 00000000..9698e3a9 --- /dev/null +++ b/src/GitHub/Data/Actions/WorkflowJobs.hs @@ -0,0 +1,98 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE KindSignatures #-} + +module GitHub.Data.Actions.WorkflowJobs ( + JobStep(..), + Job(..), + ) where + +import Prelude () +import GitHub.Internal.Prelude + (Applicative ((<*>)), Data, Eq, FromJSON (parseJSON), Generic, Integer, + Ord, Show, Text, Typeable, UTCTime, Vector, withObject, ($), (.:), + (<$>)) + +import GitHub.Data.Id (Id) +import GitHub.Data.Name (Name) +import GitHub.Data.URL (URL) + +import GitHub.Data.Actions.Common (WithTotalCount (WithTotalCount)) +import GitHub.Data.Actions.WorkflowRuns (WorkflowRun) + +------------------------------------------------------------------------------- +-- Workflow jobs +------------------------------------------------------------------------------- + +data JobStep = JobStep + { jobStepName :: !(Name JobStep) + , jobStepStatus :: !Text + , jobStepConclusion :: !Text + , jobStepNumber :: !Integer + , jobStepStartedAt :: !UTCTime + , jobStepCompletedAt :: !UTCTime + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +data Job = Job + { jobId :: !(Id Job) + , jobRunId :: !(Id WorkflowRun) + , jobRunUrl :: !URL + , jobRunAttempt :: !Integer + , jobNodeId :: !Text + , jobHeadSha :: !Text + , jobUrl :: !URL + , jobHtmlUrl :: !URL + , jobStatus :: !Text + , jobConclusion :: !Text + , jobStartedAt :: !UTCTime + , jobCompletedAt :: !UTCTime + , jobSteps :: !(Vector JobStep) + , jobRunCheckUrl :: !URL + , jobLabels :: !(Vector Text) + , jobRunnerId :: !Integer + , jobRunnerName :: !Text + , jobRunnerGroupId :: !Integer + , jobRunnerGroupName :: !Text + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +------------------------------------------------------------------------------- +-- JSON instances +------------------------------------------------------------------------------- + +instance FromJSON JobStep where + parseJSON = withObject "JobStep" $ \o -> JobStep + <$> o .: "name" + <*> o .: "status" + <*> o .: "conclusion" + <*> o .: "number" + <*> o .: "started_at" + <*> o .: "completed_at" + +instance FromJSON Job where + parseJSON = withObject "Job" $ \o -> Job + <$> o .: "id" + <*> o .: "run_id" + <*> o .: "run_url" + <*> o .: "run_attempt" + <*> o .: "node_id" + <*> o .: "head_sha" + <*> o .: "url" + <*> o .: "html_url" + <*> o .: "status" + <*> o .: "conclusion" + <*> o .: "started_at" + <*> o .: "completed_at" + <*> o .: "steps" + <*> o .: "check_run_url" + <*> o .: "labels" + <*> o .: "runner_id" + <*> o .: "runner_name" + <*> o .: "runner_group_id" + <*> o .: "runner_group_name" + +instance FromJSON (WithTotalCount Job) where + parseJSON = withObject "JobList" $ \o -> WithTotalCount + <$> o .: "jobs" + <*> o .: "total_count" diff --git a/src/GitHub/Data/Actions/WorkflowRuns.hs b/src/GitHub/Data/Actions/WorkflowRuns.hs new file mode 100644 index 00000000..3dae581b --- /dev/null +++ b/src/GitHub/Data/Actions/WorkflowRuns.hs @@ -0,0 +1,91 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE KindSignatures #-} + +module GitHub.Data.Actions.WorkflowRuns ( + WorkflowRun(..), + RunAttempt(..), + ReviewHistory(..), + ) where + +import GitHub.Data.Actions.Common (WithTotalCount (WithTotalCount)) +import GitHub.Data.Definitions +import GitHub.Data.URL (URL) +import GitHub.Internal.Prelude +import Prelude () + +import GitHub.Data.Id (Id) +import GitHub.Data.Name (Name) + +------------------------------------------------------------------------------- +-- Workflow runs +------------------------------------------------------------------------------- + +data WorkflowRun = WorkflowRun + { workflowRunWorkflowRunId :: !(Id WorkflowRun) + , workflowRunName :: !(Name WorkflowRun) + , workflowRunHeadBranch :: !Text + , workflowRunHeadSha :: !Text + , workflowRunPath :: !Text + , workflowRunDisplayTitle :: !Text + , workflowRunRunNumber :: !Integer + , workflowRunEvent :: !Text + , workflowRunStatus :: !Text + , workflowRunConclusion :: !(Maybe Text) + , workflowRunWorkflowId :: !Integer + , workflowRunUrl :: !URL + , workflowRunHtmlUrl :: !URL + , workflowRunCreatedAt :: !UTCTime + , workflowRunUpdatedAt :: !UTCTime + , workflowRunActor :: !SimpleUser + , workflowRunAttempt :: !Integer + , workflowRunStartedAt :: !UTCTime + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +data RunAttempt = RunAttempt + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +data ReviewHistory = ReviewHistory + { reviewHistoryState :: !Text + , reviewHistoryComment :: !Text + , reviewHistoryUser :: !SimpleUser + + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +------------------------------------------------------------------------------- +-- JSON instances +------------------------------------------------------------------------------- + +instance FromJSON WorkflowRun where + parseJSON = withObject "WorkflowRun" $ \o -> WorkflowRun + <$> o .: "id" + <*> o .: "name" + <*> o .: "head_branch" + <*> o .: "head_sha" + <*> o .: "path" + <*> o .: "display_title" + <*> o .: "run_number" + <*> o .: "event" + <*> o .: "status" + <*> o .: "conclusion" + <*> o .: "workflow_id" + <*> o .: "url" + <*> o .: "html_url" + <*> o .: "created_at" + <*> o .: "updated_at" + <*> o .: "actor" + <*> o .: "run_attempt" + <*> o .: "run_started_at" + +instance FromJSON (WithTotalCount WorkflowRun) where + parseJSON = withObject "WorkflowRunList" $ \o -> WithTotalCount + <$> o .: "workflow_runs" + <*> o .: "total_count" + +instance FromJSON ReviewHistory where + parseJSON = withObject "ReviewHistory" $ \o -> ReviewHistory + <$> o .: "state" + <*> o .: "comment" + <*> o .: "user" diff --git a/src/GitHub/Data/Actions/Workflows.hs b/src/GitHub/Data/Actions/Workflows.hs new file mode 100644 index 00000000..9dd2252d --- /dev/null +++ b/src/GitHub/Data/Actions/Workflows.hs @@ -0,0 +1,62 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE KindSignatures #-} + +module GitHub.Data.Actions.Workflows ( + Workflow(..), + CreateWorkflowDispatchEvent(..), + ) where + +import Prelude () +import GitHub.Internal.Prelude + +import GitHub.Data.Actions.Common (WithTotalCount (WithTotalCount)) +import GitHub.Data.Id (Id) +import GitHub.Data.URL (URL) + +data Workflow = Workflow + { workflowWorkflowId :: !(Id Workflow) + , workflowName :: !Text + , workflowPath :: !Text + , workflowState :: !Text + , workflowCreatedAt :: !UTCTime + , workflowUpdatedAt :: !UTCTime + , workflowUrl :: !URL + , workflowHtmlUrl :: !URL + , workflowBadgeUrl :: !URL + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +data CreateWorkflowDispatchEvent a = CreateWorkflowDispatchEvent + { createWorkflowDispatchEventRef :: !Text + , createWorkflowDispatchEventInputs :: !a + } + deriving (Show, Generic) + +instance (NFData a) => NFData (CreateWorkflowDispatchEvent a) where rnf = genericRnf +instance (Binary a) => Binary (CreateWorkflowDispatchEvent a) + +------------------------------------------------------------------------------- +-- JSON instances +------------------------------------------------------------------------------- + +instance FromJSON Workflow where + parseJSON = withObject "Workflow" $ \o -> Workflow + <$> o .: "id" + <*> o .: "name" + <*> o .: "path" + <*> o .: "state" + <*> o .: "created_at" + <*> o .: "updated_at" + <*> o .: "url" + <*> o .: "html_url" + <*> o .: "badge_url" + +instance FromJSON (WithTotalCount Workflow) where + parseJSON = withObject "WorkflowList" $ \o -> WithTotalCount + <$> o .: "workflows" + <*> o .: "total_count" + +instance ToJSON a => ToJSON (CreateWorkflowDispatchEvent a) where + toJSON (CreateWorkflowDispatchEvent ref inputs) = + object [ "ref" .= ref, "inputs" .= inputs ] diff --git a/src/GitHub/Data/Options.hs b/src/GitHub/Data/Options.hs index 87c489a7..f1ce58da 100644 --- a/src/GitHub/Data/Options.hs +++ b/src/GitHub/Data/Options.hs @@ -1,4 +1,5 @@ {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE LambdaCase #-} -- | -- Module with modifiers for pull requests' and issues' listings. @@ -46,6 +47,31 @@ module GitHub.Data.Options ( optionsAnyAssignee, optionsNoAssignee, optionsAssignee, + -- * Actions artifacts + ArtifactMod, + artifactModToQueryString, + optionsArtifactName, + -- * Actions cache + CacheMod, + cacheModToQueryString, + optionsRef, + optionsNoRef, + optionsKey, + optionsNoKey, + optionsDirectionAsc, + optionsDirectionDesc, + sortByCreatedAt, + sortByLastAccessedAt, + sortBySizeInBytes, + -- * Actions workflow runs + WorkflowRunMod, + workflowRunModToQueryString, + optionsWorkflowRunActor, + optionsWorkflowRunBranch, + optionsWorkflowRunEvent, + optionsWorkflowRunStatus, + optionsWorkflowRunCreated, + optionsWorkflowRunHeadSha, -- * Data IssueState (..), IssueStateReason (..), @@ -207,6 +233,18 @@ data FilterBy a deriving (Eq, Ord, Show, Generic, Typeable, Data) +-- Actions cache + +data SortCache + = SortCacheCreatedAt + | SortCacheLastAccessedAt + | SortCacheSizeInBytes + deriving + (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) + +instance NFData SortCache where rnf = genericRnf +instance Binary SortCache + ------------------------------------------------------------------------------- -- Classes ------------------------------------------------------------------------------- @@ -663,3 +701,236 @@ optionsNoAssignee = IssueRepoMod $ \opts -> optionsAssignee :: Name User -> IssueRepoMod optionsAssignee u = IssueRepoMod $ \opts -> opts { issueRepoOptionsAssignee = FilterBy u } + +------------------------------------------------------------------------------- +-- Actions artifacts +------------------------------------------------------------------------------- + +-- | See . +data ArtifactOptions = ArtifactOptions + { artifactOptionsName :: !(Maybe Text) + } + deriving + (Eq, Ord, Show, Generic, Typeable, Data) + +defaultArtifactOptions :: ArtifactOptions +defaultArtifactOptions = ArtifactOptions + { artifactOptionsName = Nothing + } + +-- | See . +newtype ArtifactMod = ArtifactMod (ArtifactOptions -> ArtifactOptions) + +instance Semigroup ArtifactMod where + ArtifactMod f <> ArtifactMod g = ArtifactMod (g . f) + +instance Monoid ArtifactMod where + mempty = ArtifactMod id + mappend = (<>) + +-- | Filters artifacts by exact match on their name field. +optionsArtifactName :: Text -> ArtifactMod +optionsArtifactName n = ArtifactMod $ \opts -> + opts { artifactOptionsName = Just n } + +toArtifactOptions :: ArtifactMod -> ArtifactOptions +toArtifactOptions (ArtifactMod f) = f defaultArtifactOptions + +artifactModToQueryString :: ArtifactMod -> QueryString +artifactModToQueryString = artifactOptionsToQueryString . toArtifactOptions + +artifactOptionsToQueryString :: ArtifactOptions -> QueryString +artifactOptionsToQueryString (ArtifactOptions name) = + catMaybes + [ mk "name" <$> name' + ] + where + mk k v = (k, Just v) + name' = fmap TE.encodeUtf8 name + +------------------------------------------------------------------------------- +-- Actions cache +------------------------------------------------------------------------------- + +-- | See . +data CacheOptions = CacheOptions + { cacheOptionsRef :: !(Maybe Text) + , cacheOptionsKey :: !(Maybe Text) + , cacheOptionsSort :: !(Maybe SortCache) + , cacheOptionsDirection :: !(Maybe SortDirection) + } + deriving + (Eq, Ord, Show, Generic, Typeable, Data) + +defaultCacheOptions :: CacheOptions +defaultCacheOptions = CacheOptions + { cacheOptionsRef = Nothing + , cacheOptionsKey = Nothing + , cacheOptionsSort = Nothing + , cacheOptionsDirection = Nothing + } + +-- | See . +newtype CacheMod = CacheMod (CacheOptions -> CacheOptions) + +instance Semigroup CacheMod where + CacheMod f <> CacheMod g = CacheMod (g . f) + +instance Monoid CacheMod where + mempty = CacheMod id + mappend = (<>) + +toCacheOptions :: CacheMod -> CacheOptions +toCacheOptions (CacheMod f) = f defaultCacheOptions + +cacheModToQueryString :: CacheMod -> QueryString +cacheModToQueryString = cacheOptionsToQueryString . toCacheOptions + +cacheOptionsToQueryString :: CacheOptions -> QueryString +cacheOptionsToQueryString (CacheOptions ref key sort dir) = + catMaybes + [ mk "ref" <$> ref' + , mk "key" <$> key' + , mk "sort" <$> sort' + , mk "directions" <$> direction' + ] + where + mk k v = (k, Just v) + sort' = sort <&> \case + SortCacheCreatedAt -> "created_at" + SortCacheLastAccessedAt -> "last_accessed_at" + SortCacheSizeInBytes -> "size_in_bytes" + direction' = dir <&> \case + SortDescending -> "desc" + SortAscending -> "asc" + ref' = fmap TE.encodeUtf8 ref + key' = fmap TE.encodeUtf8 key + +------------------------------------------------------------------------------- +-- Cache modifiers +------------------------------------------------------------------------------- + +optionsRef :: Text -> CacheMod +optionsRef x = CacheMod $ \opts -> + opts { cacheOptionsRef = Just x } + +optionsNoRef :: CacheMod +optionsNoRef = CacheMod $ \opts -> + opts { cacheOptionsRef = Nothing } + +optionsKey :: Text -> CacheMod +optionsKey x = CacheMod $ \opts -> + opts { cacheOptionsKey = Just x } + +optionsNoKey :: CacheMod +optionsNoKey = CacheMod $ \opts -> + opts { cacheOptionsKey = Nothing } + +optionsDirectionAsc :: CacheMod +optionsDirectionAsc = CacheMod $ \opts -> + opts { cacheOptionsDirection = Just SortAscending } + +optionsDirectionDesc :: CacheMod +optionsDirectionDesc = CacheMod $ \opts -> + opts { cacheOptionsDirection = Just SortDescending } + +sortByCreatedAt :: CacheMod +sortByCreatedAt = CacheMod $ \opts -> + opts { cacheOptionsSort = Just SortCacheCreatedAt } + +sortByLastAccessedAt :: CacheMod +sortByLastAccessedAt = CacheMod $ \opts -> + opts { cacheOptionsSort = Just SortCacheLastAccessedAt } + +sortBySizeInBytes :: CacheMod +sortBySizeInBytes = CacheMod $ \opts -> + opts { cacheOptionsSort = Just SortCacheSizeInBytes } + +------------------------------------------------------------------------------- +-- Actions workflow runs +------------------------------------------------------------------------------- + +-- | See . +data WorkflowRunOptions = WorkflowRunOptions + { workflowRunOptionsActor :: !(Maybe Text) + , workflowRunOptionsBranch :: !(Maybe Text) + , workflowRunOptionsEvent :: !(Maybe Text) + , workflowRunOptionsStatus :: !(Maybe Text) + , workflowRunOptionsCreated :: !(Maybe Text) + , workflowRunOptionsHeadSha :: !(Maybe Text) + } + deriving + (Eq, Ord, Show, Generic, Typeable, Data) + +defaultWorkflowRunOptions :: WorkflowRunOptions +defaultWorkflowRunOptions = WorkflowRunOptions + { workflowRunOptionsActor = Nothing + , workflowRunOptionsBranch = Nothing + , workflowRunOptionsEvent = Nothing + , workflowRunOptionsStatus = Nothing + , workflowRunOptionsCreated = Nothing + , workflowRunOptionsHeadSha = Nothing + } + +-- | See . +newtype WorkflowRunMod = WorkflowRunMod (WorkflowRunOptions -> WorkflowRunOptions) + +instance Semigroup WorkflowRunMod where + WorkflowRunMod f <> WorkflowRunMod g = WorkflowRunMod (g . f) + +instance Monoid WorkflowRunMod where + mempty = WorkflowRunMod id + mappend = (<>) + +toWorkflowRunOptions :: WorkflowRunMod -> WorkflowRunOptions +toWorkflowRunOptions (WorkflowRunMod f) = f defaultWorkflowRunOptions + +workflowRunModToQueryString :: WorkflowRunMod -> QueryString +workflowRunModToQueryString = workflowRunOptionsToQueryString . toWorkflowRunOptions + +workflowRunOptionsToQueryString :: WorkflowRunOptions -> QueryString +workflowRunOptionsToQueryString (WorkflowRunOptions actor branch event status created headSha) = + catMaybes + [ mk "actor" <$> actor' + , mk "branch" <$> branch' + , mk "event" <$> event' + , mk "status" <$> status' + , mk "created" <$> created' + , mk "head_sha" <$> headSha' + ] + where + mk k v = (k, Just v) + actor' = fmap TE.encodeUtf8 actor + branch' = fmap TE.encodeUtf8 branch + event' = fmap TE.encodeUtf8 event + status' = fmap TE.encodeUtf8 status + created' = fmap TE.encodeUtf8 created + headSha' = fmap TE.encodeUtf8 headSha + +------------------------------------------------------------------------------- +-- Workflow run modifiers +------------------------------------------------------------------------------- + +optionsWorkflowRunActor :: Text -> WorkflowRunMod +optionsWorkflowRunActor x = WorkflowRunMod $ \opts -> + opts { workflowRunOptionsActor = Just x } + +optionsWorkflowRunBranch :: Text -> WorkflowRunMod +optionsWorkflowRunBranch x = WorkflowRunMod $ \opts -> + opts { workflowRunOptionsBranch = Just x } + +optionsWorkflowRunEvent :: Text -> WorkflowRunMod +optionsWorkflowRunEvent x = WorkflowRunMod $ \opts -> + opts { workflowRunOptionsEvent = Just x } + +optionsWorkflowRunStatus :: Text -> WorkflowRunMod +optionsWorkflowRunStatus x = WorkflowRunMod $ \opts -> + opts { workflowRunOptionsStatus = Just x } + +optionsWorkflowRunCreated :: Text -> WorkflowRunMod +optionsWorkflowRunCreated x = WorkflowRunMod $ \opts -> + opts { workflowRunOptionsCreated = Just x } + +optionsWorkflowRunHeadSha :: Text -> WorkflowRunMod +optionsWorkflowRunHeadSha x = WorkflowRunMod $ \opts -> + opts { workflowRunOptionsHeadSha = Just x } diff --git a/src/GitHub/Endpoints/Actions/Artifacts.hs b/src/GitHub/Endpoints/Actions/Artifacts.hs new file mode 100644 index 00000000..ac55dd61 --- /dev/null +++ b/src/GitHub/Endpoints/Actions/Artifacts.hs @@ -0,0 +1,61 @@ +-- | +-- The actions API as documented at +-- . + +module GitHub.Endpoints.Actions.Artifacts ( + artifactsForR, + artifactR, + deleteArtifactR, + downloadArtifactR, + artifactsForWorkflowRunR, + module GitHub.Data + ) where + +import GitHub.Data +import GitHub.Internal.Prelude +import Network.URI (URI) +import Prelude () + +-- | List artifacts for repository. +-- See +artifactsForR + :: Name Owner + -> Name Repo + -> ArtifactMod + -> FetchCount + -> Request 'RA (WithTotalCount Artifact) +artifactsForR user repo opts = PagedQuery + ["repos", toPathPart user, toPathPart repo, "actions", "artifacts"] + (artifactModToQueryString opts) + +-- | Get an artifact. +-- See +artifactR :: Name Owner -> Name Repo -> Id Artifact -> Request 'RA Artifact +artifactR user repo artid = + query ["repos", toPathPart user, toPathPart repo, "actions", "artifacts", toPathPart artid] [] + +-- | Delete an artifact. +-- See +deleteArtifactR :: Name Owner -> Name Repo -> Id Comment -> GenRequest 'MtUnit 'RW () +deleteArtifactR user repo artid = + Command Delete parts mempty + where + parts = ["repos", toPathPart user, toPathPart repo, "actions", "artifacts", toPathPart artid] + +-- | Download an artifact. +-- See +downloadArtifactR :: Name Owner -> Name Repo -> Id Artifact -> GenRequest 'MtRedirect 'RW URI +downloadArtifactR user repo artid = + Query ["repos", toPathPart user, toPathPart repo, "actions", "artifacts", toPathPart artid, "zip"] [] + +-- | List artifacts for a workflow run. +-- See +artifactsForWorkflowRunR + :: Name Owner + -> Name Repo + -> Id WorkflowRun + -> FetchCount + -> Request 'RA (WithTotalCount Artifact) +artifactsForWorkflowRunR user repo runid = PagedQuery + ["repos", toPathPart user, toPathPart repo, "actions", "runs", toPathPart runid, "artifacts"] + [] diff --git a/src/GitHub/Endpoints/Actions/Cache.hs b/src/GitHub/Endpoints/Actions/Cache.hs new file mode 100644 index 00000000..fe085420 --- /dev/null +++ b/src/GitHub/Endpoints/Actions/Cache.hs @@ -0,0 +1,66 @@ +-- | +-- The actions API as documented at +-- . + +module GitHub.Endpoints.Actions.Cache ( + cacheUsageOrganizationR, + cacheUsageByRepositoryR, + cacheUsageR, + cachesForRepoR, + deleteCacheR, + module GitHub.Data + ) where + +import GitHub.Data +import GitHub.Internal.Prelude +import Prelude () + +-- | Get Actions cache usage for the organization. +-- See +cacheUsageOrganizationR + :: Name Organization + -> GenRequest 'MtJSON 'RA OrganizationCacheUsage +cacheUsageOrganizationR org = + Query ["orgs", toPathPart org, "actions", "cache", "usage"] [] + +-- | List repositories with GitHub Actions cache usage for an organization. +-- See +cacheUsageByRepositoryR + :: Name Organization + -> FetchCount + -> GenRequest 'MtJSON 'RA (WithTotalCount RepositoryCacheUsage) +cacheUsageByRepositoryR org = + PagedQuery ["orgs", toPathPart org, "actions", "cache", "usage-by-repository"] [] + +-- | Get GitHub Actions cache usage for a repository. +-- See +cacheUsageR + :: Name Owner + -> Name Repo + -> Request k RepositoryCacheUsage +cacheUsageR user repo = + Query ["repos", toPathPart user, toPathPart repo, "actions", "cache", "usage"] [] + +-- | List the GitHub Actions caches for a repository. +-- See +cachesForRepoR + :: Name Owner + -> Name Repo + -> CacheMod + -> FetchCount + -> GenRequest 'MtJSON 'RA (WithTotalCount Cache) +cachesForRepoR user repo opts = PagedQuery + ["repos", toPathPart user, toPathPart repo, "actions", "caches"] + (cacheModToQueryString opts) + +-- | Delete GitHub Actions cache for a repository. +-- See +deleteCacheR + :: Name Owner + -> Name Repo + -> Id Cache + -> GenRequest 'MtUnit 'RW () +deleteCacheR user repo cacheid = + Command Delete parts mempty + where + parts = ["repos", toPathPart user, toPathPart repo, "actions", "caches", toPathPart cacheid] diff --git a/src/GitHub/Endpoints/Actions/Secrets.hs b/src/GitHub/Endpoints/Actions/Secrets.hs new file mode 100644 index 00000000..c6b0d6b8 --- /dev/null +++ b/src/GitHub/Endpoints/Actions/Secrets.hs @@ -0,0 +1,221 @@ +-- | +-- The actions API as documented at +-- . + +module GitHub.Endpoints.Actions.Secrets ( + organizationSecretsR, + organizationPublicKeyR, + organizationSecretR, + setOrganizationSecretR, + deleteOrganizationSecretR, + organizationSelectedRepositoriesForSecretR, + setOrganizationSelectedRepositoriesForSecretR, + addOrganizationSelectedRepositoriesForSecretR, + removeOrganizationSelectedRepositoriesForSecretR, + repoSecretsR, + repoPublicKeyR, + repoSecretR, + setRepoSecretR, + deleteRepoSecretR, + environmentSecretsR, + environmentPublicKeyR, + environmentSecretR, + setEnvironmentSecretR, + deleteEnvironmentSecretR, + module GitHub.Data + ) where + +import GitHub.Data +import GitHub.Internal.Prelude +import Prelude () + +-- | List organization secrets. +-- See +organizationSecretsR + :: Name Organization + -> FetchCount + -> GenRequest 'MtJSON 'RA (WithTotalCount OrganizationSecret) +organizationSecretsR org = + PagedQuery ["orgs", toPathPart org, "actions", "secrets"] [] + +-- | List organization secrets. +-- See +organizationPublicKeyR + :: Name Organization + -> GenRequest 'MtJSON 'RA PublicKey +organizationPublicKeyR org = + Query ["orgs", toPathPart org, "actions", "secrets", "public-key"] [] + +-- | Get an organization secret. +-- See +organizationSecretR + :: Name Organization + -> Name OrganizationSecret + -> GenRequest 'MtJSON 'RA OrganizationSecret +organizationSecretR org name = + Query ["orgs", toPathPart org, "actions", "secrets", toPathPart name] [] + +-- | Create or update an organization secret. +-- See +setOrganizationSecretR + :: Name Organization + -> Name OrganizationSecret + -> SetSecret + -> GenRequest 'MtUnit 'RW () +setOrganizationSecretR org name = + Command Put ["orgs", toPathPart org, "actions", "secrets", toPathPart name] . encode + +-- | Delete an organization secret. +-- See +deleteOrganizationSecretR + :: Name Organization + -> Name OrganizationSecret + -> GenRequest 'MtUnit 'RW () +deleteOrganizationSecretR org name = + Command Delete parts mempty + where + parts = ["orgs", toPathPart org, "actions", "secrets", toPathPart name] + +-- | Get selected repositories for an organization secret. +-- See +organizationSelectedRepositoriesForSecretR + :: Name Organization + -> Name OrganizationSecret + -> FetchCount + -> GenRequest 'MtJSON 'RA (WithTotalCount SelectedRepo) +organizationSelectedRepositoriesForSecretR org name = + PagedQuery ["orgs", toPathPart org, "actions", "secrets", toPathPart name, "repositories"] [] + +-- | Set selected repositories for an organization secret. +-- See +setOrganizationSelectedRepositoriesForSecretR + :: Name Organization + -> Name OrganizationSecret + -> SetSelectedRepositories + -> GenRequest 'MtUnit 'RW () +setOrganizationSelectedRepositoriesForSecretR org name = + Command Put ["orgs", toPathPart org, "actions", "secrets", toPathPart name, "repositories"] . encode + +-- | Add selected repository to an organization secret. +-- See +addOrganizationSelectedRepositoriesForSecretR + :: Name Organization + -> Name OrganizationSecret + -> Id Repo + -> GenRequest 'MtUnit 'RW () +addOrganizationSelectedRepositoriesForSecretR org name repo = + Command Put ["orgs", toPathPart org, "actions", "secrets", toPathPart name, "repositories", toPathPart repo] mempty + +-- | Remove selected repository from an organization secret. +-- See +removeOrganizationSelectedRepositoriesForSecretR + :: Name Organization + -> Name OrganizationSecret + -> Id Repo + -> GenRequest 'MtUnit 'RW () +removeOrganizationSelectedRepositoriesForSecretR org name repo = + Command Delete ["orgs", toPathPart org, "actions", "secrets", toPathPart name, "repositories", toPathPart repo] mempty + +-- | List repository secrets. +-- See +repoSecretsR + :: Name Owner + -> Name Repo + -> FetchCount + -> GenRequest 'MtJSON 'RA (WithTotalCount RepoSecret) +repoSecretsR user repo = + PagedQuery ["repos", toPathPart user, toPathPart repo, "actions", "secrets"] [] + +-- | Get a repository public key. +-- See +repoPublicKeyR + :: Name Owner + -> Name Organization + -> GenRequest 'MtJSON 'RA PublicKey +repoPublicKeyR user org = + Query ["repos", toPathPart user, toPathPart org, "actions", "secrets", "public-key"] [] + +-- | Get a repository secret. +-- See +repoSecretR + :: Name Owner + -> Name Organization + -> Name RepoSecret + -> GenRequest 'MtJSON 'RA RepoSecret +repoSecretR user org name = + Query ["repos", toPathPart user, toPathPart org, "actions", "secrets", toPathPart name] [] + +-- | Create or update a repository secret. +-- See +setRepoSecretR + :: Name Owner + -> Name Organization + -> Name RepoSecret + -> SetRepoSecret + -> GenRequest 'MtUnit 'RW () +setRepoSecretR user org name = + Command Put ["repos", toPathPart user, toPathPart org, "actions", "secrets", toPathPart name] . encode + +-- | Delete a repository secret. +-- See +deleteRepoSecretR + :: Name Owner + -> Name Organization + -> Name RepoSecret + -> GenRequest 'MtUnit 'RW () +deleteRepoSecretR user org name = + Command Delete parts mempty + where + parts = ["repos", toPathPart user, toPathPart org, "actions", "secrets", toPathPart name] + +-- | List environment secrets. +-- See +environmentSecretsR + :: Id Repo + -> Name Environment + -> FetchCount + -> GenRequest 'MtJSON 'RA (WithTotalCount RepoSecret) +environmentSecretsR repo env = + PagedQuery ["repositories", toPathPart repo, "environments", toPathPart env, "secrets"] [] + +-- | Get an environment public key. +-- See +environmentPublicKeyR + :: Id Repo + -> Name Environment + -> GenRequest 'MtJSON 'RA PublicKey +environmentPublicKeyR repo env = + Query ["repositories", toPathPart repo, "environments", toPathPart env, "secrets", "public-key"] [] + +-- | Get an environment secret +-- See +environmentSecretR + :: Id Repo + -> Name Environment + -> Name RepoSecret + -> GenRequest 'MtJSON 'RA RepoSecret +environmentSecretR repo env name = + Query ["repositories", toPathPart repo, "environments", toPathPart env, "secrets", toPathPart name] [] + +-- | Create or update an environment secret. +-- See +setEnvironmentSecretR + :: Id Repo + -> Name Environment + -> Name RepoSecret + -> SetRepoSecret + -> GenRequest 'MtUnit 'RW () +setEnvironmentSecretR repo env name = + Command Put ["repositories", toPathPart repo, "environments", toPathPart env, "secrets", toPathPart name] . encode + +-- | Delete an environment secret. +-- See +deleteEnvironmentSecretR + :: Id Repo + -> Name Environment + -> Name RepoSecret + -> GenRequest 'MtUnit 'RW () +deleteEnvironmentSecretR repo env name = + Command Delete parts mempty + where + parts = ["repositories", toPathPart repo, "environments", toPathPart env, "secrets", toPathPart name] diff --git a/src/GitHub/Endpoints/Actions/WorkflowJobs.hs b/src/GitHub/Endpoints/Actions/WorkflowJobs.hs new file mode 100644 index 00000000..881803b4 --- /dev/null +++ b/src/GitHub/Endpoints/Actions/WorkflowJobs.hs @@ -0,0 +1,58 @@ +-- | +-- The actions API as documented at +-- . + +module GitHub.Endpoints.Actions.WorkflowJobs ( + jobR, + downloadJobLogsR, + jobsForWorkflowRunAttemptR, + jobsForWorkflowRunR, + module GitHub.Data + ) where + +import GitHub.Data +import Network.URI (URI) +import Prelude () + +-- | Get a job for a workflow run. +-- See +jobR + :: Name Owner + -> Name Repo + -> Id Job + -> Request 'RA Job +jobR owner repo job = + Query ["repos", toPathPart owner, toPathPart repo, "actions", "jobs", toPathPart job] [] + +-- | Download job logs for a workflow run. +-- See +downloadJobLogsR + :: Name Owner + -> Name Repo + -> Id Job + -> GenRequest 'MtRedirect 'RO URI +downloadJobLogsR owner repo job = + Query ["repos", toPathPart owner, toPathPart repo, "actions", "jobs", toPathPart job, "logs"] [] + +-- | List jobs for a workflow run attempt. +-- See +jobsForWorkflowRunAttemptR + :: Name Owner + -> Name Repo + -> Id WorkflowRun + -> Id RunAttempt + -> FetchCount + -> GenRequest 'MtJSON 'RA (WithTotalCount Job) +jobsForWorkflowRunAttemptR owner repo run attempt = + PagedQuery ["repos", toPathPart owner, toPathPart repo, "actions", "runs", toPathPart run, "attempts", toPathPart attempt, "jobs"] [] + +-- | List jobs for a workflow run. +-- See +jobsForWorkflowRunR + :: Name Owner + -> Name Repo + -> Id WorkflowRun + -> FetchCount + -> GenRequest 'MtJSON 'RA (WithTotalCount Job) +jobsForWorkflowRunR owner repo run = + PagedQuery ["repos", toPathPart owner, toPathPart repo, "actions", "runs", toPathPart run, "jobs"] [] diff --git a/src/GitHub/Endpoints/Actions/WorkflowRuns.hs b/src/GitHub/Endpoints/Actions/WorkflowRuns.hs new file mode 100644 index 00000000..3039323d --- /dev/null +++ b/src/GitHub/Endpoints/Actions/WorkflowRuns.hs @@ -0,0 +1,181 @@ +module GitHub.Endpoints.Actions.WorkflowRuns ( + reRunJobR, + workflowRunsR, + workflowRunR, + deleteWorkflowRunR, + workflowRunReviewHistoryR, + approveWorkflowRunR, + workflowRunAttemptR, + downloadWorkflowRunAttemptLogsR, + cancelWorkflowRunR, + downloadWorkflowRunLogsR, + deleteWorkflowRunLogsR, + reRunWorkflowR, + reRunFailedJobsR, + workflowRunsForWorkflowR, + module GitHub.Data + ) where + +import GitHub.Data +import GitHub.Internal.Prelude +import Network.URI (URI) +import Prelude () + +-- | Re-run a job from a workflow run. +-- See +reRunJobR + :: Name Owner + -> Name Repo + -> Id Job + -> GenRequest 'MtUnit 'RW () +reRunJobR user repo job = Command Post + ["repos", toPathPart user, toPathPart repo, "actions", "jobs", toPathPart job, "rerun"] + mempty + +-- | List workflow runs for a repository. +-- See +workflowRunsR + :: Name Owner + -> Name Repo + -> WorkflowRunMod + -> FetchCount + -> GenRequest 'MtJSON 'RA (WithTotalCount WorkflowRun) +workflowRunsR user repo runMod = PagedQuery + ["repos", toPathPart user, toPathPart repo, "actions", "runs"] + (workflowRunModToQueryString runMod) + +-- | Get a workflow run. +-- See +workflowRunR + :: Name Owner + -> Name Repo + -> Id WorkflowRun + -> GenRequest 'MtJSON 'RA WorkflowRun +workflowRunR user repo run = Query + ["repos", toPathPart user, toPathPart repo, "actions", "runs", toPathPart run] + [] + +-- | Delete a workflow run. +-- See +deleteWorkflowRunR + :: Name Owner + -> Name Repo + -> Id WorkflowRun + -> GenRequest 'MtUnit 'RW () +deleteWorkflowRunR user repo run = Command Delete + ["repos", toPathPart user, toPathPart repo, "actions", "runs", toPathPart run] + mempty + +-- | Get the review history for a workflow run. +-- See +workflowRunReviewHistoryR + :: Name Owner + -> Name Repo + -> Id WorkflowRun + -> GenRequest 'MtJSON 'RA (Vector ReviewHistory) +workflowRunReviewHistoryR user repo run = Query + ["repos", toPathPart user, toPathPart repo, "actions", "runs", toPathPart run, "approvals"] + [] + +-- | Approve a workflow run for a fork pull request. +-- See +approveWorkflowRunR + :: Name Owner + -> Name Repo + -> Id WorkflowRun + -> GenRequest 'MtUnit 'RW () +approveWorkflowRunR user repo run = Command Post + ["repos", toPathPart user, toPathPart repo, "actions", "runs", toPathPart run, "approve"] + mempty + +-- | Get a workflow run attempt. +-- See +workflowRunAttemptR + :: Name Owner + -> Name Repo + -> Id WorkflowRun + -> Id RunAttempt + -> GenRequest 'MtJSON 'RA WorkflowRun +workflowRunAttemptR user repo run attempt = Query + ["repos", toPathPart user, toPathPart repo, "actions", "runs", toPathPart run, "attempts", toPathPart attempt] + [] + +-- | Download workflow run attempt logs. +-- See +downloadWorkflowRunAttemptLogsR + :: Name Owner + -> Name Repo + -> Id WorkflowRun + -> Id RunAttempt + -> GenRequest 'MtRedirect 'RO URI +downloadWorkflowRunAttemptLogsR user repo run attempt = Query + ["repos", toPathPart user, toPathPart repo, "actions", "runs", toPathPart run, "attempts", toPathPart attempt, "logs"] + [] + +-- | Cancel a workflow run. +-- See +cancelWorkflowRunR + :: Name Owner + -> Name Repo + -> Id WorkflowRun + -> GenRequest 'MtUnit 'RW () +cancelWorkflowRunR user repo run = Command Post + ["repos", toPathPart user, toPathPart repo, "actions", "runs", toPathPart run, "cancel"] + mempty + +-- | Download workflow run logs. +-- See +downloadWorkflowRunLogsR + :: Name Owner + -> Name Repo + -> Id WorkflowRun + -> GenRequest 'MtRedirect 'RA URI +downloadWorkflowRunLogsR user repo run = Query + ["repos", toPathPart user, toPathPart repo, "actions", "runs", toPathPart run, "logs"] + [] + +-- | Delete workflow run logs. +-- See +deleteWorkflowRunLogsR + :: Name Owner + -> Name Repo + -> Id WorkflowRun + -> GenRequest 'MtUnit 'RW () +deleteWorkflowRunLogsR user repo run = Command Delete + ["repos", toPathPart user, toPathPart repo, "actions", "runs", toPathPart run, "logs"] + mempty + +-- | Re-run a workflow. +-- See +reRunWorkflowR + :: Name Owner + -> Name Repo + -> Id WorkflowRun + -> GenRequest 'MtUnit 'RW () +reRunWorkflowR user repo run = Command Post + ["repos", toPathPart user, toPathPart repo, "actions", "runs", toPathPart run, "rerun"] + mempty + +-- | Re-run failed jobs from a workflow run. +-- See +reRunFailedJobsR + :: Name Owner + -> Name Repo + -> Id WorkflowRun + -> GenRequest 'MtUnit 'RW () +reRunFailedJobsR user repo run = Command Post + ["repos", toPathPart user, toPathPart repo, "actions", "runs", toPathPart run, "rerun-failed-jobs"] + mempty + +-- | List workflow runs for a workflow. +-- See +workflowRunsForWorkflowR + :: (IsPathPart idOrName) => Name Owner + -> Name Repo + -> idOrName + -> WorkflowRunMod + -> FetchCount + -> GenRequest 'MtJSON 'RA (WithTotalCount WorkflowRun) +workflowRunsForWorkflowR user repo idOrName runMod = PagedQuery + ["repos", toPathPart user, toPathPart repo, "actions", "workflows", toPathPart idOrName, "runs"] + (workflowRunModToQueryString runMod) diff --git a/src/GitHub/Endpoints/Actions/Workflows.hs b/src/GitHub/Endpoints/Actions/Workflows.hs new file mode 100644 index 00000000..998a88b4 --- /dev/null +++ b/src/GitHub/Endpoints/Actions/Workflows.hs @@ -0,0 +1,68 @@ +module GitHub.Endpoints.Actions.Workflows ( + repositoryWorkflowsR, + workflowR, + disableWorkflowR, + triggerWorkflowR, + enableWorkflowR, + module GitHub.Data + ) where + +import GitHub.Data +import GitHub.Internal.Prelude +import Prelude () + +-- | List repository workflows. +-- See +repositoryWorkflowsR + :: Name Owner + -> Name Repo + -> FetchCount + -> GenRequest 'MtJSON 'RA (WithTotalCount Workflow) +repositoryWorkflowsR user repo = PagedQuery + ["repos", toPathPart user, toPathPart repo, "actions", "workflows"] + [] + +-- | Get a workflow. +-- See +workflowR + :: (IsPathPart idOrName) => Name Owner + -> Name Repo + -> idOrName + -> GenRequest 'MtJSON 'RA Workflow +workflowR user repo idOrName = Query + ["repos", toPathPart user, toPathPart repo, "actions", "workflows", toPathPart idOrName] + [] + +-- | Disable a workflow. +-- See +disableWorkflowR + :: (IsPathPart idOrName) => Name Owner + -> Name Repo + -> idOrName + -> GenRequest 'MtUnit 'RW () +disableWorkflowR user repo idOrName = Command Put + ["repos", toPathPart user, toPathPart repo, "actions", "workflows", toPathPart idOrName, "disable"] + mempty + +-- | Create a workflow dispatch event. +-- See +triggerWorkflowR + :: (ToJSON a, IsPathPart idOrName) => Name Owner + -> Name Repo + -> idOrName + -> CreateWorkflowDispatchEvent a + -> GenRequest 'MtUnit 'RW () +triggerWorkflowR user repo idOrName = Command Post + ["repos", toPathPart user, toPathPart repo, "actions", "workflows", toPathPart idOrName, "dispatches"] + . encode + +-- | Enable a workflow. +-- See +enableWorkflowR + :: (IsPathPart idOrName) => Name Owner + -> Name Repo + -> idOrName + -> GenRequest 'MtUnit 'RW () +enableWorkflowR user repo idOrName = Command Put + ["repos", toPathPart user, toPathPart repo, "actions", "workflows", toPathPart idOrName, "enable"] + mempty From f701d4108eb9f68277ccba9b2a9dade443899ae3 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Tue, 27 Jun 2023 22:45:06 +0200 Subject: [PATCH 481/510] v0.29 revision 1: allow aeson-2.2 --- github.cabal | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/github.cabal b/github.cabal index 5f94c430..e8dd34aa 100644 --- a/github.cabal +++ b/github.cabal @@ -1,6 +1,7 @@ cabal-version: 2.4 name: github version: 0.29 +x-revision: 1 synopsis: Access to the GitHub API, v3. category: Network description: @@ -197,7 +198,7 @@ library -- other packages build-depends: - aeson >=1.4.0.0 && <1.6 || >=2.0.1.0 && <2.2 + aeson >=1.4.0.0 && <1.6 || >=2.0.1.0 && <2.3 , base-compat >=0.11.1 && <0.14 , base16-bytestring >=0.1.1.6 && <1.1 , binary-instances >=1 && <1.1 From d94e93a7aa0f5345b510be4b7949420cd7879eb5 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Sun, 16 Jul 2023 20:27:39 +0200 Subject: [PATCH 482/510] v0.29 revision 2: allow bytestring-0.12 --- github.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/github.cabal b/github.cabal index e8dd34aa..6c3b1d76 100644 --- a/github.cabal +++ b/github.cabal @@ -1,7 +1,7 @@ cabal-version: 2.4 name: github version: 0.29 -x-revision: 1 +x-revision: 2 synopsis: Access to the GitHub API, v3. category: Network description: @@ -188,7 +188,7 @@ library build-depends: base >=4.7 && <5 , binary >=0.7.1.0 && <0.11 - , bytestring >=0.10.4.0 && <0.12 + , bytestring >=0.10.4.0 && <0.13 , containers >=0.5.5.1 && <0.7 , deepseq >=1.3.0.2 && <1.5 , mtl >=2.1.3.1 && <2.2 || >=2.2.1 && <2.4 From 7ba08645b601195c227c4b2491fc2b84549364ab Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Thu, 3 Aug 2023 12:13:44 +0200 Subject: [PATCH 483/510] v0.29-r3: allow deepseq-1.5 for GHC 9.8 --- github.cabal | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/github.cabal b/github.cabal index 6c3b1d76..69b1ffbf 100644 --- a/github.cabal +++ b/github.cabal @@ -1,7 +1,7 @@ cabal-version: 2.4 name: github version: 0.29 -x-revision: 2 +x-revision: 3 synopsis: Access to the GitHub API, v3. category: Network description: @@ -190,7 +190,8 @@ library , binary >=0.7.1.0 && <0.11 , bytestring >=0.10.4.0 && <0.13 , containers >=0.5.5.1 && <0.7 - , deepseq >=1.3.0.2 && <1.5 + , deepseq >=1.3.0.2 && <1.6 + , exceptions >=0.10.2 && <0.11 , mtl >=2.1.3.1 && <2.2 || >=2.2.1 && <2.4 , text >=1.2.0.6 && <2.1 , time-compat >=1.9.2.2 && <1.10 @@ -204,7 +205,6 @@ library , binary-instances >=1 && <1.1 , cryptohash-sha1 >=0.11.100.1 && <0.12 , deepseq-generics >=0.2.0.0 && <0.3 - , exceptions >=0.10.2 && <0.11 , hashable >=1.2.7.0 && <1.5 , http-client >=0.5.12 && <0.8 , http-link-header >=1.0.3.1 && <1.3 From c0ce867ce3fc8368173f8698a67e533924b97f75 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Sat, 30 Sep 2023 12:59:19 +0200 Subject: [PATCH 484/510] v0.29-r4: allow containers-0.7 and text-2.1 The former is also tested by a constraint-set in CI. (The latter cannot atm because of aeson's incompatibility with text-2.1.) --- .github/workflows/haskell-ci.yml | 72 ++++++++++++++++++++++---------- cabal.haskell-ci | 13 +++++- github.cabal | 12 +++--- samples/github-samples.cabal | 5 ++- 4 files changed, 70 insertions(+), 32 deletions(-) diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index b5d24eb9..64853c33 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -6,22 +6,20 @@ # # haskell-ci regenerate # -# For more information, see https://github.com/haskell-CI/haskell-ci +# For more information, see https://github.com/andreasabel/haskell-ci # -# version: 0.16.4 +# version: 0.17.20230928 # -# REGENDATA ("0.16.4",["--config=cabal.haskell-ci","github","cabal.project"]) +# REGENDATA ("0.17.20230928",["--config=cabal.haskell-ci","github","cabal.project"]) # name: Haskell-CI on: push: branches: - master - - ci* pull_request: branches: - master - - ci* jobs: linux: name: Haskell-CI - Linux - ${{ matrix.compiler }} @@ -29,19 +27,24 @@ jobs: timeout-minutes: 60 container: - image: buildpack-deps:bionic + image: buildpack-deps:focal continue-on-error: ${{ matrix.allow-failure }} strategy: matrix: include: - - compiler: ghc-9.6.2 + - compiler: ghc-9.8.0.20230919 compilerKind: ghc - compilerVersion: 9.6.2 + compilerVersion: 9.8.0.20230919 + setup-method: ghcup + allow-failure: true + - compiler: ghc-9.6.3 + compilerKind: ghc + compilerVersion: 9.6.3 setup-method: ghcup allow-failure: false - - compiler: ghc-9.4.5 + - compiler: ghc-9.4.7 compilerKind: ghc - compilerVersion: 9.4.5 + compilerVersion: 9.4.7 setup-method: ghcup allow-failure: false - compiler: ghc-9.2.8 @@ -89,11 +92,6 @@ jobs: compilerVersion: 7.10.3 setup-method: hvr-ppa allow-failure: false - - compiler: ghc-7.8.4 - compilerKind: ghc - compilerVersion: 7.8.4 - setup-method: hvr-ppa - allow-failure: false fail-fast: false steps: - name: apt @@ -102,8 +100,9 @@ jobs: apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5 if [ "${{ matrix.setup-method }}" = ghcup ]; then mkdir -p "$HOME/.ghcup/bin" - curl -sL https://downloads.haskell.org/ghcup/0.1.19.2/x86_64-linux-ghcup-0.1.19.2 > "$HOME/.ghcup/bin/ghcup" + curl -sL https://downloads.haskell.org/ghcup/0.1.19.5/x86_64-linux-ghcup-0.1.19.5 > "$HOME/.ghcup/bin/ghcup" chmod a+x "$HOME/.ghcup/bin/ghcup" + "$HOME/.ghcup/bin/ghcup" config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml; "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false) "$HOME/.ghcup/bin/ghcup" install cabal 3.10.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false) else @@ -111,8 +110,9 @@ jobs: apt-get update apt-get install -y "$HCNAME" mkdir -p "$HOME/.ghcup/bin" - curl -sL https://downloads.haskell.org/ghcup/0.1.19.2/x86_64-linux-ghcup-0.1.19.2 > "$HOME/.ghcup/bin/ghcup" + curl -sL https://downloads.haskell.org/ghcup/0.1.19.5/x86_64-linux-ghcup-0.1.19.5 > "$HOME/.ghcup/bin/ghcup" chmod a+x "$HOME/.ghcup/bin/ghcup" + "$HOME/.ghcup/bin/ghcup" config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml; "$HOME/.ghcup/bin/ghcup" install cabal 3.10.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false) fi env: @@ -127,10 +127,12 @@ jobs: echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV" HCDIR=/opt/$HCKIND/$HCVER if [ "${{ matrix.setup-method }}" = ghcup ]; then - HC=$HOME/.ghcup/bin/$HCKIND-$HCVER + HC=$("$HOME/.ghcup/bin/ghcup" whereis ghc "$HCVER") + HCPKG=$(echo "$HC" | sed 's#ghc$#ghc-pkg#') + HADDOCK=$(echo "$HC" | sed 's#ghc$#haddock#') echo "HC=$HC" >> "$GITHUB_ENV" - echo "HCPKG=$HOME/.ghcup/bin/$HCKIND-pkg-$HCVER" >> "$GITHUB_ENV" - echo "HADDOCK=$HOME/.ghcup/bin/haddock-$HCVER" >> "$GITHUB_ENV" + echo "HCPKG=$HCPKG" >> "$GITHUB_ENV" + echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV" echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.1.0 -vnormal+nowrap" >> "$GITHUB_ENV" else HC=$HCDIR/bin/$HCKIND @@ -144,7 +146,7 @@ jobs: echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV" echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV" echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV" - echo "HEADHACKAGE=false" >> "$GITHUB_ENV" + if [ $((HCNUMVER >= 90800)) -ne 0 ] ; then echo "HEADHACKAGE=true" >> "$GITHUB_ENV" ; else echo "HEADHACKAGE=false" >> "$GITHUB_ENV" ; fi echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV" echo "GHCJSARITH=0" >> "$GITHUB_ENV" env: @@ -173,6 +175,18 @@ jobs: repository hackage.haskell.org url: http://hackage.haskell.org/ EOF + if $HEADHACKAGE; then + cat >> $CABAL_CONFIG <> $CABAL_CONFIG <> cabal.project + fi $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: $_ installed\n" unless /^(github|github-samples)$/; }' >> cabal.project.local cat cabal.project cat cabal.project.local @@ -273,6 +291,16 @@ jobs: run: | rm -f cabal.project.local $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all + - name: prepare for constraint sets + run: | + rm -f cabal.project.local + - name: constraint set containers-0.7 + run: | + if [ $((HCNUMVER >= 90000)) -ne 0 ] ; then $CABAL v2-build $ARG_COMPILER --enable-tests --disable-benchmarks --constraint='containers >= 0.7' all --dry-run ; fi + if [ $((HCNUMVER >= 90000)) -ne 0 ] ; then cabal-plan topo | sort ; fi + if [ $((HCNUMVER >= 90000)) -ne 0 ] ; then $CABAL v2-build $ARG_COMPILER --enable-tests --disable-benchmarks --constraint='containers >= 0.7' --dependencies-only -j2 all ; fi + if [ $((HCNUMVER >= 90000)) -ne 0 ] ; then $CABAL v2-build $ARG_COMPILER --enable-tests --disable-benchmarks --constraint='containers >= 0.7' all ; fi + if [ $((HCNUMVER >= 90000)) -ne 0 ] ; then $CABAL v2-test $ARG_COMPILER --enable-tests --disable-benchmarks --constraint='containers >= 0.7' all ; fi - name: save cache uses: actions/cache/save@v3 if: always() diff --git a/cabal.haskell-ci b/cabal.haskell-ci index a3ce9738..6c697b60 100644 --- a/cabal.haskell-ci +++ b/cabal.haskell-ci @@ -1,4 +1,4 @@ -branches: master ci* +branches: master haddock: >=8.6 -- See PR #355: haddocks for GADT constructor arguments only supported from GHC 8.6 jobs-selection: any @@ -10,4 +10,13 @@ jobs-selection: any -- constraint-set text-2.0 -- constraints: text >= 2.0 --- allow-newer: *:text -- allow-newer not supported \ No newline at end of file +-- allow-newer: *:text -- allow-newer not supported + +constraint-set containers-0.7 + ghc: >= 9 + constraints: containers >= 0.7 + tests: True + run-tests: True + +raw-project + allow-newer: containers diff --git a/github.cabal b/github.cabal index 69b1ffbf..225c6c17 100644 --- a/github.cabal +++ b/github.cabal @@ -1,7 +1,7 @@ cabal-version: 2.4 name: github version: 0.29 -x-revision: 3 +x-revision: 4 synopsis: Access to the GitHub API, v3. category: Network description: @@ -31,8 +31,9 @@ copyright: Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016-2021 Oleg Grenrus tested-with: - GHC == 9.6.2 - GHC == 9.4.5 + GHC == 9.8.0 + GHC == 9.6.3 + GHC == 9.4.7 GHC == 9.2.8 GHC == 9.0.2 GHC == 8.10.7 @@ -42,7 +43,6 @@ tested-with: GHC == 8.2.2 GHC == 8.0.2 GHC == 7.10.3 - GHC == 7.8.4 extra-doc-files: README.md @@ -189,11 +189,11 @@ library base >=4.7 && <5 , binary >=0.7.1.0 && <0.11 , bytestring >=0.10.4.0 && <0.13 - , containers >=0.5.5.1 && <0.7 + , containers >=0.5.5.1 && <0.8 , deepseq >=1.3.0.2 && <1.6 , exceptions >=0.10.2 && <0.11 , mtl >=2.1.3.1 && <2.2 || >=2.2.1 && <2.4 - , text >=1.2.0.6 && <2.1 + , text >=1.2.0.6 && <2.2 , time-compat >=1.9.2.2 && <1.10 , transformers >=0.3.0.0 && <0.7 diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index c3c6813d..3686dcfd 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -10,8 +10,9 @@ description: Various samples of github package build-type: Simple tested-with: - GHC == 9.6.2 - GHC == 9.4.5 + GHC == 9.8.0 + GHC == 9.6.3 + GHC == 9.4.7 GHC == 9.2.8 GHC == 9.0.2 GHC == 8.10.7 From 6b9716c1d397248aa8394d04b386fe763053dcdd Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Tue, 17 Oct 2023 09:29:06 +0200 Subject: [PATCH 485/510] Bump Haskell-CI to GHC 9.8.1 --- .github/workflows/haskell-ci.yml | 39 ++++++++++---------------------- github.cabal | 2 +- samples/github-samples.cabal | 2 +- 3 files changed, 14 insertions(+), 29 deletions(-) diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index 64853c33..5574ac10 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -8,9 +8,9 @@ # # For more information, see https://github.com/andreasabel/haskell-ci # -# version: 0.17.20230928 +# version: 0.17.20231012 # -# REGENDATA ("0.17.20230928",["--config=cabal.haskell-ci","github","cabal.project"]) +# REGENDATA ("0.17.20231012",["--config=cabal.haskell-ci","github","cabal.project"]) # name: Haskell-CI on: @@ -32,11 +32,11 @@ jobs: strategy: matrix: include: - - compiler: ghc-9.8.0.20230919 + - compiler: ghc-9.8.1 compilerKind: ghc - compilerVersion: 9.8.0.20230919 + compilerVersion: 9.8.1 setup-method: ghcup - allow-failure: true + allow-failure: false - compiler: ghc-9.6.3 compilerKind: ghc compilerVersion: 9.6.3 @@ -65,27 +65,27 @@ jobs: - compiler: ghc-8.8.4 compilerKind: ghc compilerVersion: 8.8.4 - setup-method: hvr-ppa + setup-method: ghcup allow-failure: false - compiler: ghc-8.6.5 compilerKind: ghc compilerVersion: 8.6.5 - setup-method: hvr-ppa + setup-method: ghcup allow-failure: false - compiler: ghc-8.4.4 compilerKind: ghc compilerVersion: 8.4.4 - setup-method: hvr-ppa + setup-method: ghcup allow-failure: false - compiler: ghc-8.2.2 compilerKind: ghc compilerVersion: 8.2.2 - setup-method: hvr-ppa + setup-method: ghcup allow-failure: false - compiler: ghc-8.0.2 compilerKind: ghc compilerVersion: 8.0.2 - setup-method: hvr-ppa + setup-method: ghcup allow-failure: false - compiler: ghc-7.10.3 compilerKind: ghc @@ -97,7 +97,7 @@ jobs: - name: apt run: | apt-get update - apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5 + apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5 libnuma-dev if [ "${{ matrix.setup-method }}" = ghcup ]; then mkdir -p "$HOME/.ghcup/bin" curl -sL https://downloads.haskell.org/ghcup/0.1.19.5/x86_64-linux-ghcup-0.1.19.5 > "$HOME/.ghcup/bin/ghcup" @@ -146,7 +146,7 @@ jobs: echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV" echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV" echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV" - if [ $((HCNUMVER >= 90800)) -ne 0 ] ; then echo "HEADHACKAGE=true" >> "$GITHUB_ENV" ; else echo "HEADHACKAGE=false" >> "$GITHUB_ENV" ; fi + echo "HEADHACKAGE=false" >> "$GITHUB_ENV" echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV" echo "GHCJSARITH=0" >> "$GITHUB_ENV" env: @@ -175,18 +175,6 @@ jobs: repository hackage.haskell.org url: http://hackage.haskell.org/ EOF - if $HEADHACKAGE; then - cat >> $CABAL_CONFIG <> $CABAL_CONFIG <> cabal.project - fi $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: $_ installed\n" unless /^(github|github-samples)$/; }' >> cabal.project.local cat cabal.project cat cabal.project.local diff --git a/github.cabal b/github.cabal index 225c6c17..cde8b8ff 100644 --- a/github.cabal +++ b/github.cabal @@ -31,7 +31,7 @@ copyright: Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016-2021 Oleg Grenrus tested-with: - GHC == 9.8.0 + GHC == 9.8.1 GHC == 9.6.3 GHC == 9.4.7 GHC == 9.2.8 diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index 3686dcfd..166a0ce0 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -10,7 +10,7 @@ description: Various samples of github package build-type: Simple tested-with: - GHC == 9.8.0 + GHC == 9.8.1 GHC == 9.6.3 GHC == 9.4.7 GHC == 9.2.8 From ee8b28628552efa230d6a194d2f342e7305e56f8 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Fri, 24 May 2024 00:05:53 +0200 Subject: [PATCH 486/510] Allow base-compat<1, hashable<2, bump CI to GHC 9.10.1 --- .github/workflows/haskell-ci.yml | 88 +++++++++++--------------------- github.cabal | 18 ++++--- samples/github-samples.cabal | 7 +-- 3 files changed, 45 insertions(+), 68 deletions(-) diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index 5574ac10..738964dc 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -8,9 +8,9 @@ # # For more information, see https://github.com/andreasabel/haskell-ci # -# version: 0.17.20231012 +# version: 0.19.20240703 # -# REGENDATA ("0.17.20231012",["--config=cabal.haskell-ci","github","cabal.project"]) +# REGENDATA ("0.19.20240703",["--config=cabal.haskell-ci","github","cabal.project"]) # name: Haskell-CI on: @@ -27,24 +27,29 @@ jobs: timeout-minutes: 60 container: - image: buildpack-deps:focal + image: buildpack-deps:jammy continue-on-error: ${{ matrix.allow-failure }} strategy: matrix: include: - - compiler: ghc-9.8.1 + - compiler: ghc-9.10.1 compilerKind: ghc - compilerVersion: 9.8.1 + compilerVersion: 9.10.1 setup-method: ghcup allow-failure: false - - compiler: ghc-9.6.3 + - compiler: ghc-9.8.2 compilerKind: ghc - compilerVersion: 9.6.3 + compilerVersion: 9.8.2 setup-method: ghcup allow-failure: false - - compiler: ghc-9.4.7 + - compiler: ghc-9.6.6 compilerKind: ghc - compilerVersion: 9.4.7 + compilerVersion: 9.6.6 + setup-method: ghcup + allow-failure: false + - compiler: ghc-9.4.8 + compilerKind: ghc + compilerVersion: 9.4.8 setup-method: ghcup allow-failure: false - compiler: ghc-9.2.8 @@ -82,39 +87,17 @@ jobs: compilerVersion: 8.2.2 setup-method: ghcup allow-failure: false - - compiler: ghc-8.0.2 - compilerKind: ghc - compilerVersion: 8.0.2 - setup-method: ghcup - allow-failure: false - - compiler: ghc-7.10.3 - compilerKind: ghc - compilerVersion: 7.10.3 - setup-method: hvr-ppa - allow-failure: false fail-fast: false steps: - name: apt run: | apt-get update apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5 libnuma-dev - if [ "${{ matrix.setup-method }}" = ghcup ]; then - mkdir -p "$HOME/.ghcup/bin" - curl -sL https://downloads.haskell.org/ghcup/0.1.19.5/x86_64-linux-ghcup-0.1.19.5 > "$HOME/.ghcup/bin/ghcup" - chmod a+x "$HOME/.ghcup/bin/ghcup" - "$HOME/.ghcup/bin/ghcup" config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml; - "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false) - "$HOME/.ghcup/bin/ghcup" install cabal 3.10.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false) - else - apt-add-repository -y 'ppa:hvr/ghc' - apt-get update - apt-get install -y "$HCNAME" - mkdir -p "$HOME/.ghcup/bin" - curl -sL https://downloads.haskell.org/ghcup/0.1.19.5/x86_64-linux-ghcup-0.1.19.5 > "$HOME/.ghcup/bin/ghcup" - chmod a+x "$HOME/.ghcup/bin/ghcup" - "$HOME/.ghcup/bin/ghcup" config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml; - "$HOME/.ghcup/bin/ghcup" install cabal 3.10.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false) - fi + mkdir -p "$HOME/.ghcup/bin" + curl -sL https://downloads.haskell.org/ghcup/0.1.20.0/x86_64-linux-ghcup-0.1.20.0 > "$HOME/.ghcup/bin/ghcup" + chmod a+x "$HOME/.ghcup/bin/ghcup" + "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false) + "$HOME/.ghcup/bin/ghcup" install cabal 3.12.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false) env: HCKIND: ${{ matrix.compilerKind }} HCNAME: ${{ matrix.compiler }} @@ -126,22 +109,13 @@ jobs: echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV" echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV" HCDIR=/opt/$HCKIND/$HCVER - if [ "${{ matrix.setup-method }}" = ghcup ]; then - HC=$("$HOME/.ghcup/bin/ghcup" whereis ghc "$HCVER") - HCPKG=$(echo "$HC" | sed 's#ghc$#ghc-pkg#') - HADDOCK=$(echo "$HC" | sed 's#ghc$#haddock#') - echo "HC=$HC" >> "$GITHUB_ENV" - echo "HCPKG=$HCPKG" >> "$GITHUB_ENV" - echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV" - echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.1.0 -vnormal+nowrap" >> "$GITHUB_ENV" - else - HC=$HCDIR/bin/$HCKIND - echo "HC=$HC" >> "$GITHUB_ENV" - echo "HCPKG=$HCDIR/bin/$HCKIND-pkg" >> "$GITHUB_ENV" - echo "HADDOCK=$HCDIR/bin/haddock" >> "$GITHUB_ENV" - echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.1.0 -vnormal+nowrap" >> "$GITHUB_ENV" - fi - + HC=$("$HOME/.ghcup/bin/ghcup" whereis ghc "$HCVER") + HCPKG=$(echo "$HC" | sed 's#ghc$#ghc-pkg#') + HADDOCK=$(echo "$HC" | sed 's#ghc$#haddock#') + echo "HC=$HC" >> "$GITHUB_ENV" + echo "HCPKG=$HCPKG" >> "$GITHUB_ENV" + echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV" + echo "CABAL=$HOME/.ghcup/bin/cabal-3.12.1.0 -vnormal+nowrap" >> "$GITHUB_ENV" HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))') echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV" echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV" @@ -226,8 +200,8 @@ jobs: touch cabal.project.local echo "packages: ${PKGDIR_github}" >> cabal.project if [ $((HCNUMVER >= 80400)) -ne 0 ] ; then echo "packages: ${PKGDIR_github_samples}" >> cabal.project ; fi - if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo "package github" >> cabal.project ; fi - if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods" >> cabal.project ; fi + echo "package github" >> cabal.project + echo " ghc-options: -Werror=missing-methods" >> cabal.project if [ $((HCNUMVER >= 80400)) -ne 0 ] ; then echo "package github-samples" >> cabal.project ; fi if [ $((HCNUMVER >= 80400)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods" >> cabal.project ; fi cat >> cabal.project <> cabal.project.local + $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: any.$_ installed\n" unless /^(github|github-samples)$/; }' >> cabal.project.local cat cabal.project cat cabal.project.local - name: dump install plan @@ -245,7 +219,7 @@ jobs: $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all cabal-plan - name: restore cache - uses: actions/cache/restore@v3 + uses: actions/cache/restore@v4 with: key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }} path: ~/.cabal/store @@ -287,7 +261,7 @@ jobs: if [ $((HCNUMVER >= 90000)) -ne 0 ] ; then $CABAL v2-build $ARG_COMPILER --enable-tests --disable-benchmarks --constraint='containers >= 0.7' all ; fi if [ $((HCNUMVER >= 90000)) -ne 0 ] ; then $CABAL v2-test $ARG_COMPILER --enable-tests --disable-benchmarks --constraint='containers >= 0.7' all ; fi - name: save cache - uses: actions/cache/save@v3 + uses: actions/cache/save@v4 if: always() with: key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }} diff --git a/github.cabal b/github.cabal index cde8b8ff..eb835470 100644 --- a/github.cabal +++ b/github.cabal @@ -1,7 +1,7 @@ cabal-version: 2.4 name: github version: 0.29 -x-revision: 4 +x-revision: 5 synopsis: Access to the GitHub API, v3. category: Network description: @@ -31,9 +31,10 @@ copyright: Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016-2021 Oleg Grenrus tested-with: - GHC == 9.8.1 - GHC == 9.6.3 - GHC == 9.4.7 + GHC == 9.10.1 + GHC == 9.8.2 + GHC == 9.6.6 + GHC == 9.4.8 GHC == 9.2.8 GHC == 9.0.2 GHC == 8.10.7 @@ -41,8 +42,9 @@ tested-with: GHC == 8.6.5 GHC == 8.4.4 GHC == 8.2.2 - GHC == 8.0.2 - GHC == 7.10.3 + -- Build failure of HsOpenSSL with GHC 8.0 + -- https://github.com/haskell-cryptography/HsOpenSSL/issues/97 + -- GHC == 8.0.2 extra-doc-files: README.md @@ -200,12 +202,12 @@ library -- other packages build-depends: aeson >=1.4.0.0 && <1.6 || >=2.0.1.0 && <2.3 - , base-compat >=0.11.1 && <0.14 + , base-compat >=0.11.1 && <1 , base16-bytestring >=0.1.1.6 && <1.1 , binary-instances >=1 && <1.1 , cryptohash-sha1 >=0.11.100.1 && <0.12 , deepseq-generics >=0.2.0.0 && <0.3 - , hashable >=1.2.7.0 && <1.5 + , hashable >=1.2.7.0 && <2 , http-client >=0.5.12 && <0.8 , http-link-header >=1.0.3.1 && <1.3 , http-types >=0.12.3 && <0.13 diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index 166a0ce0..ced03e5e 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -10,9 +10,10 @@ description: Various samples of github package build-type: Simple tested-with: - GHC == 9.8.1 - GHC == 9.6.3 - GHC == 9.4.7 + GHC == 9.10.1 + GHC == 9.8.2 + GHC == 9.6.6 + GHC == 9.4.8 GHC == 9.2.8 GHC == 9.0.2 GHC == 8.10.7 From 415e4748bf5d38434ae143a3520d3bc6d5c27cdf Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Thu, 17 Oct 2024 22:28:09 +0200 Subject: [PATCH 487/510] Drop support for GHC 8.0 and below --- CHANGELOG.md | 7 +++++++ github.cabal | 21 ++++++--------------- samples/Operational/Operational.hs | 2 +- src/GitHub/Data.hs | 2 -- src/GitHub/Data/Name.hs | 5 ----- src/GitHub/Data/RateLimit.hs | 2 +- src/GitHub/Data/Repos.hs | 22 ---------------------- src/GitHub/Data/Request.hs | 1 - src/GitHub/Endpoints/Issues.hs | 2 -- src/GitHub/Endpoints/Repos/Comments.hs | 2 -- src/GitHub/Endpoints/Repos/Commits.hs | 2 -- src/GitHub/Internal/Prelude.hs | 3 +-- 12 files changed, 16 insertions(+), 55 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 0926cfee..e090d021 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,10 @@ +## Changes for 0.29.1 + +- Drop support for GHC 8.0 and below. +- Drop dependency `time-compat`. + +Tested with GHC 8.2 - 9.10.1. + ## Changes for 0.29 _2023-06-24, Andreas Abel, Midsommar edition_ diff --git a/github.cabal b/github.cabal index eb835470..d4d2d930 100644 --- a/github.cabal +++ b/github.cabal @@ -1,7 +1,6 @@ cabal-version: 2.4 name: github -version: 0.29 -x-revision: 5 +version: 0.29.1 synopsis: Access to the GitHub API, v3. category: Network description: @@ -42,9 +41,6 @@ tested-with: GHC == 8.6.5 GHC == 8.4.4 GHC == 8.2.2 - -- Build failure of HsOpenSSL with GHC 8.0 - -- https://github.com/haskell-cryptography/HsOpenSSL/issues/97 - -- GHC == 8.0.2 extra-doc-files: README.md @@ -66,11 +62,9 @@ library default-language: Haskell2010 ghc-options: -Wall - if impl(ghc >= 8.0) - ghc-options: - -Wcompat - -Wno-star-is-type - -- The star-is-type warning cannot be sensiblity addressed while supporting GHC 7. + -Wcompat + -Wno-star-is-type + -- The star-is-type warning cannot be sensiblity addressed while supporting GHC 7. hs-source-dirs: src default-extensions: DataKinds @@ -188,7 +182,7 @@ library -- Packages bundles with GHC, mtl and text are also here build-depends: - base >=4.7 && <5 + base >=4.10 && <5 , binary >=0.7.1.0 && <0.11 , bytestring >=0.10.4.0 && <0.13 , containers >=0.5.5.1 && <0.8 @@ -196,7 +190,7 @@ library , exceptions >=0.10.2 && <0.11 , mtl >=2.1.3.1 && <2.2 || >=2.2.1 && <2.4 , text >=1.2.0.6 && <2.2 - , time-compat >=1.9.2.2 && <1.10 + , time >=1.8.0.2 && <2 , transformers >=0.3.0.0 && <0.7 -- other packages @@ -229,9 +223,6 @@ library http-client-tls >=0.3.5.3 && <0.4 , tls >=1.4.1 - if !impl(ghc >=8.0) - build-depends: semigroups >=0.18.5 && <0.20 - test-suite github-test default-language: Haskell2010 type: exitcode-stdio-1.0 diff --git a/samples/Operational/Operational.hs b/samples/Operational/Operational.hs index cbfc9fb4..1fc7f897 100644 --- a/samples/Operational/Operational.hs +++ b/samples/Operational/Operational.hs @@ -1,7 +1,7 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-} + module Main (main) where import Common diff --git a/src/GitHub/Data.hs b/src/GitHub/Data.hs index 20ebe7fd..740c6837 100644 --- a/src/GitHub/Data.hs +++ b/src/GitHub/Data.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE CPP #-} - -- | -- This module re-exports the @GitHub.Data.@ and "GitHub.Auth" submodules. diff --git a/src/GitHub/Data/Name.hs b/src/GitHub/Data/Name.hs index dbc09653..99554287 100644 --- a/src/GitHub/Data/Name.hs +++ b/src/GitHub/Data/Name.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} module GitHub.Data.Name ( Name(..), mkName, @@ -8,10 +7,8 @@ module GitHub.Data.Name ( import Prelude () import GitHub.Internal.Prelude -#if MIN_VERSION_aeson(1,0,0) import Data.Aeson.Types (FromJSONKey (..), ToJSONKey (..), fromJSONKeyCoerce, toJSONKeyText) -#endif newtype Name entity = N Text deriving (Eq, Ord, Show, Generic, Typeable, Data) @@ -38,7 +35,6 @@ instance ToJSON (Name entity) where instance IsString (Name entity) where fromString = N . fromString -#if MIN_VERSION_aeson(1,0,0) -- | @since 0.15.0.0 instance ToJSONKey (Name entity) where toJSONKey = toJSONKeyText untagName @@ -46,4 +42,3 @@ instance ToJSONKey (Name entity) where -- | @since 0.15.0.0 instance FromJSONKey (Name entity) where fromJSONKey = fromJSONKeyCoerce -#endif diff --git a/src/GitHub/Data/RateLimit.hs b/src/GitHub/Data/RateLimit.hs index 2db078af..4e0b549c 100644 --- a/src/GitHub/Data/RateLimit.hs +++ b/src/GitHub/Data/RateLimit.hs @@ -3,7 +3,7 @@ module GitHub.Data.RateLimit where import GitHub.Internal.Prelude import Prelude () -import Data.Time.Clock.System.Compat (SystemTime (..)) +import Data.Time.Clock.System (SystemTime (..)) import qualified Data.ByteString.Char8 as BS8 import qualified Network.HTTP.Client as HTTP diff --git a/src/GitHub/Data/Repos.hs b/src/GitHub/Data/Repos.hs index 98c254c2..456775b6 100644 --- a/src/GitHub/Data/Repos.hs +++ b/src/GitHub/Data/Repos.hs @@ -1,6 +1,4 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} -#define UNSAFE 1 -- | -- This module also exports @@ -19,13 +17,7 @@ import Prelude () import qualified Data.HashMap.Strict as HM import qualified Data.Text as T -#if MIN_VERSION_aeson(1,0,0) import Data.Aeson.Types (FromJSONKey (..), fromJSONKeyCoerce) -#else -#ifdef UNSAFE -import Unsafe.Coerce (unsafeCoerce) -#endif -#endif data Repo = Repo { repoId :: !(Id Repo) @@ -383,22 +375,8 @@ instance FromJSON Language where instance ToJSON Language where toJSON = toJSON . getLanguage -#if MIN_VERSION_aeson(1,0,0) instance FromJSONKey Language where fromJSONKey = fromJSONKeyCoerce -#else -instance FromJSON a => FromJSON (HM.HashMap Language a) where - parseJSON = fmap mapKeyLanguage . parseJSON - where - mapKeyLanguage :: HM.HashMap Text a -> HM.HashMap Language a -#ifdef UNSAFE - mapKeyLanguage = unsafeCoerce -#else - mapKeyLanguage = mapKey Language - mapKey :: (Eq k2, Hashable k2) => (k1 -> k2) -> HM.HashMap k1 a -> HM.HashMap k2 a - mapKey f = HM.fromList . map (first f) . HM.toList -#endif -#endif data ArchiveFormat = ArchiveFormatTarball -- ^ ".tar.gz" format diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs index 445c4223..7b4eac40 100644 --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} diff --git a/src/GitHub/Endpoints/Issues.hs b/src/GitHub/Endpoints/Issues.hs index 9cd7258f..47888dc5 100644 --- a/src/GitHub/Endpoints/Issues.hs +++ b/src/GitHub/Endpoints/Issues.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE CPP #-} - -- | -- The issues API as described on . diff --git a/src/GitHub/Endpoints/Repos/Comments.hs b/src/GitHub/Endpoints/Repos/Comments.hs index 371288e3..bd554492 100644 --- a/src/GitHub/Endpoints/Repos/Comments.hs +++ b/src/GitHub/Endpoints/Repos/Comments.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE CPP #-} - -- | -- The repo commits API as described on -- . diff --git a/src/GitHub/Endpoints/Repos/Commits.hs b/src/GitHub/Endpoints/Repos/Commits.hs index 3a10e0a9..1c50c651 100644 --- a/src/GitHub/Endpoints/Repos/Commits.hs +++ b/src/GitHub/Endpoints/Repos/Commits.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE CPP #-} - -- | -- The repo commits API as described on -- . diff --git a/src/GitHub/Internal/Prelude.hs b/src/GitHub/Internal/Prelude.hs index 0419d934..d6efaf39 100644 --- a/src/GitHub/Internal/Prelude.hs +++ b/src/GitHub/Internal/Prelude.hs @@ -1,5 +1,4 @@ {-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE CPP #-} -- | -- This module may change between minor releases. Do not rely on its contents. @@ -24,7 +23,7 @@ import Data.Maybe as X (catMaybes) import Data.Semigroup as X (Semigroup (..)) import Data.String as X (IsString (..)) import Data.Text as X (Text, pack, unpack) -import Data.Time.Compat as X (UTCTime) +import Data.Time as X (UTCTime) import Data.Time.ISO8601 as X (formatISO8601) import Data.Vector as X (Vector) import GHC.Generics as X (Generic) From a71ddecb90f091349827a6aea8a856ea5bb11bc3 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Mon, 11 Nov 2024 17:42:45 +0100 Subject: [PATCH 488/510] Bump CI to GHC 9.12.1 --- .github/workflows/haskell-ci.yml | 73 +++++++++++++++++++------------- cabal.haskell-ci | 14 +++--- github.cabal | 3 +- samples/github-samples.cabal | 7 +-- 4 files changed, 57 insertions(+), 40 deletions(-) diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index 738964dc..ea643e3f 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -8,9 +8,9 @@ # # For more information, see https://github.com/andreasabel/haskell-ci # -# version: 0.19.20240703 +# version: 0.19.20241219 # -# REGENDATA ("0.19.20240703",["--config=cabal.haskell-ci","github","cabal.project"]) +# REGENDATA ("0.19.20241219",["--config=cabal.haskell-ci","github","cabal.project"]) # name: Haskell-CI on: @@ -32,14 +32,19 @@ jobs: strategy: matrix: include: + - compiler: ghc-9.12.1 + compilerKind: ghc + compilerVersion: 9.12.1 + setup-method: ghcup + allow-failure: false - compiler: ghc-9.10.1 compilerKind: ghc compilerVersion: 9.10.1 setup-method: ghcup allow-failure: false - - compiler: ghc-9.8.2 + - compiler: ghc-9.8.4 compilerKind: ghc - compilerVersion: 9.8.2 + compilerVersion: 9.8.4 setup-method: ghcup allow-failure: false - compiler: ghc-9.6.6 @@ -89,15 +94,30 @@ jobs: allow-failure: false fail-fast: false steps: - - name: apt + - name: apt-get install run: | apt-get update apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5 libnuma-dev + - name: Install GHCup + run: | mkdir -p "$HOME/.ghcup/bin" - curl -sL https://downloads.haskell.org/ghcup/0.1.20.0/x86_64-linux-ghcup-0.1.20.0 > "$HOME/.ghcup/bin/ghcup" + curl -sL https://downloads.haskell.org/ghcup/0.1.30.0/x86_64-linux-ghcup-0.1.30.0 > "$HOME/.ghcup/bin/ghcup" chmod a+x "$HOME/.ghcup/bin/ghcup" + - name: Install cabal-install (prerelease) + run: | + "$HOME/.ghcup/bin/ghcup" config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.8.yaml; + "$HOME/.ghcup/bin/ghcup" install cabal 3.15.0.0.2024.10.3 || (cat "$HOME"/.ghcup/logs/*.* && false) + echo "CABAL=$HOME/.ghcup/bin/cabal-3.15.0.0.2024.10.3 -vnormal+nowrap" >> "$GITHUB_ENV" + - name: Install GHC (GHCup) + if: matrix.setup-method == 'ghcup' + run: | "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false) - "$HOME/.ghcup/bin/ghcup" install cabal 3.12.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false) + HC=$("$HOME/.ghcup/bin/ghcup" whereis ghc "$HCVER") + HCPKG=$(echo "$HC" | sed 's#ghc$#ghc-pkg#') + HADDOCK=$(echo "$HC" | sed 's#ghc$#haddock#') + echo "HC=$HC" >> "$GITHUB_ENV" + echo "HCPKG=$HCPKG" >> "$GITHUB_ENV" + echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV" env: HCKIND: ${{ matrix.compilerKind }} HCNAME: ${{ matrix.compiler }} @@ -108,21 +128,12 @@ jobs: echo "LANG=C.UTF-8" >> "$GITHUB_ENV" echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV" echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV" - HCDIR=/opt/$HCKIND/$HCVER - HC=$("$HOME/.ghcup/bin/ghcup" whereis ghc "$HCVER") - HCPKG=$(echo "$HC" | sed 's#ghc$#ghc-pkg#') - HADDOCK=$(echo "$HC" | sed 's#ghc$#haddock#') - echo "HC=$HC" >> "$GITHUB_ENV" - echo "HCPKG=$HCPKG" >> "$GITHUB_ENV" - echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV" - echo "CABAL=$HOME/.ghcup/bin/cabal-3.12.1.0 -vnormal+nowrap" >> "$GITHUB_ENV" HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))') echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV" echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV" echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV" - echo "HEADHACKAGE=false" >> "$GITHUB_ENV" + if [ $((HCNUMVER >= 91200)) -ne 0 ] ; then echo "HEADHACKAGE=true" >> "$GITHUB_ENV" ; else echo "HEADHACKAGE=false" >> "$GITHUB_ENV" ; fi echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV" - echo "GHCJSARITH=0" >> "$GITHUB_ENV" env: HCKIND: ${{ matrix.compilerKind }} HCNAME: ${{ matrix.compiler }} @@ -149,6 +160,18 @@ jobs: repository hackage.haskell.org url: http://hackage.haskell.org/ EOF + if $HEADHACKAGE; then + cat >> $CABAL_CONFIG <> $CABAL_CONFIG <> cabal.project + fi $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: any.$_ installed\n" unless /^(github|github-samples)$/; }' >> cabal.project.local cat cabal.project cat cabal.project.local @@ -250,19 +275,9 @@ jobs: run: | rm -f cabal.project.local $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all - - name: prepare for constraint sets - run: | - rm -f cabal.project.local - - name: constraint set containers-0.7 - run: | - if [ $((HCNUMVER >= 90000)) -ne 0 ] ; then $CABAL v2-build $ARG_COMPILER --enable-tests --disable-benchmarks --constraint='containers >= 0.7' all --dry-run ; fi - if [ $((HCNUMVER >= 90000)) -ne 0 ] ; then cabal-plan topo | sort ; fi - if [ $((HCNUMVER >= 90000)) -ne 0 ] ; then $CABAL v2-build $ARG_COMPILER --enable-tests --disable-benchmarks --constraint='containers >= 0.7' --dependencies-only -j2 all ; fi - if [ $((HCNUMVER >= 90000)) -ne 0 ] ; then $CABAL v2-build $ARG_COMPILER --enable-tests --disable-benchmarks --constraint='containers >= 0.7' all ; fi - if [ $((HCNUMVER >= 90000)) -ne 0 ] ; then $CABAL v2-test $ARG_COMPILER --enable-tests --disable-benchmarks --constraint='containers >= 0.7' all ; fi - name: save cache - uses: actions/cache/save@v4 if: always() + uses: actions/cache/save@v4 with: key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }} path: ~/.cabal/store diff --git a/cabal.haskell-ci b/cabal.haskell-ci index 6c697b60..ccddf4a2 100644 --- a/cabal.haskell-ci +++ b/cabal.haskell-ci @@ -12,11 +12,11 @@ jobs-selection: any -- constraints: text >= 2.0 -- allow-newer: *:text -- allow-newer not supported -constraint-set containers-0.7 - ghc: >= 9 - constraints: containers >= 0.7 - tests: True - run-tests: True +-- constraint-set containers-0.7 +-- ghc: >= 9 +-- constraints: containers >= 0.7 +-- tests: True +-- run-tests: True -raw-project - allow-newer: containers +-- raw-project +-- allow-newer: containers diff --git a/github.cabal b/github.cabal index d4d2d930..8ac29dbb 100644 --- a/github.cabal +++ b/github.cabal @@ -30,8 +30,9 @@ copyright: Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016-2021 Oleg Grenrus tested-with: + GHC == 9.12.1 GHC == 9.10.1 - GHC == 9.8.2 + GHC == 9.8.4 GHC == 9.6.6 GHC == 9.4.8 GHC == 9.2.8 diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index ced03e5e..8ed82b07 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -10,8 +10,9 @@ description: Various samples of github package build-type: Simple tested-with: + GHC == 9.12.1 GHC == 9.10.1 - GHC == 9.8.2 + GHC == 9.8.4 GHC == 9.6.6 GHC == 9.4.8 GHC == 9.2.8 @@ -40,7 +41,7 @@ executable github-operational hs-source-dirs: Operational ghc-options: -Wall -threaded build-depends: - , base >=0 && <5 + , base , base-compat-batteries , github , github-samples @@ -56,7 +57,7 @@ common deps -Wall -threaded build-depends: - , base >=4.8 && <5 + , base , base-compat-batteries , base64-bytestring , github From e11917be3f6dc647afe2ca39e9ec1fea7867c49d Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Thu, 27 Mar 2025 17:49:01 +0100 Subject: [PATCH 489/510] Allow containers<1, bump CI to GHC 9.12.2 --- .github/workflows/haskell-ci.yml | 42 ++++++++++---------------------- github.cabal | 6 ++--- samples/github-samples.cabal | 4 +-- 3 files changed, 18 insertions(+), 34 deletions(-) diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index ea643e3f..d007d9bf 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -6,11 +6,11 @@ # # haskell-ci regenerate # -# For more information, see https://github.com/andreasabel/haskell-ci +# For more information, see https://github.com/haskell-CI/haskell-ci # -# version: 0.19.20241219 +# version: 0.19.20250327 # -# REGENDATA ("0.19.20241219",["--config=cabal.haskell-ci","github","cabal.project"]) +# REGENDATA ("0.19.20250327",["--config=cabal.haskell-ci","github","cabal.project"]) # name: Haskell-CI on: @@ -23,7 +23,7 @@ on: jobs: linux: name: Haskell-CI - Linux - ${{ matrix.compiler }} - runs-on: ubuntu-20.04 + runs-on: ubuntu-24.04 timeout-minutes: 60 container: @@ -32,9 +32,9 @@ jobs: strategy: matrix: include: - - compiler: ghc-9.12.1 + - compiler: ghc-9.12.2 compilerKind: ghc - compilerVersion: 9.12.1 + compilerVersion: 9.12.2 setup-method: ghcup allow-failure: false - compiler: ghc-9.10.1 @@ -47,9 +47,9 @@ jobs: compilerVersion: 9.8.4 setup-method: ghcup allow-failure: false - - compiler: ghc-9.6.6 + - compiler: ghc-9.6.7 compilerKind: ghc - compilerVersion: 9.6.6 + compilerVersion: 9.6.7 setup-method: ghcup allow-failure: false - compiler: ghc-9.4.8 @@ -101,13 +101,12 @@ jobs: - name: Install GHCup run: | mkdir -p "$HOME/.ghcup/bin" - curl -sL https://downloads.haskell.org/ghcup/0.1.30.0/x86_64-linux-ghcup-0.1.30.0 > "$HOME/.ghcup/bin/ghcup" + curl -sL https://downloads.haskell.org/ghcup/0.1.50.1/x86_64-linux-ghcup-0.1.50.1 > "$HOME/.ghcup/bin/ghcup" chmod a+x "$HOME/.ghcup/bin/ghcup" - - name: Install cabal-install (prerelease) + - name: Install cabal-install run: | - "$HOME/.ghcup/bin/ghcup" config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.8.yaml; - "$HOME/.ghcup/bin/ghcup" install cabal 3.15.0.0.2024.10.3 || (cat "$HOME"/.ghcup/logs/*.* && false) - echo "CABAL=$HOME/.ghcup/bin/cabal-3.15.0.0.2024.10.3 -vnormal+nowrap" >> "$GITHUB_ENV" + "$HOME/.ghcup/bin/ghcup" install cabal 3.12.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false) + echo "CABAL=$HOME/.ghcup/bin/cabal-3.12.1.0 -vnormal+nowrap" >> "$GITHUB_ENV" - name: Install GHC (GHCup) if: matrix.setup-method == 'ghcup' run: | @@ -132,7 +131,7 @@ jobs: echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV" echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV" echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV" - if [ $((HCNUMVER >= 91200)) -ne 0 ] ; then echo "HEADHACKAGE=true" >> "$GITHUB_ENV" ; else echo "HEADHACKAGE=false" >> "$GITHUB_ENV" ; fi + echo "HEADHACKAGE=false" >> "$GITHUB_ENV" echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV" env: HCKIND: ${{ matrix.compilerKind }} @@ -160,18 +159,6 @@ jobs: repository hackage.haskell.org url: http://hackage.haskell.org/ EOF - if $HEADHACKAGE; then - cat >> $CABAL_CONFIG <> $CABAL_CONFIG <> cabal.project - fi $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: any.$_ installed\n" unless /^(github|github-samples)$/; }' >> cabal.project.local cat cabal.project cat cabal.project.local diff --git a/github.cabal b/github.cabal index 8ac29dbb..044051fb 100644 --- a/github.cabal +++ b/github.cabal @@ -30,10 +30,10 @@ copyright: Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016-2021 Oleg Grenrus tested-with: - GHC == 9.12.1 + GHC == 9.12.2 GHC == 9.10.1 GHC == 9.8.4 - GHC == 9.6.6 + GHC == 9.6.7 GHC == 9.4.8 GHC == 9.2.8 GHC == 9.0.2 @@ -186,7 +186,7 @@ library base >=4.10 && <5 , binary >=0.7.1.0 && <0.11 , bytestring >=0.10.4.0 && <0.13 - , containers >=0.5.5.1 && <0.8 + , containers >=0.5.5.1 && <1 , deepseq >=1.3.0.2 && <1.6 , exceptions >=0.10.2 && <0.11 , mtl >=2.1.3.1 && <2.2 || >=2.2.1 && <2.4 diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index 8ed82b07..cb9ca075 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -10,10 +10,10 @@ description: Various samples of github package build-type: Simple tested-with: - GHC == 9.12.1 + GHC == 9.12.2 GHC == 9.10.1 GHC == 9.8.4 - GHC == 9.6.6 + GHC == 9.6.7 GHC == 9.4.8 GHC == 9.2.8 GHC == 9.0.2 From 00fd2a376985da1f7769c683e0e15857a8481000 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Fri, 9 May 2025 11:13:10 +0200 Subject: [PATCH 490/510] Bump CI to GHC 9.10.2 --- .github/workflows/haskell-ci.yml | 13 +++++++------ github.cabal | 2 +- samples/github-samples.cabal | 2 +- 3 files changed, 9 insertions(+), 8 deletions(-) diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index d007d9bf..bb4e2c16 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -8,9 +8,9 @@ # # For more information, see https://github.com/haskell-CI/haskell-ci # -# version: 0.19.20250327 +# version: 0.19.20250506 # -# REGENDATA ("0.19.20250327",["--config=cabal.haskell-ci","github","cabal.project"]) +# REGENDATA ("0.19.20250506",["--config=cabal.haskell-ci","github","cabal.project"]) # name: Haskell-CI on: @@ -37,9 +37,9 @@ jobs: compilerVersion: 9.12.2 setup-method: ghcup allow-failure: false - - compiler: ghc-9.10.1 + - compiler: ghc-9.10.2 compilerKind: ghc - compilerVersion: 9.10.1 + compilerVersion: 9.10.2 setup-method: ghcup allow-failure: false - compiler: ghc-9.8.4 @@ -105,8 +105,8 @@ jobs: chmod a+x "$HOME/.ghcup/bin/ghcup" - name: Install cabal-install run: | - "$HOME/.ghcup/bin/ghcup" install cabal 3.12.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false) - echo "CABAL=$HOME/.ghcup/bin/cabal-3.12.1.0 -vnormal+nowrap" >> "$GITHUB_ENV" + "$HOME/.ghcup/bin/ghcup" install cabal 3.14.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false) + echo "CABAL=$HOME/.ghcup/bin/cabal-3.14.2.0 -vnormal+nowrap" >> "$GITHUB_ENV" - name: Install GHC (GHCup) if: matrix.setup-method == 'ghcup' run: | @@ -217,6 +217,7 @@ jobs: cat >> cabal.project < Date: Sat, 18 Jan 2025 14:40:12 +1100 Subject: [PATCH 491/510] add missing name field --- src/GitHub/Data/Actions/WorkflowJobs.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/GitHub/Data/Actions/WorkflowJobs.hs b/src/GitHub/Data/Actions/WorkflowJobs.hs index 9698e3a9..05f28861 100644 --- a/src/GitHub/Data/Actions/WorkflowJobs.hs +++ b/src/GitHub/Data/Actions/WorkflowJobs.hs @@ -47,6 +47,7 @@ data Job = Job , jobConclusion :: !Text , jobStartedAt :: !UTCTime , jobCompletedAt :: !UTCTime + , jobName :: !(Name Job) , jobSteps :: !(Vector JobStep) , jobRunCheckUrl :: !URL , jobLabels :: !(Vector Text) @@ -84,6 +85,7 @@ instance FromJSON Job where <*> o .: "conclusion" <*> o .: "started_at" <*> o .: "completed_at" + <*> o .: "name" <*> o .: "steps" <*> o .: "check_run_url" <*> o .: "labels" From 3b24f4126272344ba7138013bdb2396addb0077f Mon Sep 17 00:00:00 2001 From: Magnus Therning Date: Sat, 9 Mar 2024 15:11:12 +0100 Subject: [PATCH 492/510] Make the subject URL optional This goes against the documentation at https://docs.github.com/en/rest/activity/notifications but it seems to be required in order to handle certain types of notifications. --- src/GitHub/Data/Activities.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/GitHub/Data/Activities.hs b/src/GitHub/Data/Activities.hs index e03986dc..850b7445 100644 --- a/src/GitHub/Data/Activities.hs +++ b/src/GitHub/Data/Activities.hs @@ -26,7 +26,7 @@ instance FromJSON RepoStarred where data Subject = Subject { subjectTitle :: !Text - , subjectURL :: !URL + , subjectURL :: !(Maybe URL) , subjectLatestCommentURL :: !(Maybe URL) -- https://developer.github.com/v3/activity/notifications/ doesn't indicate -- what the possible values for this field are. From 709cc3abb3d3b33f5305b4d299b5b2c1a173c8e7 Mon Sep 17 00:00:00 2001 From: maralorn Date: Tue, 24 Sep 2024 23:37:17 +0200 Subject: [PATCH 493/510] Add new Notification reasons --- src/GitHub/Data/Activities.hs | 34 ++++++++++++++++++++++------------ 1 file changed, 22 insertions(+), 12 deletions(-) diff --git a/src/GitHub/Data/Activities.hs b/src/GitHub/Data/Activities.hs index 850b7445..540241c8 100644 --- a/src/GitHub/Data/Activities.hs +++ b/src/GitHub/Data/Activities.hs @@ -46,13 +46,18 @@ instance FromJSON Subject where <*> o .: "type" data NotificationReason - = AssignReason + = ApprovalRequestedReason + | AssignReason | AuthorReason | CommentReason + | CiActivityReason | InvitationReason | ManualReason + | MemberFeatureRequestedReason | MentionReason | ReviewRequestedReason + | SecurityAlertReason + | SecurityAdvisoryCreditReason | StateChangeReason | SubscribedReason | TeamMentionReason @@ -63,17 +68,22 @@ instance Binary NotificationReason instance FromJSON NotificationReason where parseJSON = withText "NotificationReason" $ \t -> case T.toLower t of - "assign" -> pure AssignReason - "author" -> pure AuthorReason - "comment" -> pure CommentReason - "invitation" -> pure InvitationReason - "manual" -> pure ManualReason - "mention" -> pure MentionReason - "review_requested" -> pure ReviewRequestedReason - "state_change" -> pure StateChangeReason - "subscribed" -> pure SubscribedReason - "team_mention" -> pure TeamMentionReason - _ -> fail $ "Unknown NotificationReason " ++ show t + "approval_requested" -> pure ApprovalRequestedReason + "assign" -> pure AssignReason + "author" -> pure AuthorReason + "comment" -> pure CommentReason + "ci_activity" -> pure CiActivityReason + "invitation" -> pure InvitationReason + "manual" -> pure ManualReason + "member_feature_requested" -> pure MemberFeatureRequestedReason + "mention" -> pure MentionReason + "review_requested" -> pure ReviewRequestedReason + "security_alert" -> pure SecurityAlertReason + "security_advisory_credit" -> pure SecurityAdvisoryCreditReason + "state_change" -> pure StateChangeReason + "subscribed" -> pure SubscribedReason + "team_mention" -> pure TeamMentionReason + _ -> fail $ "Unknown NotificationReason " ++ show t data Notification = Notification -- XXX: The notification id field type IS in fact string. Not sure why gh From 529e3578ce88fb3ec84ab531fbb6ad5788f8d6e0 Mon Sep 17 00:00:00 2001 From: Daan Rijks Date: Wed, 11 Sep 2024 13:55:17 +0200 Subject: [PATCH 494/510] Add initial subset of Reactions endpoints --- github.cabal | 2 + src/GitHub.hs | 10 ++++ src/GitHub/Data.hs | 2 + src/GitHub/Data/Reactions.hs | 78 +++++++++++++++++++++++++++++++ src/GitHub/Endpoints/Reactions.hs | 60 ++++++++++++++++++++++++ 5 files changed, 152 insertions(+) create mode 100644 src/GitHub/Data/Reactions.hs create mode 100644 src/GitHub/Endpoints/Reactions.hs diff --git a/github.cabal b/github.cabal index 55a825e8..f9e8e8db 100644 --- a/github.cabal +++ b/github.cabal @@ -117,6 +117,7 @@ library GitHub.Data.PublicSSHKeys GitHub.Data.PullRequests GitHub.Data.RateLimit + GitHub.Data.Reactions GitHub.Data.Releases GitHub.Data.Repos GitHub.Data.Request @@ -157,6 +158,7 @@ library GitHub.Endpoints.PullRequests.Comments GitHub.Endpoints.PullRequests.Reviews GitHub.Endpoints.RateLimit + GitHub.Endpoints.Reactions GitHub.Endpoints.Repos GitHub.Endpoints.Repos.Collaborators GitHub.Endpoints.Repos.Comments diff --git a/src/GitHub.hs b/src/GitHub.hs index c3a3d88f..309cb1db 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -285,6 +285,15 @@ module GitHub ( commitR, diffR, + -- ** Reactions + -- | See + issueReactionsR, + createIssueReactionR, + deleteIssueReactionR, + commentReactionsR, + createCommentReactionR, + deleteCommentReactionR, + -- ** Contents -- | See contentsForR, @@ -514,6 +523,7 @@ import GitHub.Endpoints.Organizations.Teams import GitHub.Endpoints.PullRequests import GitHub.Endpoints.PullRequests.Comments import GitHub.Endpoints.PullRequests.Reviews +import GitHub.Endpoints.Reactions import GitHub.Endpoints.RateLimit import GitHub.Endpoints.Repos import GitHub.Endpoints.Repos.Collaborators diff --git a/src/GitHub/Data.hs b/src/GitHub/Data.hs index 740c6837..18fb770d 100644 --- a/src/GitHub/Data.hs +++ b/src/GitHub/Data.hs @@ -55,6 +55,7 @@ module GitHub.Data ( module GitHub.Data.PullRequests, module GitHub.Data.RateLimit, module GitHub.Data.Releases, + module GitHub.Data.Reactions, module GitHub.Data.Repos, module GitHub.Data.Request, module GitHub.Data.Reviews, @@ -97,6 +98,7 @@ import GitHub.Data.PublicSSHKeys import GitHub.Data.PullRequests import GitHub.Data.RateLimit import GitHub.Data.Releases +import GitHub.Data.Reactions import GitHub.Data.Repos import GitHub.Data.Request import GitHub.Data.Reviews diff --git a/src/GitHub/Data/Reactions.hs b/src/GitHub/Data/Reactions.hs new file mode 100644 index 00000000..f5fc3ead --- /dev/null +++ b/src/GitHub/Data/Reactions.hs @@ -0,0 +1,78 @@ +{-# LANGUAGE InstanceSigs #-} +module GitHub.Data.Reactions where + +import qualified Data.Text as T +import GitHub.Data.Id (Id) +import GitHub.Data.Definitions (SimpleUser) +import GitHub.Internal.Prelude +import Prelude () + +data Reaction = Reaction + { reactionId :: Id Reaction + , reactionUser :: !(Maybe SimpleUser) + , reactionContent :: !ReactionContent + , reactionCreatedAt :: !UTCTime + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Reaction where rnf = genericRnf +instance Binary Reaction + +data NewReaction = NewReaction + { newReactionContent :: !ReactionContent + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData NewReaction where rnf = genericRnf +instance Binary NewReaction + +-- | +-- +data ReactionContent + = PlusOne + | MinusOne + | Laugh + | Confused + | Heart + | Hooray + | Rocket + | Eyes + deriving (Show, Data, Typeable, Eq, Ord, Enum, Bounded, Generic) + +instance NFData ReactionContent where rnf = genericRnf +instance Binary ReactionContent + +-- JSON instances + +instance FromJSON Reaction where + parseJSON = withObject "Reaction" $ \o -> + Reaction + <$> o .: "id" + <*> o .:? "user" + <*> o .: "content" + <*> o .: "created_at" + +instance ToJSON NewReaction where + toJSON (NewReaction content) = object ["content" .= content] + +instance FromJSON ReactionContent where + parseJSON = withText "ReactionContent" $ \case + "+1" -> pure PlusOne + "-1" -> pure MinusOne + "laugh" -> pure Laugh + "confused" -> pure Confused + "heart" -> pure Heart + "hooray" -> pure Hooray + "rocket" -> pure Rocket + "eyes" -> pure Eyes + t -> fail $ "Unknown ReactionContent: " <> T.unpack t + +instance ToJSON ReactionContent where + toJSON PlusOne = String "+1" + toJSON MinusOne = String "-1" + toJSON Laugh = String "laugh" + toJSON Confused = String "confused" + toJSON Heart = String "heart" + toJSON Hooray = String "hooray" + toJSON Rocket = String "rocket" + toJSON Eyes = String "eyes" diff --git a/src/GitHub/Endpoints/Reactions.hs b/src/GitHub/Endpoints/Reactions.hs new file mode 100644 index 00000000..a4ec31f7 --- /dev/null +++ b/src/GitHub/Endpoints/Reactions.hs @@ -0,0 +1,60 @@ +-- | +-- The Reactions API as described at +-- . +module GitHub.Endpoints.Reactions ( + issueReactionsR, + createIssueReactionR, + deleteIssueReactionR, + commentReactionsR, + createCommentReactionR, + deleteCommentReactionR, + module GitHub.Data, +) where + +import GitHub.Data +import GitHub.Internal.Prelude +import Prelude () + +-- | List reactions for an issue. +-- See +issueReactionsR :: Name Owner -> Name Repo -> Id Issue -> FetchCount -> Request k (Vector Reaction) +issueReactionsR owner repo iid = + pagedQuery ["repos", toPathPart owner, toPathPart repo, "issues", toPathPart iid, "reactions"] [] + +-- | Create reaction for an issue comment. +-- See +createIssueReactionR :: Name Owner -> Name Repo -> Id Issue -> ReactionContent -> Request 'RW Reaction +createIssueReactionR owner repo iid content = + command Post parts (encode $ NewReaction content) + where + parts = ["repos", toPathPart owner, toPathPart repo, "issues", toPathPart iid, "reactions"] + +-- | Delete an issue comment reaction. +-- See +deleteIssueReactionR :: Name Owner -> Name Repo -> Id Issue -> Id Reaction -> GenRequest 'MtUnit 'RW () +deleteIssueReactionR owner repo iid rid = + Command Delete parts mempty + where + parts = ["repos", toPathPart owner, toPathPart repo, "issues", toPathPart iid, "reactions", toPathPart rid] + +-- | List reactions for an issue comment. +-- See +commentReactionsR :: Name Owner -> Name Repo -> Id Comment -> FetchCount -> Request k (Vector Reaction) +commentReactionsR owner repo cid = + pagedQuery ["repos", toPathPart owner, toPathPart repo, "issues", "comments", toPathPart cid, "reactions"] [] + +-- | Create reaction for an issue comment. +-- See https://docs.github.com/en/rest/reactions/reactions?apiVersion=2022-11-28#create-reaction-for-an-issue-comment +createCommentReactionR :: Name Owner -> Name Repo -> Id Comment -> ReactionContent -> Request 'RW Reaction +createCommentReactionR owner repo cid content = + command Post parts (encode $ NewReaction content) + where + parts = ["repos", toPathPart owner, toPathPart repo, "issues", "comments", toPathPart cid, "reactions"] + +-- | Delete an issue comment reaction. +-- See +deleteCommentReactionR :: Name Owner -> Name Repo -> Id Comment -> Id Reaction -> GenRequest 'MtUnit 'RW () +deleteCommentReactionR owner repo cid rid = + Command Delete parts mempty + where + parts = ["repos", toPathPart owner, toPathPart repo, "issues", "comments", toPathPart cid, "reactions", toPathPart rid] From 2bed394e451f77fca85942f6421b4968fcc0e0c4 Mon Sep 17 00:00:00 2001 From: Tom McLaughlin Date: Fri, 9 May 2025 08:13:45 -0700 Subject: [PATCH 495/510] Support pagination (#503) * Working on PerPageQuery * Add issuesForRepoPagedR + failing test * Testing, todo REVERT * About to try integrating paging into the normal executeRequest calls * API is looking better, call this v2 * Clean up some debugging stuff * More cleanup * More cleanup * Another slight refactor * Another cleanup * Improve test --- github.cabal | 1 + spec/GitHub/IssuesSpec.hs | 32 ++++++++++++++++---- src/GitHub/Data/Request.hs | 39 +++++++++++++++++++++++- src/GitHub/Request.hs | 62 ++++++++++++++++++++++++++++++-------- 4 files changed, 115 insertions(+), 19 deletions(-) diff --git a/github.cabal b/github.cabal index f9e8e8db..e97f8b41 100644 --- a/github.cabal +++ b/github.cabal @@ -264,6 +264,7 @@ test-suite github-test , file-embed , github , hspec >=2.6.1 && <2.12 + , http-client , tagged , text , unordered-containers diff --git a/spec/GitHub/IssuesSpec.hs b/spec/GitHub/IssuesSpec.hs index 2a7f5e7b..e673975f 100644 --- a/spec/GitHub/IssuesSpec.hs +++ b/spec/GitHub/IssuesSpec.hs @@ -6,12 +6,13 @@ import qualified GitHub 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, expectationFailure, it, pendingWith, shouldSatisfy) +import Data.Either.Compat (isRight) +import Data.Foldable (for_) +import Data.String (fromString) +import Network.HTTP.Client (newManager, responseBody) +import System.Environment (lookupEnv) +import Test.Hspec (Spec, describe, expectationFailure, it, pendingWith, shouldSatisfy) + fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b @@ -38,6 +39,25 @@ spec = do cms <- GitHub.executeRequest auth $ GitHub.commentsR owner repo (GitHub.issueNumber i) 1 cms `shouldSatisfy` isRight + + describe "issuesForRepoR paged" $ do + it "works" $ withAuth $ \auth -> for_ repos $ \(owner, repo) -> do + mgr <- newManager GitHub.tlsManagerSettings + ret <- GitHub.executeRequestWithMgrAndRes mgr auth $ + GitHub.issuesForRepoR owner repo mempty (GitHub.FetchPage (GitHub.PageParams (Just 2) (Just 1))) + + case ret of + Left e -> + expectationFailure . show $ e + Right res -> do + let issues = responseBody res + length issues `shouldSatisfy` (<= 2) + + for_ issues $ \i -> do + cms <- GitHub.executeRequest auth $ + GitHub.commentsR owner repo (GitHub.issueNumber i) 1 + cms `shouldSatisfy` isRight + describe "issueR" $ do it "fetches issue #428" $ withAuth $ \auth -> do resIss <- GitHub.executeRequest auth $ diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs index 7b4eac40..c8138c1a 100644 --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -14,6 +14,8 @@ module GitHub.Data.Request ( CommandMethod(..), toMethod, FetchCount(..), + PageParams(..), + PageLinks(..), MediaType (..), Paths, IsPathPart(..), @@ -29,6 +31,7 @@ import GitHub.Internal.Prelude import qualified Data.ByteString.Lazy as LBS import qualified Data.Text as T import qualified Network.HTTP.Types.Method as Method +import Network.URI (URI) ------------------------------------------------------------------------------ -- Path parts @@ -74,7 +77,10 @@ toMethod Delete = Method.methodDelete -- | 'PagedQuery' returns just some results, using this data we can specify how -- many pages we want to fetch. -data FetchCount = FetchAtLeast !Word | FetchAll +data FetchCount = + FetchAtLeast !Word + | FetchAll + | FetchPage PageParams deriving (Eq, Ord, Read, Show, Generic, Typeable) @@ -96,6 +102,37 @@ instance Hashable FetchCount instance Binary FetchCount instance NFData FetchCount where rnf = genericRnf +------------------------------------------------------------------------------- +-- PageParams +------------------------------------------------------------------------------- + +-- | Params for specifying the precise page and items per page. +data PageParams = PageParams { + pageParamsPerPage :: Maybe Int + , pageParamsPage :: Maybe Int + } + deriving (Eq, Ord, Read, Show, Generic, Typeable) + +instance Hashable PageParams +instance Binary PageParams +instance NFData PageParams where rnf = genericRnf + +------------------------------------------------------------------------------- +-- PageLinks +------------------------------------------------------------------------------- + +-- | 'PagedQuery' returns just some results, using this data we can specify how +-- many pages we want to fetch. +data PageLinks = PageLinks { + pageLinksPrev :: Maybe URI + , pageLinksNext :: Maybe URI + , pageLinksLast :: Maybe URI + , pageLinksFirst :: Maybe URI + } + deriving (Eq, Ord, Show, Generic, Typeable) + +instance NFData PageLinks where rnf = genericRnf + ------------------------------------------------------------------------------- -- MediaType ------------------------------------------------------------------------------- diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index c5eb006c..332d1124 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -54,6 +54,7 @@ module GitHub.Request ( ParseResponse (..), makeHttpRequest, parseStatus, + parsePageLinks, StatusMap, getNextUrl, performPagedRequest, @@ -79,6 +80,7 @@ import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Except (ExceptT (..), runExceptT) import Data.Aeson (eitherDecode) import Data.List (find) +import Data.Maybe (fromMaybe) import Data.Tagged (Tagged (..)) import Data.Version (showVersion) @@ -87,13 +89,14 @@ import Network.HTTP.Client httpLbs, method, newManager, redirectCount, requestBody, requestHeaders, setQueryString, setRequestIgnoreStatus) import Network.HTTP.Link.Parser (parseLinkHeaderBS) -import Network.HTTP.Link.Types (LinkParam (..), href, linkParams) +import Network.HTTP.Link.Types (Link(..), LinkParam (..), href, linkParams) import Network.HTTP.Types (Method, RequestHeaders, Status (..)) import Network.URI (URI, escapeURIString, isUnescapedInURIComponent, parseURIReference, relativeTo) import qualified Data.ByteString as BS +import Data.ByteString.Builder (intDec, toLazyByteString) import qualified Data.ByteString.Lazy as LBS import qualified Data.Text as T import qualified Data.Text.Encoding as TE @@ -199,11 +202,6 @@ executeRequest auth req = withOpenSSL $ do manager <- newManager tlsManagerSettings executeRequestWithMgr manager auth req -lessFetchCount :: Int -> FetchCount -> Bool -lessFetchCount _ FetchAll = True -lessFetchCount i (FetchAtLeast j) = i < fromIntegral j - - -- | Like 'executeRequest' but with provided 'Manager'. executeRequestWithMgr :: (AuthMethod am, ParseResponse mt a) @@ -235,10 +233,13 @@ executeRequestWithMgrAndRes mgr auth req = runExceptT $ do res <- httpLbs' httpReq (<$ res) <$> unTagged (parseResponse httpReq res :: Tagged mt (ExceptT Error IO b)) - performHttpReq httpReq (PagedQuery _ _ l) = - unTagged (performPagedRequest httpLbs' predicate httpReq :: Tagged mt (ExceptT Error IO (HTTP.Response b))) - where - predicate v = lessFetchCount (length v) l + performHttpReq httpReq (PagedQuery _ _ (FetchPage _)) = do + (res, _pageLinks) <- unTagged (performPerPageRequest httpLbs' httpReq :: Tagged mt (ExceptT Error IO (HTTP.Response b, PageLinks))) + return res + performHttpReq httpReq (PagedQuery _ _ FetchAll) = + unTagged (performPagedRequest httpLbs' (const True) httpReq :: Tagged mt (ExceptT Error IO (HTTP.Response b))) + performHttpReq httpReq (PagedQuery _ _ (FetchAtLeast j)) = + unTagged (performPagedRequest httpLbs' (\v -> length v < fromIntegral j) httpReq :: Tagged mt (ExceptT Error IO (HTTP.Response b))) performHttpReq httpReq (Command _ _ _) = do res <- httpLbs' httpReq @@ -456,7 +457,7 @@ makeHttpRequest auth r = case r of $ setReqHeaders . unTagged (modifyRequest :: Tagged mt (HTTP.Request -> HTTP.Request)) . maybe id setAuthRequest auth - . setQueryString qs + . setQueryString (qs <> extraQueryItems) $ req PagedQuery paths qs _ -> do req <- parseUrl' $ url paths @@ -464,7 +465,7 @@ makeHttpRequest auth r = case r of $ setReqHeaders . unTagged (modifyRequest :: Tagged mt (HTTP.Request -> HTTP.Request)) . maybe id setAuthRequest auth - . setQueryString qs + . setQueryString (qs <> extraQueryItems) $ req Command m paths body -> do req <- parseUrl' $ url paths @@ -496,6 +497,14 @@ makeHttpRequest auth r = case r of setBody :: LBS.ByteString -> HTTP.Request -> HTTP.Request setBody body req = req { requestBody = RequestBodyLBS body } + extraQueryItems :: [(BS.ByteString, Maybe BS.ByteString)] + extraQueryItems = case r of + PagedQuery _ _ (FetchPage pp) -> catMaybes [ + (\page -> ("page", Just (BS.toStrict $ toLazyByteString $ intDec page))) <$> pageParamsPage pp + , (\perPage -> ("per_page", Just (BS.toStrict $ toLazyByteString $ intDec perPage))) <$> pageParamsPerPage pp + ] + _ -> [] + -- | Query @Link@ header with @rel=next@ from the request headers. getNextUrl :: HTTP.Response a -> Maybe URI getNextUrl req = do @@ -542,6 +551,35 @@ performPagedRequest httpLbs' predicate initReq = Tagged $ do go (acc <> m) res' req' (_, _) -> return (acc <$ res) +-- | Helper for requesting a single page, as specified by 'PageParams'. +-- +-- This parses and returns the 'PageLinks' alongside the HTTP response. +performPerPageRequest + :: forall a m mt. (ParseResponse mt a, MonadCatch m, MonadError Error m) + => (HTTP.Request -> m (HTTP.Response LBS.ByteString)) -- ^ `httpLbs` analogue + -> HTTP.Request -- ^ initial request + -> Tagged mt (m (HTTP.Response a, PageLinks)) +performPerPageRequest httpLbs' initReq = Tagged $ do + res <- httpLbs' initReq + m <- unTagged (parseResponse initReq res :: Tagged mt (m a)) + return (m <$ res, parsePageLinks res) + +-- | Parse the 'PageLinks' from an HTTP response, where the information is +-- encoded in the Link header. +parsePageLinks :: HTTP.Response a -> PageLinks +parsePageLinks res = PageLinks { + pageLinksPrev = linkToUri <$> find (elem (Rel, "prev") . linkParams) links + , pageLinksNext = linkToUri <$> find (elem (Rel, "next") . linkParams) links + , pageLinksLast = linkToUri <$> find (elem (Rel, "last") . linkParams) links + , pageLinksFirst = linkToUri <$> find (elem (Rel, "first") . linkParams) links + } + where + links :: [Link URI] + links = fromMaybe [] (lookup "Link" (responseHeaders res) >>= parseLinkHeaderBS) + + linkToUri :: Link URI -> URI + linkToUri (Link uri _) = uri + ------------------------------------------------------------------------------- -- Internal ------------------------------------------------------------------------------- From 63a4e0cc3a2393789a6a4b489f344991b1b8a499 Mon Sep 17 00:00:00 2001 From: Tom Sydney Kerckhove Date: Sun, 16 Jul 2023 08:42:29 +0200 Subject: [PATCH 496/510] Allow JWT as an authentication method, fixes #489 --- src/GitHub/Auth.hs | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/src/GitHub/Auth.hs b/src/GitHub/Auth.hs index ccc2415a..2b41dbf4 100644 --- a/src/GitHub/Auth.hs +++ b/src/GitHub/Auth.hs @@ -1,5 +1,7 @@ module GitHub.Auth ( Auth (..), + Token, + JWTToken, AuthMethod, endpoint, setAuthRequest @@ -9,14 +11,17 @@ import GitHub.Internal.Prelude import Prelude () import qualified Data.ByteString as BS +import qualified Data.Text.Encoding as TE import qualified Network.HTTP.Client as HTTP type Token = BS.ByteString +type JWTToken = Text -- | The Github auth data type data Auth = BasicAuth BS.ByteString BS.ByteString -- ^ Username and password | OAuth Token -- ^ OAuth token + | JWT JWTToken -- ^ JWT Token | EnterpriseOAuth Text Token -- ^ Custom endpoint and OAuth token deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -40,10 +45,12 @@ instance AuthMethod () where instance AuthMethod Auth where endpoint (BasicAuth _ _) = Nothing endpoint (OAuth _) = Nothing + endpoint (JWT _) = Nothing endpoint (EnterpriseOAuth e _) = Just e setAuthRequest (BasicAuth u p) = HTTP.applyBasicAuth u p setAuthRequest (OAuth t) = setAuthHeader $ "token " <> t + setAuthRequest (JWT t) = setAuthHeader $ "Bearer " <> TE.encodeUtf8 t setAuthRequest (EnterpriseOAuth _ t) = setAuthHeader $ "token " <> t setAuthHeader :: BS.ByteString -> HTTP.Request -> HTTP.Request From dc438164bfc7b152074fdb58e1d3d18e86820777 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Fri, 9 May 2025 17:23:18 +0200 Subject: [PATCH 497/510] Revert "Support pagination (#503)" This reverts commit 2bed394e451f77fca85942f6421b4968fcc0e0c4. --- github.cabal | 1 - spec/GitHub/IssuesSpec.hs | 32 ++++---------------- src/GitHub/Data/Request.hs | 39 +----------------------- src/GitHub/Request.hs | 62 ++++++++------------------------------ 4 files changed, 19 insertions(+), 115 deletions(-) diff --git a/github.cabal b/github.cabal index e97f8b41..f9e8e8db 100644 --- a/github.cabal +++ b/github.cabal @@ -264,7 +264,6 @@ test-suite github-test , file-embed , github , hspec >=2.6.1 && <2.12 - , http-client , tagged , text , unordered-containers diff --git a/spec/GitHub/IssuesSpec.hs b/spec/GitHub/IssuesSpec.hs index e673975f..2a7f5e7b 100644 --- a/spec/GitHub/IssuesSpec.hs +++ b/spec/GitHub/IssuesSpec.hs @@ -6,13 +6,12 @@ import qualified GitHub import Prelude () import Prelude.Compat -import Data.Either.Compat (isRight) -import Data.Foldable (for_) -import Data.String (fromString) -import Network.HTTP.Client (newManager, responseBody) -import System.Environment (lookupEnv) -import Test.Hspec (Spec, describe, expectationFailure, it, pendingWith, shouldSatisfy) - +import Data.Either.Compat (isRight) +import Data.Foldable (for_) +import Data.String (fromString) +import System.Environment (lookupEnv) +import Test.Hspec + (Spec, describe, expectationFailure, it, pendingWith, shouldSatisfy) fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b @@ -39,25 +38,6 @@ spec = do cms <- GitHub.executeRequest auth $ GitHub.commentsR owner repo (GitHub.issueNumber i) 1 cms `shouldSatisfy` isRight - - describe "issuesForRepoR paged" $ do - it "works" $ withAuth $ \auth -> for_ repos $ \(owner, repo) -> do - mgr <- newManager GitHub.tlsManagerSettings - ret <- GitHub.executeRequestWithMgrAndRes mgr auth $ - GitHub.issuesForRepoR owner repo mempty (GitHub.FetchPage (GitHub.PageParams (Just 2) (Just 1))) - - case ret of - Left e -> - expectationFailure . show $ e - Right res -> do - let issues = responseBody res - length issues `shouldSatisfy` (<= 2) - - for_ issues $ \i -> do - cms <- GitHub.executeRequest auth $ - GitHub.commentsR owner repo (GitHub.issueNumber i) 1 - cms `shouldSatisfy` isRight - describe "issueR" $ do it "fetches issue #428" $ withAuth $ \auth -> do resIss <- GitHub.executeRequest auth $ diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs index c8138c1a..7b4eac40 100644 --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -14,8 +14,6 @@ module GitHub.Data.Request ( CommandMethod(..), toMethod, FetchCount(..), - PageParams(..), - PageLinks(..), MediaType (..), Paths, IsPathPart(..), @@ -31,7 +29,6 @@ import GitHub.Internal.Prelude import qualified Data.ByteString.Lazy as LBS import qualified Data.Text as T import qualified Network.HTTP.Types.Method as Method -import Network.URI (URI) ------------------------------------------------------------------------------ -- Path parts @@ -77,10 +74,7 @@ toMethod Delete = Method.methodDelete -- | 'PagedQuery' returns just some results, using this data we can specify how -- many pages we want to fetch. -data FetchCount = - FetchAtLeast !Word - | FetchAll - | FetchPage PageParams +data FetchCount = FetchAtLeast !Word | FetchAll deriving (Eq, Ord, Read, Show, Generic, Typeable) @@ -102,37 +96,6 @@ instance Hashable FetchCount instance Binary FetchCount instance NFData FetchCount where rnf = genericRnf -------------------------------------------------------------------------------- --- PageParams -------------------------------------------------------------------------------- - --- | Params for specifying the precise page and items per page. -data PageParams = PageParams { - pageParamsPerPage :: Maybe Int - , pageParamsPage :: Maybe Int - } - deriving (Eq, Ord, Read, Show, Generic, Typeable) - -instance Hashable PageParams -instance Binary PageParams -instance NFData PageParams where rnf = genericRnf - -------------------------------------------------------------------------------- --- PageLinks -------------------------------------------------------------------------------- - --- | 'PagedQuery' returns just some results, using this data we can specify how --- many pages we want to fetch. -data PageLinks = PageLinks { - pageLinksPrev :: Maybe URI - , pageLinksNext :: Maybe URI - , pageLinksLast :: Maybe URI - , pageLinksFirst :: Maybe URI - } - deriving (Eq, Ord, Show, Generic, Typeable) - -instance NFData PageLinks where rnf = genericRnf - ------------------------------------------------------------------------------- -- MediaType ------------------------------------------------------------------------------- diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index 332d1124..c5eb006c 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -54,7 +54,6 @@ module GitHub.Request ( ParseResponse (..), makeHttpRequest, parseStatus, - parsePageLinks, StatusMap, getNextUrl, performPagedRequest, @@ -80,7 +79,6 @@ import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Except (ExceptT (..), runExceptT) import Data.Aeson (eitherDecode) import Data.List (find) -import Data.Maybe (fromMaybe) import Data.Tagged (Tagged (..)) import Data.Version (showVersion) @@ -89,14 +87,13 @@ import Network.HTTP.Client httpLbs, method, newManager, redirectCount, requestBody, requestHeaders, setQueryString, setRequestIgnoreStatus) import Network.HTTP.Link.Parser (parseLinkHeaderBS) -import Network.HTTP.Link.Types (Link(..), LinkParam (..), href, linkParams) +import Network.HTTP.Link.Types (LinkParam (..), href, linkParams) import Network.HTTP.Types (Method, RequestHeaders, Status (..)) import Network.URI (URI, escapeURIString, isUnescapedInURIComponent, parseURIReference, relativeTo) import qualified Data.ByteString as BS -import Data.ByteString.Builder (intDec, toLazyByteString) import qualified Data.ByteString.Lazy as LBS import qualified Data.Text as T import qualified Data.Text.Encoding as TE @@ -202,6 +199,11 @@ executeRequest auth req = withOpenSSL $ do manager <- newManager tlsManagerSettings executeRequestWithMgr manager auth req +lessFetchCount :: Int -> FetchCount -> Bool +lessFetchCount _ FetchAll = True +lessFetchCount i (FetchAtLeast j) = i < fromIntegral j + + -- | Like 'executeRequest' but with provided 'Manager'. executeRequestWithMgr :: (AuthMethod am, ParseResponse mt a) @@ -233,13 +235,10 @@ executeRequestWithMgrAndRes mgr auth req = runExceptT $ do res <- httpLbs' httpReq (<$ res) <$> unTagged (parseResponse httpReq res :: Tagged mt (ExceptT Error IO b)) - performHttpReq httpReq (PagedQuery _ _ (FetchPage _)) = do - (res, _pageLinks) <- unTagged (performPerPageRequest httpLbs' httpReq :: Tagged mt (ExceptT Error IO (HTTP.Response b, PageLinks))) - return res - performHttpReq httpReq (PagedQuery _ _ FetchAll) = - unTagged (performPagedRequest httpLbs' (const True) httpReq :: Tagged mt (ExceptT Error IO (HTTP.Response b))) - performHttpReq httpReq (PagedQuery _ _ (FetchAtLeast j)) = - unTagged (performPagedRequest httpLbs' (\v -> length v < fromIntegral j) httpReq :: Tagged mt (ExceptT Error IO (HTTP.Response b))) + performHttpReq httpReq (PagedQuery _ _ l) = + unTagged (performPagedRequest httpLbs' predicate httpReq :: Tagged mt (ExceptT Error IO (HTTP.Response b))) + where + predicate v = lessFetchCount (length v) l performHttpReq httpReq (Command _ _ _) = do res <- httpLbs' httpReq @@ -457,7 +456,7 @@ makeHttpRequest auth r = case r of $ setReqHeaders . unTagged (modifyRequest :: Tagged mt (HTTP.Request -> HTTP.Request)) . maybe id setAuthRequest auth - . setQueryString (qs <> extraQueryItems) + . setQueryString qs $ req PagedQuery paths qs _ -> do req <- parseUrl' $ url paths @@ -465,7 +464,7 @@ makeHttpRequest auth r = case r of $ setReqHeaders . unTagged (modifyRequest :: Tagged mt (HTTP.Request -> HTTP.Request)) . maybe id setAuthRequest auth - . setQueryString (qs <> extraQueryItems) + . setQueryString qs $ req Command m paths body -> do req <- parseUrl' $ url paths @@ -497,14 +496,6 @@ makeHttpRequest auth r = case r of setBody :: LBS.ByteString -> HTTP.Request -> HTTP.Request setBody body req = req { requestBody = RequestBodyLBS body } - extraQueryItems :: [(BS.ByteString, Maybe BS.ByteString)] - extraQueryItems = case r of - PagedQuery _ _ (FetchPage pp) -> catMaybes [ - (\page -> ("page", Just (BS.toStrict $ toLazyByteString $ intDec page))) <$> pageParamsPage pp - , (\perPage -> ("per_page", Just (BS.toStrict $ toLazyByteString $ intDec perPage))) <$> pageParamsPerPage pp - ] - _ -> [] - -- | Query @Link@ header with @rel=next@ from the request headers. getNextUrl :: HTTP.Response a -> Maybe URI getNextUrl req = do @@ -551,35 +542,6 @@ performPagedRequest httpLbs' predicate initReq = Tagged $ do go (acc <> m) res' req' (_, _) -> return (acc <$ res) --- | Helper for requesting a single page, as specified by 'PageParams'. --- --- This parses and returns the 'PageLinks' alongside the HTTP response. -performPerPageRequest - :: forall a m mt. (ParseResponse mt a, MonadCatch m, MonadError Error m) - => (HTTP.Request -> m (HTTP.Response LBS.ByteString)) -- ^ `httpLbs` analogue - -> HTTP.Request -- ^ initial request - -> Tagged mt (m (HTTP.Response a, PageLinks)) -performPerPageRequest httpLbs' initReq = Tagged $ do - res <- httpLbs' initReq - m <- unTagged (parseResponse initReq res :: Tagged mt (m a)) - return (m <$ res, parsePageLinks res) - --- | Parse the 'PageLinks' from an HTTP response, where the information is --- encoded in the Link header. -parsePageLinks :: HTTP.Response a -> PageLinks -parsePageLinks res = PageLinks { - pageLinksPrev = linkToUri <$> find (elem (Rel, "prev") . linkParams) links - , pageLinksNext = linkToUri <$> find (elem (Rel, "next") . linkParams) links - , pageLinksLast = linkToUri <$> find (elem (Rel, "last") . linkParams) links - , pageLinksFirst = linkToUri <$> find (elem (Rel, "first") . linkParams) links - } - where - links :: [Link URI] - links = fromMaybe [] (lookup "Link" (responseHeaders res) >>= parseLinkHeaderBS) - - linkToUri :: Link URI -> URI - linkToUri (Link uri _) = uri - ------------------------------------------------------------------------------- -- Internal ------------------------------------------------------------------------------- From 953b7519b588841c3ae7fd6235ad4fd72dbfdf0b Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Fri, 9 May 2025 12:07:46 +0200 Subject: [PATCH 498/510] Bump to 0.30, fix #520 --- github.cabal | 2 +- src/GitHub/Data/Options.hs | 3 +++ 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/github.cabal b/github.cabal index f9e8e8db..2c6bccf0 100644 --- a/github.cabal +++ b/github.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: github -version: 0.29.1 +version: 0.30 synopsis: Access to the GitHub API, v3. category: Network description: diff --git a/src/GitHub/Data/Options.hs b/src/GitHub/Data/Options.hs index f1ce58da..bf03c617 100644 --- a/src/GitHub/Data/Options.hs +++ b/src/GitHub/Data/Options.hs @@ -122,6 +122,7 @@ instance Binary IssueState -- | 'GitHub.Data.Issues.Issue' state reason data IssueStateReason = StateReasonCompleted + | StateReasonDuplicate | StateReasonNotPlanned | StateReasonReopened deriving @@ -130,12 +131,14 @@ data IssueStateReason instance ToJSON IssueStateReason where toJSON = String . \case StateReasonCompleted -> "completed" + StateReasonDuplicate -> "duplicate" StateReasonNotPlanned -> "not_planned" StateReasonReopened -> "reopened" instance FromJSON IssueStateReason where parseJSON = withText "IssueStateReason" $ \t -> case T.toLower t of "completed" -> pure StateReasonCompleted + "duplicate" -> pure StateReasonDuplicate "not_planned" -> pure StateReasonNotPlanned "reopened" -> pure StateReasonReopened _ -> fail $ "Unknown IssueStateReason: " <> T.unpack t From a76cec17bdcda100bc58114fb7c5037a1034cf1a Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Fri, 9 May 2025 17:31:29 +0200 Subject: [PATCH 499/510] cabal.project: pass use-pkg-config flag to HsOpenSSL --- cabal.project | 1 + 1 file changed, 1 insertion(+) diff --git a/cabal.project b/cabal.project index ed0996f6..be4081d6 100644 --- a/cabal.project +++ b/cabal.project @@ -6,6 +6,7 @@ tests: True constraints: github +openssl constraints: github-samples +openssl +constraints: HsOpenSSL +use-pkg-config constraints: operational -buildExamples -- constraints: text >=2 From 854aa2138bba952503420e08cda8c5ab3733f81a Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Fri, 9 May 2025 17:29:28 +0200 Subject: [PATCH 500/510] Revert "Revert "Support pagination (#503)"" This reverts commit dc438164bfc7b152074fdb58e1d3d18e86820777. --- github.cabal | 1 + spec/GitHub/IssuesSpec.hs | 32 ++++++++++++++++---- src/GitHub/Data/Request.hs | 39 +++++++++++++++++++++++- src/GitHub/Request.hs | 62 ++++++++++++++++++++++++++++++-------- 4 files changed, 115 insertions(+), 19 deletions(-) diff --git a/github.cabal b/github.cabal index 2c6bccf0..517468bc 100644 --- a/github.cabal +++ b/github.cabal @@ -264,6 +264,7 @@ test-suite github-test , file-embed , github , hspec >=2.6.1 && <2.12 + , http-client , tagged , text , unordered-containers diff --git a/spec/GitHub/IssuesSpec.hs b/spec/GitHub/IssuesSpec.hs index 2a7f5e7b..e673975f 100644 --- a/spec/GitHub/IssuesSpec.hs +++ b/spec/GitHub/IssuesSpec.hs @@ -6,12 +6,13 @@ import qualified GitHub 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, expectationFailure, it, pendingWith, shouldSatisfy) +import Data.Either.Compat (isRight) +import Data.Foldable (for_) +import Data.String (fromString) +import Network.HTTP.Client (newManager, responseBody) +import System.Environment (lookupEnv) +import Test.Hspec (Spec, describe, expectationFailure, it, pendingWith, shouldSatisfy) + fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b @@ -38,6 +39,25 @@ spec = do cms <- GitHub.executeRequest auth $ GitHub.commentsR owner repo (GitHub.issueNumber i) 1 cms `shouldSatisfy` isRight + + describe "issuesForRepoR paged" $ do + it "works" $ withAuth $ \auth -> for_ repos $ \(owner, repo) -> do + mgr <- newManager GitHub.tlsManagerSettings + ret <- GitHub.executeRequestWithMgrAndRes mgr auth $ + GitHub.issuesForRepoR owner repo mempty (GitHub.FetchPage (GitHub.PageParams (Just 2) (Just 1))) + + case ret of + Left e -> + expectationFailure . show $ e + Right res -> do + let issues = responseBody res + length issues `shouldSatisfy` (<= 2) + + for_ issues $ \i -> do + cms <- GitHub.executeRequest auth $ + GitHub.commentsR owner repo (GitHub.issueNumber i) 1 + cms `shouldSatisfy` isRight + describe "issueR" $ do it "fetches issue #428" $ withAuth $ \auth -> do resIss <- GitHub.executeRequest auth $ diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs index 7b4eac40..c8138c1a 100644 --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -14,6 +14,8 @@ module GitHub.Data.Request ( CommandMethod(..), toMethod, FetchCount(..), + PageParams(..), + PageLinks(..), MediaType (..), Paths, IsPathPart(..), @@ -29,6 +31,7 @@ import GitHub.Internal.Prelude import qualified Data.ByteString.Lazy as LBS import qualified Data.Text as T import qualified Network.HTTP.Types.Method as Method +import Network.URI (URI) ------------------------------------------------------------------------------ -- Path parts @@ -74,7 +77,10 @@ toMethod Delete = Method.methodDelete -- | 'PagedQuery' returns just some results, using this data we can specify how -- many pages we want to fetch. -data FetchCount = FetchAtLeast !Word | FetchAll +data FetchCount = + FetchAtLeast !Word + | FetchAll + | FetchPage PageParams deriving (Eq, Ord, Read, Show, Generic, Typeable) @@ -96,6 +102,37 @@ instance Hashable FetchCount instance Binary FetchCount instance NFData FetchCount where rnf = genericRnf +------------------------------------------------------------------------------- +-- PageParams +------------------------------------------------------------------------------- + +-- | Params for specifying the precise page and items per page. +data PageParams = PageParams { + pageParamsPerPage :: Maybe Int + , pageParamsPage :: Maybe Int + } + deriving (Eq, Ord, Read, Show, Generic, Typeable) + +instance Hashable PageParams +instance Binary PageParams +instance NFData PageParams where rnf = genericRnf + +------------------------------------------------------------------------------- +-- PageLinks +------------------------------------------------------------------------------- + +-- | 'PagedQuery' returns just some results, using this data we can specify how +-- many pages we want to fetch. +data PageLinks = PageLinks { + pageLinksPrev :: Maybe URI + , pageLinksNext :: Maybe URI + , pageLinksLast :: Maybe URI + , pageLinksFirst :: Maybe URI + } + deriving (Eq, Ord, Show, Generic, Typeable) + +instance NFData PageLinks where rnf = genericRnf + ------------------------------------------------------------------------------- -- MediaType ------------------------------------------------------------------------------- diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index c5eb006c..332d1124 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -54,6 +54,7 @@ module GitHub.Request ( ParseResponse (..), makeHttpRequest, parseStatus, + parsePageLinks, StatusMap, getNextUrl, performPagedRequest, @@ -79,6 +80,7 @@ import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Except (ExceptT (..), runExceptT) import Data.Aeson (eitherDecode) import Data.List (find) +import Data.Maybe (fromMaybe) import Data.Tagged (Tagged (..)) import Data.Version (showVersion) @@ -87,13 +89,14 @@ import Network.HTTP.Client httpLbs, method, newManager, redirectCount, requestBody, requestHeaders, setQueryString, setRequestIgnoreStatus) import Network.HTTP.Link.Parser (parseLinkHeaderBS) -import Network.HTTP.Link.Types (LinkParam (..), href, linkParams) +import Network.HTTP.Link.Types (Link(..), LinkParam (..), href, linkParams) import Network.HTTP.Types (Method, RequestHeaders, Status (..)) import Network.URI (URI, escapeURIString, isUnescapedInURIComponent, parseURIReference, relativeTo) import qualified Data.ByteString as BS +import Data.ByteString.Builder (intDec, toLazyByteString) import qualified Data.ByteString.Lazy as LBS import qualified Data.Text as T import qualified Data.Text.Encoding as TE @@ -199,11 +202,6 @@ executeRequest auth req = withOpenSSL $ do manager <- newManager tlsManagerSettings executeRequestWithMgr manager auth req -lessFetchCount :: Int -> FetchCount -> Bool -lessFetchCount _ FetchAll = True -lessFetchCount i (FetchAtLeast j) = i < fromIntegral j - - -- | Like 'executeRequest' but with provided 'Manager'. executeRequestWithMgr :: (AuthMethod am, ParseResponse mt a) @@ -235,10 +233,13 @@ executeRequestWithMgrAndRes mgr auth req = runExceptT $ do res <- httpLbs' httpReq (<$ res) <$> unTagged (parseResponse httpReq res :: Tagged mt (ExceptT Error IO b)) - performHttpReq httpReq (PagedQuery _ _ l) = - unTagged (performPagedRequest httpLbs' predicate httpReq :: Tagged mt (ExceptT Error IO (HTTP.Response b))) - where - predicate v = lessFetchCount (length v) l + performHttpReq httpReq (PagedQuery _ _ (FetchPage _)) = do + (res, _pageLinks) <- unTagged (performPerPageRequest httpLbs' httpReq :: Tagged mt (ExceptT Error IO (HTTP.Response b, PageLinks))) + return res + performHttpReq httpReq (PagedQuery _ _ FetchAll) = + unTagged (performPagedRequest httpLbs' (const True) httpReq :: Tagged mt (ExceptT Error IO (HTTP.Response b))) + performHttpReq httpReq (PagedQuery _ _ (FetchAtLeast j)) = + unTagged (performPagedRequest httpLbs' (\v -> length v < fromIntegral j) httpReq :: Tagged mt (ExceptT Error IO (HTTP.Response b))) performHttpReq httpReq (Command _ _ _) = do res <- httpLbs' httpReq @@ -456,7 +457,7 @@ makeHttpRequest auth r = case r of $ setReqHeaders . unTagged (modifyRequest :: Tagged mt (HTTP.Request -> HTTP.Request)) . maybe id setAuthRequest auth - . setQueryString qs + . setQueryString (qs <> extraQueryItems) $ req PagedQuery paths qs _ -> do req <- parseUrl' $ url paths @@ -464,7 +465,7 @@ makeHttpRequest auth r = case r of $ setReqHeaders . unTagged (modifyRequest :: Tagged mt (HTTP.Request -> HTTP.Request)) . maybe id setAuthRequest auth - . setQueryString qs + . setQueryString (qs <> extraQueryItems) $ req Command m paths body -> do req <- parseUrl' $ url paths @@ -496,6 +497,14 @@ makeHttpRequest auth r = case r of setBody :: LBS.ByteString -> HTTP.Request -> HTTP.Request setBody body req = req { requestBody = RequestBodyLBS body } + extraQueryItems :: [(BS.ByteString, Maybe BS.ByteString)] + extraQueryItems = case r of + PagedQuery _ _ (FetchPage pp) -> catMaybes [ + (\page -> ("page", Just (BS.toStrict $ toLazyByteString $ intDec page))) <$> pageParamsPage pp + , (\perPage -> ("per_page", Just (BS.toStrict $ toLazyByteString $ intDec perPage))) <$> pageParamsPerPage pp + ] + _ -> [] + -- | Query @Link@ header with @rel=next@ from the request headers. getNextUrl :: HTTP.Response a -> Maybe URI getNextUrl req = do @@ -542,6 +551,35 @@ performPagedRequest httpLbs' predicate initReq = Tagged $ do go (acc <> m) res' req' (_, _) -> return (acc <$ res) +-- | Helper for requesting a single page, as specified by 'PageParams'. +-- +-- This parses and returns the 'PageLinks' alongside the HTTP response. +performPerPageRequest + :: forall a m mt. (ParseResponse mt a, MonadCatch m, MonadError Error m) + => (HTTP.Request -> m (HTTP.Response LBS.ByteString)) -- ^ `httpLbs` analogue + -> HTTP.Request -- ^ initial request + -> Tagged mt (m (HTTP.Response a, PageLinks)) +performPerPageRequest httpLbs' initReq = Tagged $ do + res <- httpLbs' initReq + m <- unTagged (parseResponse initReq res :: Tagged mt (m a)) + return (m <$ res, parsePageLinks res) + +-- | Parse the 'PageLinks' from an HTTP response, where the information is +-- encoded in the Link header. +parsePageLinks :: HTTP.Response a -> PageLinks +parsePageLinks res = PageLinks { + pageLinksPrev = linkToUri <$> find (elem (Rel, "prev") . linkParams) links + , pageLinksNext = linkToUri <$> find (elem (Rel, "next") . linkParams) links + , pageLinksLast = linkToUri <$> find (elem (Rel, "last") . linkParams) links + , pageLinksFirst = linkToUri <$> find (elem (Rel, "first") . linkParams) links + } + where + links :: [Link URI] + links = fromMaybe [] (lookup "Link" (responseHeaders res) >>= parseLinkHeaderBS) + + linkToUri :: Link URI -> URI + linkToUri (Link uri _) = uri + ------------------------------------------------------------------------------- -- Internal ------------------------------------------------------------------------------- From c54e7d65fad497c9d2e492ee9ea2c9e5650c2d71 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Fri, 9 May 2025 17:39:55 +0200 Subject: [PATCH 501/510] Fix compilation with bytestring<11 --- src/GitHub/Request.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index 332d1124..39deb0a6 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -500,8 +500,8 @@ makeHttpRequest auth r = case r of extraQueryItems :: [(BS.ByteString, Maybe BS.ByteString)] extraQueryItems = case r of PagedQuery _ _ (FetchPage pp) -> catMaybes [ - (\page -> ("page", Just (BS.toStrict $ toLazyByteString $ intDec page))) <$> pageParamsPage pp - , (\perPage -> ("per_page", Just (BS.toStrict $ toLazyByteString $ intDec perPage))) <$> pageParamsPerPage pp + (\page -> ("page", Just (LBS.toStrict $ toLazyByteString $ intDec page))) <$> pageParamsPage pp + , (\perPage -> ("per_page", Just (LBS.toStrict $ toLazyByteString $ intDec perPage))) <$> pageParamsPerPage pp ] _ -> [] From affa80fba86af0086cc6665675fd008cd0c06702 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Domen=20Ko=C5=BEar?= Date: Fri, 9 Sep 2022 10:59:33 +0100 Subject: [PATCH 502/510] Implement organization membership endpoint --- src/GitHub.hs | 1 + src/GitHub/Data/Definitions.hs | 57 +++++++++++++++++++ src/GitHub/Endpoints/Organizations/Members.hs | 8 +++ 3 files changed, 66 insertions(+) diff --git a/src/GitHub.hs b/src/GitHub.hs index 309cb1db..5d323de8 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -173,6 +173,7 @@ module GitHub ( membersOfWithR, isMemberOfR, orgInvitationsR, + orgMembershipR, -- ** Outside Collaborators -- | See -- diff --git a/src/GitHub/Data/Definitions.hs b/src/GitHub/Data/Definitions.hs index 73962f28..456974f7 100644 --- a/src/GitHub/Data/Definitions.hs +++ b/src/GitHub/Data/Definitions.hs @@ -233,6 +233,63 @@ type QueryString = [(BS.ByteString, Maybe BS.ByteString)] -- | Count of elements type Count = Int + + +data MembershipRole + = MembershipRoleMember + | MembershipRoleAdmin + | MembershipRoleBillingManager + deriving + (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) + +instance NFData MembershipRole where rnf = genericRnf +instance Binary MembershipRole + +instance FromJSON MembershipRole where + parseJSON = withText "MembershipRole" $ \t -> case T.toLower t of + "member" -> pure MembershipRoleMember + "admin" -> pure MembershipRoleAdmin + "billing_manager" -> pure MembershipRoleBillingManager + _ -> fail $ "Unknown MembershipRole: " <> T.unpack t + +data MembershipState + = MembershipPending + | MembershipActive + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData MembershipState where rnf = genericRnf +instance Binary MembershipState + +instance FromJSON MembershipState where + parseJSON = withText "MembershipState" $ \t -> case T.toLower t of + "active" -> pure MembershipActive + "pending" -> pure MembershipPending + _ -> fail $ "Unknown MembershipState: " <> T.unpack t + + +data Membership = Membership + { membershipUrl :: !URL + , membershipState :: !MembershipState + , membershipRole :: !MembershipRole + , membershipOrganizationUrl :: !URL + , membershipOrganization :: !SimpleOrganization + , membershipUser :: !SimpleUser + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Membership where rnf = genericRnf +instance Binary Membership + +instance FromJSON Membership where + parseJSON = withObject "Membership" $ \o -> Membership + <$> o .: "url" + <*> o .: "state" + <*> o .: "role" + <*> o .: "organization_url" + <*> o .: "organization" + <*> o .: "user" + + ------------------------------------------------------------------------------- -- IssueNumber ------------------------------------------------------------------------------- diff --git a/src/GitHub/Endpoints/Organizations/Members.hs b/src/GitHub/Endpoints/Organizations/Members.hs index 84e52e43..8de82b77 100644 --- a/src/GitHub/Endpoints/Organizations/Members.hs +++ b/src/GitHub/Endpoints/Organizations/Members.hs @@ -7,6 +7,7 @@ module GitHub.Endpoints.Organizations.Members ( membersOfWithR, isMemberOfR, orgInvitationsR, + orgMembershipR, module GitHub.Data, ) where @@ -48,3 +49,10 @@ isMemberOfR user org = -- See orgInvitationsR :: Name Organization -> FetchCount -> Request 'RA (Vector Invitation) orgInvitationsR org = pagedQuery ["orgs", toPathPart org, "invitations"] [] + +-- | Get user membership information in an organization +-- +-- See +orgMembershipR :: Name User -> Name Organization -> Request 'RA Membership +orgMembershipR user org = + Query [ "orgs", toPathPart org, "memberships", toPathPart user ] [] \ No newline at end of file From 78e136d0936dd1430a5d2d366bf743b893d939b3 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Fri, 9 May 2025 18:10:20 +0200 Subject: [PATCH 503/510] Changelog for 0.30 --- CHANGELOG.md | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index e090d021..45c00f5a 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,9 +1,19 @@ -## Changes for 0.29.1 +## Changes for 0.30 +_2025-05-09, Andreas Abel, Peace edition_ + +- Organization membership endpoint (Domen Kožar, PR [#487](https://github.com/haskell-github/github/pull/487)). +- Allow JWT as an authentication method (Tom Sydney Kerckhove, PR [#497](https://github.com/haskell-github/github/pull/497)). +- Support pagination (Tom McLaughlin, PR [#503](https://github.com/haskell-github/github/pull/503)). +- Initial subset of Reactions endpoints (Dan Rijks, PR [#509](https://github.com/haskell-github/github/pull/509)). +- Fix `getNotifications` (maralorn, PR [#511](https://github.com/haskell-github/github/pull/511)). +- Add missing `name` field to `WorkflowJobs` `Job` type (Hugh Davidson, PR [#518](https://github.com/haskell-github/github/pull/518)). +- Add `StateReasonDuplicate` to `IssueStateReason` (PR [#523](https://github.com/haskell-github/github/pull/523)). - Drop support for GHC 8.0 and below. - Drop dependency `time-compat`. -Tested with GHC 8.2 - 9.10.1. +Tested with GHC 8.2 - 9.12.2. + ## Changes for 0.29 From 7076a46da978683e16f5617e666eb0e6fe3a3b21 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Wed, 27 Aug 2025 12:34:25 +0200 Subject: [PATCH 504/510] Drop obsolete dependency on deepseq-generics Functionality is available from deepseq --- github.cabal | 1 - src/GitHub/Auth.hs | 2 +- src/GitHub/Data/Actions/Workflows.hs | 2 +- src/GitHub/Data/Activities.hs | 8 +++--- src/GitHub/Data/Comments.hs | 10 +++---- src/GitHub/Data/Content.hs | 22 +++++++-------- src/GitHub/Data/Definitions.hs | 24 ++++++++--------- src/GitHub/Data/Deployments.hs | 12 ++++----- src/GitHub/Data/Email.hs | 4 +-- src/GitHub/Data/Enterprise/Organizations.hs | 6 ++--- src/GitHub/Data/Events.hs | 2 +- src/GitHub/Data/Gists.hs | 10 +++---- src/GitHub/Data/GitData.hs | 30 ++++++++++----------- src/GitHub/Data/Invitation.hs | 6 ++--- src/GitHub/Data/Issues.hs | 12 ++++----- src/GitHub/Data/Milestone.hs | 6 ++--- src/GitHub/Data/Options.hs | 16 +++++------ src/GitHub/Data/PullRequests.hs | 18 ++++++------- src/GitHub/Data/RateLimit.hs | 4 +-- src/GitHub/Data/Reactions.hs | 6 ++--- src/GitHub/Data/Releases.hs | 4 +-- src/GitHub/Data/Repos.hs | 20 +++++++------- src/GitHub/Data/Request.hs | 6 ++--- src/GitHub/Data/Reviews.hs | 12 +++------ src/GitHub/Data/Search.hs | 4 +-- src/GitHub/Data/Statuses.hs | 4 +-- src/GitHub/Data/Teams.hs | 20 +++++++------- src/GitHub/Data/URL.hs | 2 +- src/GitHub/Data/Webhooks.hs | 12 ++++----- src/GitHub/Internal/Prelude.hs | 1 - 30 files changed, 139 insertions(+), 147 deletions(-) diff --git a/github.cabal b/github.cabal index 517468bc..b9843588 100644 --- a/github.cabal +++ b/github.cabal @@ -203,7 +203,6 @@ library , base16-bytestring >=0.1.1.6 && <1.1 , binary-instances >=1 && <1.1 , cryptohash-sha1 >=0.11.100.1 && <0.12 - , deepseq-generics >=0.2.0.0 && <0.3 , hashable >=1.2.7.0 && <2 , http-client >=0.5.12 && <0.8 , http-link-header >=1.0.3.1 && <1.3 diff --git a/src/GitHub/Auth.hs b/src/GitHub/Auth.hs index 2b41dbf4..1800808f 100644 --- a/src/GitHub/Auth.hs +++ b/src/GitHub/Auth.hs @@ -25,7 +25,7 @@ data Auth | EnterpriseOAuth Text Token -- ^ Custom endpoint and OAuth token deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Auth where rnf = genericRnf +instance NFData Auth instance Binary Auth instance Hashable Auth diff --git a/src/GitHub/Data/Actions/Workflows.hs b/src/GitHub/Data/Actions/Workflows.hs index 9dd2252d..ae36ddbf 100644 --- a/src/GitHub/Data/Actions/Workflows.hs +++ b/src/GitHub/Data/Actions/Workflows.hs @@ -33,7 +33,7 @@ data CreateWorkflowDispatchEvent a = CreateWorkflowDispatchEvent } deriving (Show, Generic) -instance (NFData a) => NFData (CreateWorkflowDispatchEvent a) where rnf = genericRnf +instance (NFData a) => NFData (CreateWorkflowDispatchEvent a) instance (Binary a) => Binary (CreateWorkflowDispatchEvent a) ------------------------------------------------------------------------------- diff --git a/src/GitHub/Data/Activities.hs b/src/GitHub/Data/Activities.hs index 540241c8..70e356cf 100644 --- a/src/GitHub/Data/Activities.hs +++ b/src/GitHub/Data/Activities.hs @@ -15,7 +15,7 @@ data RepoStarred = RepoStarred } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData RepoStarred where rnf = genericRnf +instance NFData RepoStarred instance Binary RepoStarred -- JSON Instances @@ -35,7 +35,7 @@ data Subject = Subject } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Subject where rnf = genericRnf +instance NFData Subject instance Binary Subject instance FromJSON Subject where @@ -63,7 +63,7 @@ data NotificationReason | TeamMentionReason deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic) -instance NFData NotificationReason where rnf = genericRnf +instance NFData NotificationReason instance Binary NotificationReason instance FromJSON NotificationReason where @@ -99,7 +99,7 @@ data Notification = Notification } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Notification where rnf = genericRnf +instance NFData Notification instance Binary Notification instance FromJSON Notification where diff --git a/src/GitHub/Data/Comments.hs b/src/GitHub/Data/Comments.hs index d4a9194d..0084cd9b 100644 --- a/src/GitHub/Data/Comments.hs +++ b/src/GitHub/Data/Comments.hs @@ -21,7 +21,7 @@ data Comment = Comment } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Comment where rnf = genericRnf +instance NFData Comment instance Binary Comment instance FromJSON Comment where @@ -43,7 +43,7 @@ data NewComment = NewComment } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData NewComment where rnf = genericRnf +instance NFData NewComment instance Binary NewComment instance ToJSON NewComment where @@ -54,7 +54,7 @@ data EditComment = EditComment } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData EditComment where rnf = genericRnf +instance NFData EditComment instance Binary EditComment instance ToJSON EditComment where @@ -68,7 +68,7 @@ data NewPullComment = NewPullComment } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData NewPullComment where rnf = genericRnf +instance NFData NewPullComment instance Binary NewPullComment instance ToJSON NewPullComment where @@ -84,7 +84,7 @@ data PullCommentReply = PullCommentReply } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData PullCommentReply where rnf = genericRnf +instance NFData PullCommentReply instance ToJSON PullCommentReply where toJSON (PullCommentReply b) = diff --git a/src/GitHub/Data/Content.hs b/src/GitHub/Data/Content.hs index d776c2b6..2ac55039 100644 --- a/src/GitHub/Data/Content.hs +++ b/src/GitHub/Data/Content.hs @@ -20,7 +20,7 @@ data Content | ContentDirectory !(Vector ContentItem) deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Content where rnf = genericRnf +instance NFData Content instance Binary Content data ContentFileData = ContentFileData { @@ -30,7 +30,7 @@ data ContentFileData = ContentFileData { ,contentFileContent :: !Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData ContentFileData where rnf = genericRnf +instance NFData ContentFileData instance Binary ContentFileData -- | An item in a directory listing. @@ -39,13 +39,13 @@ data ContentItem = ContentItem { ,contentItemInfo :: !ContentInfo } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData ContentItem where rnf = genericRnf +instance NFData ContentItem instance Binary ContentItem data ContentItemType = ItemFile | ItemDir deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData ContentItemType where rnf = genericRnf +instance NFData ContentItemType instance Binary ContentItemType -- | Information common to both kinds of Content: files and directories. @@ -58,7 +58,7 @@ data ContentInfo = ContentInfo { ,contentHtmlUrl :: !URL } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData ContentInfo where rnf = genericRnf +instance NFData ContentInfo instance Binary ContentInfo data ContentResultInfo = ContentResultInfo @@ -66,7 +66,7 @@ data ContentResultInfo = ContentResultInfo , contentResultSize :: !Int } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData ContentResultInfo where rnf = genericRnf +instance NFData ContentResultInfo instance Binary ContentResultInfo data ContentResult = ContentResult @@ -74,7 +74,7 @@ data ContentResult = ContentResult , contentResultCommit :: !GitCommit } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData ContentResult where rnf = genericRnf +instance NFData ContentResult instance Binary ContentResult data Author = Author @@ -83,7 +83,7 @@ data Author = Author } deriving (Eq, Ord, Show, Data, Typeable, Generic) -instance NFData Author where rnf = genericRnf +instance NFData Author instance Binary Author data CreateFile = CreateFile @@ -96,7 +96,7 @@ data CreateFile = CreateFile } deriving (Eq, Ord, Show, Data, Typeable, Generic) -instance NFData CreateFile where rnf = genericRnf +instance NFData CreateFile instance Binary CreateFile data UpdateFile = UpdateFile @@ -110,7 +110,7 @@ data UpdateFile = UpdateFile } deriving (Eq, Ord, Show, Data, Typeable, Generic) -instance NFData UpdateFile where rnf = genericRnf +instance NFData UpdateFile instance Binary UpdateFile data DeleteFile = DeleteFile @@ -123,7 +123,7 @@ data DeleteFile = DeleteFile } deriving (Eq, Ord, Show, Data, Typeable, Generic) -instance NFData DeleteFile where rnf = genericRnf +instance NFData DeleteFile instance Binary DeleteFile instance FromJSON Content where diff --git a/src/GitHub/Data/Definitions.hs b/src/GitHub/Data/Definitions.hs index 456974f7..060c4bec 100644 --- a/src/GitHub/Data/Definitions.hs +++ b/src/GitHub/Data/Definitions.hs @@ -41,7 +41,7 @@ data SimpleUser = SimpleUser } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData SimpleUser where rnf = genericRnf +instance NFData SimpleUser instance Binary SimpleUser data SimpleOrganization = SimpleOrganization @@ -52,7 +52,7 @@ data SimpleOrganization = SimpleOrganization } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData SimpleOrganization where rnf = genericRnf +instance NFData SimpleOrganization instance Binary SimpleOrganization -- | Sometimes we don't know the type of the owner, e.g. in 'Repo' @@ -65,7 +65,7 @@ data SimpleOwner = SimpleOwner } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData SimpleOwner where rnf = genericRnf +instance NFData SimpleOwner instance Binary SimpleOwner data User = User @@ -90,7 +90,7 @@ data User = User } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData User where rnf = genericRnf +instance NFData User instance Binary User data Organization = Organization @@ -113,14 +113,14 @@ data Organization = Organization } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Organization where rnf = genericRnf +instance NFData Organization instance Binary Organization -- | In practice you can't have concrete values of 'Owner'. newtype Owner = Owner (Either User Organization) deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Owner where rnf = genericRnf +instance NFData Owner instance Binary Owner fromOwner :: Owner -> Either User Organization @@ -242,7 +242,7 @@ data MembershipRole deriving (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) -instance NFData MembershipRole where rnf = genericRnf +instance NFData MembershipRole instance Binary MembershipRole instance FromJSON MembershipRole where @@ -257,7 +257,7 @@ data MembershipState | MembershipActive deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData MembershipState where rnf = genericRnf +instance NFData MembershipState instance Binary MembershipState instance FromJSON MembershipState where @@ -277,7 +277,7 @@ data Membership = Membership } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Membership where rnf = genericRnf +instance NFData Membership instance Binary Membership instance FromJSON Membership where @@ -324,7 +324,7 @@ data IssueLabel = IssueLabel } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData IssueLabel where rnf = genericRnf +instance NFData IssueLabel instance Binary IssueLabel instance FromJSON IssueLabel where @@ -346,7 +346,7 @@ data NewIssueLabel = NewIssueLabel } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData NewIssueLabel where rnf = genericRnf +instance NFData NewIssueLabel instance Binary NewIssueLabel @@ -373,7 +373,7 @@ data UpdateIssueLabel = UpdateIssueLabel } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData UpdateIssueLabel where rnf = genericRnf +instance NFData UpdateIssueLabel instance Binary UpdateIssueLabel diff --git a/src/GitHub/Data/Deployments.hs b/src/GitHub/Data/Deployments.hs index e14a214e..b8ba2df0 100644 --- a/src/GitHub/Data/Deployments.hs +++ b/src/GitHub/Data/Deployments.hs @@ -36,7 +36,7 @@ data DeploymentQueryOption | DeploymentQueryEnvironment !Text deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData DeploymentQueryOption where rnf = genericRnf +instance NFData DeploymentQueryOption instance Binary DeploymentQueryOption renderDeploymentQueryOption :: DeploymentQueryOption -> (ByteString, ByteString) @@ -63,7 +63,7 @@ data Deployment a = Deployment , deploymentRepositoryUrl :: !URL } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData a => NFData (Deployment a) where rnf = genericRnf +instance NFData a => NFData (Deployment a) instance Binary a => Binary (Deployment a) instance FromJSON a => FromJSON (Deployment a) where @@ -106,7 +106,7 @@ data CreateDeployment a = CreateDeployment -- ^ Short description of the deployment. Default: "" } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData a => NFData (CreateDeployment a) where rnf = genericRnf +instance NFData a => NFData (CreateDeployment a) instance Binary a => Binary (CreateDeployment a) instance ToJSON a => ToJSON (CreateDeployment a) where @@ -134,7 +134,7 @@ data DeploymentStatus = DeploymentStatus , deploymentStatusRepositoryUrl :: !URL } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData DeploymentStatus where rnf = genericRnf +instance NFData DeploymentStatus instance Binary DeploymentStatus instance FromJSON DeploymentStatus where @@ -159,7 +159,7 @@ data DeploymentStatusState | DeploymentStatusInactive deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData DeploymentStatusState where rnf = genericRnf +instance NFData DeploymentStatusState instance Binary DeploymentStatusState instance ToJSON DeploymentStatusState where @@ -192,7 +192,7 @@ data CreateDeploymentStatus = CreateDeploymentStatus -- Default: "" } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData CreateDeploymentStatus where rnf = genericRnf +instance NFData CreateDeploymentStatus instance Binary CreateDeploymentStatus instance ToJSON CreateDeploymentStatus where diff --git a/src/GitHub/Data/Email.hs b/src/GitHub/Data/Email.hs index 9ff578b6..6e151760 100644 --- a/src/GitHub/Data/Email.hs +++ b/src/GitHub/Data/Email.hs @@ -10,7 +10,7 @@ data EmailVisibility | EmailVisibilityPublic deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic) -instance NFData EmailVisibility where rnf = genericRnf +instance NFData EmailVisibility instance Binary EmailVisibility instance FromJSON EmailVisibility where @@ -26,7 +26,7 @@ data Email = Email , emailVisibility :: !(Maybe EmailVisibility) } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Email where rnf = genericRnf +instance NFData Email instance Binary Email instance FromJSON Email where diff --git a/src/GitHub/Data/Enterprise/Organizations.hs b/src/GitHub/Data/Enterprise/Organizations.hs index 9c48f386..29f179af 100644 --- a/src/GitHub/Data/Enterprise/Organizations.hs +++ b/src/GitHub/Data/Enterprise/Organizations.hs @@ -13,7 +13,7 @@ data CreateOrganization = CreateOrganization } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData CreateOrganization where rnf = genericRnf +instance NFData CreateOrganization instance Binary CreateOrganization data RenameOrganization = RenameOrganization @@ -21,7 +21,7 @@ data RenameOrganization = RenameOrganization } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData RenameOrganization where rnf = genericRnf +instance NFData RenameOrganization instance Binary RenameOrganization data RenameOrganizationResponse = RenameOrganizationResponse @@ -30,7 +30,7 @@ data RenameOrganizationResponse = RenameOrganizationResponse } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData RenameOrganizationResponse where rnf = genericRnf +instance NFData RenameOrganizationResponse instance Binary RenameOrganizationResponse -- JSON Instances diff --git a/src/GitHub/Data/Events.hs b/src/GitHub/Data/Events.hs index db0e881a..16b85eca 100644 --- a/src/GitHub/Data/Events.hs +++ b/src/GitHub/Data/Events.hs @@ -18,7 +18,7 @@ data Event = Event } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Event where rnf = genericRnf +instance NFData Event instance Binary Event instance FromJSON Event where diff --git a/src/GitHub/Data/Gists.hs b/src/GitHub/Data/Gists.hs index ab2e846d..7e46c686 100644 --- a/src/GitHub/Data/Gists.hs +++ b/src/GitHub/Data/Gists.hs @@ -23,7 +23,7 @@ data Gist = Gist , gistGitPullUrl :: !URL } deriving (Show, Data, Typeable, Eq, Generic) -instance NFData Gist where rnf = genericRnf +instance NFData Gist instance Binary Gist instance FromJSON Gist where @@ -51,7 +51,7 @@ data GistFile = GistFile } deriving (Show, Data, Typeable, Eq, Generic) -instance NFData GistFile where rnf = genericRnf +instance NFData GistFile instance Binary GistFile instance FromJSON GistFile where @@ -73,7 +73,7 @@ data GistComment = GistComment } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData GistComment where rnf = genericRnf +instance NFData GistComment instance Binary GistComment instance FromJSON GistComment where @@ -91,7 +91,7 @@ data NewGist = NewGist , newGistPublic :: !(Maybe Bool) } deriving (Show, Data, Typeable, Eq, Generic) -instance NFData NewGist where rnf = genericRnf +instance NFData NewGist instance Binary NewGist instance ToJSON NewGist where @@ -111,7 +111,7 @@ data NewGistFile = NewGistFile { newGistFileContent :: !Text } deriving (Show, Data, Typeable, Eq, Generic) -instance NFData NewGistFile where rnf = genericRnf +instance NFData NewGistFile instance Binary NewGistFile instance ToJSON NewGistFile where diff --git a/src/GitHub/Data/GitData.hs b/src/GitHub/Data/GitData.hs index 95b47533..d4fd8798 100644 --- a/src/GitHub/Data/GitData.hs +++ b/src/GitHub/Data/GitData.hs @@ -24,7 +24,7 @@ data Stats = Stats } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Stats where rnf = genericRnf +instance NFData Stats instance Binary Stats data Commit = Commit @@ -39,7 +39,7 @@ data Commit = Commit } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Commit where rnf = genericRnf +instance NFData Commit instance Binary Commit data Tree = Tree @@ -49,7 +49,7 @@ data Tree = Tree } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Tree where rnf = genericRnf +instance NFData Tree instance Binary Tree data GitTree = GitTree @@ -63,7 +63,7 @@ data GitTree = GitTree } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData GitTree where rnf = genericRnf +instance NFData GitTree instance Binary GitTree data GitCommit = GitCommit @@ -77,7 +77,7 @@ data GitCommit = GitCommit } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData GitCommit where rnf = genericRnf +instance NFData GitCommit instance Binary GitCommit data Blob = Blob @@ -89,7 +89,7 @@ data Blob = Blob } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Blob where rnf = genericRnf +instance NFData Blob instance Binary Blob data Tag = Tag @@ -100,7 +100,7 @@ data Tag = Tag } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Tag where rnf = genericRnf +instance NFData Tag instance Binary Tag data Branch = Branch @@ -109,7 +109,7 @@ data Branch = Branch } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Branch where rnf = genericRnf +instance NFData Branch data BranchCommit = BranchCommit { branchCommitSha :: !Text @@ -117,7 +117,7 @@ data BranchCommit = BranchCommit } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData BranchCommit where rnf = genericRnf +instance NFData BranchCommit instance Binary BranchCommit data Diff = Diff @@ -136,7 +136,7 @@ data Diff = Diff } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Diff where rnf = genericRnf +instance NFData Diff instance Binary Diff data NewGitReference = NewGitReference @@ -145,7 +145,7 @@ data NewGitReference = NewGitReference } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData NewGitReference where rnf = genericRnf +instance NFData NewGitReference instance Binary NewGitReference data GitReference = GitReference @@ -155,7 +155,7 @@ data GitReference = GitReference } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData GitReference where rnf = genericRnf +instance NFData GitReference instance Binary GitReference data GitObject = GitObject @@ -165,7 +165,7 @@ data GitObject = GitObject } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData GitObject where rnf = genericRnf +instance NFData GitObject instance Binary GitObject data GitUser = GitUser @@ -175,7 +175,7 @@ data GitUser = GitUser } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData GitUser where rnf = genericRnf +instance NFData GitUser instance Binary GitUser data File = File @@ -191,7 +191,7 @@ data File = File } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData File where rnf = genericRnf +instance NFData File instance Binary File -- JSON instances diff --git a/src/GitHub/Data/Invitation.hs b/src/GitHub/Data/Invitation.hs index 1ea656f9..3267c2a3 100644 --- a/src/GitHub/Data/Invitation.hs +++ b/src/GitHub/Data/Invitation.hs @@ -21,7 +21,7 @@ data Invitation = Invitation } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Invitation where rnf = genericRnf +instance NFData Invitation instance Binary Invitation instance FromJSON Invitation where @@ -43,7 +43,7 @@ data InvitationRole deriving (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) -instance NFData InvitationRole where rnf = genericRnf +instance NFData InvitationRole instance Binary InvitationRole instance FromJSON InvitationRole where @@ -67,7 +67,7 @@ data RepoInvitation = RepoInvitation } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData RepoInvitation where rnf = genericRnf +instance NFData RepoInvitation instance Binary RepoInvitation instance FromJSON RepoInvitation where diff --git a/src/GitHub/Data/Issues.hs b/src/GitHub/Data/Issues.hs index 191b342e..99928ece 100644 --- a/src/GitHub/Data/Issues.hs +++ b/src/GitHub/Data/Issues.hs @@ -35,7 +35,7 @@ data Issue = Issue } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Issue where rnf = genericRnf +instance NFData Issue instance Binary Issue data NewIssue = NewIssue @@ -47,7 +47,7 @@ data NewIssue = NewIssue } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData NewIssue where rnf = genericRnf +instance NFData NewIssue instance Binary NewIssue data EditIssue = EditIssue @@ -60,7 +60,7 @@ data EditIssue = EditIssue } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData EditIssue where rnf = genericRnf +instance NFData EditIssue instance Binary EditIssue data IssueComment = IssueComment @@ -74,7 +74,7 @@ data IssueComment = IssueComment } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData IssueComment where rnf = genericRnf +instance NFData IssueComment instance Binary IssueComment -- | See @@ -108,7 +108,7 @@ data EventType | ConvertedNoteToIssue -- ^ The issue was created by converting a note in a project board to an issue. deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic) -instance NFData EventType where rnf = genericRnf +instance NFData EventType instance Binary EventType -- | Issue event @@ -124,7 +124,7 @@ data IssueEvent = IssueEvent } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData IssueEvent where rnf = genericRnf +instance NFData IssueEvent instance Binary IssueEvent instance FromJSON IssueEvent where diff --git a/src/GitHub/Data/Milestone.hs b/src/GitHub/Data/Milestone.hs index 385678d1..aa907999 100644 --- a/src/GitHub/Data/Milestone.hs +++ b/src/GitHub/Data/Milestone.hs @@ -20,7 +20,7 @@ data Milestone = Milestone } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Milestone where rnf = genericRnf +instance NFData Milestone instance Binary Milestone instance FromJSON Milestone where @@ -44,7 +44,7 @@ data NewMilestone = NewMilestone } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData NewMilestone where rnf = genericRnf +instance NFData NewMilestone instance Binary NewMilestone @@ -67,7 +67,7 @@ data UpdateMilestone = UpdateMilestone } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData UpdateMilestone where rnf = genericRnf +instance NFData UpdateMilestone instance Binary UpdateMilestone diff --git a/src/GitHub/Data/Options.hs b/src/GitHub/Data/Options.hs index bf03c617..33899fbe 100644 --- a/src/GitHub/Data/Options.hs +++ b/src/GitHub/Data/Options.hs @@ -116,7 +116,7 @@ instance FromJSON IssueState where "closed" -> pure StateClosed _ -> fail $ "Unknown IssueState: " <> T.unpack t -instance NFData IssueState where rnf = genericRnf +instance NFData IssueState instance Binary IssueState -- | 'GitHub.Data.Issues.Issue' state reason @@ -143,7 +143,7 @@ instance FromJSON IssueStateReason where "reopened" -> pure StateReasonReopened _ -> fail $ "Unknown IssueStateReason: " <> T.unpack t -instance NFData IssueStateReason where rnf = genericRnf +instance NFData IssueStateReason instance Binary IssueStateReason -- | 'GitHub.Data.PullRequests.PullRequest' mergeable_state @@ -178,7 +178,7 @@ instance FromJSON MergeableState where "draft" -> pure StateDraft _ -> fail $ "Unknown MergeableState: " <> T.unpack t -instance NFData MergeableState where rnf = genericRnf +instance NFData MergeableState instance Binary MergeableState data SortDirection @@ -187,7 +187,7 @@ data SortDirection deriving (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) -instance NFData SortDirection where rnf = genericRnf +instance NFData SortDirection instance Binary SortDirection -- PR @@ -200,7 +200,7 @@ data SortPR deriving (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) -instance NFData SortPR where rnf = genericRnf +instance NFData SortPR instance Binary SortPR -- Issue @@ -213,7 +213,7 @@ data IssueFilter deriving (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) -instance NFData IssueFilter where rnf = genericRnf +instance NFData IssueFilter instance Binary IssueFilter data SortIssue @@ -223,7 +223,7 @@ data SortIssue deriving (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) -instance NFData SortIssue where rnf = genericRnf +instance NFData SortIssue instance Binary SortIssue data FilterBy a @@ -245,7 +245,7 @@ data SortCache deriving (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) -instance NFData SortCache where rnf = genericRnf +instance NFData SortCache instance Binary SortCache ------------------------------------------------------------------------------- diff --git a/src/GitHub/Data/PullRequests.hs b/src/GitHub/Data/PullRequests.hs index 79054b6a..660fd0a5 100644 --- a/src/GitHub/Data/PullRequests.hs +++ b/src/GitHub/Data/PullRequests.hs @@ -45,7 +45,7 @@ data SimplePullRequest = SimplePullRequest } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData SimplePullRequest where rnf = genericRnf +instance NFData SimplePullRequest instance Binary SimplePullRequest data PullRequest = PullRequest @@ -83,7 +83,7 @@ data PullRequest = PullRequest } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData PullRequest where rnf = genericRnf +instance NFData PullRequest instance Binary PullRequest data EditPullRequest = EditPullRequest @@ -96,7 +96,7 @@ data EditPullRequest = EditPullRequest } deriving (Show, Generic) -instance NFData EditPullRequest where rnf = genericRnf +instance NFData EditPullRequest instance Binary EditPullRequest data CreatePullRequest @@ -113,7 +113,7 @@ data CreatePullRequest } deriving (Show, Generic) -instance NFData CreatePullRequest where rnf = genericRnf +instance NFData CreatePullRequest instance Binary CreatePullRequest data PullRequestLinks = PullRequestLinks @@ -124,7 +124,7 @@ data PullRequestLinks = PullRequestLinks } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData PullRequestLinks where rnf = genericRnf +instance NFData PullRequestLinks instance Binary PullRequestLinks data PullRequestCommit = PullRequestCommit @@ -136,7 +136,7 @@ data PullRequestCommit = PullRequestCommit } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData PullRequestCommit where rnf = genericRnf +instance NFData PullRequestCommit instance Binary PullRequestCommit data PullRequestEvent = PullRequestEvent @@ -148,7 +148,7 @@ data PullRequestEvent = PullRequestEvent } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData PullRequestEvent where rnf = genericRnf +instance NFData PullRequestEvent instance Binary PullRequestEvent data PullRequestEventType @@ -165,7 +165,7 @@ data PullRequestEventType | PullRequestEdited deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData PullRequestEventType where rnf = genericRnf +instance NFData PullRequestEventType instance Binary PullRequestEventType data PullRequestReference = PullRequestReference @@ -175,7 +175,7 @@ data PullRequestReference = PullRequestReference } deriving (Eq, Ord, Show, Generic, Typeable, Data) -instance NFData PullRequestReference where rnf = genericRnf +instance NFData PullRequestReference instance Binary PullRequestReference diff --git a/src/GitHub/Data/RateLimit.hs b/src/GitHub/Data/RateLimit.hs index 4e0b549c..d2b98d73 100644 --- a/src/GitHub/Data/RateLimit.hs +++ b/src/GitHub/Data/RateLimit.hs @@ -15,7 +15,7 @@ data Limits = Limits } deriving (Show, {- Data, -} Typeable, Eq, Ord, Generic) -instance NFData Limits where rnf = genericRnf +instance NFData Limits instance Binary Limits instance FromJSON Limits where @@ -31,7 +31,7 @@ data RateLimit = RateLimit } deriving (Show, {- Data, -} Typeable, Eq, Ord, Generic) -instance NFData RateLimit where rnf = genericRnf +instance NFData RateLimit instance Binary RateLimit instance FromJSON RateLimit where diff --git a/src/GitHub/Data/Reactions.hs b/src/GitHub/Data/Reactions.hs index f5fc3ead..ade4ec7b 100644 --- a/src/GitHub/Data/Reactions.hs +++ b/src/GitHub/Data/Reactions.hs @@ -15,7 +15,7 @@ data Reaction = Reaction } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Reaction where rnf = genericRnf +instance NFData Reaction instance Binary Reaction data NewReaction = NewReaction @@ -23,7 +23,7 @@ data NewReaction = NewReaction } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData NewReaction where rnf = genericRnf +instance NFData NewReaction instance Binary NewReaction -- | @@ -39,7 +39,7 @@ data ReactionContent | Eyes deriving (Show, Data, Typeable, Eq, Ord, Enum, Bounded, Generic) -instance NFData ReactionContent where rnf = genericRnf +instance NFData ReactionContent instance Binary ReactionContent -- JSON instances diff --git a/src/GitHub/Data/Releases.hs b/src/GitHub/Data/Releases.hs index 582b524c..0f9c40b7 100644 --- a/src/GitHub/Data/Releases.hs +++ b/src/GitHub/Data/Releases.hs @@ -47,7 +47,7 @@ instance FromJSON Release where <*> o .: "author" <*> o .: "assets" -instance NFData Release where rnf = genericRnf +instance NFData Release instance Binary Release data ReleaseAsset = ReleaseAsset @@ -81,5 +81,5 @@ instance FromJSON ReleaseAsset where <*> o .: "updated_at" <*> o .: "uploader" -instance NFData ReleaseAsset where rnf = genericRnf +instance NFData ReleaseAsset instance Binary ReleaseAsset diff --git a/src/GitHub/Data/Repos.hs b/src/GitHub/Data/Repos.hs index 456775b6..8964c00b 100644 --- a/src/GitHub/Data/Repos.hs +++ b/src/GitHub/Data/Repos.hs @@ -55,7 +55,7 @@ data Repo = Repo } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Repo where rnf = genericRnf +instance NFData Repo instance Binary Repo data CodeSearchRepo = CodeSearchRepo @@ -90,7 +90,7 @@ data CodeSearchRepo = CodeSearchRepo } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData CodeSearchRepo where rnf = genericRnf +instance NFData CodeSearchRepo instance Binary CodeSearchRepo -- | Repository permissions, as they relate to the authenticated user. @@ -103,7 +103,7 @@ data RepoPermissions = RepoPermissions } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData RepoPermissions where rnf = genericRnf +instance NFData RepoPermissions instance Binary RepoPermissions data RepoRef = RepoRef @@ -112,7 +112,7 @@ data RepoRef = RepoRef } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData RepoRef where rnf = genericRnf +instance NFData RepoRef instance Binary RepoRef data NewRepo = NewRepo @@ -131,7 +131,7 @@ data NewRepo = NewRepo , newRepoAllowRebaseMerge :: !(Maybe Bool) } deriving (Eq, Ord, Show, Data, Typeable, Generic) -instance NFData NewRepo where rnf = genericRnf +instance NFData NewRepo instance Binary NewRepo newRepo :: Name Repo -> NewRepo @@ -153,7 +153,7 @@ data EditRepo = EditRepo } deriving (Eq, Ord, Show, Data, Typeable, Generic) -instance NFData EditRepo where rnf = genericRnf +instance NFData EditRepo instance Binary EditRepo -- | Filter the list of the user's repos using any of these constructors. @@ -175,7 +175,7 @@ newtype Language = Language Text getLanguage :: Language -> Text getLanguage (Language l) = l -instance NFData Language where rnf = genericRnf +instance NFData Language instance Binary Language instance Hashable Language where hashWithSalt salt (Language l) = hashWithSalt salt l @@ -190,7 +190,7 @@ data Contributor | AnonymousContributor !Int !Text deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Contributor where rnf = genericRnf +instance NFData Contributor instance Binary Contributor contributorToSimpleUser :: Contributor -> Maybe SimpleUser @@ -207,7 +207,7 @@ data CollaboratorPermission | CollaboratorPermissionNone deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic) -instance NFData CollaboratorPermission where rnf = genericRnf +instance NFData CollaboratorPermission instance Binary CollaboratorPermission -- | A collaborator and its permission on a repository. @@ -216,7 +216,7 @@ data CollaboratorWithPermission = CollaboratorWithPermission SimpleUser CollaboratorPermission deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData CollaboratorWithPermission where rnf = genericRnf +instance NFData CollaboratorWithPermission instance Binary CollaboratorWithPermission -- JSON instances diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs index c8138c1a..0ff3ae1b 100644 --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -100,7 +100,7 @@ instance Num FetchCount where instance Hashable FetchCount instance Binary FetchCount -instance NFData FetchCount where rnf = genericRnf +instance NFData FetchCount ------------------------------------------------------------------------------- -- PageParams @@ -115,7 +115,7 @@ data PageParams = PageParams { instance Hashable PageParams instance Binary PageParams -instance NFData PageParams where rnf = genericRnf +instance NFData PageParams ------------------------------------------------------------------------------- -- PageLinks @@ -131,7 +131,7 @@ data PageLinks = PageLinks { } deriving (Eq, Ord, Show, Generic, Typeable) -instance NFData PageLinks where rnf = genericRnf +instance NFData PageLinks ------------------------------------------------------------------------------- -- MediaType diff --git a/src/GitHub/Data/Reviews.hs b/src/GitHub/Data/Reviews.hs index b00edb74..c8761e0a 100644 --- a/src/GitHub/Data/Reviews.hs +++ b/src/GitHub/Data/Reviews.hs @@ -16,9 +16,7 @@ data ReviewState | ReviewStateChangesRequested deriving (Show, Enum, Bounded, Eq, Ord, Generic) -instance NFData ReviewState where - rnf = genericRnf - +instance NFData ReviewState instance Binary ReviewState instance FromJSON ReviewState where @@ -41,9 +39,7 @@ data Review = Review , reviewId :: !(Id Review) } deriving (Show, Generic) -instance NFData Review where - rnf = genericRnf - +instance NFData Review instance Binary Review instance FromJSON Review where @@ -74,9 +70,7 @@ data ReviewComment = ReviewComment , reviewCommentPullRequestUrl :: !URL } deriving (Show, Generic) -instance NFData ReviewComment where - rnf = genericRnf - +instance NFData ReviewComment instance Binary ReviewComment instance FromJSON ReviewComment where diff --git a/src/GitHub/Data/Search.hs b/src/GitHub/Data/Search.hs index b56067b0..fd333482 100644 --- a/src/GitHub/Data/Search.hs +++ b/src/GitHub/Data/Search.hs @@ -15,7 +15,7 @@ data SearchResult' entities = SearchResult type SearchResult entity = SearchResult' (V.Vector entity) -instance NFData entities => NFData (SearchResult' entities) where rnf = genericRnf +instance NFData entities => NFData (SearchResult' entities) instance Binary entities => Binary (SearchResult' entities) instance (Monoid entities, FromJSON entities) => FromJSON (SearchResult' entities) where @@ -40,7 +40,7 @@ data Code = Code } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Code where rnf = genericRnf +instance NFData Code instance Binary Code instance FromJSON Code where diff --git a/src/GitHub/Data/Statuses.hs b/src/GitHub/Data/Statuses.hs index 09853b26..5b488920 100644 --- a/src/GitHub/Data/Statuses.hs +++ b/src/GitHub/Data/Statuses.hs @@ -23,7 +23,7 @@ data StatusState | StatusFailure deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic) -instance NFData StatusState where rnf = genericRnf +instance NFData StatusState instance Binary StatusState instance FromJSON StatusState where @@ -75,7 +75,7 @@ data NewStatus = NewStatus } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData NewStatus where rnf = genericRnf +instance NFData NewStatus instance Binary NewStatus instance ToJSON NewStatus where diff --git a/src/GitHub/Data/Teams.hs b/src/GitHub/Data/Teams.hs index 622370ae..4f3da777 100644 --- a/src/GitHub/Data/Teams.hs +++ b/src/GitHub/Data/Teams.hs @@ -20,7 +20,7 @@ data Privacy | PrivacySecret deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic) -instance NFData Privacy where rnf = genericRnf +instance NFData Privacy instance Binary Privacy data Permission @@ -29,7 +29,7 @@ data Permission | PermissionAdmin deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic) -instance NFData Permission where rnf = genericRnf +instance NFData Permission instance Binary Permission data AddTeamRepoPermission = AddTeamRepoPermission @@ -37,7 +37,7 @@ data AddTeamRepoPermission = AddTeamRepoPermission } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData AddTeamRepoPermission where rnf = genericRnf +instance NFData AddTeamRepoPermission instance Binary AddTeamRepoPermission data SimpleTeam = SimpleTeam @@ -53,7 +53,7 @@ data SimpleTeam = SimpleTeam } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData SimpleTeam where rnf = genericRnf +instance NFData SimpleTeam instance Binary SimpleTeam data Team = Team @@ -72,7 +72,7 @@ data Team = Team } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData Team where rnf = genericRnf +instance NFData Team instance Binary Team data CreateTeam = CreateTeam @@ -84,7 +84,7 @@ data CreateTeam = CreateTeam } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData CreateTeam where rnf = genericRnf +instance NFData CreateTeam instance Binary CreateTeam data EditTeam = EditTeam @@ -95,7 +95,7 @@ data EditTeam = EditTeam } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData EditTeam where rnf = genericRnf +instance NFData EditTeam instance Binary EditTeam data Role @@ -111,7 +111,7 @@ data ReqState | StateActive deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData ReqState where rnf = genericRnf +instance NFData ReqState instance Binary ReqState data TeamMembership = TeamMembership @@ -121,14 +121,14 @@ data TeamMembership = TeamMembership } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData TeamMembership where rnf = genericRnf +instance NFData TeamMembership instance Binary TeamMembership data CreateTeamMembership = CreateTeamMembership { createTeamMembershipRole :: !Role } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData CreateTeamMembership where rnf = genericRnf +instance NFData CreateTeamMembership instance Binary CreateTeamMembership -- JSON Instances diff --git a/src/GitHub/Data/URL.hs b/src/GitHub/Data/URL.hs index d98703ae..c3d9edcc 100644 --- a/src/GitHub/Data/URL.hs +++ b/src/GitHub/Data/URL.hs @@ -15,7 +15,7 @@ newtype URL = URL Text getUrl :: URL -> Text getUrl (URL url) = url -instance NFData URL where rnf = genericRnf +instance NFData URL instance Binary URL instance ToJSON URL where diff --git a/src/GitHub/Data/Webhooks.hs b/src/GitHub/Data/Webhooks.hs index 143d8006..32e97287 100644 --- a/src/GitHub/Data/Webhooks.hs +++ b/src/GitHub/Data/Webhooks.hs @@ -22,7 +22,7 @@ data RepoWebhook = RepoWebhook } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData RepoWebhook where rnf = genericRnf +instance NFData RepoWebhook instance Binary RepoWebhook -- | See . @@ -87,7 +87,7 @@ data RepoWebhookEvent | WebhookWorkflowRun deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData RepoWebhookEvent where rnf = genericRnf +instance NFData RepoWebhookEvent instance Binary RepoWebhookEvent data RepoWebhookResponse = RepoWebhookResponse @@ -97,7 +97,7 @@ data RepoWebhookResponse = RepoWebhookResponse } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData RepoWebhookResponse where rnf = genericRnf +instance NFData RepoWebhookResponse instance Binary RepoWebhookResponse data PingEvent = PingEvent @@ -107,7 +107,7 @@ data PingEvent = PingEvent } deriving (Show, Data, Typeable, Eq, Ord, Generic) -instance NFData PingEvent where rnf = genericRnf +instance NFData PingEvent instance Binary PingEvent data NewRepoWebhook = NewRepoWebhook @@ -118,7 +118,7 @@ data NewRepoWebhook = NewRepoWebhook } deriving (Eq, Ord, Show, Typeable, Data, Generic) -instance NFData NewRepoWebhook where rnf = genericRnf +instance NFData NewRepoWebhook instance Binary NewRepoWebhook data EditRepoWebhook = EditRepoWebhook @@ -130,7 +130,7 @@ data EditRepoWebhook = EditRepoWebhook } deriving (Eq, Ord, Show, Typeable, Data, Generic) -instance NFData EditRepoWebhook where rnf = genericRnf +instance NFData EditRepoWebhook instance Binary EditRepoWebhook -- JSON instances diff --git a/src/GitHub/Internal/Prelude.hs b/src/GitHub/Internal/Prelude.hs index d6efaf39..03a38b13 100644 --- a/src/GitHub/Internal/Prelude.hs +++ b/src/GitHub/Internal/Prelude.hs @@ -7,7 +7,6 @@ module GitHub.Internal.Prelude ( module X ) where import Control.Applicative as X ((<|>)) import Control.DeepSeq as X (NFData (..)) -import Control.DeepSeq.Generics as X (genericRnf) import Data.Aeson as X (FromJSON (..), Object, ToJSON (..), Value (..), encode, object, withObject, withText, (.!=), (.:), (.:?), (.=)) From 355eb4813f169eec5f12da279f6c208ff4785f7e Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Wed, 27 Aug 2025 12:43:44 +0200 Subject: [PATCH 505/510] Bump dependency lower bounds to at least Stackage LTS 10.0 (GHC 8.2.2) --- github.cabal | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/github.cabal b/github.cabal index b9843588..ba4bae57 100644 --- a/github.cabal +++ b/github.cabal @@ -184,17 +184,18 @@ library autogen-modules: Paths_github -- Packages bundles with GHC, mtl and text are also here + -- Lower bounds at least those of https://www.stackage.org/lts-10.0 (GHC 8.2.2) build-depends: base >=4.10 && <5 - , binary >=0.7.1.0 && <0.11 - , bytestring >=0.10.4.0 && <0.13 - , containers >=0.5.5.1 && <1 - , deepseq >=1.3.0.2 && <1.6 + , binary >=0.8.5.1 && <0.11 + , bytestring >=0.10.8.2 && <0.13 + , containers >=0.5.10.2 && <1 + , deepseq >=1.4.3.0 && <1.6 , exceptions >=0.10.2 && <0.11 - , mtl >=2.1.3.1 && <2.2 || >=2.2.1 && <2.4 - , text >=1.2.0.6 && <2.2 + , mtl >=2.2.1 && <2.4 + , text >=1.2.2.2 && <2.2 , time >=1.8.0.2 && <2 - , transformers >=0.3.0.0 && <0.7 + , transformers >=0.5.2.0 && <0.7 -- other packages build-depends: From 81009cb0f4dd5dd442ef46379d84cb7c6828a9f2 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Wed, 27 Aug 2025 12:47:05 +0200 Subject: [PATCH 506/510] Remove unused dependency transformers-compat --- github.cabal | 1 - 1 file changed, 1 deletion(-) diff --git a/github.cabal b/github.cabal index ba4bae57..54f0d2a1 100644 --- a/github.cabal +++ b/github.cabal @@ -211,7 +211,6 @@ library , iso8601-time >=0.1.5 && <0.2 , network-uri >=2.6.1.0 && <2.7 , tagged >=0.8.5 && <0.9 - , transformers-compat >=0.6.5 && <0.8 , unordered-containers >=0.2.10.0 && <0.3 , vector >=0.12.0.1 && <0.14 From 50e43d5e6790ee5f7630821709b94db47b43a0c4 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Wed, 27 Aug 2025 12:51:35 +0200 Subject: [PATCH 507/510] Remove obsolete `deriving Typeable` --- src/GitHub/Auth.hs | 2 +- src/GitHub/Data/Actions/Artifacts.hs | 4 +-- src/GitHub/Data/Actions/Cache.hs | 6 ++-- src/GitHub/Data/Actions/Common.hs | 2 +- src/GitHub/Data/Actions/Secrets.hs | 16 +++++----- src/GitHub/Data/Actions/WorkflowJobs.hs | 6 ++-- src/GitHub/Data/Actions/WorkflowRuns.hs | 6 ++-- src/GitHub/Data/Actions/Workflows.hs | 2 +- src/GitHub/Data/Activities.hs | 8 ++--- src/GitHub/Data/Comments.hs | 10 +++--- src/GitHub/Data/Content.hs | 22 ++++++------- src/GitHub/Data/Definitions.hs | 34 ++++++++++----------- src/GitHub/Data/DeployKeys.hs | 4 +-- src/GitHub/Data/Deployments.hs | 12 ++++---- src/GitHub/Data/Email.hs | 4 +-- src/GitHub/Data/Enterprise/Organizations.hs | 6 ++-- src/GitHub/Data/Events.hs | 2 +- src/GitHub/Data/Gists.hs | 10 +++--- src/GitHub/Data/GitData.hs | 32 +++++++++---------- src/GitHub/Data/Id.hs | 2 +- src/GitHub/Data/Invitation.hs | 6 ++-- src/GitHub/Data/Issues.hs | 12 ++++---- src/GitHub/Data/Milestone.hs | 6 ++-- src/GitHub/Data/Name.hs | 2 +- src/GitHub/Data/Options.hs | 30 +++++++++--------- src/GitHub/Data/PublicSSHKeys.hs | 6 ++-- src/GitHub/Data/PullRequests.hs | 16 +++++----- src/GitHub/Data/RateLimit.hs | 4 +-- src/GitHub/Data/Reactions.hs | 6 ++-- src/GitHub/Data/Releases.hs | 4 +-- src/GitHub/Data/Repos.hs | 24 +++++++-------- src/GitHub/Data/Request.hs | 13 ++++---- src/GitHub/Data/Search.hs | 4 +-- src/GitHub/Data/Statuses.hs | 12 +++----- src/GitHub/Data/Teams.hs | 27 ++++++++-------- src/GitHub/Data/URL.hs | 2 +- src/GitHub/Data/Webhooks.hs | 12 ++++---- src/GitHub/Internal/Prelude.hs | 2 +- 38 files changed, 186 insertions(+), 192 deletions(-) diff --git a/src/GitHub/Auth.hs b/src/GitHub/Auth.hs index 1800808f..cd53cd2e 100644 --- a/src/GitHub/Auth.hs +++ b/src/GitHub/Auth.hs @@ -23,7 +23,7 @@ data Auth | OAuth Token -- ^ OAuth token | JWT JWTToken -- ^ JWT Token | EnterpriseOAuth Text Token -- ^ Custom endpoint and OAuth token - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData Auth instance Binary Auth diff --git a/src/GitHub/Data/Actions/Artifacts.hs b/src/GitHub/Data/Actions/Artifacts.hs index 7b572d2b..9d8ca28e 100644 --- a/src/GitHub/Data/Actions/Artifacts.hs +++ b/src/GitHub/Data/Actions/Artifacts.hs @@ -27,7 +27,7 @@ data ArtifactWorkflowRun = ArtifactWorkflowRun , artifactWorkflowRunHeadBranch :: !Text , artifactWorkflowRunHeadSha :: !Text } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) data Artifact = Artifact { artifactArchiveDownloadUrl :: !URL @@ -42,7 +42,7 @@ data Artifact = Artifact , artifactUrl :: !URL , artifactWorkflowRun :: !ArtifactWorkflowRun } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) ------------------------------------------------------------------------------- -- JSON instances diff --git a/src/GitHub/Data/Actions/Cache.hs b/src/GitHub/Data/Actions/Cache.hs index a4f65a60..363e0ce3 100644 --- a/src/GitHub/Data/Actions/Cache.hs +++ b/src/GitHub/Data/Actions/Cache.hs @@ -27,20 +27,20 @@ data Cache = Cache , cacheCreatedAt :: !UTCTime , cacheSizeInBytes :: !Int } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) data RepositoryCacheUsage = RepositoryCacheUsage { repositoryCacheUsageFullName :: !Text , repositoryCacheUsageActiveCachesSizeInBytes :: !Int , repositoryCacheUsageActiveCachesCount :: !Int } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) data OrganizationCacheUsage = OrganizationCacheUsage { organizationCacheUsageTotalActiveCachesSizeInBytes :: !Int , organizationCacheUsageTotalActiveCachesCount :: !Int } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) ------------------------------------------------------------------------------- -- JSON instances diff --git a/src/GitHub/Data/Actions/Common.hs b/src/GitHub/Data/Actions/Common.hs index ed02b6f0..76a6130a 100644 --- a/src/GitHub/Data/Actions/Common.hs +++ b/src/GitHub/Data/Actions/Common.hs @@ -20,7 +20,7 @@ data WithTotalCount a = WithTotalCount , withTotalCountTotalCount :: !Int -- ^ The total size of the answer. } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -- | Joining two pages of a paginated response. -- The 'withTotalCountTotalCount' is assumed to be the same in both pages, diff --git a/src/GitHub/Data/Actions/Secrets.hs b/src/GitHub/Data/Actions/Secrets.hs index c734ad89..1e2ce31b 100644 --- a/src/GitHub/Data/Actions/Secrets.hs +++ b/src/GitHub/Data/Actions/Secrets.hs @@ -33,13 +33,13 @@ data OrganizationSecret = OrganizationSecret , organizationSecretUpdatedAt :: !UTCTime , organizationSecretVisibility :: !Text } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) data PublicKey = PublicKey { publicKeyId :: !Text , publicKeyKey :: !Text } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) data SetSecret = SetSecret { setSecretPublicKeyId :: !Text @@ -47,35 +47,35 @@ data SetSecret = SetSecret , setSecretVisibility :: !Text , setSecretSelectedRepositoryIds :: !(Maybe [Id Repo]) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) data SetRepoSecret = SetRepoSecret { setRepoSecretPublicKeyId :: !Text , setRepoSecretEncryptedValue :: !Text } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) data SelectedRepo = SelectedRepo { selectedRepoRepoId :: !(Id Repo) , selectedRepoRepoName :: !(Name Repo) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) data SetSelectedRepositories = SetSelectedRepositories { setSelectedRepositoriesRepositoryIds :: ![Id Repo] } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) data RepoSecret = RepoSecret { repoSecretName :: !(Name RepoSecret) , repoSecretCreatedAt :: !UTCTime , repoSecretUpdatedAt :: !UTCTime } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -- TODO move somewhere else? data Environment = Environment - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) ------------------------------------------------------------------------------- -- JSON instances diff --git a/src/GitHub/Data/Actions/WorkflowJobs.hs b/src/GitHub/Data/Actions/WorkflowJobs.hs index 05f28861..47f11f20 100644 --- a/src/GitHub/Data/Actions/WorkflowJobs.hs +++ b/src/GitHub/Data/Actions/WorkflowJobs.hs @@ -10,7 +10,7 @@ module GitHub.Data.Actions.WorkflowJobs ( import Prelude () import GitHub.Internal.Prelude (Applicative ((<*>)), Data, Eq, FromJSON (parseJSON), Generic, Integer, - Ord, Show, Text, Typeable, UTCTime, Vector, withObject, ($), (.:), + Ord, Show, Text, UTCTime, Vector, withObject, ($), (.:), (<$>)) import GitHub.Data.Id (Id) @@ -32,7 +32,7 @@ data JobStep = JobStep , jobStepStartedAt :: !UTCTime , jobStepCompletedAt :: !UTCTime } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) data Job = Job { jobId :: !(Id Job) @@ -56,7 +56,7 @@ data Job = Job , jobRunnerGroupId :: !Integer , jobRunnerGroupName :: !Text } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) ------------------------------------------------------------------------------- -- JSON instances diff --git a/src/GitHub/Data/Actions/WorkflowRuns.hs b/src/GitHub/Data/Actions/WorkflowRuns.hs index 3dae581b..07657e84 100644 --- a/src/GitHub/Data/Actions/WorkflowRuns.hs +++ b/src/GitHub/Data/Actions/WorkflowRuns.hs @@ -41,10 +41,10 @@ data WorkflowRun = WorkflowRun , workflowRunAttempt :: !Integer , workflowRunStartedAt :: !UTCTime } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) data RunAttempt = RunAttempt - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) data ReviewHistory = ReviewHistory { reviewHistoryState :: !Text @@ -52,7 +52,7 @@ data ReviewHistory = ReviewHistory , reviewHistoryUser :: !SimpleUser } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) ------------------------------------------------------------------------------- -- JSON instances diff --git a/src/GitHub/Data/Actions/Workflows.hs b/src/GitHub/Data/Actions/Workflows.hs index ae36ddbf..a75fa0ff 100644 --- a/src/GitHub/Data/Actions/Workflows.hs +++ b/src/GitHub/Data/Actions/Workflows.hs @@ -25,7 +25,7 @@ data Workflow = Workflow , workflowHtmlUrl :: !URL , workflowBadgeUrl :: !URL } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) data CreateWorkflowDispatchEvent a = CreateWorkflowDispatchEvent { createWorkflowDispatchEventRef :: !Text diff --git a/src/GitHub/Data/Activities.hs b/src/GitHub/Data/Activities.hs index 70e356cf..b480ef21 100644 --- a/src/GitHub/Data/Activities.hs +++ b/src/GitHub/Data/Activities.hs @@ -13,7 +13,7 @@ data RepoStarred = RepoStarred { repoStarredStarredAt :: !UTCTime , repoStarredRepo :: !Repo } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData RepoStarred instance Binary RepoStarred @@ -33,7 +33,7 @@ data Subject = Subject -- TODO: Make an ADT for this. , subjectType :: !Text } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData Subject instance Binary Subject @@ -61,7 +61,7 @@ data NotificationReason | StateChangeReason | SubscribedReason | TeamMentionReason - deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Enum, Bounded, Eq, Ord, Generic) instance NFData NotificationReason instance Binary NotificationReason @@ -97,7 +97,7 @@ data Notification = Notification , notificationLastReadAt :: !(Maybe UTCTime) , notificationUrl :: !URL } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData Notification instance Binary Notification diff --git a/src/GitHub/Data/Comments.hs b/src/GitHub/Data/Comments.hs index 0084cd9b..c5987c77 100644 --- a/src/GitHub/Data/Comments.hs +++ b/src/GitHub/Data/Comments.hs @@ -19,7 +19,7 @@ data Comment = Comment , commentUser :: !SimpleUser , commentId :: !(Id Comment) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData Comment instance Binary Comment @@ -41,7 +41,7 @@ instance FromJSON Comment where data NewComment = NewComment { newCommentBody :: !Text } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData NewComment instance Binary NewComment @@ -52,7 +52,7 @@ instance ToJSON NewComment where data EditComment = EditComment { editCommentBody :: !Text } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData EditComment instance Binary EditComment @@ -66,7 +66,7 @@ data NewPullComment = NewPullComment , newPullCommentPosition :: !Int , newPullCommentBody :: !Text } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData NewPullComment instance Binary NewPullComment @@ -82,7 +82,7 @@ instance ToJSON NewPullComment where data PullCommentReply = PullCommentReply { pullCommentReplyBody :: Text } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData PullCommentReply diff --git a/src/GitHub/Data/Content.hs b/src/GitHub/Data/Content.hs index 2ac55039..5e0c4b92 100644 --- a/src/GitHub/Data/Content.hs +++ b/src/GitHub/Data/Content.hs @@ -18,7 +18,7 @@ import Data.Aeson (Key) data Content = ContentFile !ContentFileData | ContentDirectory !(Vector ContentItem) - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData Content instance Binary Content @@ -28,7 +28,7 @@ data ContentFileData = ContentFileData { ,contentFileEncoding :: !Text ,contentFileSize :: !Int ,contentFileContent :: !Text -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +} deriving (Show, Data, Eq, Ord, Generic) instance NFData ContentFileData instance Binary ContentFileData @@ -37,13 +37,13 @@ instance Binary ContentFileData data ContentItem = ContentItem { contentItemType :: !ContentItemType ,contentItemInfo :: !ContentInfo -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +} deriving (Show, Data, Eq, Ord, Generic) instance NFData ContentItem instance Binary ContentItem data ContentItemType = ItemFile | ItemDir - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData ContentItemType instance Binary ContentItemType @@ -56,7 +56,7 @@ data ContentInfo = ContentInfo { ,contentUrl :: !URL ,contentGitUrl :: !URL ,contentHtmlUrl :: !URL -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +} deriving (Show, Data, Eq, Ord, Generic) instance NFData ContentInfo instance Binary ContentInfo @@ -64,7 +64,7 @@ instance Binary ContentInfo data ContentResultInfo = ContentResultInfo { contentResultInfo :: !ContentInfo , contentResultSize :: !Int - } deriving (Show, Data, Typeable, Eq, Ord, Generic) + } deriving (Show, Data, Eq, Ord, Generic) instance NFData ContentResultInfo instance Binary ContentResultInfo @@ -72,7 +72,7 @@ instance Binary ContentResultInfo data ContentResult = ContentResult { contentResultContent :: !ContentResultInfo , contentResultCommit :: !GitCommit - } deriving (Show, Data, Typeable, Eq, Ord, Generic) + } deriving (Show, Data, Eq, Ord, Generic) instance NFData ContentResult instance Binary ContentResult @@ -81,7 +81,7 @@ data Author = Author { authorName :: !Text , authorEmail :: !Text } - deriving (Eq, Ord, Show, Data, Typeable, Generic) + deriving (Eq, Ord, Show, Data, Generic) instance NFData Author instance Binary Author @@ -94,7 +94,7 @@ data CreateFile = CreateFile , createFileAuthor :: !(Maybe Author) , createFileCommitter :: !(Maybe Author) } - deriving (Eq, Ord, Show, Data, Typeable, Generic) + deriving (Eq, Ord, Show, Data, Generic) instance NFData CreateFile instance Binary CreateFile @@ -108,7 +108,7 @@ data UpdateFile = UpdateFile , updateFileAuthor :: !(Maybe Author) , updateFileCommitter :: !(Maybe Author) } - deriving (Eq, Ord, Show, Data, Typeable, Generic) + deriving (Eq, Ord, Show, Data, Generic) instance NFData UpdateFile instance Binary UpdateFile @@ -121,7 +121,7 @@ data DeleteFile = DeleteFile , deleteFileAuthor :: !(Maybe Author) , deleteFileCommitter :: !(Maybe Author) } - deriving (Eq, Ord, Show, Data, Typeable, Generic) + deriving (Eq, Ord, Show, Data, Generic) instance NFData DeleteFile instance Binary DeleteFile diff --git a/src/GitHub/Data/Definitions.hs b/src/GitHub/Data/Definitions.hs index 060c4bec..12f392df 100644 --- a/src/GitHub/Data/Definitions.hs +++ b/src/GitHub/Data/Definitions.hs @@ -22,13 +22,13 @@ data Error | ParseError !Text -- ^ An error in the parser itself. | JsonError !Text -- ^ The JSON is malformed or unexpected. | UserError !Text -- ^ Incorrect input. - deriving (Show, Typeable) + deriving (Show) instance E.Exception Error -- | Type of the repository owners. data OwnerType = OwnerUser | OwnerOrganization | OwnerBot - deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic, Typeable, Data) + deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic, Data) instance NFData OwnerType instance Binary OwnerType @@ -39,7 +39,7 @@ data SimpleUser = SimpleUser , simpleUserAvatarUrl :: !URL , simpleUserUrl :: !URL } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData SimpleUser instance Binary SimpleUser @@ -50,7 +50,7 @@ data SimpleOrganization = SimpleOrganization , simpleOrganizationUrl :: !URL , simpleOrganizationAvatarUrl :: !URL } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData SimpleOrganization instance Binary SimpleOrganization @@ -63,7 +63,7 @@ data SimpleOwner = SimpleOwner , simpleOwnerAvatarUrl :: !URL , simpleOwnerType :: !OwnerType } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData SimpleOwner instance Binary SimpleOwner @@ -88,7 +88,7 @@ data User = User , userUrl :: !URL , userHtmlUrl :: !URL } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData User instance Binary User @@ -111,14 +111,14 @@ data Organization = Organization , organizationUrl :: !URL , organizationCreatedAt :: !UTCTime } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData Organization instance Binary Organization -- | In practice you can't have concrete values of 'Owner'. newtype Owner = Owner (Either User Organization) - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData Owner instance Binary Owner @@ -218,14 +218,14 @@ instance FromJSON Owner where data OrgMemberFilter = OrgMemberFilter2faDisabled -- ^ Members without two-factor authentication enabled. Available for organization owners. | OrgMemberFilterAll -- ^ All members the authenticated user can see. - deriving (Show, Eq, Ord, Enum, Bounded, Typeable, Data, Generic) + deriving (Show, Eq, Ord, Enum, Bounded, Data, Generic) -- | Filter members returned by their role. data OrgMemberRole = OrgMemberRoleAll -- ^ All members of the organization, regardless of role. | OrgMemberRoleAdmin -- ^ Organization owners. | OrgMemberRoleMember -- ^ Non-owner organization members. - deriving (Show, Eq, Ord, Enum, Bounded, Typeable, Data, Generic) + deriving (Show, Eq, Ord, Enum, Bounded, Data, Generic) -- | Request query string type QueryString = [(BS.ByteString, Maybe BS.ByteString)] @@ -240,7 +240,7 @@ data MembershipRole | MembershipRoleAdmin | MembershipRoleBillingManager deriving - (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) + (Eq, Ord, Show, Enum, Bounded, Generic, Data) instance NFData MembershipRole instance Binary MembershipRole @@ -255,7 +255,7 @@ instance FromJSON MembershipRole where data MembershipState = MembershipPending | MembershipActive - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData MembershipState instance Binary MembershipState @@ -275,7 +275,7 @@ data Membership = Membership , membershipOrganization :: !SimpleOrganization , membershipUser :: !SimpleUser } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData Membership instance Binary Membership @@ -295,7 +295,7 @@ instance FromJSON Membership where ------------------------------------------------------------------------------- newtype IssueNumber = IssueNumber Int - deriving (Eq, Ord, Show, Generic, Typeable, Data) + deriving (Eq, Ord, Show, Generic, Data) unIssueNumber :: IssueNumber -> Int unIssueNumber (IssueNumber i) = i @@ -322,7 +322,7 @@ data IssueLabel = IssueLabel , labelName :: !(Name IssueLabel) , labelDesc :: !(Maybe Text) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData IssueLabel instance Binary IssueLabel @@ -344,7 +344,7 @@ data NewIssueLabel = NewIssueLabel , newLabelName :: !(Name NewIssueLabel) , newLabelDesc :: !(Maybe Text) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData NewIssueLabel instance Binary NewIssueLabel @@ -371,7 +371,7 @@ data UpdateIssueLabel = UpdateIssueLabel , updateLabelName :: !(Name UpdateIssueLabel) , updateLabelDesc :: !(Maybe Text) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData UpdateIssueLabel instance Binary UpdateIssueLabel diff --git a/src/GitHub/Data/DeployKeys.hs b/src/GitHub/Data/DeployKeys.hs index 7dd1bb1d..af43c6cf 100644 --- a/src/GitHub/Data/DeployKeys.hs +++ b/src/GitHub/Data/DeployKeys.hs @@ -19,7 +19,7 @@ data RepoDeployKey = RepoDeployKey , repoDeployKeyCreatedAt :: !UTCTime , repoDeployKeyReadOnly :: !Bool } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance FromJSON RepoDeployKey where parseJSON = withObject "RepoDeployKey" $ \o -> RepoDeployKey @@ -36,7 +36,7 @@ data NewRepoDeployKey = NewRepoDeployKey , newRepoDeployKeyTitle :: !Text , newRepoDeployKeyReadOnly :: !Bool } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance ToJSON NewRepoDeployKey where toJSON (NewRepoDeployKey key title readOnly) = object diff --git a/src/GitHub/Data/Deployments.hs b/src/GitHub/Data/Deployments.hs index b8ba2df0..043e74be 100644 --- a/src/GitHub/Data/Deployments.hs +++ b/src/GitHub/Data/Deployments.hs @@ -34,7 +34,7 @@ data DeploymentQueryOption | DeploymentQueryRef !Text | DeploymentQueryTask !Text | DeploymentQueryEnvironment !Text - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData DeploymentQueryOption instance Binary DeploymentQueryOption @@ -61,7 +61,7 @@ data Deployment a = Deployment , deploymentUpdatedAt :: !UTCTime , deploymentStatusesUrl :: !URL , deploymentRepositoryUrl :: !URL - } deriving (Show, Data, Typeable, Eq, Ord, Generic) + } deriving (Show, Data, Eq, Ord, Generic) instance NFData a => NFData (Deployment a) instance Binary a => Binary (Deployment a) @@ -104,7 +104,7 @@ data CreateDeployment a = CreateDeployment -- qa). Default: production , createDeploymentDescription :: !(Maybe Text) -- ^ Short description of the deployment. Default: "" - } deriving (Show, Data, Typeable, Eq, Ord, Generic) + } deriving (Show, Data, Eq, Ord, Generic) instance NFData a => NFData (CreateDeployment a) instance Binary a => Binary (CreateDeployment a) @@ -132,7 +132,7 @@ data DeploymentStatus = DeploymentStatus , deploymentStatusUpdatedAt :: !UTCTime , deploymentStatusDeploymentUrl :: !URL , deploymentStatusRepositoryUrl :: !URL - } deriving (Show, Data, Typeable, Eq, Ord, Generic) + } deriving (Show, Data, Eq, Ord, Generic) instance NFData DeploymentStatus instance Binary DeploymentStatus @@ -157,7 +157,7 @@ data DeploymentStatusState | DeploymentStatusPending | DeploymentStatusSuccess | DeploymentStatusInactive - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData DeploymentStatusState instance Binary DeploymentStatusState @@ -190,7 +190,7 @@ data CreateDeploymentStatus = CreateDeploymentStatus , createDeploymentStatusDescription :: !(Maybe Text) -- ^ A short description of the status. Maximum length of 140 characters. -- Default: "" - } deriving (Show, Data, Typeable, Eq, Ord, Generic) + } deriving (Show, Data, Eq, Ord, Generic) instance NFData CreateDeploymentStatus instance Binary CreateDeploymentStatus diff --git a/src/GitHub/Data/Email.hs b/src/GitHub/Data/Email.hs index 6e151760..76efafa0 100644 --- a/src/GitHub/Data/Email.hs +++ b/src/GitHub/Data/Email.hs @@ -8,7 +8,7 @@ import qualified Data.Text as T data EmailVisibility = EmailVisibilityPrivate | EmailVisibilityPublic - deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Enum, Bounded, Eq, Ord, Generic) instance NFData EmailVisibility instance Binary EmailVisibility @@ -24,7 +24,7 @@ data Email = Email , emailVerified :: !Bool , emailPrimary :: !Bool , emailVisibility :: !(Maybe EmailVisibility) - } deriving (Show, Data, Typeable, Eq, Ord, Generic) + } deriving (Show, Data, Eq, Ord, Generic) instance NFData Email instance Binary Email diff --git a/src/GitHub/Data/Enterprise/Organizations.hs b/src/GitHub/Data/Enterprise/Organizations.hs index 29f179af..02c99453 100644 --- a/src/GitHub/Data/Enterprise/Organizations.hs +++ b/src/GitHub/Data/Enterprise/Organizations.hs @@ -11,7 +11,7 @@ data CreateOrganization = CreateOrganization , createOrganizationAdmin :: !(Name User) , createOrganizationProfileName :: !(Maybe Text) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData CreateOrganization instance Binary CreateOrganization @@ -19,7 +19,7 @@ instance Binary CreateOrganization data RenameOrganization = RenameOrganization { renameOrganizationLogin :: !(Name Organization) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData RenameOrganization instance Binary RenameOrganization @@ -28,7 +28,7 @@ data RenameOrganizationResponse = RenameOrganizationResponse { renameOrganizationResponseMessage :: !Text , renameOrganizationResponseUrl :: !URL } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData RenameOrganizationResponse instance Binary RenameOrganizationResponse diff --git a/src/GitHub/Data/Events.hs b/src/GitHub/Data/Events.hs index 16b85eca..4025aae7 100644 --- a/src/GitHub/Data/Events.hs +++ b/src/GitHub/Data/Events.hs @@ -16,7 +16,7 @@ data Event = Event , eventCreatedAt :: !UTCTime , eventPublic :: !Bool } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData Event instance Binary Event diff --git a/src/GitHub/Data/Gists.hs b/src/GitHub/Data/Gists.hs index 7e46c686..983b7a1d 100644 --- a/src/GitHub/Data/Gists.hs +++ b/src/GitHub/Data/Gists.hs @@ -21,7 +21,7 @@ data Gist = Gist , gistId :: !(Name Gist) , gistFiles :: !(HashMap Text GistFile) , gistGitPullUrl :: !URL - } deriving (Show, Data, Typeable, Eq, Generic) + } deriving (Show, Data, Eq, Generic) instance NFData Gist instance Binary Gist @@ -49,7 +49,7 @@ data GistFile = GistFile , gistFileFilename :: !Text , gistFileContent :: !(Maybe Text) } - deriving (Show, Data, Typeable, Eq, Generic) + deriving (Show, Data, Eq, Generic) instance NFData GistFile instance Binary GistFile @@ -71,7 +71,7 @@ data GistComment = GistComment , gistCommentUpdatedAt :: !UTCTime , gistCommentId :: !(Id GistComment) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData GistComment instance Binary GistComment @@ -89,7 +89,7 @@ data NewGist = NewGist { newGistDescription :: !(Maybe Text) , newGistFiles :: !(HashMap Text NewGistFile) , newGistPublic :: !(Maybe Bool) - } deriving (Show, Data, Typeable, Eq, Generic) + } deriving (Show, Data, Eq, Generic) instance NFData NewGist instance Binary NewGist @@ -109,7 +109,7 @@ instance ToJSON NewGist where data NewGistFile = NewGistFile { newGistFileContent :: !Text - } deriving (Show, Data, Typeable, Eq, Generic) + } deriving (Show, Data, Eq, Generic) instance NFData NewGistFile instance Binary NewGistFile diff --git a/src/GitHub/Data/GitData.hs b/src/GitHub/Data/GitData.hs index d4fd8798..41158632 100644 --- a/src/GitHub/Data/GitData.hs +++ b/src/GitHub/Data/GitData.hs @@ -15,14 +15,14 @@ data CommitQueryOption | CommitQueryAuthor !Text | CommitQuerySince !UTCTime | CommitQueryUntil !UTCTime - deriving (Show, Eq, Ord, Generic, Typeable, Data) + deriving (Show, Eq, Ord, Generic, Data) data Stats = Stats { statsAdditions :: !Int , statsTotal :: !Int , statsDeletions :: !Int } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData Stats instance Binary Stats @@ -37,7 +37,7 @@ data Commit = Commit , commitFiles :: !(Vector File) , commitStats :: !(Maybe Stats) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData Commit instance Binary Commit @@ -47,7 +47,7 @@ data Tree = Tree , treeUrl :: !URL , treeGitTrees :: !(Vector GitTree) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData Tree instance Binary Tree @@ -61,7 +61,7 @@ data GitTree = GitTree , gitTreePath :: !Text , gitTreeMode :: !Text } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData GitTree instance Binary GitTree @@ -75,7 +75,7 @@ data GitCommit = GitCommit , gitCommitSha :: !(Maybe (Name GitCommit)) , gitCommitParents :: !(Vector Tree) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData GitCommit instance Binary GitCommit @@ -87,7 +87,7 @@ data Blob = Blob , blobSha :: !(Name Blob) , blobSize :: !Int } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData Blob instance Binary Blob @@ -98,7 +98,7 @@ data Tag = Tag , tagTarballUrl :: !URL , tagCommit :: !BranchCommit } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData Tag instance Binary Tag @@ -107,7 +107,7 @@ data Branch = Branch { branchName :: !Text , branchCommit :: !BranchCommit } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData Branch @@ -115,7 +115,7 @@ data BranchCommit = BranchCommit { branchCommitSha :: !Text , branchCommitUrl :: !URL } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData BranchCommit instance Binary BranchCommit @@ -134,7 +134,7 @@ data Diff = Diff , diffDiffUrl :: !URL , diffPermalinkUrl :: !URL } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData Diff instance Binary Diff @@ -143,7 +143,7 @@ data NewGitReference = NewGitReference { newGitReferenceRef :: !Text , newGitReferenceSha :: !Text } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData NewGitReference instance Binary NewGitReference @@ -153,7 +153,7 @@ data GitReference = GitReference , gitReferenceUrl :: !URL , gitReferenceRef :: !(Name GitReference) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData GitReference instance Binary GitReference @@ -163,7 +163,7 @@ data GitObject = GitObject , gitObjectSha :: !Text , gitObjectUrl :: !URL } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData GitObject instance Binary GitObject @@ -173,7 +173,7 @@ data GitUser = GitUser , gitUserEmail :: !Text , gitUserDate :: !UTCTime } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData GitUser instance Binary GitUser @@ -189,7 +189,7 @@ data File = File , fileFilename :: !Text , fileDeletions :: !Int } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData File instance Binary File diff --git a/src/GitHub/Data/Id.hs b/src/GitHub/Data/Id.hs index ddbc9e25..6c18c2e2 100644 --- a/src/GitHub/Data/Id.hs +++ b/src/GitHub/Data/Id.hs @@ -9,7 +9,7 @@ import Prelude () -- | Numeric identifier. newtype Id entity = Id Int - deriving (Eq, Ord, Show, Generic, Typeable, Data) + deriving (Eq, Ord, Show, Generic, Data) -- | Smart constructor for 'Id'. mkId :: proxy entity -> Int -> Id entity diff --git a/src/GitHub/Data/Invitation.hs b/src/GitHub/Data/Invitation.hs index 3267c2a3..5818a296 100644 --- a/src/GitHub/Data/Invitation.hs +++ b/src/GitHub/Data/Invitation.hs @@ -19,7 +19,7 @@ data Invitation = Invitation , invitationCreatedAt :: !UTCTime , inviter :: !SimpleUser } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData Invitation instance Binary Invitation @@ -41,7 +41,7 @@ data InvitationRole | InvitationRoleHiringManager | InvitationRoleReinstate deriving - (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) + (Eq, Ord, Show, Enum, Bounded, Generic, Data) instance NFData InvitationRole instance Binary InvitationRole @@ -65,7 +65,7 @@ data RepoInvitation = RepoInvitation , repoInvitationPermission :: !Text , repoInvitationHtmlUrl :: !URL } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData RepoInvitation instance Binary RepoInvitation diff --git a/src/GitHub/Data/Issues.hs b/src/GitHub/Data/Issues.hs index 99928ece..2f815c0d 100644 --- a/src/GitHub/Data/Issues.hs +++ b/src/GitHub/Data/Issues.hs @@ -33,7 +33,7 @@ data Issue = Issue , issueMilestone :: !(Maybe Milestone) , issueStateReason :: !(Maybe IssueStateReason) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData Issue instance Binary Issue @@ -45,7 +45,7 @@ data NewIssue = NewIssue , newIssueMilestone :: !(Maybe (Id Milestone)) , newIssueLabels :: !(Maybe (Vector (Name IssueLabel))) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData NewIssue instance Binary NewIssue @@ -58,7 +58,7 @@ data EditIssue = EditIssue , editIssueMilestone :: !(Maybe (Id Milestone)) , editIssueLabels :: !(Maybe (Vector (Name IssueLabel))) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData EditIssue instance Binary EditIssue @@ -72,7 +72,7 @@ data IssueComment = IssueComment , issueCommentBody :: !Text , issueCommentId :: !Int } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData IssueComment instance Binary IssueComment @@ -106,7 +106,7 @@ data EventType | MovedColumnsInProject -- ^ The issue was moved between columns in a project board. | RemovedFromProject -- ^ The issue was removed from a project board. | ConvertedNoteToIssue -- ^ The issue was created by converting a note in a project board to an issue. - deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Enum, Bounded, Eq, Ord, Generic) instance NFData EventType instance Binary EventType @@ -122,7 +122,7 @@ data IssueEvent = IssueEvent , issueEventIssue :: !(Maybe Issue) , issueEventLabel :: !(Maybe IssueLabel) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData IssueEvent instance Binary IssueEvent diff --git a/src/GitHub/Data/Milestone.hs b/src/GitHub/Data/Milestone.hs index aa907999..789b2324 100644 --- a/src/GitHub/Data/Milestone.hs +++ b/src/GitHub/Data/Milestone.hs @@ -18,7 +18,7 @@ data Milestone = Milestone , milestoneCreatedAt :: !UTCTime , milestoneState :: !Text } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData Milestone instance Binary Milestone @@ -42,7 +42,7 @@ data NewMilestone = NewMilestone , newMilestoneDescription :: !(Maybe Text) , newMilestoneDueOn :: !(Maybe UTCTime) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData NewMilestone instance Binary NewMilestone @@ -65,7 +65,7 @@ data UpdateMilestone = UpdateMilestone , updateMilestoneDescription :: !(Maybe Text) , updateMilestoneDueOn :: !(Maybe UTCTime) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData UpdateMilestone instance Binary UpdateMilestone diff --git a/src/GitHub/Data/Name.hs b/src/GitHub/Data/Name.hs index 99554287..a9ecf8e5 100644 --- a/src/GitHub/Data/Name.hs +++ b/src/GitHub/Data/Name.hs @@ -11,7 +11,7 @@ import Data.Aeson.Types (FromJSONKey (..), ToJSONKey (..), fromJSONKeyCoerce, toJSONKeyText) newtype Name entity = N Text - deriving (Eq, Ord, Show, Generic, Typeable, Data) + deriving (Eq, Ord, Show, Generic, Data) -- | Smart constructor for 'Name' mkName :: proxy entity -> Text -> Name entity diff --git a/src/GitHub/Data/Options.hs b/src/GitHub/Data/Options.hs index 33899fbe..da137f0f 100644 --- a/src/GitHub/Data/Options.hs +++ b/src/GitHub/Data/Options.hs @@ -104,7 +104,7 @@ data IssueState = StateOpen | StateClosed deriving - (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) + (Eq, Ord, Show, Enum, Bounded, Generic, Data) instance ToJSON IssueState where toJSON StateOpen = String "open" @@ -126,7 +126,7 @@ data IssueStateReason | StateReasonNotPlanned | StateReasonReopened deriving - (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) + (Eq, Ord, Show, Enum, Bounded, Generic, Data) instance ToJSON IssueStateReason where toJSON = String . \case @@ -156,7 +156,7 @@ data MergeableState | StateBehind | StateDraft deriving - (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) + (Eq, Ord, Show, Enum, Bounded, Generic, Data) instance ToJSON MergeableState where toJSON StateUnknown = String "unknown" @@ -185,7 +185,7 @@ data SortDirection = SortAscending | SortDescending deriving - (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) + (Eq, Ord, Show, Enum, Bounded, Generic, Data) instance NFData SortDirection instance Binary SortDirection @@ -198,7 +198,7 @@ data SortPR | SortPRPopularity | SortPRLongRunning deriving - (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) + (Eq, Ord, Show, Enum, Bounded, Generic, Data) instance NFData SortPR instance Binary SortPR @@ -211,7 +211,7 @@ data IssueFilter | IssueFilterSubscribed | IssueFilterAll deriving - (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) + (Eq, Ord, Show, Enum, Bounded, Generic, Data) instance NFData IssueFilter instance Binary IssueFilter @@ -221,7 +221,7 @@ data SortIssue | SortIssueUpdated | SortIssueComments deriving - (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) + (Eq, Ord, Show, Enum, Bounded, Generic, Data) instance NFData SortIssue instance Binary SortIssue @@ -234,7 +234,7 @@ data FilterBy a -- ^ e.g. for milestones "any" means "any milestone". -- I.e. won't show issues without mileston specified deriving - (Eq, Ord, Show, Generic, Typeable, Data) + (Eq, Ord, Show, Generic, Data) -- Actions cache @@ -243,7 +243,7 @@ data SortCache | SortCacheLastAccessedAt | SortCacheSizeInBytes deriving - (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) + (Eq, Ord, Show, Enum, Bounded, Generic, Data) instance NFData SortCache instance Binary SortCache @@ -334,7 +334,7 @@ data PullRequestOptions = PullRequestOptions , pullRequestOptionsDirection :: !SortDirection } deriving - (Eq, Ord, Show, Generic, Typeable, Data) + (Eq, Ord, Show, Generic, Data) defaultPullRequestOptions :: PullRequestOptions defaultPullRequestOptions = PullRequestOptions @@ -429,7 +429,7 @@ data IssueOptions = IssueOptions , issueOptionsSince :: !(Maybe UTCTime) } deriving - (Eq, Ord, Show, Generic, Typeable, Data) + (Eq, Ord, Show, Generic, Data) defaultIssueOptions :: IssueOptions defaultIssueOptions = IssueOptions @@ -575,7 +575,7 @@ data IssueRepoOptions = IssueRepoOptions , issueRepoOptionsSince :: !(Maybe UTCTime) -- ^ 'HasSince' } deriving - (Eq, Ord, Show, Generic, Typeable, Data) + (Eq, Ord, Show, Generic, Data) defaultIssueRepoOptions :: IssueRepoOptions defaultIssueRepoOptions = IssueRepoOptions @@ -714,7 +714,7 @@ data ArtifactOptions = ArtifactOptions { artifactOptionsName :: !(Maybe Text) } deriving - (Eq, Ord, Show, Generic, Typeable, Data) + (Eq, Ord, Show, Generic, Data) defaultArtifactOptions :: ArtifactOptions defaultArtifactOptions = ArtifactOptions @@ -763,7 +763,7 @@ data CacheOptions = CacheOptions , cacheOptionsDirection :: !(Maybe SortDirection) } deriving - (Eq, Ord, Show, Generic, Typeable, Data) + (Eq, Ord, Show, Generic, Data) defaultCacheOptions :: CacheOptions defaultCacheOptions = CacheOptions @@ -863,7 +863,7 @@ data WorkflowRunOptions = WorkflowRunOptions , workflowRunOptionsHeadSha :: !(Maybe Text) } deriving - (Eq, Ord, Show, Generic, Typeable, Data) + (Eq, Ord, Show, Generic, Data) defaultWorkflowRunOptions :: WorkflowRunOptions defaultWorkflowRunOptions = WorkflowRunOptions diff --git a/src/GitHub/Data/PublicSSHKeys.hs b/src/GitHub/Data/PublicSSHKeys.hs index 125cd4aa..a7bf18f9 100644 --- a/src/GitHub/Data/PublicSSHKeys.hs +++ b/src/GitHub/Data/PublicSSHKeys.hs @@ -14,7 +14,7 @@ data PublicSSHKeyBasic = PublicSSHKeyBasic { basicPublicSSHKeyId :: !(Id PublicSSHKey) , basicPublicSSHKeyKey :: !Text } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance FromJSON PublicSSHKeyBasic where parseJSON = withObject "PublicSSHKeyBasic" $ \o -> PublicSSHKeyBasic @@ -30,7 +30,7 @@ data PublicSSHKey = PublicSSHKey , publicSSHKeyCreatedAt :: !(Maybe UTCTime) , publicSSHKeyReadOnly :: !Bool } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance FromJSON PublicSSHKey where parseJSON = withObject "PublicSSHKey" $ \o -> PublicSSHKey @@ -46,7 +46,7 @@ data NewPublicSSHKey = NewPublicSSHKey { newPublicSSHKeyKey :: !Text , newPublicSSHKeyTitle :: !Text } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance ToJSON NewPublicSSHKey where toJSON (NewPublicSSHKey key title) = object diff --git a/src/GitHub/Data/PullRequests.hs b/src/GitHub/Data/PullRequests.hs index 660fd0a5..74370960 100644 --- a/src/GitHub/Data/PullRequests.hs +++ b/src/GitHub/Data/PullRequests.hs @@ -43,7 +43,7 @@ data SimplePullRequest = SimplePullRequest , simplePullRequestTitle :: !Text , simplePullRequestId :: !(Id PullRequest) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData SimplePullRequest instance Binary SimplePullRequest @@ -81,7 +81,7 @@ data PullRequest = PullRequest , pullRequestMergeable :: !(Maybe Bool) , pullRequestMergeableState :: !MergeableState } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData PullRequest instance Binary PullRequest @@ -122,7 +122,7 @@ data PullRequestLinks = PullRequestLinks , pullRequestLinksHtml :: !URL , pullRequestLinksSelf :: !URL } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData PullRequestLinks instance Binary PullRequestLinks @@ -134,7 +134,7 @@ data PullRequestCommit = PullRequestCommit , pullRequestCommitUser :: !SimpleUser , pullRequestCommitRepo :: !(Maybe Repo) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData PullRequestCommit instance Binary PullRequestCommit @@ -146,7 +146,7 @@ data PullRequestEvent = PullRequestEvent , pullRequestRepository :: !Repo , pullRequestSender :: !SimpleUser } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData PullRequestEvent instance Binary PullRequestEvent @@ -163,7 +163,7 @@ data PullRequestEventType | PullRequestReviewRequested | PullRequestReviewRequestRemoved | PullRequestEdited - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData PullRequestEventType instance Binary PullRequestEventType @@ -173,7 +173,7 @@ data PullRequestReference = PullRequestReference , pullRequestReferencePatchUrl :: !(Maybe URL) , pullRequestReferenceDiffUrl :: !(Maybe URL) } - deriving (Eq, Ord, Show, Generic, Typeable, Data) + deriving (Eq, Ord, Show, Generic, Data) instance NFData PullRequestReference instance Binary PullRequestReference @@ -316,4 +316,4 @@ data MergeResult = MergeSuccessful | MergeCannotPerform | MergeConflict - deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable) + deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic) diff --git a/src/GitHub/Data/RateLimit.hs b/src/GitHub/Data/RateLimit.hs index d2b98d73..743a096e 100644 --- a/src/GitHub/Data/RateLimit.hs +++ b/src/GitHub/Data/RateLimit.hs @@ -13,7 +13,7 @@ data Limits = Limits , limitsRemaining :: !Int , limitsReset :: !SystemTime } - deriving (Show, {- Data, -} Typeable, Eq, Ord, Generic) + deriving (Show, Eq, Ord, Generic) instance NFData Limits instance Binary Limits @@ -29,7 +29,7 @@ data RateLimit = RateLimit , rateLimitSearch :: Limits , rateLimitGraphQL :: Limits } - deriving (Show, {- Data, -} Typeable, Eq, Ord, Generic) + deriving (Show, Eq, Ord, Generic) instance NFData RateLimit instance Binary RateLimit diff --git a/src/GitHub/Data/Reactions.hs b/src/GitHub/Data/Reactions.hs index ade4ec7b..574fda00 100644 --- a/src/GitHub/Data/Reactions.hs +++ b/src/GitHub/Data/Reactions.hs @@ -13,7 +13,7 @@ data Reaction = Reaction , reactionContent :: !ReactionContent , reactionCreatedAt :: !UTCTime } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData Reaction instance Binary Reaction @@ -21,7 +21,7 @@ instance Binary Reaction data NewReaction = NewReaction { newReactionContent :: !ReactionContent } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData NewReaction instance Binary NewReaction @@ -37,7 +37,7 @@ data ReactionContent | Hooray | Rocket | Eyes - deriving (Show, Data, Typeable, Eq, Ord, Enum, Bounded, Generic) + deriving (Show, Data, Eq, Ord, Enum, Bounded, Generic) instance NFData ReactionContent instance Binary ReactionContent diff --git a/src/GitHub/Data/Releases.hs b/src/GitHub/Data/Releases.hs index 0f9c40b7..7f87b825 100644 --- a/src/GitHub/Data/Releases.hs +++ b/src/GitHub/Data/Releases.hs @@ -25,7 +25,7 @@ data Release = Release , releaseAuthor :: !SimpleUser , releaseAssets :: !(Vector ReleaseAsset) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance FromJSON Release where parseJSON = withObject "Event" $ \o -> Release @@ -64,7 +64,7 @@ data ReleaseAsset = ReleaseAsset , releaseAssetUpdatedAt :: !UTCTime , releaseAssetUploader :: !SimpleUser } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance FromJSON ReleaseAsset where parseJSON = withObject "Event" $ \o -> ReleaseAsset diff --git a/src/GitHub/Data/Repos.hs b/src/GitHub/Data/Repos.hs index 8964c00b..6dce3919 100644 --- a/src/GitHub/Data/Repos.hs +++ b/src/GitHub/Data/Repos.hs @@ -53,7 +53,7 @@ data Repo = Repo , repoUpdatedAt :: !(Maybe UTCTime) , repoPermissions :: !(Maybe RepoPermissions) -- ^ Repository permissions as they relate to the authenticated user. } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData Repo instance Binary Repo @@ -88,7 +88,7 @@ data CodeSearchRepo = CodeSearchRepo , codeSearchRepoUpdatedAt :: !(Maybe UTCTime) , codeSearchRepoPermissions :: !(Maybe RepoPermissions) -- ^ Repository permissions as they relate to the authenticated user. } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData CodeSearchRepo instance Binary CodeSearchRepo @@ -101,7 +101,7 @@ data RepoPermissions = RepoPermissions , repoPermissionPush :: !Bool , repoPermissionPull :: !Bool } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData RepoPermissions instance Binary RepoPermissions @@ -110,7 +110,7 @@ data RepoRef = RepoRef { repoRefOwner :: !SimpleOwner , repoRefRepo :: !(Name Repo) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData RepoRef instance Binary RepoRef @@ -129,7 +129,7 @@ data NewRepo = NewRepo , newRepoAllowSquashMerge :: !(Maybe Bool) , newRepoAllowMergeCommit :: !(Maybe Bool) , newRepoAllowRebaseMerge :: !(Maybe Bool) - } deriving (Eq, Ord, Show, Data, Typeable, Generic) + } deriving (Eq, Ord, Show, Data, Generic) instance NFData NewRepo instance Binary NewRepo @@ -151,7 +151,7 @@ data EditRepo = EditRepo , editAllowRebaseMerge :: !(Maybe Bool) , editArchived :: !(Maybe Bool) } - deriving (Eq, Ord, Show, Data, Typeable, Generic) + deriving (Eq, Ord, Show, Data, Generic) instance NFData EditRepo instance Binary EditRepo @@ -163,14 +163,14 @@ data RepoPublicity | RepoPublicityPublic -- ^ Only public repos. | RepoPublicityPrivate -- ^ Only private repos. | RepoPublicityMember -- ^ Only repos to which the user is a member but not an owner. - deriving (Show, Eq, Ord, Enum, Bounded, Typeable, Data, Generic) + deriving (Show, Eq, Ord, Enum, Bounded, Data, Generic) -- | The value is the number of bytes of code written in that language. type Languages = HM.HashMap Language Int -- | A programming language. newtype Language = Language Text - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) getLanguage :: Language -> Text getLanguage (Language l) = l @@ -188,7 +188,7 @@ data Contributor = KnownContributor !Int !URL !(Name User) !URL !(Id User) !Text -- | An unknown Github user with their number of contributions and recorded name. | AnonymousContributor !Int !Text - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData Contributor instance Binary Contributor @@ -205,7 +205,7 @@ data CollaboratorPermission | CollaboratorPermissionWrite | CollaboratorPermissionRead | CollaboratorPermissionNone - deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Enum, Bounded, Eq, Ord, Generic) instance NFData CollaboratorPermission instance Binary CollaboratorPermission @@ -214,7 +214,7 @@ instance Binary CollaboratorPermission -- See data CollaboratorWithPermission = CollaboratorWithPermission SimpleUser CollaboratorPermission - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData CollaboratorWithPermission instance Binary CollaboratorWithPermission @@ -381,7 +381,7 @@ instance FromJSONKey Language where data ArchiveFormat = ArchiveFormatTarball -- ^ ".tar.gz" format | ArchiveFormatZipball -- ^ ".zip" format - deriving (Show, Eq, Ord, Enum, Bounded, Typeable, Data, Generic) + deriving (Show, Eq, Ord, Enum, Bounded, Data, Generic) instance IsPathPart ArchiveFormat where toPathPart af = case af of diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs index 0ff3ae1b..07ac89dd 100644 --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -61,7 +61,7 @@ data CommandMethod | Patch | Put | Delete - deriving (Eq, Ord, Read, Show, Enum, Bounded, Typeable, Data, Generic) + deriving (Eq, Ord, Read, Show, Enum, Bounded, Data, Generic) instance Hashable CommandMethod @@ -81,7 +81,7 @@ data FetchCount = FetchAtLeast !Word | FetchAll | FetchPage PageParams - deriving (Eq, Ord, Read, Show, Generic, Typeable) + deriving (Eq, Ord, Read, Show, Generic) -- | This instance is there mostly for 'fromInteger'. @@ -111,7 +111,7 @@ data PageParams = PageParams { pageParamsPerPage :: Maybe Int , pageParamsPage :: Maybe Int } - deriving (Eq, Ord, Read, Show, Generic, Typeable) + deriving (Eq, Ord, Read, Show, Generic) instance Hashable PageParams instance Binary PageParams @@ -129,7 +129,7 @@ data PageLinks = PageLinks { , pageLinksLast :: Maybe URI , pageLinksFirst :: Maybe URI } - deriving (Eq, Ord, Show, Generic, Typeable) + deriving (Eq, Ord, Show, Generic) instance NFData PageLinks @@ -148,7 +148,7 @@ data MediaType a | MtStatus -- ^ Parse status | MtUnit -- ^ Always succeeds | MtPreview a -- ^ Some other (preview) type; this is an extension point. - deriving (Eq, Ord, Read, Show, Typeable, Data, Generic) + deriving (Eq, Ord, Read, Show, Data, Generic) ------------------------------------------------------------------------------ -- RW @@ -160,7 +160,7 @@ data RW = RO -- ^ /Read-only/, doesn't necessarily requires authentication | RA -- ^ /Read authenticated/ | RW -- ^ /Read-write/, requires authentication - deriving (Eq, Ord, Read, Show, Enum, Bounded, Typeable, Data, Generic) + deriving (Eq, Ord, Read, Show, Enum, Bounded, Data, Generic) {- data SRO (rw :: RW) where @@ -194,7 +194,6 @@ data GenRequest (mt :: MediaType *) (rw :: RW) a where -> Paths -- ^ path -> LBS.ByteString -- ^ body -> GenRequest mt 'RW a - deriving (Typeable) -- | Most requests ask for @JSON@. type Request = GenRequest 'MtJSON diff --git a/src/GitHub/Data/Search.hs b/src/GitHub/Data/Search.hs index fd333482..a84710d2 100644 --- a/src/GitHub/Data/Search.hs +++ b/src/GitHub/Data/Search.hs @@ -11,7 +11,7 @@ data SearchResult' entities = SearchResult { searchResultTotalCount :: !Int , searchResultResults :: !entities } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) type SearchResult entity = SearchResult' (V.Vector entity) @@ -38,7 +38,7 @@ data Code = Code , codeHtmlUrl :: !URL , codeRepo :: !CodeSearchRepo } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData Code instance Binary Code diff --git a/src/GitHub/Data/Statuses.hs b/src/GitHub/Data/Statuses.hs index 5b488920..a2e19219 100644 --- a/src/GitHub/Data/Statuses.hs +++ b/src/GitHub/Data/Statuses.hs @@ -1,7 +1,5 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} + module GitHub.Data.Statuses where import GitHub.Data.Definitions @@ -21,7 +19,7 @@ data StatusState | StatusSuccess | StatusError | StatusFailure - deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Enum, Bounded, Eq, Ord, Generic) instance NFData StatusState instance Binary StatusState @@ -52,7 +50,7 @@ data Status = Status , statusContext :: !(Maybe Text) , statusCreator :: !(Maybe SimpleUser) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance FromJSON Status where parseJSON = withObject "Status" $ \o -> Status @@ -73,7 +71,7 @@ data NewStatus = NewStatus , newStatusDescription :: !(Maybe Text) , newStatusContext :: !(Maybe Text) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData NewStatus instance Binary NewStatus @@ -99,7 +97,7 @@ data CombinedStatus = CombinedStatus , combinedStatusCommitUrl :: !URL , combinedStatusUrl :: !URL } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance FromJSON CombinedStatus where parseJSON = withObject "CombinedStatus" $ \o -> CombinedStatus diff --git a/src/GitHub/Data/Teams.hs b/src/GitHub/Data/Teams.hs index 4f3da777..01b1429c 100644 --- a/src/GitHub/Data/Teams.hs +++ b/src/GitHub/Data/Teams.hs @@ -1,7 +1,4 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} module GitHub.Data.Teams where @@ -18,7 +15,7 @@ import qualified Data.Text as T data Privacy = PrivacyClosed | PrivacySecret - deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Enum, Bounded, Eq, Ord, Generic) instance NFData Privacy instance Binary Privacy @@ -27,7 +24,7 @@ data Permission = PermissionPull | PermissionPush | PermissionAdmin - deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Enum, Bounded, Eq, Ord, Generic) instance NFData Permission instance Binary Permission @@ -35,7 +32,7 @@ instance Binary Permission data AddTeamRepoPermission = AddTeamRepoPermission { addTeamRepoPermission :: !Permission } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData AddTeamRepoPermission instance Binary AddTeamRepoPermission @@ -51,7 +48,7 @@ data SimpleTeam = SimpleTeam , simpleTeamMembersUrl :: !URL , simpleTeamRepositoriesUrl :: !URL } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData SimpleTeam instance Binary SimpleTeam @@ -70,7 +67,7 @@ data Team = Team , teamReposCount :: !Int , teamOrganization :: !SimpleOrganization } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData Team instance Binary Team @@ -82,7 +79,7 @@ data CreateTeam = CreateTeam , createTeamPrivacy :: !Privacy , createTeamPermission :: !Permission } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData CreateTeam instance Binary CreateTeam @@ -93,7 +90,7 @@ data EditTeam = EditTeam , editTeamPrivacy :: !(Maybe Privacy) , editTeamPermission :: !(Maybe Permission) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData EditTeam instance Binary EditTeam @@ -101,7 +98,7 @@ instance Binary EditTeam data Role = RoleMaintainer | RoleMember - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData Role instance Binary Role @@ -109,7 +106,7 @@ instance Binary Role data ReqState = StatePending | StateActive - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData ReqState instance Binary ReqState @@ -119,14 +116,14 @@ data TeamMembership = TeamMembership , teamMembershipRole :: !Role , teamMembershipReqState :: !ReqState } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData TeamMembership instance Binary TeamMembership data CreateTeamMembership = CreateTeamMembership { createTeamMembershipRole :: !Role -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +} deriving (Show, Data, Eq, Ord, Generic) instance NFData CreateTeamMembership instance Binary CreateTeamMembership @@ -254,4 +251,4 @@ data TeamMemberRole = TeamMemberRoleAll -- ^ all members of the team. | TeamMemberRoleMaintainer -- ^ team maintainers | TeamMemberRoleMember -- ^ normal members of the team. - deriving (Show, Eq, Ord, Enum, Bounded, Typeable, Data, Generic) + deriving (Show, Eq, Ord, Enum, Bounded, Data, Generic) diff --git a/src/GitHub/Data/URL.hs b/src/GitHub/Data/URL.hs index c3d9edcc..69ddde70 100644 --- a/src/GitHub/Data/URL.hs +++ b/src/GitHub/Data/URL.hs @@ -10,7 +10,7 @@ import Prelude () -- -- /N.B./ syntactical validity is not verified. newtype URL = URL Text - deriving (Eq, Ord, Show, Generic, Typeable, Data) + deriving (Eq, Ord, Show, Generic, Data) getUrl :: URL -> Text getUrl (URL url) = url diff --git a/src/GitHub/Data/Webhooks.hs b/src/GitHub/Data/Webhooks.hs index 32e97287..7d2bac40 100644 --- a/src/GitHub/Data/Webhooks.hs +++ b/src/GitHub/Data/Webhooks.hs @@ -20,7 +20,7 @@ data RepoWebhook = RepoWebhook , repoWebhookUpdatedAt :: !UTCTime , repoWebhookCreatedAt :: !UTCTime } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData RepoWebhook instance Binary RepoWebhook @@ -85,7 +85,7 @@ data RepoWebhookEvent | WebhookWatchEvent | WebhookWorkflowDispatch | WebhookWorkflowRun - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData RepoWebhookEvent instance Binary RepoWebhookEvent @@ -95,7 +95,7 @@ data RepoWebhookResponse = RepoWebhookResponse , repoWebhookResponseStatus :: !(Maybe Text) , repoWebhookResponseMessage :: !(Maybe Text) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData RepoWebhookResponse instance Binary RepoWebhookResponse @@ -105,7 +105,7 @@ data PingEvent = PingEvent , pingEventHook :: !RepoWebhook , pingEventHookId :: !(Id RepoWebhook) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData PingEvent instance Binary PingEvent @@ -116,7 +116,7 @@ data NewRepoWebhook = NewRepoWebhook , newRepoWebhookEvents :: !(Maybe (Vector RepoWebhookEvent)) , newRepoWebhookActive :: !(Maybe Bool) } - deriving (Eq, Ord, Show, Typeable, Data, Generic) + deriving (Eq, Ord, Show, Data, Generic) instance NFData NewRepoWebhook instance Binary NewRepoWebhook @@ -128,7 +128,7 @@ data EditRepoWebhook = EditRepoWebhook , editRepoWebhookRemoveEvents :: !(Maybe (Vector RepoWebhookEvent)) , editRepoWebhookActive :: !(Maybe Bool) } - deriving (Eq, Ord, Show, Typeable, Data, Generic) + deriving (Eq, Ord, Show, Data, Generic) instance NFData EditRepoWebhook instance Binary EditRepoWebhook diff --git a/src/GitHub/Internal/Prelude.hs b/src/GitHub/Internal/Prelude.hs index 03a38b13..a001da65 100644 --- a/src/GitHub/Internal/Prelude.hs +++ b/src/GitHub/Internal/Prelude.hs @@ -13,7 +13,7 @@ import Data.Aeson as X import Data.Aeson.Types as X (emptyObject, typeMismatch) import Data.Binary as X (Binary) import Data.Binary.Instances as X () -import Data.Data as X (Data, Typeable) +import Data.Data as X (Data) import Data.Foldable as X (toList) import Data.Hashable as X (Hashable (..)) import Data.HashMap.Strict as X (HashMap) From 0c07f9e17076dfd67fe82d0b5cada98d961964a9 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Wed, 27 Aug 2025 12:56:31 +0200 Subject: [PATCH 508/510] Bump to v0.30.0.1 and CHANGELOG, bump Haskell CI to 9.14 alpha1 --- .github/workflows/haskell-ci.yml | 57 ++++++++++++++++++++++++++++---- CHANGELOG.md | 9 +++++ github.cabal | 3 +- samples/github-samples.cabal | 1 + 4 files changed, 62 insertions(+), 8 deletions(-) diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index bb4e2c16..b6ee1af9 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -8,9 +8,9 @@ # # For more information, see https://github.com/haskell-CI/haskell-ci # -# version: 0.19.20250506 +# version: 0.19.20250821 # -# REGENDATA ("0.19.20250506",["--config=cabal.haskell-ci","github","cabal.project"]) +# REGENDATA ("0.19.20250821",["--config=cabal.haskell-ci","github","cabal.project"]) # name: Haskell-CI on: @@ -32,6 +32,11 @@ jobs: strategy: matrix: include: + - compiler: ghc-9.14.0.20250819 + compilerKind: ghc + compilerVersion: 9.14.0.20250819 + setup-method: ghcup-prerelease + allow-failure: false - compiler: ghc-9.12.2 compilerKind: ghc compilerVersion: 9.12.2 @@ -105,8 +110,8 @@ jobs: chmod a+x "$HOME/.ghcup/bin/ghcup" - name: Install cabal-install run: | - "$HOME/.ghcup/bin/ghcup" install cabal 3.14.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false) - echo "CABAL=$HOME/.ghcup/bin/cabal-3.14.2.0 -vnormal+nowrap" >> "$GITHUB_ENV" + "$HOME/.ghcup/bin/ghcup" install cabal 3.16.0.0 || (cat "$HOME"/.ghcup/logs/*.* && false) + echo "CABAL=$HOME/.ghcup/bin/cabal-3.16.0.0 -vnormal+nowrap" >> "$GITHUB_ENV" - name: Install GHC (GHCup) if: matrix.setup-method == 'ghcup' run: | @@ -121,6 +126,21 @@ jobs: HCKIND: ${{ matrix.compilerKind }} HCNAME: ${{ matrix.compiler }} HCVER: ${{ matrix.compilerVersion }} + - name: Install GHC (GHCup prerelease) + if: matrix.setup-method == 'ghcup-prerelease' + run: | + "$HOME/.ghcup/bin/ghcup" config add-release-channel prereleases + "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false) + HC=$("$HOME/.ghcup/bin/ghcup" whereis ghc "$HCVER") + HCPKG=$(echo "$HC" | sed 's#ghc$#ghc-pkg#') + HADDOCK=$(echo "$HC" | sed 's#ghc$#haddock#') + echo "HC=$HC" >> "$GITHUB_ENV" + echo "HCPKG=$HCPKG" >> "$GITHUB_ENV" + echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV" + env: + HCKIND: ${{ matrix.compilerKind }} + HCNAME: ${{ matrix.compiler }} + HCVER: ${{ matrix.compilerVersion }} - name: Set PATH and environment variables run: | echo "$HOME/.cabal/bin" >> $GITHUB_PATH @@ -131,7 +151,7 @@ jobs: echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV" echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV" echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV" - echo "HEADHACKAGE=false" >> "$GITHUB_ENV" + if [ $((HCNUMVER >= 91400)) -ne 0 ] ; then echo "HEADHACKAGE=true" >> "$GITHUB_ENV" ; else echo "HEADHACKAGE=false" >> "$GITHUB_ENV" ; fi echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV" env: HCKIND: ${{ matrix.compilerKind }} @@ -159,6 +179,18 @@ jobs: repository hackage.haskell.org url: http://hackage.haskell.org/ EOF + if $HEADHACKAGE; then + cat >> $CABAL_CONFIG <> $CABAL_CONFIG <> cabal.project if [ $((HCNUMVER >= 80400)) -ne 0 ] ; then echo "packages: ${PKGDIR_github_samples}" >> cabal.project ; fi echo "package github" >> cabal.project - echo " ghc-options: -Werror=missing-methods" >> cabal.project + echo " ghc-options: -Werror=missing-methods -Werror=missing-fields" >> cabal.project if [ $((HCNUMVER >= 80400)) -ne 0 ] ; then echo "package github-samples" >> cabal.project ; fi - if [ $((HCNUMVER >= 80400)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods" >> cabal.project ; fi + if [ $((HCNUMVER >= 80400)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods -Werror=missing-fields" >> cabal.project ; fi + if [ $((HCNUMVER >= 90400)) -ne 0 ] ; then echo "package github" >> cabal.project ; fi + if [ $((HCNUMVER >= 90400)) -ne 0 ] ; then echo " ghc-options: -Werror=unused-packages" >> cabal.project ; fi + if [ $((HCNUMVER >= 90400)) -ne 0 ] ; then echo "package github-samples" >> cabal.project ; fi + if [ $((HCNUMVER >= 90400)) -ne 0 ] ; then echo " ghc-options: -Werror=unused-packages" >> cabal.project ; fi + if [ $((HCNUMVER >= 90000)) -ne 0 ] ; then echo "package github" >> cabal.project ; fi + if [ $((HCNUMVER >= 90000)) -ne 0 ] ; then echo " ghc-options: -Werror=incomplete-patterns -Werror=incomplete-uni-patterns" >> cabal.project ; fi + if [ $((HCNUMVER >= 90000)) -ne 0 ] ; then echo "package github-samples" >> cabal.project ; fi + if [ $((HCNUMVER >= 90000)) -ne 0 ] ; then echo " ghc-options: -Werror=incomplete-patterns -Werror=incomplete-uni-patterns" >> cabal.project ; fi cat >> cabal.project <> cabal.project + fi $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: any.$_ installed\n" unless /^(github|github-samples)$/; }' >> cabal.project.local cat cabal.project cat cabal.project.local diff --git a/CHANGELOG.md b/CHANGELOG.md index 45c00f5a..014e7e29 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,12 @@ +## Changes for 0.30.0.1 + +_2025-08-27, Andreas Abel_ + +- Drop dependencies `deepseq-generics` and `transformers-compat`. +- Remove obsolete `deriving Typeable`. + +Tested with GHC 8.2 - 9.14 alpha1. + ## Changes for 0.30 _2025-05-09, Andreas Abel, Peace edition_ diff --git a/github.cabal b/github.cabal index 54f0d2a1..759c9f95 100644 --- a/github.cabal +++ b/github.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: github -version: 0.30 +version: 0.30.0.1 synopsis: Access to the GitHub API, v3. category: Network description: @@ -30,6 +30,7 @@ copyright: Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016-2021 Oleg Grenrus tested-with: + GHC == 9.14.1 GHC == 9.12.2 GHC == 9.10.2 GHC == 9.8.4 diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index 2fd3287a..d58512a7 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -10,6 +10,7 @@ description: Various samples of github package build-type: Simple tested-with: + GHC == 9.14.1 GHC == 9.12.2 GHC == 9.10.2 GHC == 9.8.4 From 4adbc91b2192eb5d6b1c7c59552d93cfa6ddfca4 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Wed, 27 Aug 2025 15:59:20 +0200 Subject: [PATCH 509/510] Silence -Wincomplete-uni-patterns in testsuite (for Haskell CI) --- spec/GitHub/ReposSpec.hs | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/spec/GitHub/ReposSpec.hs b/spec/GitHub/ReposSpec.hs index 45c32415..9ccc7066 100644 --- a/spec/GitHub/ReposSpec.hs +++ b/spec/GitHub/ReposSpec.hs @@ -1,4 +1,10 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} + +#if __GLASGOW_HASKELL__ >= 900 +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} +#endif + module GitHub.ReposSpec where import GitHub From e42e78961099e80cb18d05386b574e4bc87187d2 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Wed, 27 Aug 2025 16:19:56 +0200 Subject: [PATCH 510/510] Haskell CI: turn of -Werror=unused-packages; hopeless for github-samples --- .github/workflows/haskell-ci.yml | 4 ---- cabal.haskell-ci | 5 +++++ samples/github-samples.cabal | 1 - 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index b6ee1af9..2e003f87 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -246,10 +246,6 @@ jobs: echo " ghc-options: -Werror=missing-methods -Werror=missing-fields" >> cabal.project if [ $((HCNUMVER >= 80400)) -ne 0 ] ; then echo "package github-samples" >> cabal.project ; fi if [ $((HCNUMVER >= 80400)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods -Werror=missing-fields" >> cabal.project ; fi - if [ $((HCNUMVER >= 90400)) -ne 0 ] ; then echo "package github" >> cabal.project ; fi - if [ $((HCNUMVER >= 90400)) -ne 0 ] ; then echo " ghc-options: -Werror=unused-packages" >> cabal.project ; fi - if [ $((HCNUMVER >= 90400)) -ne 0 ] ; then echo "package github-samples" >> cabal.project ; fi - if [ $((HCNUMVER >= 90400)) -ne 0 ] ; then echo " ghc-options: -Werror=unused-packages" >> cabal.project ; fi if [ $((HCNUMVER >= 90000)) -ne 0 ] ; then echo "package github" >> cabal.project ; fi if [ $((HCNUMVER >= 90000)) -ne 0 ] ; then echo " ghc-options: -Werror=incomplete-patterns -Werror=incomplete-uni-patterns" >> cabal.project ; fi if [ $((HCNUMVER >= 90000)) -ne 0 ] ; then echo "package github-samples" >> cabal.project ; fi diff --git a/cabal.haskell-ci b/cabal.haskell-ci index ccddf4a2..e44b77d2 100644 --- a/cabal.haskell-ci +++ b/cabal.haskell-ci @@ -3,6 +3,11 @@ haddock: >=8.6 -- See PR #355: haddocks for GADT constructor arguments only supported from GHC 8.6 jobs-selection: any +-- Package github-samples uses "include" for dependencies, +-- so they are a superset. +-- Dissecting this is a waste of time, so I turn -Werror=unused-packages off +error-unused-packages: False + -- Some dependencies do not allow mtl-2.3 yet, so this doesn't pass yet: -- constraint-set mtl-2.3 -- ghc: >= 8.6 diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index d58512a7..2e7a8699 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -29,7 +29,6 @@ library build-depends: , base >=4.11 && <5 -- require base-4.11 because then (<>) is in Prelude - , base-compat-batteries , github , text