{-# LANGUAGE DeriveFoldable    #-}
{-# LANGUAGE DeriveFunctor     #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE NamedFieldPuns    #-}
{-# LANGUAGE OverloadedStrings #-}

module Web.Slack.Pager
  ( Response
  , conversationsHistoryAllBy
  , repliesFetchAllBy
  , LoadPage
  , loadingPage
  ) where

-- base
import           Control.Monad.IO.Class (MonadIO, liftIO)
import           Data.IORef             (newIORef, readIORef, writeIORef)
import           Data.Maybe             (isNothing)

-- slack-web
import qualified Web.Slack.Common       as Common
import qualified Web.Slack.Conversation as Conversation
import           Web.Slack.Types        (Cursor)


-- | Public only for testing.
conversationsHistoryAllBy
  :: MonadIO m
  => (Conversation.HistoryReq -> m (Response Conversation.HistoryRsp))
  -- ^ Response generator
  -> Conversation.HistoryReq
  -- ^ The first request to send. _NOTE_: 'Conversation.historyReqCursor' is silently ignored.
  -> m (LoadPage m Common.Message)
  -- ^ An action which returns a new page of messages every time called.
  --   If there are no pages anymore, it returns an empty list.
conversationsHistoryAllBy :: (HistoryReq -> m (Response HistoryRsp))
-> HistoryReq -> m (LoadPage m Message)
conversationsHistoryAllBy HistoryReq -> m (Response HistoryRsp)
sendRequest HistoryReq
initialRequest =
  (HistoryReq -> m (Response HistoryRsp))
-> (Maybe Cursor -> HistoryReq) -> m (LoadPage m Message)
forall (m :: * -> *) a.
MonadIO m =>
(a -> m (Response HistoryRsp))
-> (Maybe Cursor -> a) -> m (LoadPage m Message)
genericFetchAllBy
    HistoryReq -> m (Response HistoryRsp)
sendRequest
    (\Maybe Cursor
cursor -> HistoryReq
initialRequest { historyReqCursor :: Maybe Cursor
Conversation.historyReqCursor = Maybe Cursor
cursor })


-- | Public only for testing.
repliesFetchAllBy
  :: MonadIO m
  => (Conversation.RepliesReq -> m (Response Conversation.HistoryRsp))
  -- ^ Response generator
  -> Conversation.RepliesReq
  -- ^ The first request to send. _NOTE_: 'Conversation.historyReqCursor' is silently ignored.
  -> m (LoadPage m Common.Message)
  -- ^ An action which returns a new page of messages every time called.
  --   If there are no pages anymore, it returns an empty list.
repliesFetchAllBy :: (RepliesReq -> m (Response HistoryRsp))
-> RepliesReq -> m (LoadPage m Message)
repliesFetchAllBy RepliesReq -> m (Response HistoryRsp)
sendRequest RepliesReq
initialRequest =
  (RepliesReq -> m (Response HistoryRsp))
-> (Maybe Cursor -> RepliesReq) -> m (LoadPage m Message)
forall (m :: * -> *) a.
MonadIO m =>
(a -> m (Response HistoryRsp))
-> (Maybe Cursor -> a) -> m (LoadPage m Message)
genericFetchAllBy
    RepliesReq -> m (Response HistoryRsp)
sendRequest
    (\Maybe Cursor
cursor -> RepliesReq
initialRequest { repliesReqCursor :: Maybe Cursor
Conversation.repliesReqCursor = Maybe Cursor
cursor })


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 :: 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 (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
page
            then n -> m n
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
. (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)


genericFetchAllBy
  :: MonadIO m
  => (a -> m (Response Conversation.HistoryRsp))
  -> (Maybe Cursor -> a)
  -> m (LoadPage m Common.Message)
genericFetchAllBy :: (a -> m (Response HistoryRsp))
-> (Maybe Cursor -> a) -> m (LoadPage m Message)
genericFetchAllBy a -> m (Response HistoryRsp)
sendRequest Maybe Cursor -> a
requestFromCursor = do
  IORef (Maybe Cursor)
cursorRef <- IO (IORef (Maybe Cursor)) -> m (IORef (Maybe Cursor))
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 a. a -> IO (IORef a)
newIORef Maybe Cursor
forall a. Maybe a
Nothing

  let collectAndUpdateCursor :: HistoryRsp -> IO [Message]
collectAndUpdateCursor
        Conversation.HistoryRsp
          { [Message]
historyRspMessages :: HistoryRsp -> [Message]
historyRspMessages :: [Message]
Conversation.historyRspMessages
          , Maybe ResponseMetadata
historyRspResponseMetadata :: HistoryRsp -> Maybe ResponseMetadata
historyRspResponseMetadata :: Maybe ResponseMetadata
Conversation.historyRspResponseMetadata
          } = 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
=<< Maybe ResponseMetadata
historyRspResponseMetadata
            -- 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 a. IORef a -> a -> IO ()
writeIORef IORef (Maybe Cursor)
cursorRef Maybe Cursor
cursorToSave
        [Message] -> IO [Message]
forall (m :: * -> *) a. Monad m => a -> m a
return [Message]
historyRspMessages

  LoadPage m Message -> m (LoadPage m Message)
forall (m :: * -> *) a. Monad m => a -> m a
return (LoadPage m Message -> m (LoadPage m Message))
-> LoadPage m Message -> m (LoadPage m Message)
forall a b. (a -> b) -> a -> b
$ do
    Maybe Cursor
cursor <- IO (Maybe Cursor) -> m (Maybe Cursor)
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 a. IORef a -> IO 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 [Message] -> LoadPage m Message
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SlackClientError [Message] -> LoadPage m Message)
-> Either SlackClientError [Message] -> LoadPage m Message
forall a b. (a -> b) -> a -> b
$ [Message] -> Either SlackClientError [Message]
forall a b. b -> Either a b
Right []
      else
        (HistoryRsp -> m [Message])
-> Response HistoryRsp -> LoadPage m Message
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (IO [Message] -> m [Message]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Message] -> m [Message])
-> (HistoryRsp -> IO [Message]) -> HistoryRsp -> m [Message]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HistoryRsp -> IO [Message]
collectAndUpdateCursor)
          (Response HistoryRsp -> LoadPage m Message)
-> m (Response HistoryRsp) -> LoadPage m Message
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< a -> m (Response HistoryRsp)
sendRequest (Maybe Cursor -> a
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
""