From e3e579c8be836909af11da7dc581524b8ea5eef7 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 9 Feb 2016 16:25:31 +0200 Subject: [PATCH 01/56] 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 02/56] 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 03/56] 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 04/56] 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 05/56] 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 06/56] 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 07/56] 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 08/56] 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 09/56] 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 10/56] 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 11/56] 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 12/56] 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 13/56] 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 14/56] 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 15/56] 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 16/56] 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 17/56] 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 18/56] 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 19/56] 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 20/56] 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 21/56] 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 22/56] 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 23/56] 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 24/56] 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 25/56] 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 26/56] 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 27/56] 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 28/56] 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 29/56] 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 30/56] 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 31/56] 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 32/56] 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 33/56] 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 34/56] 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 35/56] 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 36/56] 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 37/56] 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 38/56] 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 39/56] 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 40/56] 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 41/56] 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 42/56] 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 43/56] 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 44/56] 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 45/56] 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 46/56] 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 47/56] 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 48/56] 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 49/56] 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 50/56] 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 51/56] 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 52/56] 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 53/56] 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 54/56] 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 55/56] 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 56/56] 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