-- | 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 :: forall (m :: * -> *) body i.
MonadIO m =>
(Request -> m (Response body))
-> Request -> ConduitT i (Response body) m ()
sourcePaginated = forall (m :: * -> *) body i.
MonadIO m =>
(Request -> Response body -> Maybe Request)
-> (Request -> m (Response body))
-> Request
-> ConduitT i (Response body) m ()
sourcePaginatedBy forall body. Request -> Response body -> Maybe Request
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 :: forall (m :: * -> *) body i.
MonadIO m =>
(Request -> Response body -> Maybe Request)
-> (Request -> m (Response body))
-> Request
-> ConduitT i (Response body) m ()
sourcePaginatedBy Request -> Response body -> Maybe Request
mNextRequest Request -> m (Response body)
runRequest Request
req = do
  Response body
resp <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ Request -> m (Response body)
runRequest Request
req
  forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield Response body
resp
  forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (forall (m :: * -> *) body i.
MonadIO m =>
(Request -> Response body -> Maybe Request)
-> (Request -> m (Response body))
-> Request
-> ConduitT i (Response body) m ()
sourcePaginatedBy Request -> Response body -> Maybe Request
mNextRequest Request -> m (Response body)
runRequest) forall a b. (a -> b) -> a -> b
$ Request -> Response body -> Maybe Request
mNextRequest Request
req Response body
resp

linkHeader :: Request -> Response body -> Maybe Request
linkHeader :: forall body. Request -> Response body -> Maybe Request
linkHeader Request
_req Response body
resp = do
  ByteString
header <- forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ forall a. HeaderName -> Response a -> [ByteString]
getResponseHeader HeaderName
"Link" Response body
resp
  [Link]
links <- forall a b. Either a b -> Maybe b
hush forall a b. (a -> b) -> a -> b
$ Text -> Either String [Link]
parseLinkURI forall a b. (a -> b) -> a -> b
$ ByteString -> Text
decodeUtf8 ByteString
header
  URI
uri <- forall uri. IsURI uri => Link uri -> uri
href forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (((LinkParam
Rel, Text
"next") forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall uri. Link uri -> [(LinkParam, Text)]
linkParams) [Link]
links
  forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show URI
uri