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