Revert "Support pagination"

github.cabal

@@ -264,7 +264,6 @@ test-suite github-test
     , file-embed
     , github
     , hspec                 >=2.6.1 && <2.12
-    , http-client
     , tagged
     , text
     , unordered-containers

spec/GitHub/IssuesSpec.hs

@@ -6,13 +6,12 @@ import qualified GitHub
 import Prelude ()
 import Prelude.Compat
 
-import Data.Either.Compat  (isRight)
-import Data.Foldable       (for_)
-import Data.String         (fromString)
-import Network.HTTP.Client (newManager, responseBody)
-import System.Environment  (lookupEnv)
-import Test.Hspec          (Spec, describe, expectationFailure, it, pendingWith, shouldSatisfy)
-
+import Data.Either.Compat (isRight)
+import Data.Foldable      (for_)
+import Data.String        (fromString)
+import System.Environment (lookupEnv)
+import Test.Hspec
+       (Spec, describe, expectationFailure, it, pendingWith, shouldSatisfy)
 
 fromRightS :: Show a => Either a b -> b
 fromRightS (Right b) = b
@@ -39,25 +38,6 @@ spec = do
                   cms <- GitHub.executeRequest auth $
                     GitHub.commentsR owner repo (GitHub.issueNumber i) 1
                   cms `shouldSatisfy` isRight
-
-    describe "issuesForRepoR paged" $ do
-        it "works" $ withAuth $ \auth -> for_ repos $ \(owner, repo) -> do
-            mgr <- newManager GitHub.tlsManagerSettings
-            ret <- GitHub.executeRequestWithMgrAndRes mgr auth $
-                GitHub.issuesForRepoR owner repo mempty (GitHub.FetchPage (GitHub.PageParams (Just 2) (Just 1)))
-
-            case ret of
-              Left e ->
-                expectationFailure . show $ e
-              Right res -> do
-                let issues = responseBody res
-                length issues `shouldSatisfy` (<= 2)
-
-                for_ issues $ \i -> do
-                  cms <- GitHub.executeRequest auth $
-                    GitHub.commentsR owner repo (GitHub.issueNumber i) 1
-                  cms `shouldSatisfy` isRight
-
     describe "issueR" $ do
         it "fetches issue #428" $ withAuth $ \auth -> do
             resIss <- GitHub.executeRequest auth $

src/GitHub/Data/Request.hs

