Skip to content

Commit dc43816

Browse files
andreasabelandreasabel
committed
Revert "Support pagination (#503)"
This reverts commit 2bed394.
1 parent 63a4e0c commit dc43816

File tree

4 files changed

+19
-115
lines changed

4 files changed

+19
-115
lines changed

‎github.cabal‎

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -264,7 +264,6 @@ test-suite github-test
264264
, file-embed
265265
, github
266266
, hspec >=2.6.1 && <2.12
267-
, http-client
268267
, tagged
269268
, text
270269
, unordered-containers

‎spec/GitHub/IssuesSpec.hs‎

Lines changed: 6 additions & 26 deletions
Original file line numberDiff line numberDiff line change
@@ -6,13 +6,12 @@ import qualified GitHub
66
import Prelude ()
77
import Prelude.Compat
88

9-
import Data.Either.Compat (isRight)
10-
import Data.Foldable (for_)
11-
import Data.String (fromString)
12-
import Network.HTTP.Client (newManager, responseBody)
13-
import System.Environment (lookupEnv)
14-
import Test.Hspec (Spec, describe, expectationFailure, it, pendingWith, shouldSatisfy)
15-
9+
import Data.Either.Compat (isRight)
10+
import Data.Foldable (for_)
11+
import Data.String (fromString)
12+
import System.Environment (lookupEnv)
13+
import Test.Hspec
14+
(Spec, describe, expectationFailure, it, pendingWith, shouldSatisfy)
1615

1716
fromRightS :: Show a => Either a b -> b
1817
fromRightS (Right b) = b
@@ -39,25 +38,6 @@ spec = do
3938
cms <- GitHub.executeRequest auth $
4039
GitHub.commentsR owner repo (GitHub.issueNumber i) 1
4140
cms `shouldSatisfy` isRight
42-
43-
describe "issuesForRepoR paged" $ do
44-
it "works" $ withAuth $ \auth -> for_ repos $ \(owner, repo) -> do
45-
mgr <- newManager GitHub.tlsManagerSettings
46-
ret <- GitHub.executeRequestWithMgrAndRes mgr auth $
47-
GitHub.issuesForRepoR owner repo mempty (GitHub.FetchPage (GitHub.PageParams (Just 2) (Just 1)))
48-
49-
case ret of
50-
Left e ->
51-
expectationFailure . show $ e
52-
Right res -> do
53-
let issues = responseBody res
54-
length issues `shouldSatisfy` (<= 2)
55-
56-
for_ issues $ \i -> do
57-
cms <- GitHub.executeRequest auth $
58-
GitHub.commentsR owner repo (GitHub.issueNumber i) 1
59-
cms `shouldSatisfy` isRight
60-
6141
describe "issueR" $ do
6242
it "fetches issue #428" $ withAuth $ \auth -> do
6343
resIss <- GitHub.executeRequest auth $

‎src/GitHub/Data/Request.hs‎

