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
sourcePaginated
:: MonadIO m
=> (Request -> m (Response body))
-> 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
sourcePaginatedBy
:: MonadIO m
=> (Request -> Response body -> Maybe Request)
-> (Request -> m (Response body))
-> 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
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