@@ -14,8 +14,6 @@ module GitHub.Data.Request (
     CommandMethod(..),
     toMethod,
     FetchCount(..),
-    PageParams(..),
-    PageLinks(..),
     MediaType (..),
     Paths,
     IsPathPart(..),
@@ -31,7 +29,6 @@ import GitHub.Internal.Prelude
 import qualified Data.ByteString.Lazy      as LBS
 import qualified Data.Text                 as T
 import qualified Network.HTTP.Types.Method as Method
-import Network.URI (URI)
 
 ------------------------------------------------------------------------------
 -- Path parts
@@ -77,10 +74,7 @@ toMethod Delete = Method.methodDelete
 
 -- | 'PagedQuery' returns just some results, using this data we can specify how
 -- many pages we want to fetch.
-data FetchCount =
-    FetchAtLeast !Word
-    | FetchAll
-    | FetchPage PageParams
+data FetchCount = FetchAtLeast !Word | FetchAll
     deriving (Eq, Ord, Read, Show, Generic, Typeable)
 
 
@@ -102,37 +96,6 @@ instance Hashable FetchCount
 instance Binary FetchCount
 instance NFData FetchCount where rnf = genericRnf
 
--------------------------------------------------------------------------------
--- PageParams
--------------------------------------------------------------------------------
-
--- | Params for specifying the precise page and items per page.
-data PageParams = PageParams {
-    pageParamsPerPage :: Maybe Int
-    , pageParamsPage :: Maybe Int
-    }
-    deriving (Eq, Ord, Read, Show, Generic, Typeable)
-
-instance Hashable PageParams
-instance Binary PageParams
-instance NFData PageParams where rnf = genericRnf
-
--------------------------------------------------------------------------------
--- PageLinks
--------------------------------------------------------------------------------
-
--- | 'PagedQuery' returns just some results, using this data we can specify how
--- many pages we want to fetch.
-data PageLinks = PageLinks {
-    pageLinksPrev :: Maybe URI
-    , pageLinksNext :: Maybe URI
-    , pageLinksLast :: Maybe URI
-    , pageLinksFirst :: Maybe URI
-    }
-    deriving (Eq, Ord, Show, Generic, Typeable)
-
-instance NFData PageLinks where rnf = genericRnf
-
 -------------------------------------------------------------------------------
 -- MediaType
 -------------------------------------------------------------------------------

src/GitHub/Request.hs

@@ -54,7 +54,6 @@ module GitHub.Request (
     ParseResponse (..),
     makeHttpRequest,
     parseStatus,
-    parsePageLinks,
     StatusMap,
     getNextUrl,
     performPagedRequest,
@@ -80,7 +79,6 @@ import Control.Monad.Trans.Class  (lift)
 import Control.Monad.Trans.Except (ExceptT (..), runExceptT)
 import Data.Aeson                 (eitherDecode)
 import Data.List                  (find)
-import Data.Maybe                 (fromMaybe)
 import Data.Tagged                (Tagged (..))
 import Data.Version               (showVersion)
 
@@ -89,14 +87,13 @@ import Network.HTTP.Client
        httpLbs, method, newManager, redirectCount, requestBody, requestHeaders,
        setQueryString, setRequestIgnoreStatus)
 import Network.HTTP.Link.Parser (parseLinkHeaderBS)
-import Network.HTTP.Link.Types  (Link(..), LinkParam (..), href, linkParams)
+import Network.HTTP.Link.Types  (LinkParam (..), href, linkParams)
 import Network.HTTP.Types       (Method, RequestHeaders, Status (..))
 import Network.URI
        (URI, escapeURIString, isUnescapedInURIComponent, parseURIReference,
        relativeTo)
 
 import qualified Data.ByteString              as BS
-import           Data.ByteString.Builder      (intDec, toLazyByteString)
 import qualified Data.ByteString.Lazy         as LBS
 import qualified Data.Text                    as T
 import qualified Data.Text.Encoding           as TE
@@ -202,6 +199,11 @@ executeRequest auth req = withOpenSSL $ do
     manager <- newManager tlsManagerSettings
     executeRequestWithMgr manager auth req
 
+lessFetchCount :: Int -> FetchCount -> Bool
+lessFetchCount _ FetchAll         = True
+lessFetchCount i (FetchAtLeast j) = i < fromIntegral j
+
+
 -- | Like 'executeRequest' but with provided 'Manager'.
 executeRequestWithMgr
     :: (AuthMethod am, ParseResponse mt a)
@@ -233,13 +235,10 @@ executeRequestWithMgrAndRes mgr auth req = runExceptT $ do
         res <- httpLbs' httpReq
         (<$ res) <$> unTagged (parseResponse httpReq res :: Tagged mt (ExceptT Error IO b))
 
-    performHttpReq httpReq (PagedQuery _ _ (FetchPage _)) = do
-        (res, _pageLinks) <- unTagged (performPerPageRequest httpLbs' httpReq :: Tagged mt (ExceptT Error IO (HTTP.Response b, PageLinks)))
-        return res
-    performHttpReq httpReq (PagedQuery _ _ FetchAll) =
-        unTagged (performPagedRequest httpLbs' (const True) httpReq :: Tagged mt (ExceptT Error IO (HTTP.Response b)))
-    performHttpReq httpReq (PagedQuery _ _ (FetchAtLeast j)) =
-        unTagged (performPagedRequest httpLbs' (\v -> length v < fromIntegral j) httpReq :: Tagged mt (ExceptT Error IO (HTTP.Response b)))
+    performHttpReq httpReq (PagedQuery _ _ l) =
+        unTagged (performPagedRequest httpLbs' predicate httpReq :: Tagged mt (ExceptT Error IO (HTTP.Response b)))
+      where
+        predicate v = lessFetchCount (length v) l
 
     performHttpReq httpReq (Command _ _ _) = do
         res <- httpLbs' httpReq
@@ -457,15 +456,15 @@ makeHttpRequest auth r = case r of
             $ setReqHeaders
             . unTagged (modifyRequest :: Tagged mt (HTTP.Request -> HTTP.Request))
             . maybe id setAuthRequest auth
-            . setQueryString (qs <> extraQueryItems)
+            . setQueryString qs
             $ req
     PagedQuery paths qs _ -> do
         req <- parseUrl' $ url paths
         return
             $ setReqHeaders
             . unTagged (modifyRequest :: Tagged mt (HTTP.Request -> HTTP.Request))
             . maybe id setAuthRequest auth
-            . setQueryString (qs <> extraQueryItems)
+            . setQueryString qs
             $ req
     Command m paths body -> do
         req <- parseUrl' $ url paths
@@ -497,14 +496,6 @@ makeHttpRequest auth r = case r of
     setBody :: LBS.ByteString -> HTTP.Request -> HTTP.Request
     setBody body req = req { requestBody = RequestBodyLBS body }
 
-    extraQueryItems :: [(BS.ByteString, Maybe BS.ByteString)]
-    extraQueryItems = case r of
-      PagedQuery _ _ (FetchPage pp) -> catMaybes [
-          (\page -> ("page", Just (BS.toStrict $ toLazyByteString $ intDec page))) <$> pageParamsPage pp
-          , (\perPage -> ("per_page", Just (BS.toStrict $ toLazyByteString $ intDec perPage))) <$> pageParamsPerPage pp
-          ]
-      _ -> []
-
 -- | Query @Link@ header with @rel=next@ from the request headers.
 getNextUrl :: HTTP.Response a -> Maybe URI
 getNextUrl req = do
@@ -551,35 +542,6 @@ performPagedRequest httpLbs' predicate initReq = Tagged $ do
                 go (acc <> m) res' req'
             (_, _)           -> return (acc <$ res)
 
--- | Helper for requesting a single page, as specified by 'PageParams'.
---
--- This parses and returns the 'PageLinks' alongside the HTTP response.
-performPerPageRequest
-    :: forall a m mt. (ParseResponse mt a, MonadCatch m, MonadError Error m)
-    => (HTTP.Request -> m (HTTP.Response LBS.ByteString))  -- ^ `httpLbs` analogue
-    -> HTTP.Request                                        -- ^ initial request
-    -> Tagged mt (m (HTTP.Response a, PageLinks))
-performPerPageRequest httpLbs' initReq = Tagged $ do
-    res <- httpLbs' initReq
-    m <- unTagged (parseResponse initReq res :: Tagged mt (m a))
-    return (m <$ res, parsePageLinks res)
-
--- | Parse the 'PageLinks' from an HTTP response, where the information is
--- encoded in the Link header.
-parsePageLinks :: HTTP.Response a -> PageLinks
-parsePageLinks res = PageLinks {
-    pageLinksPrev = linkToUri <$> find (elem (Rel, "prev") . linkParams) links
-    , pageLinksNext = linkToUri <$> find (elem (Rel, "next") . linkParams) links
-    , pageLinksLast = linkToUri <$> find (elem (Rel, "last") . linkParams) links
-    , pageLinksFirst = linkToUri <$> find (elem (Rel, "first") . linkParams) links
-    }
-    where
-        links :: [Link URI]
-        links = fromMaybe [] (lookup "Link" (responseHeaders res) >>= parseLinkHeaderBS)
-
-        linkToUri :: Link URI -> URI
-        linkToUri (Link uri _) = uri
-
 -------------------------------------------------------------------------------
 -- Internal
 -------------------------------------------------------------------------------