Paginate.hs

-- | Streaming interface for paginated HTTP APIs
--
-- == Examples
--
-- Take an action on each page as it is requested:
--
-- @
-- let req = parseRequest_ "https://..."
--
-- runConduit
--   $ sourcePaginated httpJson req
--   .| mapM_C onEachPage
--
-- onEachPage :: Response (Either HttpDecodeError [MyJsonThing]) -> m ()
-- onEachPage = undefined
-- @
--
-- Take and action /and/ collect:
--
-- @
-- allPages <- runConduit
--   $ 'sourcePaginated' httpJson req
--   .| iterM onEachPage
--   .| sinkList
-- @
--
-- For APIs that do pagination not via @Link@, you can use 'sourcePaginatedBy'
--
-- @
-- data Page a = Page
--   { pData :: [a]
--   , pNext :: Int
--   }
--
-- instance FromJSON a => FromJSON (Item a) where
--   parseJSON = withObject "Page" $ \o -> Page
--     <$> o .: "data"
--     <*> o .: "next"
--
-- runConduit
--   $ 'sourcePaginatedBy' nextPage httpJson req
--   .| mapMC (fmap pData . 'getResponseBodyUnsafe')
--   .| foldC
--
-- nextPage
--   :: Request
--   -> Response (Either ('HttpDecodeError' String) (Page a))
--   -> Maybe Request
-- nextPage req resp = do
--   body <- hush $ getResponseBody resp
--   let next = C8.pack $ show $ pNext body
--   pure $ addToRequestQueryString [("next", Just next)] req
-- @
--
module Freckle.App.Http.Paginate
  ( sourcePaginated
  , sourcePaginatedBy
  ) where

import Freckle.App.Prelude

import Conduit
import Control.Error.Util (hush)
import Network.HTTP.Link.Compat hiding (linkHeader)
import Network.HTTP.Simple

-- | Stream pages of a paginated response, using @Link@ to find next pages
--
sourcePaginated
  :: MonadIO m
  => (Request -> m (Response body))
  -- ^ Run one request
  -> Request
  -- ^ Initial request
  -> ConduitT i (Response body) m ()
sourcePaginated = sourcePaginatedBy linkHeader

-- | Stream pages of a paginated response, using a custom /find next/
sourcePaginatedBy
  :: MonadIO m
  => (Request -> Response body -> Maybe Request)
  -- ^ How to get the next page from each request
  -> (Request -> m (Response body))
  -- ^ Run one request
  -> Request
  -- ^ Initial request
  -> ConduitT i (Response body) m ()
sourcePaginatedBy mNextRequest runRequest req = do
  resp <- lift $ runRequest req
  yield resp
  traverse_ (sourcePaginatedBy mNextRequest runRequest) $ mNextRequest req resp

linkHeader :: Request -> Response body -> Maybe Request
linkHeader _req resp = do
  header <- listToMaybe $ getResponseHeader "Link" resp
  links <- hush $ parseLinkURI $ decodeUtf8 header
  uri <- href <$> find (((Rel, "next") `elem`) . linkParams) links
  parseRequest $ show uri