module Web.Slack.Pager
( Response,
LoadPage,
loadingPage,
fetchAllBy,
module Web.Slack.Pager.Types,
)
where
import Web.Slack.Common qualified as Common
import Web.Slack.Conversation qualified as Conversation
import Web.Slack.Pager.Types
import Web.Slack.Prelude
type Response a = Either Common.SlackClientError a
type LoadPage m a = m (Response [a])
loadingPage :: (Monad m, Monoid n) => LoadPage m a -> (Response [a] -> m n) -> m n
loadingPage :: forall (m :: * -> *) n a.
(Monad m, Monoid n) =>
LoadPage m a -> (Response [a] -> m n) -> m n
loadingPage LoadPage m a
loadPage Response [a] -> m n
usePage = n -> m n
go forall a. Monoid a => a
mempty
where
go :: n -> m n
go n
result = do
Response [a]
epage <- LoadPage m a
loadPage
case Response [a]
epage of
Right [a]
page ->
if forall mono. MonoFoldable mono => mono -> Bool
null [a]
page
then forall (m :: * -> *) a. Monad m => a -> m a
return n
result
else (n -> m n
go forall a b. (a -> b) -> a -> b
$!) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (n
result forall a. Semigroup a => a -> a -> a
<>) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Response [a] -> m n
usePage Response [a]
epage
Left SlackClientError
e -> (n
result forall a. Semigroup a => a -> a -> a
<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Response [a] -> m n
usePage (forall a b. a -> Either a b
Left SlackClientError
e)
fetchAllBy ::
( MonadIO m
, PagedRequest req
, PagedResponse resp
) =>
(req -> m (Response resp)) ->
req ->
m (LoadPage m (ResponseObject resp))
fetchAllBy :: forall (m :: * -> *) req resp.
(MonadIO m, PagedRequest req, PagedResponse resp) =>
(req -> m (Response resp))
-> req -> m (LoadPage m (ResponseObject resp))
fetchAllBy req -> m (Response resp)
sendRequest req
initialRequest = do
IORef (Maybe Cursor)
cursorRef <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef forall a. Maybe a
Nothing
let requestFromCursor :: Maybe Cursor -> req
requestFromCursor Maybe Cursor
cursor = forall a. PagedRequest a => Maybe Cursor -> a -> a
setCursor Maybe Cursor
cursor req
initialRequest
collectAndUpdateCursor :: resp -> IO [ResponseObject resp]
collectAndUpdateCursor resp
resp = do
let newCursor :: Maybe Cursor
newCursor = ResponseMetadata -> Maybe Cursor
Conversation.responseMetadataNextCursor forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. PagedResponse a => a -> Maybe ResponseMetadata
getResponseMetadata resp
resp
cursorToSave :: Maybe Cursor
cursorToSave = if forall a. Maybe a -> Bool
isNothing Maybe Cursor
newCursor then Maybe Cursor
emptyCursor else Maybe Cursor
newCursor
forall (m :: * -> *) a. MonadIO m => IORef a -> a -> m ()
writeIORef IORef (Maybe Cursor)
cursorRef Maybe Cursor
cursorToSave
return $ forall a. PagedResponse a => a -> [ResponseObject a]
getResponseData resp
resp
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ do
Maybe Cursor
cursor <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef IORef (Maybe Cursor)
cursorRef
if Maybe Cursor
cursor forall a. Eq a => a -> a -> Bool
== Maybe Cursor
emptyCursor
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right []
else
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. resp -> IO [ResponseObject resp]
collectAndUpdateCursor)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< req -> m (Response resp)
sendRequest (Maybe Cursor -> req
requestFromCursor Maybe Cursor
cursor)
where
emptyCursor :: Maybe Cursor
emptyCursor = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> Cursor
Common.Cursor Text
""