Lines changed: 1 addition & 38 deletions
Original file line numberDiff line numberDiff line change
@@ -14,8 +14,6 @@ module GitHub.Data.Request (
1414
CommandMethod(..),
1515
toMethod,
1616
FetchCount(..),
17-
PageParams(..),
18-
PageLinks(..),
1917
MediaType (..),
2018
Paths,
2119
IsPathPart(..),
@@ -31,7 +29,6 @@ import GitHub.Internal.Prelude
3129
import qualified Data.ByteString.Lazy as LBS
3230
import qualified Data.Text as T
3331
import qualified Network.HTTP.Types.Method as Method
34-
import Network.URI (URI)
3532

3633
------------------------------------------------------------------------------
3734
-- Path parts
@@ -77,10 +74,7 @@ toMethod Delete = Method.methodDelete
7774

7875
-- | 'PagedQuery' returns just some results, using this data we can specify how
7976
-- many pages we want to fetch.
80-
data FetchCount =
81-
FetchAtLeast !Word
82-
| FetchAll
83-
| FetchPage PageParams
77+
data FetchCount = FetchAtLeast !Word | FetchAll
8478
deriving (Eq, Ord, Read, Show, Generic, Typeable)
8579

8680

@@ -102,37 +96,6 @@ instance Hashable FetchCount
10296
instance Binary FetchCount
10397
instance NFData FetchCount where rnf = genericRnf
10498

105-
-------------------------------------------------------------------------------
106-
-- PageParams
107-
-------------------------------------------------------------------------------
108-
109-
-- | Params for specifying the precise page and items per page.
110-
data PageParams = PageParams {
111-
pageParamsPerPage :: Maybe Int
112-
, pageParamsPage :: Maybe Int
113-
}
114-
deriving (Eq, Ord, Read, Show, Generic, Typeable)
115-
116-
instance Hashable PageParams
117-
instance Binary PageParams
118-
instance NFData PageParams where rnf = genericRnf
119-
120-
-------------------------------------------------------------------------------
121-
-- PageLinks
122-
-------------------------------------------------------------------------------
123-
124-
-- | 'PagedQuery' returns just some results, using this data we can specify how
125-
-- many pages we want to fetch.
126-
data PageLinks = PageLinks {
127-
pageLinksPrev :: Maybe URI
128-
, pageLinksNext :: Maybe URI
129-
, pageLinksLast :: Maybe URI
130-
, pageLinksFirst :: Maybe URI
131-
}
132-
deriving (Eq, Ord, Show, Generic, Typeable)
133-
134-
instance NFData PageLinks where rnf = genericRnf
135-
13699
-------------------------------------------------------------------------------
137100
-- MediaType
138101
-------------------------------------------------------------------------------

‎src/GitHub/Request.hs‎

Lines changed: 12 additions & 50 deletions
Original file line numberDiff line numberDiff line change
@@ -54,7 +54,6 @@ module GitHub.Request (
5454
ParseResponse (..),
5555
makeHttpRequest,
5656
parseStatus,
57-
parsePageLinks,
5857
StatusMap,
5958
getNextUrl,
6059
performPagedRequest,
@@ -80,7 +79,6 @@ import Control.Monad.Trans.Class (lift)
8079
import Control.Monad.Trans.Except (ExceptT (..), runExceptT)
8180
import Data.Aeson (eitherDecode)
8281
import Data.List (find)
83-
import Data.Maybe (fromMaybe)
8482
import Data.Tagged (Tagged (..))
8583
import Data.Version (showVersion)
8684

@@ -89,14 +87,13 @@ import Network.HTTP.Client
8987
httpLbs, method, newManager, redirectCount, requestBody, requestHeaders,
9088
setQueryString, setRequestIgnoreStatus)
9189
import Network.HTTP.Link.Parser (parseLinkHeaderBS)
92-
import Network.HTTP.Link.Types (Link(..), LinkParam (..), href, linkParams)
90+
import Network.HTTP.Link.Types (LinkParam (..), href, linkParams)
9391
import Network.HTTP.Types (Method, RequestHeaders, Status (..))
9492
import Network.URI
9593
(URI, escapeURIString, isUnescapedInURIComponent, parseURIReference,
9694
relativeTo)
9795

9896
import qualified Data.ByteString as BS
99-
import Data.ByteString.Builder (intDec, toLazyByteString)
10097
import qualified Data.ByteString.Lazy as LBS
10198
import qualified Data.Text as T
10299
import qualified Data.Text.Encoding as TE
@@ -202,6 +199,11 @@ executeRequest auth req = withOpenSSL $ do
202199
manager <- newManager tlsManagerSettings
203200
executeRequestWithMgr manager auth req
204201

202+
lessFetchCount :: Int -> FetchCount -> Bool
203+
lessFetchCount _ FetchAll = True
204+
lessFetchCount i (FetchAtLeast j) = i < fromIntegral j
205+
206+
205207
-- | Like 'executeRequest' but with provided 'Manager'.
206208
executeRequestWithMgr
207209
:: (AuthMethod am, ParseResponse mt a)
@@ -233,13 +235,10 @@ executeRequestWithMgrAndRes mgr auth req = runExceptT $ do
233235
res <- httpLbs' httpReq
234236
(<$ res) <$> unTagged (parseResponse httpReq res :: Tagged mt (ExceptT Error IO b))
235237

236-
performHttpReq httpReq (PagedQuery _ _ (FetchPage _)) = do
237-
(res, _pageLinks) <- unTagged (performPerPageRequest httpLbs' httpReq :: Tagged mt (ExceptT Error IO (HTTP.Response b, PageLinks)))
238-
return res
239-
performHttpReq httpReq (PagedQuery _ _ FetchAll) =
240-
unTagged (performPagedRequest httpLbs' (const True) httpReq :: Tagged mt (ExceptT Error IO (HTTP.Response b)))
241-
performHttpReq httpReq (PagedQuery _ _ (FetchAtLeast j)) =
242-
unTagged (performPagedRequest httpLbs' (\v -> length v < fromIntegral j) httpReq :: Tagged mt (ExceptT Error IO (HTTP.Response b)))
238+
performHttpReq httpReq (PagedQuery _ _ l) =
239+
unTagged (performPagedRequest httpLbs' predicate httpReq :: Tagged mt (ExceptT Error IO (HTTP.Response b)))
240+
where
241+
predicate v = lessFetchCount (length v) l
243242

244243
performHttpReq httpReq (Command _ _ _) = do
245244
res <- httpLbs' httpReq
@@ -457,15 +456,15 @@ makeHttpRequest auth r = case r of
457456
$ setReqHeaders
458457
. unTagged (modifyRequest :: Tagged mt (HTTP.Request -> HTTP.Request))
459458
. maybe id setAuthRequest auth
460-
. setQueryString (qs <> extraQueryItems)
459+
. setQueryString qs
461460
$ req
462461
PagedQuery paths qs _ -> do
463462
req <- parseUrl' $ url paths
464463
return
465464
$ setReqHeaders
466465
. unTagged (modifyRequest :: Tagged mt (HTTP.Request -> HTTP.Request))
467466
. maybe id setAuthRequest auth
468-
. setQueryString (qs <> extraQueryItems)
467+
. setQueryString qs
469468
$ req
470469
Command m paths body -> do
471470
req <- parseUrl' $ url paths
@@ -497,14 +496,6 @@ makeHttpRequest auth r = case r of
497496
setBody :: LBS.ByteString -> HTTP.Request -> HTTP.Request
498497
setBody body req = req { requestBody = RequestBodyLBS body }
499498

500-
extraQueryItems :: [(BS.ByteString, Maybe BS.ByteString)]
501-
extraQueryItems = case r of
502-
PagedQuery _ _ (FetchPage pp) -> catMaybes [
503-
(\page -> ("page", Just (BS.toStrict $ toLazyByteString $ intDec page))) <$> pageParamsPage pp
504-
, (\perPage -> ("per_page", Just (BS.toStrict $ toLazyByteString $ intDec perPage))) <$> pageParamsPerPage pp
505-
]
506-
_ -> []
507-
508499
-- | Query @Link@ header with @rel=next@ from the request headers.
509500
getNextUrl :: HTTP.Response a -> Maybe URI
510501
getNextUrl req = do
@@ -551,35 +542,6 @@ performPagedRequest httpLbs' predicate initReq = Tagged $ do
551542
go (acc <> m) res' req'
552543
(_, _) -> return (acc <$ res)
553544

554-
-- | Helper for requesting a single page, as specified by 'PageParams'.
555-
--
556-
-- This parses and returns the 'PageLinks' alongside the HTTP response.
557-
performPerPageRequest
558-
:: forall a m mt. (ParseResponse mt a, MonadCatch m, MonadError Error m)
559-
=> (HTTP.Request -> m (HTTP.Response LBS.ByteString)) -- ^ `httpLbs` analogue
560-
-> HTTP.Request -- ^ initial request
561-
-> Tagged mt (m (HTTP.Response a, PageLinks))
562-
performPerPageRequest httpLbs' initReq = Tagged $ do
563-
res <- httpLbs' initReq
564-
m <- unTagged (parseResponse initReq res :: Tagged mt (m a))
565-
return (m <$ res, parsePageLinks res)
566-
567-
-- | Parse the 'PageLinks' from an HTTP response, where the information is
568-
-- encoded in the Link header.
569-
parsePageLinks :: HTTP.Response a -> PageLinks
570-
parsePageLinks res = PageLinks {
571-
pageLinksPrev = linkToUri <$> find (elem (Rel, "prev") . linkParams) links
572-
, pageLinksNext = linkToUri <$> find (elem (Rel, "next") . linkParams) links
573-
, pageLinksLast = linkToUri <$> find (elem (Rel, "last") . linkParams) links
574-
, pageLinksFirst = linkToUri <$> find (elem (Rel, "first") . linkParams) links
575-
}
576-
where
577-
links :: [Link URI]
578-
links = fromMaybe [] (lookup "Link" (responseHeaders res) >>= parseLinkHeaderBS)
579-
580-
linkToUri :: Link URI -> URI
581-
linkToUri (Link uri _) = uri
582-
583545
-------------------------------------------------------------------------------
584546
-- Internal
585547
-------------------------------------------------------------------------------

0 commit comments

Comments
 (0)