{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
module Web.Slack.Pager
( Response
, conversationsHistoryAllBy
, repliesFetchAllBy
, LoadPage
, loadingPage
) where
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.IORef (newIORef, readIORef, writeIORef)
import Data.Maybe (isNothing)
import qualified Web.Slack.Common as Common
import qualified Web.Slack.Conversation as Conversation
import Web.Slack.Types (Cursor)
conversationsHistoryAllBy
:: MonadIO m
=> (Conversation.HistoryReq -> m (Response Conversation.HistoryRsp))
-> Conversation.HistoryReq
-> m (LoadPage m Common.Message)
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 })
repliesFetchAllBy
:: MonadIO m
=> (Conversation.RepliesReq -> m (Response Conversation.HistoryRsp))
-> Conversation.RepliesReq
-> m (LoadPage m Common.Message)
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
type LoadPage m a = m (Response [a])
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
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
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
""