-- | 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 :: (Request -> m (Response body))
-> Request -> ConduitT i (Response body) m ()
sourcePaginated = (Request -> Response body -> Maybe Request)
-> (Request -> m (Response body))
-> Request
-> ConduitT i (Response body) m ()
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
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 :: (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 <- m (Response body) -> ConduitT i (Response body) m (Response body)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Response body) -> ConduitT i (Response body) m (Response body))
-> m (Response body)
-> ConduitT i (Response body) m (Response body)
forall a b. (a -> b) -> a -> b
$ Request -> m (Response body)
runRequest Request
req
  Response body -> ConduitT i (Response body) m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield Response body
resp
  (Request -> ConduitT i (Response body) m ())
-> Maybe Request -> ConduitT i (Response body) m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ((Request -> Response body -> Maybe Request)
-> (Request -> m (Response body))
-> Request
-> ConduitT i (Response body) m ()
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) (Maybe Request -> ConduitT i (Response body) m ())
-> Maybe Request -> ConduitT i (Response body) m ()
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 :: Request -> Response body -> Maybe Request
linkHeader Request
_req Response body
resp = do
  ByteString
header <- [ByteString] -> Maybe ByteString
forall a. [a] -> Maybe a
listToMaybe ([ByteString] -> Maybe ByteString)
-> [ByteString] -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ HeaderName -> Response body -> [ByteString]
forall a. HeaderName -> Response a -> [ByteString]
getResponseHeader HeaderName
"Link" Response body
resp
  [Link]
links <- Either String [Link] -> Maybe [Link]
forall a b. Either a b -> Maybe b
hush (Either String [Link] -> Maybe [Link])
-> Either String [Link] -> Maybe [Link]
forall a b. (a -> b) -> a -> b
$ Text -> Either String [Link]
parseLinkURI (Text -> Either String [Link]) -> Text -> Either String [Link]
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
decodeUtf8 ByteString
header
  URI
uri <- Link -> URI
forall uri. IsURI uri => Link uri -> uri
href (Link -> URI) -> Maybe Link -> Maybe URI
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Link -> Bool) -> [Link] -> Maybe Link
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (((LinkParam
Rel, Text
"next") (LinkParam, Text) -> [(LinkParam, Text)] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`) ([(LinkParam, Text)] -> Bool)
-> (Link -> [(LinkParam, Text)]) -> Link -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Link -> [(LinkParam, Text)]
forall uri. Link uri -> [(LinkParam, Text)]
linkParams) [Link]
links
  String -> Maybe Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest (String -> Maybe Request) -> String -> Maybe Request
forall a b. (a -> b) -> a -> b
$ URI -> String
forall a. Show a => a -> String
show URI
uri