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

-- | Represents an action which returns a paginated response from Slack.
--   Every time calling the action, it performs a request with a new cursor
--   to get the next page.
--   If there is no more response, the action returns an empty list.
type LoadPage m a = m (Response [a])

-- | Utility function for 'LoadPage'. Perform the 'LoadPage' action to call
--   the function with the loaded page, until an empty page is loaded.
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 n
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 [a] -> Bool
forall mono. MonoFoldable mono => mono -> Bool
null [a]
page
            then n -> m n
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return n
result
            else (n -> m n
go (n -> m n) -> n -> m n
forall a b. (a -> b) -> a -> b
$!) (n -> m n) -> (n -> n) -> n -> m n
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (n
result n -> n -> n
forall a. Semigroup a => a -> a -> a
<>) (n -> m n) -> m n -> m n
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 n -> n -> n
forall a. Semigroup a => a -> a -> a
<>) (n -> n) -> m n -> m n
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Response [a] -> m n
usePage (SlackClientError -> Response [a]
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 <- IO (IORef (Maybe Cursor)) -> m (IORef (Maybe Cursor))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (Maybe Cursor)) -> m (IORef (Maybe Cursor)))
-> IO (IORef (Maybe Cursor)) -> m (IORef (Maybe Cursor))
forall a b. (a -> b) -> a -> b
$ Maybe Cursor -> IO (IORef (Maybe Cursor))
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef Maybe Cursor
forall a. Maybe a
Nothing

  let requestFromCursor :: Maybe Cursor -> req
requestFromCursor Maybe Cursor
cursor = Maybe Cursor -> req -> req
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 (ResponseMetadata -> Maybe Cursor)
-> Maybe ResponseMetadata -> Maybe Cursor
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< resp -> Maybe ResponseMetadata
forall a. PagedResponse a => a -> Maybe ResponseMetadata
getResponseMetadata resp
resp
            -- emptyCursor is used for the marker to show that there are no more pages.
            cursorToSave :: Maybe Cursor
cursorToSave = if Maybe Cursor -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Cursor
newCursor then Maybe Cursor
emptyCursor else Maybe Cursor
newCursor
        IORef (Maybe Cursor) -> Maybe Cursor -> IO ()
forall (m :: * -> *) a. MonadIO m => IORef a -> a -> m ()
writeIORef IORef (Maybe Cursor)
cursorRef Maybe Cursor
cursorToSave
        return $ resp -> [ResponseObject resp]
forall a. PagedResponse a => a -> [ResponseObject a]
getResponseData resp
resp

  LoadPage m (ResponseObject resp)
-> m (LoadPage m (ResponseObject resp))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
return (LoadPage m (ResponseObject resp)
 -> m (LoadPage m (ResponseObject resp)))
-> LoadPage m (ResponseObject resp)
-> m (LoadPage m (ResponseObject resp))
forall a b. (a -> b) -> a -> b
$ do
    Maybe Cursor
cursor <- IO (Maybe Cursor) -> m (Maybe Cursor)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Cursor) -> m (Maybe Cursor))
-> IO (Maybe Cursor) -> m (Maybe Cursor)
forall a b. (a -> b) -> a -> b
$ IORef (Maybe Cursor) -> IO (Maybe Cursor)
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef IORef (Maybe Cursor)
cursorRef
    if Maybe Cursor
cursor Maybe Cursor -> Maybe Cursor -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Cursor
emptyCursor
      then Either SlackClientError [ResponseObject resp]
-> LoadPage m (ResponseObject resp)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SlackClientError [ResponseObject resp]
 -> LoadPage m (ResponseObject resp))
-> Either SlackClientError [ResponseObject resp]
-> LoadPage m (ResponseObject resp)
forall a b. (a -> b) -> a -> b
$ [ResponseObject resp]
-> Either SlackClientError [ResponseObject resp]
forall a b. b -> Either a b
Right []
      else
        (resp -> m [ResponseObject resp])
-> Response resp -> LoadPage m (ResponseObject resp)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> Either SlackClientError a -> f (Either SlackClientError b)
traverse (IO [ResponseObject resp] -> m [ResponseObject resp]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [ResponseObject resp] -> m [ResponseObject resp])
-> (resp -> IO [ResponseObject resp])
-> resp
-> m [ResponseObject resp]
forall b c a. (b -> c) -> (a -> b) -> a -> c
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)
          (Response resp -> LoadPage m (ResponseObject resp))
-> m (Response resp) -> LoadPage m (ResponseObject resp)
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
    -- Used for the marker to show that there are no more pages.
    emptyCursor :: Maybe Cursor
emptyCursor = Cursor -> Maybe Cursor
forall a. a -> Maybe a
Just (Cursor -> Maybe Cursor) -> Cursor -> Maybe Cursor
forall a b. (a -> b) -> a -> b
$ Text -> Cursor
Common.Cursor Text
""