{-# LANGUAGE MultiWayIf #-}
module Matterhorn.State.Messages
  ( PostToAdd(..)
  , addDisconnectGaps
  , lastMsg
  , sendMessage
  , editMessage
  , deleteMessage
  , addNewPostedMessage
  , addObtainedMessages
  , asyncFetchMoreMessages
  , asyncFetchMessagesForGap
  , asyncFetchMessagesSurrounding
  , fetchVisibleIfNeeded
  , disconnectChannels
  , toggleMessageTimestamps
  , jumpToPost
  )
where

import           Prelude ()
import           Matterhorn.Prelude

import           Brick.Main ( getVtyHandle, invalidateCacheEntry, invalidateCache )
import qualified Brick.Widgets.FileBrowser as FB
import           Control.Exception ( SomeException, try )
import qualified Data.Foldable as F
import qualified Data.HashMap.Strict as HM
import qualified Data.Set as Set
import qualified Data.Sequence as Seq
import qualified Data.Text as T
import           Graphics.Vty ( outputIface )
import           Graphics.Vty.Output.Interface ( ringTerminalBell )
import           Lens.Micro.Platform ( Traversal', (.=), (%=), (%~), (.~), (^?)
                                     , to, at, traversed, filtered, ix, _1 )

import           Network.Mattermost
import qualified Network.Mattermost.Endpoints as MM
import           Network.Mattermost.Lenses
import           Network.Mattermost.Types

import           Matterhorn.Constants
import           Matterhorn.State.Channels
import           Matterhorn.State.Common
import           Matterhorn.State.Reactions
import           Matterhorn.State.Users
import           Matterhorn.TimeUtils
import           Matterhorn.Types
import           Matterhorn.Types.Common ( sanitizeUserText )
import           Matterhorn.Types.DirectionalSeq ( DirectionalSeq, SeqDirection )


-- ----------------------------------------------------------------------
-- Message gaps


-- | Called to add an UnknownGap to the end of the Messages collection
-- for all channels when the client has become disconnected from the
-- server.  This gaps will later be removed by successful fetching
-- overlaps if the connection is re-established.  Note that the
-- disconnect is re-iterated periodically via a re-connect timer
-- attempt, so do not duplicate gaps.  Also clear any flags
-- representing a pending exchange with the server (which will now
-- never complete).
addDisconnectGaps :: MH ()
addDisconnectGaps :: MH ()
addDisconnectGaps = (ChannelId -> MH ()) -> [ChannelId] -> MH ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ChannelId -> MH ()
onEach ([ChannelId] -> MH ())
-> (ClientChannels -> [ChannelId]) -> ClientChannels -> MH ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ClientChannel -> Bool) -> ClientChannels -> [ChannelId]
filteredChannelIds (Bool -> ClientChannel -> Bool
forall a b. a -> b -> a
const Bool
True) (ClientChannels -> MH ()) -> MH ClientChannels -> MH ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Getting ClientChannels ChatState ClientChannels
-> MH ClientChannels
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting ClientChannels ChatState ClientChannels
Lens' ChatState ClientChannels
csChannels
    where onEach :: ChannelId -> MH ()
onEach ChannelId
c = do ChannelId -> MH ()
addEndGap ChannelId
c
                        ChannelId -> MH ()
clearPendingFlags ChannelId
c
                        EventM Name () -> MH ()
forall a. EventM Name a -> MH a
mh (EventM Name () -> MH ()) -> EventM Name () -> MH ()
forall a b. (a -> b) -> a -> b
$ Name -> EventM Name ()
forall n. Ord n => n -> EventM n ()
invalidateCacheEntry (ChannelId -> Name
ChannelMessages ChannelId
c)

-- | Websocket was disconnected, so all channels may now miss some
-- messages
disconnectChannels :: MH ()
disconnectChannels :: MH ()
disconnectChannels = MH ()
addDisconnectGaps

toggleMessageTimestamps :: MH ()
toggleMessageTimestamps :: MH ()
toggleMessageTimestamps = do
    EventM Name () -> MH ()
forall a. EventM Name a -> MH a
mh EventM Name ()
forall n. Ord n => EventM n ()
invalidateCache
    let toggle :: Config -> Config
toggle Config
c = Config
c { configShowMessageTimestamps :: Bool
configShowMessageTimestamps = Bool -> Bool
not (Config -> Bool
configShowMessageTimestamps Config
c)
                     }
    (ChatResources -> Identity ChatResources)
-> ChatState -> Identity ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Identity ChatResources)
 -> ChatState -> Identity ChatState)
-> ((Config -> Identity Config)
    -> ChatResources -> Identity ChatResources)
-> (Config -> Identity Config)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Config -> Identity Config)
-> ChatResources -> Identity ChatResources
Lens' ChatResources Config
crConfiguration ((Config -> Identity Config) -> ChatState -> Identity ChatState)
-> (Config -> Config) -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Config -> Config
toggle

clearPendingFlags :: ChannelId -> MH ()
clearPendingFlags :: ChannelId -> MH ()
clearPendingFlags ChannelId
c = ChannelId -> Traversal' ChatState ClientChannel
csChannel(ChannelId
c)((ClientChannel -> Identity ClientChannel)
 -> ChatState -> Identity ChatState)
-> ((Bool -> Identity Bool)
    -> ClientChannel -> Identity ClientChannel)
-> (Bool -> Identity Bool)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChannelContents -> Identity ChannelContents)
-> ClientChannel -> Identity ClientChannel
Lens' ClientChannel ChannelContents
ccContents((ChannelContents -> Identity ChannelContents)
 -> ClientChannel -> Identity ClientChannel)
-> ((Bool -> Identity Bool)
    -> ChannelContents -> Identity ChannelContents)
-> (Bool -> Identity Bool)
-> ClientChannel
-> Identity ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Identity Bool)
-> ChannelContents -> Identity ChannelContents
Lens' ChannelContents Bool
cdFetchPending ((Bool -> Identity Bool) -> ChatState -> Identity ChatState)
-> Bool -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
False

addEndGap :: ChannelId -> MH ()
addEndGap :: ChannelId -> MH ()
addEndGap ChannelId
cId = ChannelId -> (ClientChannel -> MH ()) -> MH ()
withChannel ChannelId
cId ((ClientChannel -> MH ()) -> MH ())
-> (ClientChannel -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \ClientChannel
chan ->
    let lastmsg_ :: Maybe Message
lastmsg_ = ClientChannel
chanClientChannel
-> Getting (Maybe Message) ClientChannel (Maybe Message)
-> Maybe Message
forall s a. s -> Getting a s a -> a
^.(ChannelContents -> Const (Maybe Message) ChannelContents)
-> ClientChannel -> Const (Maybe Message) ClientChannel
Lens' ClientChannel ChannelContents
ccContents((ChannelContents -> Const (Maybe Message) ChannelContents)
 -> ClientChannel -> Const (Maybe Message) ClientChannel)
-> ((Maybe Message -> Const (Maybe Message) (Maybe Message))
    -> ChannelContents -> Const (Maybe Message) ChannelContents)
-> Getting (Maybe Message) ClientChannel (Maybe Message)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Const (Maybe Message) Messages)
-> ChannelContents -> Const (Maybe Message) ChannelContents
Lens' ChannelContents Messages
cdMessages((Messages -> Const (Maybe Message) Messages)
 -> ChannelContents -> Const (Maybe Message) ChannelContents)
-> ((Maybe Message -> Const (Maybe Message) (Maybe Message))
    -> Messages -> Const (Maybe Message) Messages)
-> (Maybe Message -> Const (Maybe Message) (Maybe Message))
-> ChannelContents
-> Const (Maybe Message) ChannelContents
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> RetrogradeMessages)
-> SimpleGetter Messages RetrogradeMessages
forall s a. (s -> a) -> SimpleGetter s a
to Messages -> RetrogradeMessages
reverseMessagesGetting (Maybe Message) Messages RetrogradeMessages
-> ((Maybe Message -> Const (Maybe Message) (Maybe Message))
    -> RetrogradeMessages -> Const (Maybe Message) RetrogradeMessages)
-> (Maybe Message -> Const (Maybe Message) (Maybe Message))
-> Messages
-> Const (Maybe Message) Messages
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(RetrogradeMessages -> Maybe Message)
-> SimpleGetter RetrogradeMessages (Maybe Message)
forall s a. (s -> a) -> SimpleGetter s a
to RetrogradeMessages -> Maybe Message
lastMsg
        lastIsGap :: Bool
lastIsGap = Bool -> (Message -> Bool) -> Maybe Message -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Message -> Bool
isGap Maybe Message
lastmsg_
        gapMsg :: Message
gapMsg = ServerTime -> Message
newGapMessage ServerTime
timeJustAfterLast
        timeJustAfterLast :: ServerTime
timeJustAfterLast = ServerTime
-> (Message -> ServerTime) -> Maybe Message -> ServerTime
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ServerTime
t0 (ServerTime -> ServerTime
justAfter (ServerTime -> ServerTime)
-> (Message -> ServerTime) -> Message -> ServerTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message -> ServerTime
_mDate) Maybe Message
lastmsg_
        t0 :: ServerTime
t0 = UTCTime -> ServerTime
ServerTime (UTCTime -> ServerTime) -> UTCTime -> ServerTime
forall a b. (a -> b) -> a -> b
$ UTCTime
originTime  -- use any time for a channel with no messages yet
        newGapMessage :: ServerTime -> Message
newGapMessage = Text -> MessageType -> ServerTime -> Message
newMessageOfType
                        (String -> Text
T.pack String
"Disconnected. Will refresh when connected.")
                        (ClientMessageType -> MessageType
C ClientMessageType
UnknownGapAfter)
    in Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
lastIsGap
           ((ClientChannels -> Identity ClientChannels)
-> ChatState -> Identity ChatState
Lens' ChatState ClientChannels
csChannels ((ClientChannels -> Identity ClientChannels)
 -> ChatState -> Identity ChatState)
-> (ClientChannels -> ClientChannels) -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ChannelId
-> (ClientChannel -> ClientChannel)
-> ClientChannels
-> ClientChannels
modifyChannelById ChannelId
cId ((ChannelContents -> Identity ChannelContents)
-> ClientChannel -> Identity ClientChannel
Lens' ClientChannel ChannelContents
ccContents((ChannelContents -> Identity ChannelContents)
 -> ClientChannel -> Identity ClientChannel)
-> ((Messages -> Identity Messages)
    -> ChannelContents -> Identity ChannelContents)
-> (Messages -> Identity Messages)
-> ClientChannel
-> Identity ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Identity Messages)
-> ChannelContents -> Identity ChannelContents
Lens' ChannelContents Messages
cdMessages ((Messages -> Identity Messages)
 -> ClientChannel -> Identity ClientChannel)
-> (Messages -> Messages) -> ClientChannel -> ClientChannel
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Message -> Messages -> Messages
forall a. MessageOps a => Message -> a -> a
addMessage Message
gapMsg))

lastMsg :: RetrogradeMessages -> Maybe Message
lastMsg :: RetrogradeMessages -> Maybe Message
lastMsg = (Message -> Message) -> RetrogradeMessages -> Maybe Message
forall dir r.
SeqDirection dir =>
(Message -> r) -> DirectionalSeq dir Message -> Maybe r
withFirstMessage Message -> Message
forall a. a -> a
id

-- | Send a message and attachments to the specified channel.
sendMessage :: ChannelId -> EditMode -> Text -> [AttachmentData] -> MH ()
sendMessage :: ChannelId -> EditMode -> Text -> [AttachmentData] -> MH ()
sendMessage ChannelId
chanId EditMode
mode Text
msg [AttachmentData]
attachments =
    Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Bool
shouldSkipMessage Text
msg) (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ do
        ConnectionStatus
status <- Getting ConnectionStatus ChatState ConnectionStatus
-> MH ConnectionStatus
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting ConnectionStatus ChatState ConnectionStatus
Lens' ChatState ConnectionStatus
csConnectionStatus
        case ConnectionStatus
status of
            ConnectionStatus
Disconnected -> do
                let m :: Text
m = [Text] -> Text
T.concat [ Text
"Cannot send messages while disconnected. Enable logging to "
                                 , Text
"get disconnection information. If Matterhorn's reconnection "
                                 , Text
"attempts are failing, use `/reconnect` to attempt to "
                                 , Text
"reconnect manually."
                                 ]
                MHError -> MH ()
mhError (MHError -> MH ()) -> MHError -> MH ()
forall a b. (a -> b) -> a -> b
$ Text -> MHError
GenericError Text
m
            ConnectionStatus
Connected -> do
                Session
session <- MH Session
getSession
                AsyncPriority -> IO () -> MH ()
doAsync AsyncPriority
Preempt (IO () -> MH ()) -> IO () -> MH ()
forall a b. (a -> b) -> a -> b
$ do
                    -- Upload attachments
                    [UploadResponse]
fileInfos <- [AttachmentData]
-> (AttachmentData -> IO UploadResponse) -> IO [UploadResponse]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [AttachmentData]
attachments ((AttachmentData -> IO UploadResponse) -> IO [UploadResponse])
-> (AttachmentData -> IO UploadResponse) -> IO [UploadResponse]
forall a b. (a -> b) -> a -> b
$ \AttachmentData
a -> do
                        ChannelId -> String -> ByteString -> Session -> IO UploadResponse
MM.mmUploadFile ChannelId
chanId (FileInfo -> String
FB.fileInfoFilename (FileInfo -> String) -> FileInfo -> String
forall a b. (a -> b) -> a -> b
$ AttachmentData -> FileInfo
attachmentDataFileInfo AttachmentData
a)
                            (AttachmentData -> ByteString
attachmentDataBytes AttachmentData
a) Session
session

                    let fileIds :: Seq FileId
fileIds = [FileId] -> Seq FileId
forall a. [a] -> Seq a
Seq.fromList ([FileId] -> Seq FileId) -> [FileId] -> Seq FileId
forall a b. (a -> b) -> a -> b
$
                                  (FileInfo -> FileId) -> [FileInfo] -> [FileId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FileInfo -> FileId
fileInfoId ([FileInfo] -> [FileId]) -> [FileInfo] -> [FileId]
forall a b. (a -> b) -> a -> b
$
                                  [[FileInfo]] -> [FileInfo]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[FileInfo]] -> [FileInfo]) -> [[FileInfo]] -> [FileInfo]
forall a b. (a -> b) -> a -> b
$
                                  (Seq FileInfo -> [FileInfo]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (Seq FileInfo -> [FileInfo])
-> (UploadResponse -> Seq FileInfo) -> UploadResponse -> [FileInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UploadResponse -> Seq FileInfo
MM.uploadResponseFileInfos) (UploadResponse -> [FileInfo]) -> [UploadResponse] -> [[FileInfo]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [UploadResponse]
fileInfos

                    case EditMode
mode of
                        EditMode
NewPost -> do
                            let pendingPost :: RawPost
pendingPost = (Text -> ChannelId -> RawPost
rawPost Text
msg ChannelId
chanId) { rawPostFileIds :: Seq FileId
rawPostFileIds = Seq FileId
fileIds }
                            IO Post -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Post -> IO ()) -> IO Post -> IO ()
forall a b. (a -> b) -> a -> b
$ RawPost -> Session -> IO Post
MM.mmCreatePost RawPost
pendingPost Session
session
                        Replying Message
_ Post
p -> do
                            let pendingPost :: RawPost
pendingPost = (Text -> ChannelId -> RawPost
rawPost Text
msg ChannelId
chanId) { rawPostRootId :: Maybe PostId
rawPostRootId = Post -> Maybe PostId
postRootId Post
p Maybe PostId -> Maybe PostId -> Maybe PostId
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (PostId -> Maybe PostId
forall a. a -> Maybe a
Just (PostId -> Maybe PostId) -> PostId -> Maybe PostId
forall a b. (a -> b) -> a -> b
$ Post -> PostId
postId Post
p)
                                                                   , rawPostFileIds :: Seq FileId
rawPostFileIds = Seq FileId
fileIds
                                                                   }
                            IO Post -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Post -> IO ()) -> IO Post -> IO ()
forall a b. (a -> b) -> a -> b
$ RawPost -> Session -> IO Post
MM.mmCreatePost RawPost
pendingPost Session
session
                        Editing Post
p MessageType
ty -> do
                            let body :: Text
body = case MessageType
ty of
                                         CP ClientPostType
Emote -> Text -> Text
addEmoteFormatting Text
msg
                                         MessageType
_ -> Text
msg
                                update :: PostUpdate
update = (Text -> PostUpdate
postUpdateBody Text
body) { postUpdateFileIds :: Maybe (Seq FileId)
postUpdateFileIds = if Seq FileId -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Seq FileId
fileIds
                                                                                     then Maybe (Seq FileId)
forall a. Maybe a
Nothing
                                                                                     else Seq FileId -> Maybe (Seq FileId)
forall a. a -> Maybe a
Just Seq FileId
fileIds
                                                               }
                            IO Post -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Post -> IO ()) -> IO Post -> IO ()
forall a b. (a -> b) -> a -> b
$ PostId -> PostUpdate -> Session -> IO Post
MM.mmPatchPost (Post -> PostId
postId Post
p) PostUpdate
update Session
session

shouldSkipMessage :: Text -> Bool
shouldSkipMessage :: Text -> Bool
shouldSkipMessage Text
"" = Bool
True
shouldSkipMessage Text
s = (Char -> Bool) -> Text -> Bool
T.all (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
" \t"::String)) Text
s

editMessage :: Post -> MH ()
editMessage :: Post -> MH ()
editMessage Post
new = do
    UserId
myId <- (ChatState -> UserId) -> MH UserId
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ChatState -> UserId
myUserId
    ChannelId -> (ClientChannel -> MH ()) -> MH ()
withChannel (Post
newPost -> Getting ChannelId Post ChannelId -> ChannelId
forall s a. s -> Getting a s a -> a
^.Getting ChannelId Post ChannelId
Lens' Post ChannelId
postChannelIdL) ((ClientChannel -> MH ()) -> MH ())
-> (ClientChannel -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \ClientChannel
chan -> do
        let mTId :: Maybe TeamId
mTId = ClientChannel
chanClientChannel
-> Getting (Maybe TeamId) ClientChannel (Maybe TeamId)
-> Maybe TeamId
forall s a. s -> Getting a s a -> a
^.(ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
-> ClientChannel -> Const (Maybe TeamId) ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
 -> ClientChannel -> Const (Maybe TeamId) ClientChannel)
-> ((Maybe TeamId -> Const (Maybe TeamId) (Maybe TeamId))
    -> ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
-> Getting (Maybe TeamId) ClientChannel (Maybe TeamId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe TeamId -> Const (Maybe TeamId) (Maybe TeamId))
-> ChannelInfo -> Const (Maybe TeamId) ChannelInfo
Lens' ChannelInfo (Maybe TeamId)
cdTeamId
        Maybe TeamBaseURL
mBaseUrl <- case Maybe TeamId
mTId of
            Maybe TeamId
Nothing -> Maybe TeamBaseURL -> MH (Maybe TeamBaseURL)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TeamBaseURL
forall a. Maybe a
Nothing
            Just TeamId
tId -> TeamBaseURL -> Maybe TeamBaseURL
forall a. a -> Maybe a
Just (TeamBaseURL -> Maybe TeamBaseURL)
-> MH TeamBaseURL -> MH (Maybe TeamBaseURL)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TeamId -> MH TeamBaseURL
getServerBaseUrl TeamId
tId

        let (Message
msg, Set MentionedUser
mentionedUsers) = ClientPost -> (Message, Set MentionedUser)
clientPostToMessage (Maybe TeamBaseURL -> Post -> Maybe PostId -> ClientPost
toClientPost Maybe TeamBaseURL
mBaseUrl Post
new (Post
newPost -> Getting (Maybe PostId) Post (Maybe PostId) -> Maybe PostId
forall s a. s -> Getting a s a -> a
^.Getting (Maybe PostId) Post (Maybe PostId)
Lens' Post (Maybe PostId)
postRootIdL))
            isEditedMessage :: Message -> Bool
isEditedMessage Message
m = Message
mMessage
-> Getting (Maybe MessageId) Message (Maybe MessageId)
-> Maybe MessageId
forall s a. s -> Getting a s a -> a
^.Getting (Maybe MessageId) Message (Maybe MessageId)
Lens' Message (Maybe MessageId)
mMessageId Maybe MessageId -> Maybe MessageId -> Bool
forall a. Eq a => a -> a -> Bool
== MessageId -> Maybe MessageId
forall a. a -> Maybe a
Just (PostId -> MessageId
MessagePostId (PostId -> MessageId) -> PostId -> MessageId
forall a b. (a -> b) -> a -> b
$ Post
newPost -> Getting PostId Post PostId -> PostId
forall s a. s -> Getting a s a -> a
^.Getting PostId Post PostId
Lens' Post PostId
postIdL)

        ChannelId -> Traversal' ChatState ClientChannel
csChannel (Post
newPost -> Getting ChannelId Post ChannelId -> ChannelId
forall s a. s -> Getting a s a -> a
^.Getting ChannelId Post ChannelId
Lens' Post ChannelId
postChannelIdL) ((ClientChannel -> Identity ClientChannel)
 -> ChatState -> Identity ChatState)
-> ((Message -> Identity Message)
    -> ClientChannel -> Identity ClientChannel)
-> (Message -> Identity Message)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChannelContents -> Identity ChannelContents)
-> ClientChannel -> Identity ClientChannel
Lens' ClientChannel ChannelContents
ccContents ((ChannelContents -> Identity ChannelContents)
 -> ClientChannel -> Identity ClientChannel)
-> ((Message -> Identity Message)
    -> ChannelContents -> Identity ChannelContents)
-> (Message -> Identity Message)
-> ClientChannel
-> Identity ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Messages -> Identity Messages)
-> ChannelContents -> Identity ChannelContents
Lens' ChannelContents Messages
cdMessages ((Messages -> Identity Messages)
 -> ChannelContents -> Identity ChannelContents)
-> ((Message -> Identity Message) -> Messages -> Identity Messages)
-> (Message -> Identity Message)
-> ChannelContents
-> Identity ChannelContents
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Message -> Identity Message) -> Messages -> Identity Messages
forall (f :: * -> *) a b.
Traversable f =>
Traversal (f a) (f b) a b
traversed ((Message -> Identity Message) -> Messages -> Identity Messages)
-> ((Message -> Identity Message) -> Message -> Identity Message)
-> (Message -> Identity Message)
-> Messages
-> Identity Messages
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Message -> Bool) -> Traversal' Message Message
forall a. (a -> Bool) -> Traversal' a a
filtered Message -> Bool
isEditedMessage ((Message -> Identity Message) -> ChatState -> Identity ChatState)
-> Message -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Message
msg
        EventM Name () -> MH ()
forall a. EventM Name a -> MH a
mh (EventM Name () -> MH ()) -> EventM Name () -> MH ()
forall a b. (a -> b) -> a -> b
$ Name -> EventM Name ()
forall n. Ord n => n -> EventM n ()
invalidateCacheEntry (ChannelId -> Name
ChannelMessages (ChannelId -> Name) -> ChannelId -> Name
forall a b. (a -> b) -> a -> b
$ Post
newPost -> Getting ChannelId Post ChannelId -> ChannelId
forall s a. s -> Getting a s a -> a
^.Getting ChannelId Post ChannelId
Lens' Post ChannelId
postChannelIdL)

        Set MentionedUser -> MH ()
fetchMentionedUsers Set MentionedUser
mentionedUsers

        Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Post -> Maybe UserId
postUserId Post
new Maybe UserId -> Maybe UserId -> Bool
forall a. Eq a => a -> a -> Bool
/= UserId -> Maybe UserId
forall a. a -> Maybe a
Just UserId
myId) (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$
            ChannelId -> Traversal' ChatState ClientChannel
csChannel (Post
newPost -> Getting ChannelId Post ChannelId -> ChannelId
forall s a. s -> Getting a s a -> a
^.Getting ChannelId Post ChannelId
Lens' Post ChannelId
postChannelIdL) ((ClientChannel -> Identity ClientChannel)
 -> ChatState -> Identity ChatState)
-> (ClientChannel -> ClientChannel) -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Post -> ClientChannel -> ClientChannel
adjustEditedThreshold Post
new

        (HashMap PostId Message -> Identity (HashMap PostId Message))
-> ChatState -> Identity ChatState
Lens' ChatState (HashMap PostId Message)
csPostMap((HashMap PostId Message -> Identity (HashMap PostId Message))
 -> ChatState -> Identity ChatState)
-> ((Message -> Identity Message)
    -> HashMap PostId Message -> Identity (HashMap PostId Message))
-> (Message -> Identity Message)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Index (HashMap PostId Message)
-> Traversal'
     (HashMap PostId Message) (IxValue (HashMap PostId Message))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix(Post -> PostId
postId Post
new) ((Message -> Identity Message) -> ChatState -> Identity ChatState)
-> Message -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Message
msg
        ChannelId -> Post -> MH ()
asyncFetchReactionsForPost (Post -> ChannelId
postChannelId Post
new) Post
new
        Post -> MH ()
asyncFetchAttachments Post
new

deleteMessage :: Post -> MH ()
deleteMessage :: Post -> MH ()
deleteMessage Post
new = do
    let isDeletedMessage :: Message -> Bool
isDeletedMessage Message
m = Message
mMessage
-> Getting (Maybe MessageId) Message (Maybe MessageId)
-> Maybe MessageId
forall s a. s -> Getting a s a -> a
^.Getting (Maybe MessageId) Message (Maybe MessageId)
Lens' Message (Maybe MessageId)
mMessageId Maybe MessageId -> Maybe MessageId -> Bool
forall a. Eq a => a -> a -> Bool
== MessageId -> Maybe MessageId
forall a. a -> Maybe a
Just (PostId -> MessageId
MessagePostId (PostId -> MessageId) -> PostId -> MessageId
forall a b. (a -> b) -> a -> b
$ Post
newPost -> Getting PostId Post PostId -> PostId
forall s a. s -> Getting a s a -> a
^.Getting PostId Post PostId
Lens' Post PostId
postIdL) Bool -> Bool -> Bool
||
                             PostId -> Message -> Bool
isReplyTo (Post
newPost -> Getting PostId Post PostId -> PostId
forall s a. s -> Getting a s a -> a
^.Getting PostId Post PostId
Lens' Post PostId
postIdL) Message
m
        chan :: Traversal' ChatState ClientChannel
        chan :: (ClientChannel -> f ClientChannel) -> ChatState -> f ChatState
chan = ChannelId -> Traversal' ChatState ClientChannel
csChannel (Post
newPost -> Getting ChannelId Post ChannelId -> ChannelId
forall s a. s -> Getting a s a -> a
^.Getting ChannelId Post ChannelId
Lens' Post ChannelId
postChannelIdL)
    (ClientChannel -> Identity ClientChannel)
-> ChatState -> Identity ChatState
Traversal' ChatState ClientChannel
chan((ClientChannel -> Identity ClientChannel)
 -> ChatState -> Identity ChatState)
-> ((Message -> Identity Message)
    -> ClientChannel -> Identity ClientChannel)
-> (Message -> Identity Message)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChannelContents -> Identity ChannelContents)
-> ClientChannel -> Identity ClientChannel
Lens' ClientChannel ChannelContents
ccContents((ChannelContents -> Identity ChannelContents)
 -> ClientChannel -> Identity ClientChannel)
-> ((Message -> Identity Message)
    -> ChannelContents -> Identity ChannelContents)
-> (Message -> Identity Message)
-> ClientChannel
-> Identity ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Identity Messages)
-> ChannelContents -> Identity ChannelContents
Lens' ChannelContents Messages
cdMessages((Messages -> Identity Messages)
 -> ChannelContents -> Identity ChannelContents)
-> ((Message -> Identity Message) -> Messages -> Identity Messages)
-> (Message -> Identity Message)
-> ChannelContents
-> Identity ChannelContents
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Message -> Identity Message) -> Messages -> Identity Messages
forall (f :: * -> *) a b.
Traversable f =>
Traversal (f a) (f b) a b
traversed((Message -> Identity Message) -> Messages -> Identity Messages)
-> ((Message -> Identity Message) -> Message -> Identity Message)
-> (Message -> Identity Message)
-> Messages
-> Identity Messages
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Message -> Bool) -> Traversal' Message Message
forall a. (a -> Bool) -> Traversal' a a
filtered Message -> Bool
isDeletedMessage ((Message -> Identity Message) -> ChatState -> Identity ChatState)
-> (Message -> Message) -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Message -> (Message -> Message) -> Message
forall a b. a -> (a -> b) -> b
& (Bool -> Identity Bool) -> Message -> Identity Message
Lens' Message Bool
mDeleted ((Bool -> Identity Bool) -> Message -> Identity Message)
-> Bool -> Message -> Message
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True)
    (ClientChannel -> Identity ClientChannel)
-> ChatState -> Identity ChatState
Traversal' ChatState ClientChannel
chan ((ClientChannel -> Identity ClientChannel)
 -> ChatState -> Identity ChatState)
-> (ClientChannel -> ClientChannel) -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Post -> ClientChannel -> ClientChannel
adjustUpdated Post
new
    EventM Name () -> MH ()
forall a. EventM Name a -> MH a
mh (EventM Name () -> MH ()) -> EventM Name () -> MH ()
forall a b. (a -> b) -> a -> b
$ Name -> EventM Name ()
forall n. Ord n => n -> EventM n ()
invalidateCacheEntry (ChannelId -> Name
ChannelMessages (ChannelId -> Name) -> ChannelId -> Name
forall a b. (a -> b) -> a -> b
$ Post
newPost -> Getting ChannelId Post ChannelId -> ChannelId
forall s a. s -> Getting a s a -> a
^.Getting ChannelId Post ChannelId
Lens' Post ChannelId
postChannelIdL)

addNewPostedMessage :: PostToAdd -> MH ()
addNewPostedMessage :: PostToAdd -> MH ()
addNewPostedMessage PostToAdd
p =
    Bool -> Bool -> PostToAdd -> MH PostProcessMessageAdd
addMessageToState Bool
True Bool
True PostToAdd
p MH PostProcessMessageAdd
-> (PostProcessMessageAdd -> MH ()) -> MH ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PostProcessMessageAdd -> MH ()
postProcessMessageAdd

-- | Adds the set of Posts to the indicated channel.  The Posts must
-- all be for the specified Channel.  The reqCnt argument indicates
-- how many posts were requested, which will determine whether a gap
-- message is added to either end of the posts list or not.
--
-- The addTrailingGap is only True when fetching the very latest messages
-- for the channel, and will suppress the generation of a Gap message
-- following the added block of messages.
addObtainedMessages :: ChannelId -> Int -> Bool -> Posts -> MH PostProcessMessageAdd
addObtainedMessages :: ChannelId -> Int -> Bool -> Posts -> MH PostProcessMessageAdd
addObtainedMessages ChannelId
cId Int
reqCnt Bool
addTrailingGap Posts
posts =
  if Seq PostId -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Seq PostId -> Bool) -> Seq PostId -> Bool
forall a b. (a -> b) -> a -> b
$ Posts
postsPosts -> Getting (Seq PostId) Posts (Seq PostId) -> Seq PostId
forall s a. s -> Getting a s a -> a
^.Getting (Seq PostId) Posts (Seq PostId)
Lens' Posts (Seq PostId)
postsOrderL
  then do Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
addTrailingGap (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$
            -- Fetched at the end of the channel, but nothing was
            -- available.  This is common if this is a new channel
            -- with no messages in it.  Need to remove any gaps that
            -- exist at the end of the channel.
            (ClientChannels -> Identity ClientChannels)
-> ChatState -> Identity ChatState
Lens' ChatState ClientChannels
csChannels ((ClientChannels -> Identity ClientChannels)
 -> ChatState -> Identity ChatState)
-> (ClientChannels -> ClientChannels) -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ChannelId
-> (ClientChannel -> ClientChannel)
-> ClientChannels
-> ClientChannels
modifyChannelById ChannelId
cId
              ((ChannelContents -> Identity ChannelContents)
-> ClientChannel -> Identity ClientChannel
Lens' ClientChannel ChannelContents
ccContents((ChannelContents -> Identity ChannelContents)
 -> ClientChannel -> Identity ClientChannel)
-> ((Messages -> Identity Messages)
    -> ChannelContents -> Identity ChannelContents)
-> (Messages -> Identity Messages)
-> ClientChannel
-> Identity ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Identity Messages)
-> ChannelContents -> Identity ChannelContents
Lens' ChannelContents Messages
cdMessages ((Messages -> Identity Messages)
 -> ClientChannel -> Identity ClientChannel)
-> (Messages -> Messages) -> ClientChannel -> ClientChannel
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~
               \Messages
msgs -> let startPoint :: Maybe MessageId
startPoint = Maybe (Maybe MessageId) -> Maybe MessageId
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe MessageId) -> Maybe MessageId)
-> Maybe (Maybe MessageId) -> Maybe MessageId
forall a b. (a -> b) -> a -> b
$ Message -> Maybe MessageId
_mMessageId (Message -> Maybe MessageId)
-> Maybe Message -> Maybe (Maybe MessageId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Messages -> Maybe Message
getLatestPostMsg Messages
msgs
                        in (Messages, Messages) -> Messages
forall a b. (a, b) -> a
fst ((Messages, Messages) -> Messages)
-> (Messages, Messages) -> Messages
forall a b. (a -> b) -> a -> b
$ (Message -> Bool)
-> Maybe MessageId
-> Maybe MessageId
-> Messages
-> (Messages, Messages)
removeMatchesFromSubset Message -> Bool
isGap Maybe MessageId
startPoint Maybe MessageId
forall a. Maybe a
Nothing Messages
msgs)
          PostProcessMessageAdd -> MH PostProcessMessageAdd
forall (m :: * -> *) a. Monad m => a -> m a
return PostProcessMessageAdd
NoAction
  else
    -- Adding a block of server-provided messages, which are known to
    -- be contiguous.  Locally this may overlap with some UnknownGap
    -- messages, which can therefore be removed.  Alternatively the
    -- new block may be discontiguous with the local blocks, in which
    -- case the new block should be surrounded by UnknownGaps.
    ChannelId
-> PostProcessMessageAdd
-> (ClientChannel -> MH PostProcessMessageAdd)
-> MH PostProcessMessageAdd
forall a. ChannelId -> a -> (ClientChannel -> MH a) -> MH a
withChannelOrDefault ChannelId
cId PostProcessMessageAdd
NoAction ((ClientChannel -> MH PostProcessMessageAdd)
 -> MH PostProcessMessageAdd)
-> (ClientChannel -> MH PostProcessMessageAdd)
-> MH PostProcessMessageAdd
forall a b. (a -> b) -> a -> b
$ \ClientChannel
chan -> do
        let pIdList :: [PostId]
pIdList = Seq PostId -> [PostId]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Posts
postsPosts -> Getting (Seq PostId) Posts (Seq PostId) -> Seq PostId
forall s a. s -> Getting a s a -> a
^.Getting (Seq PostId) Posts (Seq PostId)
Lens' Posts (Seq PostId)
postsOrderL)
            mTId :: Maybe TeamId
mTId = ClientChannel
chanClientChannel
-> Getting (Maybe TeamId) ClientChannel (Maybe TeamId)
-> Maybe TeamId
forall s a. s -> Getting a s a -> a
^.(ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
-> ClientChannel -> Const (Maybe TeamId) ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
 -> ClientChannel -> Const (Maybe TeamId) ClientChannel)
-> ((Maybe TeamId -> Const (Maybe TeamId) (Maybe TeamId))
    -> ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
-> Getting (Maybe TeamId) ClientChannel (Maybe TeamId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe TeamId -> Const (Maybe TeamId) (Maybe TeamId))
-> ChannelInfo -> Const (Maybe TeamId) ChannelInfo
Lens' ChannelInfo (Maybe TeamId)
cdTeamId
            -- the first and list PostId in the batch to be added
            earliestPId :: PostId
earliestPId = [PostId] -> PostId
forall a. [a] -> a
last [PostId]
pIdList
            latestPId :: PostId
latestPId = [PostId] -> PostId
forall a. [a] -> a
head [PostId]
pIdList
            earliestDate :: ServerTime
earliestDate = Post -> ServerTime
postCreateAt (Post -> ServerTime) -> Post -> ServerTime
forall a b. (a -> b) -> a -> b
$ (Posts
postsPosts
-> Getting (HashMap PostId Post) Posts (HashMap PostId Post)
-> HashMap PostId Post
forall s a. s -> Getting a s a -> a
^.Getting (HashMap PostId Post) Posts (HashMap PostId Post)
Lens' Posts (HashMap PostId Post)
postsPostsL) HashMap PostId Post -> PostId -> Post
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HM.! PostId
earliestPId
            latestDate :: ServerTime
latestDate = Post -> ServerTime
postCreateAt (Post -> ServerTime) -> Post -> ServerTime
forall a b. (a -> b) -> a -> b
$ (Posts
postsPosts
-> Getting (HashMap PostId Post) Posts (HashMap PostId Post)
-> HashMap PostId Post
forall s a. s -> Getting a s a -> a
^.Getting (HashMap PostId Post) Posts (HashMap PostId Post)
Lens' Posts (HashMap PostId Post)
postsPostsL) HashMap PostId Post -> PostId -> Post
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HM.! PostId
latestPId

            localMessages :: Messages
localMessages = ClientChannel
chanClientChannel
-> Getting Messages ClientChannel Messages -> Messages
forall s a. s -> Getting a s a -> a
^.(ChannelContents -> Const Messages ChannelContents)
-> ClientChannel -> Const Messages ClientChannel
Lens' ClientChannel ChannelContents
ccContents ((ChannelContents -> Const Messages ChannelContents)
 -> ClientChannel -> Const Messages ClientChannel)
-> ((Messages -> Const Messages Messages)
    -> ChannelContents -> Const Messages ChannelContents)
-> Getting Messages ClientChannel Messages
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Messages -> Const Messages Messages)
-> ChannelContents -> Const Messages ChannelContents
Lens' ChannelContents Messages
cdMessages

            -- Get a list of the duplicated message PostIds between
            -- the messages already in the channel and the new posts
            -- to be added.

            match :: Messages
match = (Messages, Messages) -> Messages
forall a b. (a, b) -> b
snd ((Messages, Messages) -> Messages)
-> (Messages, Messages) -> Messages
forall a b. (a -> b) -> a -> b
$ (Message -> Bool)
-> Maybe MessageId
-> Maybe MessageId
-> Messages
-> (Messages, Messages)
removeMatchesFromSubset
                          (\Message
m -> Bool -> (PostId -> Bool) -> Maybe PostId -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (\PostId
p -> PostId
p PostId -> [PostId] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PostId]
pIdList) (Message -> Maybe PostId
messagePostId Message
m))
                          (MessageId -> Maybe MessageId
forall a. a -> Maybe a
Just (PostId -> MessageId
MessagePostId PostId
earliestPId))
                          (MessageId -> Maybe MessageId
forall a. a -> Maybe a
Just (PostId -> MessageId
MessagePostId PostId
latestPId))
                          Messages
localMessages

            accum :: Message -> [PostId] -> [PostId]
accum Message
m [PostId]
l =
                case Message -> Maybe PostId
messagePostId Message
m of
                    Just PostId
pId -> PostId
pId PostId -> [PostId] -> [PostId]
forall a. a -> [a] -> [a]
: [PostId]
l
                    Maybe PostId
Nothing -> [PostId]
l
            dupPIds :: [PostId]
dupPIds = (Message -> [PostId] -> [PostId])
-> [PostId] -> Messages -> [PostId]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Message -> [PostId] -> [PostId]
accum [] Messages
match

            -- If there were any matches, then there was overlap of
            -- the new messages with existing messages.

            -- Don't re-add matching messages (avoid overhead like
            -- re-checking/re-fetching related post information, and
            -- do not signal action needed for notifications), and
            -- remove any gaps in the overlapping region.

            newGapMessage :: ServerTime -> Bool -> MH Message
newGapMessage ServerTime
d Bool
isOlder =
              -- newGapMessage is a helper for generating a gap
              -- message
              do UUID
uuid <- MH UUID
generateUUID
                 let txt :: Text
txt = Text
"Load " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                           (if Bool
isOlder then Text
"older" else Text
"newer") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                           Text
" messages" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                           (if Bool
isOlder then Text
"  ↥↥↥" else Text
"  ↧↧↧")
                     ty :: MessageType
ty = if Bool
isOlder
                          then ClientMessageType -> MessageType
C ClientMessageType
UnknownGapBefore
                          else ClientMessageType -> MessageType
C ClientMessageType
UnknownGapAfter
                 Message -> MH Message
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> MessageType -> ServerTime -> Message
newMessageOfType Text
txt MessageType
ty ServerTime
d
                         Message -> (Message -> Message) -> Message
forall a b. a -> (a -> b) -> b
& (Maybe MessageId -> Identity (Maybe MessageId))
-> Message -> Identity Message
Lens' Message (Maybe MessageId)
mMessageId ((Maybe MessageId -> Identity (Maybe MessageId))
 -> Message -> Identity Message)
-> Maybe MessageId -> Message -> Message
forall s t a b. ASetter s t a b -> b -> s -> t
.~ MessageId -> Maybe MessageId
forall a. a -> Maybe a
Just (UUID -> MessageId
MessageUUID UUID
uuid))

            -- If this batch contains the latest known messages, do
            -- not add a following gap.  A gap at this point is added
            -- by a websocket disconnect, and any fetches thereafter
            -- are assumed to be the most current information (until
            -- another disconnect), so no gap is needed.
            -- Additionally, the presence of a gap at the end for a
            -- connected client causes a fetch of messages at this
            -- location, so adding the gap here would cause an
            -- infinite update loop.

            addingAtEnd :: Bool
addingAtEnd = Bool -> (ServerTime -> Bool) -> Maybe ServerTime -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (ServerTime
latestDate ServerTime -> ServerTime -> Bool
forall a. Ord a => a -> a -> Bool
>=) (Maybe ServerTime -> Bool) -> Maybe ServerTime -> Bool
forall a b. (a -> b) -> a -> b
$
                          (Message -> Getting ServerTime Message ServerTime -> ServerTime
forall s a. s -> Getting a s a -> a
^.Getting ServerTime Message ServerTime
Lens' Message ServerTime
mDate) (Message -> ServerTime) -> Maybe Message -> Maybe ServerTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Messages -> Maybe Message
getLatestPostMsg Messages
localMessages

            addingAtStart :: Bool
addingAtStart = Bool -> (ServerTime -> Bool) -> Maybe ServerTime -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (ServerTime
earliestDate ServerTime -> ServerTime -> Bool
forall a. Ord a => a -> a -> Bool
<=) (Maybe ServerTime -> Bool) -> Maybe ServerTime -> Bool
forall a b. (a -> b) -> a -> b
$
                            (Message -> Getting ServerTime Message ServerTime -> ServerTime
forall s a. s -> Getting a s a -> a
^.Getting ServerTime Message ServerTime
Lens' Message ServerTime
mDate) (Message -> ServerTime) -> Maybe Message -> Maybe ServerTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Messages -> Maybe Message
getEarliestPostMsg Messages
localMessages
            removeStart :: Maybe MessageId
removeStart = if Bool
addingAtStart Bool -> Bool -> Bool
&& Bool
noMoreBefore
                          then Maybe MessageId
forall a. Maybe a
Nothing
                          else MessageId -> Maybe MessageId
forall a. a -> Maybe a
Just (PostId -> MessageId
MessagePostId PostId
earliestPId)
            removeEnd :: Maybe MessageId
removeEnd = if Bool
addTrailingGap Bool -> Bool -> Bool
|| (Bool
addingAtEnd Bool -> Bool -> Bool
&& Bool
noMoreAfter)
                        then Maybe MessageId
forall a. Maybe a
Nothing
                        else MessageId -> Maybe MessageId
forall a. a -> Maybe a
Just (PostId -> MessageId
MessagePostId PostId
latestPId)

            noMoreBefore :: Bool
noMoreBefore = Int
reqCnt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
&& [PostId] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PostId]
pIdList Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< (-Int
reqCnt)
            noMoreAfter :: Bool
noMoreAfter = Bool
addTrailingGap Bool -> Bool -> Bool
|| Int
reqCnt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& [PostId] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PostId]
pIdList Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
reqCnt

            reAddGapBefore :: Bool
reAddGapBefore = PostId
earliestPId PostId -> [PostId] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PostId]
dupPIds Bool -> Bool -> Bool
|| Bool
noMoreBefore
            -- addingAtEnd used to be in reAddGapAfter but does not
            -- seem to be needed.  I may have missed a specific use
            -- case/scenario, so I've left it commented out here for
            -- debug assistance.
            reAddGapAfter :: Bool
reAddGapAfter = PostId
latestPId PostId -> [PostId] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PostId]
dupPIds Bool -> Bool -> Bool
|| {- addingAtEnd || -} Bool
noMoreAfter

        -- The post map returned by the server will *already* have
        -- all thread messages for each post that is part of a
        -- thread. By calling installMessagesFromPosts here, we go ahead
        -- and populate the csPostMap with those posts so that below, in
        -- addMessageToState, we notice that we already know about reply
        -- parent messages and can avoid fetching them. This converts
        -- the posts to Messages and stores those and also returns
        -- them, but we don't need them here. We just want the post
        -- map update. This also gathers up the set of all mentioned
        -- usernames in the text of the messages which we need to use to
        -- submit a single batch request for user metadata so we don't
        -- submit one request per mention.
        MH Messages -> MH ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (MH Messages -> MH ()) -> MH Messages -> MH ()
forall a b. (a -> b) -> a -> b
$ Maybe TeamId -> Posts -> MH Messages
installMessagesFromPosts Maybe TeamId
mTId Posts
posts

        -- Add all the new *unique* posts into the existing channel
        -- corpus, generating needed fetches of data associated with
        -- the post, and determining an notification action to be
        -- taken (if any).
        PostProcessMessageAdd
action <- (PostProcessMessageAdd
 -> PostProcessMessageAdd -> PostProcessMessageAdd)
-> PostProcessMessageAdd
-> [PostProcessMessageAdd]
-> PostProcessMessageAdd
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr PostProcessMessageAdd
-> PostProcessMessageAdd -> PostProcessMessageAdd
andProcessWith PostProcessMessageAdd
NoAction ([PostProcessMessageAdd] -> PostProcessMessageAdd)
-> MH [PostProcessMessageAdd] -> MH PostProcessMessageAdd
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
          (Post -> MH PostProcessMessageAdd)
-> [Post] -> MH [PostProcessMessageAdd]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Bool -> Bool -> PostToAdd -> MH PostProcessMessageAdd
addMessageToState Bool
False Bool
False (PostToAdd -> MH PostProcessMessageAdd)
-> (Post -> PostToAdd) -> Post -> MH PostProcessMessageAdd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Post -> PostToAdd
OldPost)
                   [ (Posts
postsPosts
-> Getting (HashMap PostId Post) Posts (HashMap PostId Post)
-> HashMap PostId Post
forall s a. s -> Getting a s a -> a
^.Getting (HashMap PostId Post) Posts (HashMap PostId Post)
Lens' Posts (HashMap PostId Post)
postsPostsL) HashMap PostId Post -> PostId -> Post
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HM.! PostId
p
                   | PostId
p <- Seq PostId -> [PostId]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Posts
postsPosts -> Getting (Seq PostId) Posts (Seq PostId) -> Seq PostId
forall s a. s -> Getting a s a -> a
^.Getting (Seq PostId) Posts (Seq PostId)
Lens' Posts (Seq PostId)
postsOrderL)
                   , Bool -> Bool
not (PostId
p PostId -> [PostId] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PostId]
dupPIds)
                   ]

        -- The channel messages now include all the fetched messages.
        -- Things to do at this point are:
        --
        --   1. Remove any duplicates just added, as well as any gaps
        --   2. Add new gaps (if needed) at either end of the added
        --      messages.
        --   3. Update the "current selection" if it was on a removed message.
        --
        -- Do this with the updated copy of the channel's messages.

        ChannelId -> () -> (ClientChannel -> MH ()) -> MH ()
forall a. ChannelId -> a -> (ClientChannel -> MH a) -> MH a
withChannelOrDefault ChannelId
cId () ((ClientChannel -> MH ()) -> MH ())
-> (ClientChannel -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \ClientChannel
updchan -> do
          let updMsgs :: Messages
updMsgs = ClientChannel
updchan ClientChannel
-> Getting Messages ClientChannel Messages -> Messages
forall s a. s -> Getting a s a -> a
^. (ChannelContents -> Const Messages ChannelContents)
-> ClientChannel -> Const Messages ClientChannel
Lens' ClientChannel ChannelContents
ccContents ((ChannelContents -> Const Messages ChannelContents)
 -> ClientChannel -> Const Messages ClientChannel)
-> ((Messages -> Const Messages Messages)
    -> ChannelContents -> Const Messages ChannelContents)
-> Getting Messages ClientChannel Messages
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Messages -> Const Messages Messages)
-> ChannelContents -> Const Messages ChannelContents
Lens' ChannelContents Messages
cdMessages

          -- Remove any gaps in the added region.  If there was an
          -- active message selection and it is one of the removed
          -- gaps, reset the selection to the beginning or end of the
          -- added region (if there are any added selectable messages,
          -- otherwise just the end if the message list in it's
          -- entirety, or no selection at all).

          let (Messages
resultMessages, Messages
removedMessages) =
                (Message -> Bool)
-> Maybe MessageId
-> Maybe MessageId
-> Messages
-> (Messages, Messages)
removeMatchesFromSubset Message -> Bool
isGap Maybe MessageId
removeStart Maybe MessageId
removeEnd Messages
updMsgs
          (ClientChannels -> Identity ClientChannels)
-> ChatState -> Identity ChatState
Lens' ChatState ClientChannels
csChannels ((ClientChannels -> Identity ClientChannels)
 -> ChatState -> Identity ChatState)
-> (ClientChannels -> ClientChannels) -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ChannelId
-> (ClientChannel -> ClientChannel)
-> ClientChannels
-> ClientChannels
modifyChannelById ChannelId
cId
            ((ChannelContents -> Identity ChannelContents)
-> ClientChannel -> Identity ClientChannel
Lens' ClientChannel ChannelContents
ccContents((ChannelContents -> Identity ChannelContents)
 -> ClientChannel -> Identity ClientChannel)
-> ((Messages -> Identity Messages)
    -> ChannelContents -> Identity ChannelContents)
-> (Messages -> Identity Messages)
-> ClientChannel
-> Identity ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Identity Messages)
-> ChannelContents -> Identity ChannelContents
Lens' ChannelContents Messages
cdMessages ((Messages -> Identity Messages)
 -> ClientChannel -> Identity ClientChannel)
-> Messages -> ClientChannel -> ClientChannel
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Messages
resultMessages)

          let processTeam :: TeamId -> MH ()
processTeam TeamId
tId = do
                -- Determine if the current selected message was one of the
                -- removed messages.
                Maybe MessageId
selMsgId <- Getting (Maybe MessageId) ChatState (Maybe MessageId)
-> MH (Maybe MessageId)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)((TeamState -> Const (Maybe MessageId) TeamState)
 -> ChatState -> Const (Maybe MessageId) ChatState)
-> ((Maybe MessageId -> Const (Maybe MessageId) (Maybe MessageId))
    -> TeamState -> Const (Maybe MessageId) TeamState)
-> Getting (Maybe MessageId) ChatState (Maybe MessageId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MessageSelectState -> Const (Maybe MessageId) MessageSelectState)
-> TeamState -> Const (Maybe MessageId) TeamState
Lens' TeamState MessageSelectState
tsMessageSelect((MessageSelectState -> Const (Maybe MessageId) MessageSelectState)
 -> TeamState -> Const (Maybe MessageId) TeamState)
-> ((Maybe MessageId -> Const (Maybe MessageId) (Maybe MessageId))
    -> MessageSelectState
    -> Const (Maybe MessageId) MessageSelectState)
-> (Maybe MessageId -> Const (Maybe MessageId) (Maybe MessageId))
-> TeamState
-> Const (Maybe MessageId) TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MessageSelectState -> Maybe MessageId)
-> SimpleGetter MessageSelectState (Maybe MessageId)
forall s a. (s -> a) -> SimpleGetter s a
to MessageSelectState -> Maybe MessageId
selectMessageId)
                let rmvdSel :: Maybe Message
rmvdSel = do
                      MessageId
i <- Maybe MessageId
selMsgId -- :: Maybe MessageId
                      MessageId -> Messages -> Maybe Message
findMessage MessageId
i Messages
removedMessages
                    rmvdSelType :: Maybe MessageType
rmvdSelType = Message -> MessageType
_mType (Message -> MessageType) -> Maybe Message -> Maybe MessageType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Message
rmvdSel

                case Maybe Message
rmvdSel of
                  Maybe Message
Nothing -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                  Just Message
rm ->
                    if Message -> Bool
isGap Message
rm
                    then () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()  -- handled during gap insertion below
                    else do
                      -- Replaced a selected message that wasn't a gap.
                      -- This is unlikely, but may occur if the previously
                      -- selected message was just deleted by another user
                      -- and is in the fetched region.  The choices here are
                      -- to move the selection, or cancel the selection.
                      -- Both will be unpleasant surprises for the user, but
                      -- cancelling the selection is probably the better
                      -- choice than allowing the user to perform select
                      -- actions on a message that isn't the one they just
                      -- selected.
                      Mode -> MH ()
setMode Mode
Main
                      TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)((TeamState -> Identity TeamState)
 -> ChatState -> Identity ChatState)
-> ((MessageSelectState -> Identity MessageSelectState)
    -> TeamState -> Identity TeamState)
-> (MessageSelectState -> Identity MessageSelectState)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MessageSelectState -> Identity MessageSelectState)
-> TeamState -> Identity TeamState
Lens' TeamState MessageSelectState
tsMessageSelect ((MessageSelectState -> Identity MessageSelectState)
 -> ChatState -> Identity ChatState)
-> MessageSelectState -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe MessageId -> MessageSelectState
MessageSelectState Maybe MessageId
forall a. Maybe a
Nothing

                -- Add a gap at each end of the newly fetched data, unless:
                --   1. there is an overlap
                --   2. there is no more in the indicated direction
                --      a. indicated by adding messages later than any currently
                --         held messages (see note above re 'addingAtEnd').
                --      b. the amount returned was less than the amount requested

                if Bool
reAddGapBefore
                  then
                    -- No more gaps.  If the selected gap was removed, move
                    -- select to first (earliest) message)
                    case Maybe MessageType
rmvdSelType of
                      Just (C ClientMessageType
UnknownGapBefore) ->
                        TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)((TeamState -> Identity TeamState)
 -> ChatState -> Identity ChatState)
-> ((MessageSelectState -> Identity MessageSelectState)
    -> TeamState -> Identity TeamState)
-> (MessageSelectState -> Identity MessageSelectState)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MessageSelectState -> Identity MessageSelectState)
-> TeamState -> Identity TeamState
Lens' TeamState MessageSelectState
tsMessageSelect ((MessageSelectState -> Identity MessageSelectState)
 -> ChatState -> Identity ChatState)
-> MessageSelectState -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe MessageId -> MessageSelectState
MessageSelectState (MessageId -> Maybe MessageId
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MessageId -> Maybe MessageId) -> MessageId -> Maybe MessageId
forall a b. (a -> b) -> a -> b
$ PostId -> MessageId
MessagePostId PostId
earliestPId)
                      Maybe MessageType
_ -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                  else do
                    -- add a gap at the start of the newly fetched block and
                    -- make that the active selection if this fetch removed
                    -- the previously selected gap in this direction.
                    Message
gapMsg <- ServerTime -> Bool -> MH Message
newGapMessage (ServerTime -> ServerTime
justBefore ServerTime
earliestDate) Bool
True
                    (ClientChannels -> Identity ClientChannels)
-> ChatState -> Identity ChatState
Lens' ChatState ClientChannels
csChannels ((ClientChannels -> Identity ClientChannels)
 -> ChatState -> Identity ChatState)
-> (ClientChannels -> ClientChannels) -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ChannelId
-> (ClientChannel -> ClientChannel)
-> ClientChannels
-> ClientChannels
modifyChannelById ChannelId
cId
                      ((ChannelContents -> Identity ChannelContents)
-> ClientChannel -> Identity ClientChannel
Lens' ClientChannel ChannelContents
ccContents((ChannelContents -> Identity ChannelContents)
 -> ClientChannel -> Identity ClientChannel)
-> ((Messages -> Identity Messages)
    -> ChannelContents -> Identity ChannelContents)
-> (Messages -> Identity Messages)
-> ClientChannel
-> Identity ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Identity Messages)
-> ChannelContents -> Identity ChannelContents
Lens' ChannelContents Messages
cdMessages ((Messages -> Identity Messages)
 -> ClientChannel -> Identity ClientChannel)
-> (Messages -> Messages) -> ClientChannel -> ClientChannel
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Message -> Messages -> Messages
forall a. MessageOps a => Message -> a -> a
addMessage Message
gapMsg)
                    -- Move selection from old gap to new gap
                    case Maybe MessageType
rmvdSelType of
                      Just (C ClientMessageType
UnknownGapBefore) -> do
                        TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)((TeamState -> Identity TeamState)
 -> ChatState -> Identity ChatState)
-> ((MessageSelectState -> Identity MessageSelectState)
    -> TeamState -> Identity TeamState)
-> (MessageSelectState -> Identity MessageSelectState)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MessageSelectState -> Identity MessageSelectState)
-> TeamState -> Identity TeamState
Lens' TeamState MessageSelectState
tsMessageSelect ((MessageSelectState -> Identity MessageSelectState)
 -> ChatState -> Identity ChatState)
-> MessageSelectState -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe MessageId -> MessageSelectState
MessageSelectState (Message
gapMsgMessage
-> Getting (Maybe MessageId) Message (Maybe MessageId)
-> Maybe MessageId
forall s a. s -> Getting a s a -> a
^.Getting (Maybe MessageId) Message (Maybe MessageId)
Lens' Message (Maybe MessageId)
mMessageId)
                      Maybe MessageType
_ -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

                if Bool
reAddGapAfter
                  then
                    -- No more gaps.  If the selected gap was removed, move
                    -- select to last (latest) message.
                    case Maybe MessageType
rmvdSelType of
                      Just (C ClientMessageType
UnknownGapAfter) ->
                        TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)((TeamState -> Identity TeamState)
 -> ChatState -> Identity ChatState)
-> ((MessageSelectState -> Identity MessageSelectState)
    -> TeamState -> Identity TeamState)
-> (MessageSelectState -> Identity MessageSelectState)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MessageSelectState -> Identity MessageSelectState)
-> TeamState -> Identity TeamState
Lens' TeamState MessageSelectState
tsMessageSelect ((MessageSelectState -> Identity MessageSelectState)
 -> ChatState -> Identity ChatState)
-> MessageSelectState -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe MessageId -> MessageSelectState
MessageSelectState (MessageId -> Maybe MessageId
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MessageId -> Maybe MessageId) -> MessageId -> Maybe MessageId
forall a b. (a -> b) -> a -> b
$ PostId -> MessageId
MessagePostId PostId
latestPId)
                      Maybe MessageType
_ -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                  else do
                    -- add a gap at the end of the newly fetched block and
                    -- make that the active selection if this fetch removed
                    -- the previously selected gap in this direction.
                    Message
gapMsg <- ServerTime -> Bool -> MH Message
newGapMessage (ServerTime -> ServerTime
justAfter ServerTime
latestDate) Bool
False
                    (ClientChannels -> Identity ClientChannels)
-> ChatState -> Identity ChatState
Lens' ChatState ClientChannels
csChannels ((ClientChannels -> Identity ClientChannels)
 -> ChatState -> Identity ChatState)
-> (ClientChannels -> ClientChannels) -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ChannelId
-> (ClientChannel -> ClientChannel)
-> ClientChannels
-> ClientChannels
modifyChannelById ChannelId
cId
                      ((ChannelContents -> Identity ChannelContents)
-> ClientChannel -> Identity ClientChannel
Lens' ClientChannel ChannelContents
ccContents((ChannelContents -> Identity ChannelContents)
 -> ClientChannel -> Identity ClientChannel)
-> ((Messages -> Identity Messages)
    -> ChannelContents -> Identity ChannelContents)
-> (Messages -> Identity Messages)
-> ClientChannel
-> Identity ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Identity Messages)
-> ChannelContents -> Identity ChannelContents
Lens' ChannelContents Messages
cdMessages ((Messages -> Identity Messages)
 -> ClientChannel -> Identity ClientChannel)
-> (Messages -> Messages) -> ClientChannel -> ClientChannel
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Message -> Messages -> Messages
forall a. MessageOps a => Message -> a -> a
addMessage Message
gapMsg)
                    -- Move selection from old gap to new gap
                    case Maybe MessageType
rmvdSelType of
                      Just (C ClientMessageType
UnknownGapAfter) ->
                        TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)((TeamState -> Identity TeamState)
 -> ChatState -> Identity ChatState)
-> ((MessageSelectState -> Identity MessageSelectState)
    -> TeamState -> Identity TeamState)
-> (MessageSelectState -> Identity MessageSelectState)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MessageSelectState -> Identity MessageSelectState)
-> TeamState -> Identity TeamState
Lens' TeamState MessageSelectState
tsMessageSelect ((MessageSelectState -> Identity MessageSelectState)
 -> ChatState -> Identity ChatState)
-> MessageSelectState -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe MessageId -> MessageSelectState
MessageSelectState (Message
gapMsgMessage
-> Getting (Maybe MessageId) Message (Maybe MessageId)
-> Maybe MessageId
forall s a. s -> Getting a s a -> a
^.Getting (Maybe MessageId) Message (Maybe MessageId)
Lens' Message (Maybe MessageId)
mMessageId)
                      Maybe MessageType
_ -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

          case Maybe TeamId
mTId of
              Maybe TeamId
Nothing -> do
                  HashMap TeamId TeamState
ts <- Getting
  (HashMap TeamId TeamState) ChatState (HashMap TeamId TeamState)
-> MH (HashMap TeamId TeamState)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting
  (HashMap TeamId TeamState) ChatState (HashMap TeamId TeamState)
Lens' ChatState (HashMap TeamId TeamState)
csTeams
                  [TeamId] -> (TeamId -> MH ()) -> MH ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (HashMap TeamId TeamState -> [TeamId]
forall k v. HashMap k v -> [k]
HM.keys HashMap TeamId TeamState
ts) TeamId -> MH ()
processTeam
              Just TeamId
tId -> TeamId -> MH ()
processTeam TeamId
tId

        -- Now initiate fetches for use information for any
        -- as-yet-unknown users related to this new set of messages

        let users :: Set UserId
users = (Post -> Set UserId -> Set UserId)
-> Set UserId -> HashMap PostId Post -> Set UserId
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Post
post Set UserId
s -> Set UserId -> (UserId -> Set UserId) -> Maybe UserId -> Set UserId
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Set UserId
s ((UserId -> Set UserId -> Set UserId)
-> Set UserId -> UserId -> Set UserId
forall a b c. (a -> b -> c) -> b -> a -> c
flip UserId -> Set UserId -> Set UserId
forall a. Ord a => a -> Set a -> Set a
Set.insert Set UserId
s) (Post -> Maybe UserId
postUserId Post
post))
                          Set UserId
forall a. Set a
Set.empty (Posts
postsPosts
-> Getting (HashMap PostId Post) Posts (HashMap PostId Post)
-> HashMap PostId Post
forall s a. s -> Getting a s a -> a
^.Getting (HashMap PostId Post) Posts (HashMap PostId Post)
Lens' Posts (HashMap PostId Post)
postsPostsL)
            addUnknownUsers :: Set UserId -> MH ()
addUnknownUsers Set UserId
inputUserIds = do
                Set UserId
knownUserIds <- [UserId] -> Set UserId
forall a. Ord a => [a] -> Set a
Set.fromList ([UserId] -> Set UserId) -> MH [UserId] -> MH (Set UserId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ChatState -> [UserId]) -> MH [UserId]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ChatState -> [UserId]
allUserIds
                let unknownUsers :: Set UserId
unknownUsers = Set UserId -> Set UserId -> Set UserId
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set UserId
inputUserIds Set UserId
knownUserIds
                if Set UserId -> Bool
forall a. Set a -> Bool
Set.null Set UserId
unknownUsers
                   then () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                   else Seq UserId -> MH () -> MH ()
handleNewUsers ([UserId] -> Seq UserId
forall a. [a] -> Seq a
Seq.fromList ([UserId] -> Seq UserId) -> [UserId] -> Seq UserId
forall a b. (a -> b) -> a -> b
$ Set UserId -> [UserId]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set UserId
unknownUsers) (() -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())

        Set UserId -> MH ()
addUnknownUsers Set UserId
users

        -- Return the aggregated user notification action needed
        -- relative to the set of added messages.

        PostProcessMessageAdd -> MH PostProcessMessageAdd
forall (m :: * -> *) a. Monad m => a -> m a
return PostProcessMessageAdd
action

-- | Adds a possibly new message to the associated channel contents.
-- Returns an indicator of whether the user should be potentially
-- notified of a change (a new message not posted by this user, a
-- mention of the user, etc.).  This operation has no effect on any
-- existing UnknownGap entries and should be called when those are
-- irrelevant.
--
-- The first boolean argument ('doFetchMentionedUsers') indicates
-- whether this function should schedule a fetch for any mentioned
-- users in the message. This is provided so that callers can batch
-- this operation if a large collection of messages is being added
-- together, in which case we don't want this function to schedule a
-- single request per message (worst case). If you're calling this as
-- part of scrollback processing, you should pass False. Otherwise if
-- you're adding only a single message, you should pass True.
--
-- The second boolean argument ('fetchAuthor') is similar to the first
-- boolean argument but it refers to the author of the message instead
-- of any user mentions within the message body.
--
-- The third argument ('newPostData') indicates whether this message
-- is being added as part of a fetch of old messages (e.g. scrollback)
-- or if ti is a new message and affects things like whether
-- notifications are generated and if the "New Messages" marker gets
-- updated.
addMessageToState :: Bool -> Bool -> PostToAdd -> MH PostProcessMessageAdd
addMessageToState :: Bool -> Bool -> PostToAdd -> MH PostProcessMessageAdd
addMessageToState Bool
doFetchMentionedUsers Bool
fetchAuthor PostToAdd
newPostData = do
    let (Post
new, Bool
wasMentioned) = case PostToAdd
newPostData of
          -- A post from scrollback history has no mention data, and
          -- that's okay: we only need to track mentions to tell the
          -- user that recent posts contained mentions.
          OldPost Post
p      -> (Post
p, Bool
False)
          RecentPost Post
p Bool
m -> (Post
p, Bool
m)

    ChatState
st <- Getting ChatState ChatState ChatState -> MH ChatState
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting ChatState ChatState ChatState
forall a. a -> a
id
    case ChatState
st ChatState
-> Getting (First ClientChannel) ChatState ClientChannel
-> Maybe ClientChannel
forall s a. s -> Getting (First a) s a -> Maybe a
^? ChannelId -> Traversal' ChatState ClientChannel
csChannel(Post -> ChannelId
postChannelId Post
new) of
        Maybe ClientChannel
Nothing -> do
            Session
session <- MH Session
getSession
            AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Preempt (IO (Maybe (MH ())) -> MH ()) -> IO (Maybe (MH ())) -> MH ()
forall a b. (a -> b) -> a -> b
$ do
                Channel
nc <- ChannelId -> Session -> IO Channel
MM.mmGetChannel (Post -> ChannelId
postChannelId Post
new) Session
session
                ChannelMember
member <- ChannelId -> UserParam -> Session -> IO ChannelMember
MM.mmGetChannelMember (Post -> ChannelId
postChannelId Post
new) UserParam
UserMe Session
session

                let chType :: Type
chType = Channel
ncChannel -> Getting Type Channel Type -> Type
forall s a. s -> Getting a s a -> a
^.Getting Type Channel Type
Lens' Channel Type
channelTypeL
                    pref :: Preference
pref = ChannelId -> UserId -> Preference
showGroupChannelPref (Post -> ChannelId
postChannelId Post
new) (ChatState -> UserId
myUserId ChatState
st)

                -- If the channel has been archived, we don't want to
                -- post this message or add the channel to the state.
                case Channel -> Bool
channelDeleted Channel
nc of
                    Bool
True -> Maybe (MH ()) -> IO (Maybe (MH ()))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MH ())
forall a. Maybe a
Nothing
                    Bool
False -> Maybe (MH ()) -> IO (Maybe (MH ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MH ()) -> IO (Maybe (MH ())))
-> Maybe (MH ()) -> IO (Maybe (MH ()))
forall a b. (a -> b) -> a -> b
$ MH () -> Maybe (MH ())
forall a. a -> Maybe a
Just (MH () -> Maybe (MH ())) -> MH () -> Maybe (MH ())
forall a b. (a -> b) -> a -> b
$ do
                        -- If the incoming message is for a group
                        -- channel we don't know about, that's because
                        -- it was previously hidden by the user. We need
                        -- to show it, and to do that we need to update
                        -- the server-side preference. (That, in turn,
                        -- triggers a channel refresh.)
                        if Type
chType Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== Type
Group
                            then Preference -> MH ()
applyPreferenceChange Preference
pref
                            else SidebarUpdate -> Channel -> ChannelMember -> MH ()
refreshChannel SidebarUpdate
SidebarUpdateImmediate Channel
nc ChannelMember
member

                        Bool -> Bool -> PostToAdd -> MH PostProcessMessageAdd
addMessageToState Bool
doFetchMentionedUsers Bool
fetchAuthor PostToAdd
newPostData MH PostProcessMessageAdd
-> (PostProcessMessageAdd -> MH ()) -> MH ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                            PostProcessMessageAdd -> MH ()
postProcessMessageAdd

            PostProcessMessageAdd -> MH PostProcessMessageAdd
forall (m :: * -> *) a. Monad m => a -> m a
return PostProcessMessageAdd
NoAction
        Just ClientChannel
ch -> do
            let mTId :: Maybe TeamId
mTId = ClientChannel
chClientChannel
-> Getting (Maybe TeamId) ClientChannel (Maybe TeamId)
-> Maybe TeamId
forall s a. s -> Getting a s a -> a
^.(ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
-> ClientChannel -> Const (Maybe TeamId) ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
 -> ClientChannel -> Const (Maybe TeamId) ClientChannel)
-> ((Maybe TeamId -> Const (Maybe TeamId) (Maybe TeamId))
    -> ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
-> Getting (Maybe TeamId) ClientChannel (Maybe TeamId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe TeamId -> Const (Maybe TeamId) (Maybe TeamId))
-> ChannelInfo -> Const (Maybe TeamId) ChannelInfo
Lens' ChannelInfo (Maybe TeamId)
cdTeamId
            Maybe TeamBaseURL
mBaseUrl <- case Maybe TeamId
mTId of
                Maybe TeamId
Nothing -> Maybe TeamBaseURL -> MH (Maybe TeamBaseURL)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TeamBaseURL
forall a. Maybe a
Nothing
                Just TeamId
tId -> TeamBaseURL -> Maybe TeamBaseURL
forall a. a -> Maybe a
Just (TeamBaseURL -> Maybe TeamBaseURL)
-> MH TeamBaseURL -> MH (Maybe TeamBaseURL)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TeamId -> MH TeamBaseURL
getServerBaseUrl TeamId
tId

            let cp :: ClientPost
cp = Maybe TeamBaseURL -> Post -> Maybe PostId -> ClientPost
toClientPost Maybe TeamBaseURL
mBaseUrl Post
new (Post
newPost -> Getting (Maybe PostId) Post (Maybe PostId) -> Maybe PostId
forall s a. s -> Getting a s a -> a
^.Getting (Maybe PostId) Post (Maybe PostId)
Lens' Post (Maybe PostId)
postRootIdL)
                fromMe :: Bool
fromMe = (ClientPost
cpClientPost
-> Getting (Maybe UserId) ClientPost (Maybe UserId) -> Maybe UserId
forall s a. s -> Getting a s a -> a
^.Getting (Maybe UserId) ClientPost (Maybe UserId)
Lens' ClientPost (Maybe UserId)
cpUser Maybe UserId -> Maybe UserId -> Bool
forall a. Eq a => a -> a -> Bool
== (UserId -> Maybe UserId
forall a. a -> Maybe a
Just (UserId -> Maybe UserId) -> UserId -> Maybe UserId
forall a b. (a -> b) -> a -> b
$ ChatState -> UserId
myUserId ChatState
st)) Bool -> Bool -> Bool
&&
                         (Maybe Text -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe Text -> Bool) -> Maybe Text -> Bool
forall a b. (a -> b) -> a -> b
$ ClientPost
cpClientPost
-> Getting (Maybe Text) ClientPost (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^.Getting (Maybe Text) ClientPost (Maybe Text)
Lens' ClientPost (Maybe Text)
cpUserOverride)
                userPrefs :: UserPreferences
userPrefs = ChatState
stChatState
-> Getting UserPreferences ChatState UserPreferences
-> UserPreferences
forall s a. s -> Getting a s a -> a
^.(ChatResources -> Const UserPreferences ChatResources)
-> ChatState -> Const UserPreferences ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Const UserPreferences ChatResources)
 -> ChatState -> Const UserPreferences ChatState)
-> ((UserPreferences -> Const UserPreferences UserPreferences)
    -> ChatResources -> Const UserPreferences ChatResources)
-> Getting UserPreferences ChatState UserPreferences
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(UserPreferences -> Const UserPreferences UserPreferences)
-> ChatResources -> Const UserPreferences ChatResources
Lens' ChatResources UserPreferences
crUserPreferences
                isJoinOrLeave :: Bool
isJoinOrLeave = case ClientPost
cpClientPost
-> Getting ClientPostType ClientPost ClientPostType
-> ClientPostType
forall s a. s -> Getting a s a -> a
^.Getting ClientPostType ClientPost ClientPostType
Lens' ClientPost ClientPostType
cpType of
                  ClientPostType
Join  -> Bool
True
                  ClientPostType
Leave -> Bool
True
                  ClientPostType
_     -> Bool
False
                ignoredJoinLeaveMessage :: Bool
ignoredJoinLeaveMessage =
                  Bool -> Bool
not (UserPreferences
userPrefsUserPreferences -> Getting Bool UserPreferences Bool -> Bool
forall s a. s -> Getting a s a -> a
^.Getting Bool UserPreferences Bool
Lens' UserPreferences Bool
userPrefShowJoinLeave) Bool -> Bool -> Bool
&& Bool
isJoinOrLeave
                cId :: ChannelId
cId = Post -> ChannelId
postChannelId Post
new

                doAddMessage :: MH PostProcessMessageAdd
doAddMessage = do
                    -- Do we have the user data for the post author?
                    case ClientPost
cpClientPost
-> Getting (Maybe UserId) ClientPost (Maybe UserId) -> Maybe UserId
forall s a. s -> Getting a s a -> a
^.Getting (Maybe UserId) ClientPost (Maybe UserId)
Lens' ClientPost (Maybe UserId)
cpUser of
                        Maybe UserId
Nothing -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                        Just UserId
authorId -> Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
fetchAuthor (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ do
                            Maybe UserInfo
authorResult <- (ChatState -> Maybe UserInfo) -> MH (Maybe UserInfo)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (UserId -> ChatState -> Maybe UserInfo
userById UserId
authorId)
                            Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe UserInfo -> Bool
forall a. Maybe a -> Bool
isNothing Maybe UserInfo
authorResult) (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$
                                Seq UserId -> MH () -> MH ()
handleNewUsers (UserId -> Seq UserId
forall a. a -> Seq a
Seq.singleton UserId
authorId) (() -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())

                    TeamId
curTId <- Getting TeamId ChatState TeamId -> MH TeamId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting TeamId ChatState TeamId
SimpleGetter ChatState TeamId
csCurrentTeamId
                    ChannelId
currCId <- Getting ChannelId ChatState ChannelId -> MH ChannelId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> SimpleGetter ChatState ChannelId
csCurrentChannelId TeamId
curTId)
                    Set PostId
flags <- Getting (Set PostId) ChatState (Set PostId) -> MH (Set PostId)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((ChatResources -> Const (Set PostId) ChatResources)
-> ChatState -> Const (Set PostId) ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Const (Set PostId) ChatResources)
 -> ChatState -> Const (Set PostId) ChatState)
-> ((Set PostId -> Const (Set PostId) (Set PostId))
    -> ChatResources -> Const (Set PostId) ChatResources)
-> Getting (Set PostId) ChatState (Set PostId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Set PostId -> Const (Set PostId) (Set PostId))
-> ChatResources -> Const (Set PostId) ChatResources
Lens' ChatResources (Set PostId)
crFlaggedPosts)
                    let (Message
msg', Set MentionedUser
mentionedUsers) = ClientPost -> (Message, Set MentionedUser)
clientPostToMessage ClientPost
cp
                                 (Message, Set MentionedUser)
-> ((Message, Set MentionedUser) -> (Message, Set MentionedUser))
-> (Message, Set MentionedUser)
forall a b. a -> (a -> b) -> b
& (Message -> Identity Message)
-> (Message, Set MentionedUser)
-> Identity (Message, Set MentionedUser)
forall s t a b. Field1 s t a b => Lens s t a b
_1((Message -> Identity Message)
 -> (Message, Set MentionedUser)
 -> Identity (Message, Set MentionedUser))
-> ((Bool -> Identity Bool) -> Message -> Identity Message)
-> (Bool -> Identity Bool)
-> (Message, Set MentionedUser)
-> Identity (Message, Set MentionedUser)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Identity Bool) -> Message -> Identity Message
Lens' Message Bool
mFlagged ((Bool -> Identity Bool)
 -> (Message, Set MentionedUser)
 -> Identity (Message, Set MentionedUser))
-> Bool
-> (Message, Set MentionedUser)
-> (Message, Set MentionedUser)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ((ClientPost
cpClientPost -> Getting PostId ClientPost PostId -> PostId
forall s a. s -> Getting a s a -> a
^.Getting PostId ClientPost PostId
Lens' ClientPost PostId
cpPostId) PostId -> Set PostId -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set PostId
flags)

                    Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
doFetchMentionedUsers (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$
                        Set MentionedUser -> MH ()
fetchMentionedUsers Set MentionedUser
mentionedUsers

                    (HashMap PostId Message -> Identity (HashMap PostId Message))
-> ChatState -> Identity ChatState
Lens' ChatState (HashMap PostId Message)
csPostMap((HashMap PostId Message -> Identity (HashMap PostId Message))
 -> ChatState -> Identity ChatState)
-> ((Maybe Message -> Identity (Maybe Message))
    -> HashMap PostId Message -> Identity (HashMap PostId Message))
-> (Maybe Message -> Identity (Maybe Message))
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Index (HashMap PostId Message)
-> Lens'
     (HashMap PostId Message) (Maybe (IxValue (HashMap PostId Message)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at(Post -> PostId
postId Post
new) ((Maybe Message -> Identity (Maybe Message))
 -> ChatState -> Identity ChatState)
-> Maybe Message -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Message -> Maybe Message
forall a. a -> Maybe a
Just Message
msg'
                    EventM Name () -> MH ()
forall a. EventM Name a -> MH a
mh (EventM Name () -> MH ()) -> EventM Name () -> MH ()
forall a b. (a -> b) -> a -> b
$ Name -> EventM Name ()
forall n. Ord n => n -> EventM n ()
invalidateCacheEntry (ChannelId -> Name
ChannelMessages ChannelId
cId)
                    (ClientChannels -> Identity ClientChannels)
-> ChatState -> Identity ChatState
Lens' ChatState ClientChannels
csChannels ((ClientChannels -> Identity ClientChannels)
 -> ChatState -> Identity ChatState)
-> (ClientChannels -> ClientChannels) -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ChannelId
-> (ClientChannel -> ClientChannel)
-> ClientChannels
-> ClientChannels
modifyChannelById ChannelId
cId
                      (((ChannelContents -> Identity ChannelContents)
-> ClientChannel -> Identity ClientChannel
Lens' ClientChannel ChannelContents
ccContents((ChannelContents -> Identity ChannelContents)
 -> ClientChannel -> Identity ClientChannel)
-> ((Messages -> Identity Messages)
    -> ChannelContents -> Identity ChannelContents)
-> (Messages -> Identity Messages)
-> ClientChannel
-> Identity ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Identity Messages)
-> ChannelContents -> Identity ChannelContents
Lens' ChannelContents Messages
cdMessages ((Messages -> Identity Messages)
 -> ClientChannel -> Identity ClientChannel)
-> (Messages -> Messages) -> ClientChannel -> ClientChannel
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Message -> Messages -> Messages
forall a. MessageOps a => Message -> a -> a
addMessage Message
msg') (ClientChannel -> ClientChannel)
-> (ClientChannel -> ClientChannel)
-> ClientChannel
-> ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                       (if Bool -> Bool
not Bool
ignoredJoinLeaveMessage then Post -> ClientChannel -> ClientChannel
adjustUpdated Post
new else ClientChannel -> ClientChannel
forall a. a -> a
id) (ClientChannel -> ClientChannel)
-> (ClientChannel -> ClientChannel)
-> ClientChannel
-> ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                       (\ClientChannel
c -> if ChannelId
currCId ChannelId -> ChannelId -> Bool
forall a. Eq a => a -> a -> Bool
== ChannelId
cId
                              then ClientChannel
c
                              else case PostToAdd
newPostData of
                                     OldPost Post
_ -> ClientChannel
c
                                     RecentPost Post
_ Bool
_ ->
                                       Post -> ClientChannel -> ClientChannel
updateNewMessageIndicator Post
new ClientChannel
c) (ClientChannel -> ClientChannel)
-> (ClientChannel -> ClientChannel)
-> ClientChannel
-> ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                       (\ClientChannel
c -> if Bool
wasMentioned
                              then ClientChannel
c ClientChannel -> (ClientChannel -> ClientChannel) -> ClientChannel
forall a b. a -> (a -> b) -> b
& (ChannelInfo -> Identity ChannelInfo)
-> ClientChannel -> Identity ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Identity ChannelInfo)
 -> ClientChannel -> Identity ClientChannel)
-> ((Int -> Identity Int) -> ChannelInfo -> Identity ChannelInfo)
-> (Int -> Identity Int)
-> ClientChannel
-> Identity ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> Identity Int) -> ChannelInfo -> Identity ChannelInfo
Lens' ChannelInfo Int
cdMentionCount ((Int -> Identity Int) -> ClientChannel -> Identity ClientChannel)
-> (Int -> Int) -> ClientChannel -> ClientChannel
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Int -> Int
forall a. Enum a => a -> a
succ
                              else ClientChannel
c)
                      )
                    ChannelId -> Post -> MH ()
asyncFetchReactionsForPost ChannelId
cId Post
new
                    Post -> MH ()
asyncFetchAttachments Post
new
                    MH PostProcessMessageAdd
postedChanMessage

                doHandleAddedMessage :: MH PostProcessMessageAdd
doHandleAddedMessage = do
                    -- If the message is in reply to another message,
                    -- try to find it in the scrollback for the post's
                    -- channel. If the message isn't there, fetch it. If
                    -- we have to fetch it, don't post this message to the
                    -- channel until we have fetched the parent.
                    case ClientPost
cpClientPost
-> Getting (Maybe PostId) ClientPost (Maybe PostId) -> Maybe PostId
forall s a. s -> Getting a s a -> a
^.Getting (Maybe PostId) ClientPost (Maybe PostId)
Lens' ClientPost (Maybe PostId)
cpInReplyToPost of
                        Just PostId
parentId ->
                            case ChatState -> PostId -> Maybe Message
getMessageForPostId ChatState
st PostId
parentId of
                                Maybe Message
Nothing -> do
                                    DoAsyncChannelMM Posts
forall a. DoAsyncChannelMM a
doAsyncChannelMM AsyncPriority
Preempt ChannelId
cId
                                        (\Session
s ChannelId
_ -> PostId -> Session -> IO Posts
MM.mmGetThread PostId
parentId Session
s)
                                        (\ChannelId
_ Posts
p -> MH () -> Maybe (MH ())
forall a. a -> Maybe a
Just (MH () -> Maybe (MH ())) -> MH () -> Maybe (MH ())
forall a b. (a -> b) -> a -> b
$ Maybe TeamId -> Posts -> MH ()
updatePostMap Maybe TeamId
mTId Posts
p)
                                Maybe Message
_ -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                        Maybe PostId
_ -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

                    MH PostProcessMessageAdd
doAddMessage

                postedChanMessage :: MH PostProcessMessageAdd
postedChanMessage =
                  ChannelId
-> PostProcessMessageAdd
-> (ClientChannel -> MH PostProcessMessageAdd)
-> MH PostProcessMessageAdd
forall a. ChannelId -> a -> (ClientChannel -> MH a) -> MH a
withChannelOrDefault (Post -> ChannelId
postChannelId Post
new) PostProcessMessageAdd
NoAction ((ClientChannel -> MH PostProcessMessageAdd)
 -> MH PostProcessMessageAdd)
-> (ClientChannel -> MH PostProcessMessageAdd)
-> MH PostProcessMessageAdd
forall a b. (a -> b) -> a -> b
$ \ClientChannel
chan -> do
                      TeamId
currTid <- Getting TeamId ChatState TeamId -> MH TeamId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting TeamId ChatState TeamId
SimpleGetter ChatState TeamId
csCurrentTeamId
                      ChannelId
currCId <- Getting ChannelId ChatState ChannelId -> MH ChannelId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> SimpleGetter ChatState ChannelId
csCurrentChannelId TeamId
currTid)

                      let notifyPref :: NotifyOption
notifyPref = User -> ClientChannel -> NotifyOption
notifyPreference (ChatState -> User
myUser ChatState
st) ClientChannel
chan
                          curChannelAction :: PostProcessMessageAdd
curChannelAction = if Post -> ChannelId
postChannelId Post
new ChannelId -> ChannelId -> Bool
forall a. Eq a => a -> a -> Bool
== ChannelId
currCId
                                             then PostProcessMessageAdd
UpdateServerViewed
                                             else PostProcessMessageAdd
NoAction
                          originUserAction :: PostProcessMessageAdd
originUserAction =
                            if | Bool
fromMe                            -> PostProcessMessageAdd
NoAction
                               | Bool
ignoredJoinLeaveMessage           -> PostProcessMessageAdd
NoAction
                               | NotifyOption
notifyPref NotifyOption -> NotifyOption -> Bool
forall a. Eq a => a -> a -> Bool
== NotifyOption
NotifyOptionAll     -> [PostToAdd] -> PostProcessMessageAdd
NotifyUser [PostToAdd
newPostData]
                               | NotifyOption
notifyPref NotifyOption -> NotifyOption -> Bool
forall a. Eq a => a -> a -> Bool
== NotifyOption
NotifyOptionMention
                                   Bool -> Bool -> Bool
&& Bool
wasMentioned                 -> [PostToAdd] -> PostProcessMessageAdd
NotifyUser [PostToAdd
newPostData]
                               | Bool
otherwise                         -> PostProcessMessageAdd
NoAction

                      PostProcessMessageAdd -> MH PostProcessMessageAdd
forall (m :: * -> *) a. Monad m => a -> m a
return (PostProcessMessageAdd -> MH PostProcessMessageAdd)
-> PostProcessMessageAdd -> MH PostProcessMessageAdd
forall a b. (a -> b) -> a -> b
$ PostProcessMessageAdd
curChannelAction PostProcessMessageAdd
-> PostProcessMessageAdd -> PostProcessMessageAdd
`andProcessWith` PostProcessMessageAdd
originUserAction

            MH PostProcessMessageAdd
doHandleAddedMessage

-- | PostProcessMessageAdd is an internal value that informs the main
-- code whether the user should be notified (e.g., ring the bell) or
-- the server should be updated (e.g., that the channel has been
-- viewed).  This is a monoid so that it can be folded over when there
-- are multiple inbound posts to be processed.
data PostProcessMessageAdd = NoAction
                           | NotifyUser [PostToAdd]
                           | UpdateServerViewed
                           | NotifyUserAndServer [PostToAdd]

andProcessWith
  :: PostProcessMessageAdd -> PostProcessMessageAdd -> PostProcessMessageAdd
andProcessWith :: PostProcessMessageAdd
-> PostProcessMessageAdd -> PostProcessMessageAdd
andProcessWith PostProcessMessageAdd
NoAction PostProcessMessageAdd
x                                        = PostProcessMessageAdd
x
andProcessWith PostProcessMessageAdd
x PostProcessMessageAdd
NoAction                                        = PostProcessMessageAdd
x
andProcessWith (NotifyUserAndServer [PostToAdd]
p) PostProcessMessageAdd
UpdateServerViewed        = [PostToAdd] -> PostProcessMessageAdd
NotifyUserAndServer [PostToAdd]
p
andProcessWith (NotifyUserAndServer [PostToAdd]
p1) (NotifyUser [PostToAdd]
p2)          = [PostToAdd] -> PostProcessMessageAdd
NotifyUserAndServer ([PostToAdd]
p1 [PostToAdd] -> [PostToAdd] -> [PostToAdd]
forall a. Semigroup a => a -> a -> a
<> [PostToAdd]
p2)
andProcessWith (NotifyUserAndServer [PostToAdd]
p1) (NotifyUserAndServer [PostToAdd]
p2) = [PostToAdd] -> PostProcessMessageAdd
NotifyUserAndServer ([PostToAdd]
p1 [PostToAdd] -> [PostToAdd] -> [PostToAdd]
forall a. Semigroup a => a -> a -> a
<> [PostToAdd]
p2)
andProcessWith (NotifyUser [PostToAdd]
p1) (NotifyUserAndServer [PostToAdd]
p2)          = [PostToAdd] -> PostProcessMessageAdd
NotifyUser ([PostToAdd]
p1 [PostToAdd] -> [PostToAdd] -> [PostToAdd]
forall a. Semigroup a => a -> a -> a
<> [PostToAdd]
p2)
andProcessWith (NotifyUser [PostToAdd]
p1) (NotifyUser [PostToAdd]
p2)                   = [PostToAdd] -> PostProcessMessageAdd
NotifyUser ([PostToAdd]
p1 [PostToAdd] -> [PostToAdd] -> [PostToAdd]
forall a. Semigroup a => a -> a -> a
<> [PostToAdd]
p2)
andProcessWith (NotifyUser [PostToAdd]
p) PostProcessMessageAdd
UpdateServerViewed                 = [PostToAdd] -> PostProcessMessageAdd
NotifyUserAndServer [PostToAdd]
p
andProcessWith PostProcessMessageAdd
UpdateServerViewed PostProcessMessageAdd
UpdateServerViewed             = PostProcessMessageAdd
UpdateServerViewed
andProcessWith PostProcessMessageAdd
UpdateServerViewed (NotifyUserAndServer [PostToAdd]
p)        = [PostToAdd] -> PostProcessMessageAdd
NotifyUserAndServer [PostToAdd]
p
andProcessWith PostProcessMessageAdd
UpdateServerViewed (NotifyUser [PostToAdd]
p)                 = [PostToAdd] -> PostProcessMessageAdd
NotifyUserAndServer [PostToAdd]
p

-- | postProcessMessageAdd performs the actual actions indicated by
-- the corresponding input value.
postProcessMessageAdd :: PostProcessMessageAdd -> MH ()
postProcessMessageAdd :: PostProcessMessageAdd -> MH ()
postProcessMessageAdd PostProcessMessageAdd
ppma = PostProcessMessageAdd -> MH ()
postOp PostProcessMessageAdd
ppma
    where
        postOp :: PostProcessMessageAdd -> MH ()
postOp PostProcessMessageAdd
NoAction                = () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        postOp PostProcessMessageAdd
UpdateServerViewed      = Bool -> MH ()
updateViewed Bool
False
        postOp (NotifyUser [PostToAdd]
p)          = MH ()
maybeRingBell MH () -> MH () -> MH ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (PostToAdd -> MH ()) -> [PostToAdd] -> MH ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ PostToAdd -> MH ()
maybeNotify [PostToAdd]
p
        postOp (NotifyUserAndServer [PostToAdd]
p) = Bool -> MH ()
updateViewed Bool
False MH () -> MH () -> MH ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MH ()
maybeRingBell MH () -> MH () -> MH ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (PostToAdd -> MH ()) -> [PostToAdd] -> MH ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ PostToAdd -> MH ()
maybeNotify [PostToAdd]
p

maybeNotify :: PostToAdd -> MH ()
maybeNotify :: PostToAdd -> MH ()
maybeNotify (OldPost Post
_) = do
    () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
maybeNotify (RecentPost Post
post Bool
mentioned) = Post -> Bool -> MH ()
runNotifyCommand Post
post Bool
mentioned

maybeRingBell :: MH ()
maybeRingBell :: MH ()
maybeRingBell = do
    Bool
doBell <- Getting Bool ChatState Bool -> MH Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((ChatResources -> Const Bool ChatResources)
-> ChatState -> Const Bool ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Const Bool ChatResources)
 -> ChatState -> Const Bool ChatState)
-> ((Bool -> Const Bool Bool)
    -> ChatResources -> Const Bool ChatResources)
-> Getting Bool ChatState Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Config -> Const Bool Config)
-> ChatResources -> Const Bool ChatResources
Lens' ChatResources Config
crConfiguration((Config -> Const Bool Config)
 -> ChatResources -> Const Bool ChatResources)
-> ((Bool -> Const Bool Bool) -> Config -> Const Bool Config)
-> (Bool -> Const Bool Bool)
-> ChatResources
-> Const Bool ChatResources
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Const Bool Bool) -> Config -> Const Bool Config
Lens' Config Bool
configActivityBellL)
    Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
doBell (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ do
        Vty
vty <- EventM Name Vty -> MH Vty
forall a. EventM Name a -> MH a
mh EventM Name Vty
forall n. EventM n Vty
getVtyHandle
        IO () -> MH ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> MH ()) -> IO () -> MH ()
forall a b. (a -> b) -> a -> b
$ Output -> IO ()
ringTerminalBell (Output -> IO ()) -> Output -> IO ()
forall a b. (a -> b) -> a -> b
$ Vty -> Output
outputIface Vty
vty

-- | When we add posts to the application state, we either get them
-- from the server during scrollback fetches (here called 'OldPost') or
-- we get them from websocket events when they are posted in real time
-- (here called 'RecentPost').
data PostToAdd =
    OldPost Post
    -- ^ A post from the server's history
    | RecentPost Post Bool
    -- ^ A message posted to the channel since the user connected, along
    -- with a flag indicating whether the post triggered any of the
    -- user's mentions. We need an extra flag because the server
    -- determines whether the post has any mentions, and that data is
    -- only available in websocket events (and then provided to this
    -- constructor).

runNotifyCommand :: Post -> Bool -> MH ()
runNotifyCommand :: Post -> Bool -> MH ()
runNotifyCommand Post
post Bool
mentioned = do
    TChan ProgramOutput
outputChan <- Getting (TChan ProgramOutput) ChatState (TChan ProgramOutput)
-> MH (TChan ProgramOutput)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((ChatResources -> Const (TChan ProgramOutput) ChatResources)
-> ChatState -> Const (TChan ProgramOutput) ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Const (TChan ProgramOutput) ChatResources)
 -> ChatState -> Const (TChan ProgramOutput) ChatState)
-> ((TChan ProgramOutput
     -> Const (TChan ProgramOutput) (TChan ProgramOutput))
    -> ChatResources -> Const (TChan ProgramOutput) ChatResources)
-> Getting (TChan ProgramOutput) ChatState (TChan ProgramOutput)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(TChan ProgramOutput
 -> Const (TChan ProgramOutput) (TChan ProgramOutput))
-> ChatResources -> Const (TChan ProgramOutput) ChatResources
Lens' ChatResources (TChan ProgramOutput)
crSubprocessLog)
    ChatState
st <- Getting ChatState ChatState ChatState -> MH ChatState
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting ChatState ChatState ChatState
forall a. a -> a
id
    Maybe Text
notifyCommand <- Getting (Maybe Text) ChatState (Maybe Text) -> MH (Maybe Text)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((ChatResources -> Const (Maybe Text) ChatResources)
-> ChatState -> Const (Maybe Text) ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Const (Maybe Text) ChatResources)
 -> ChatState -> Const (Maybe Text) ChatState)
-> ((Maybe Text -> Const (Maybe Text) (Maybe Text))
    -> ChatResources -> Const (Maybe Text) ChatResources)
-> Getting (Maybe Text) ChatState (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Config -> Const (Maybe Text) Config)
-> ChatResources -> Const (Maybe Text) ChatResources
Lens' ChatResources Config
crConfiguration((Config -> Const (Maybe Text) Config)
 -> ChatResources -> Const (Maybe Text) ChatResources)
-> ((Maybe Text -> Const (Maybe Text) (Maybe Text))
    -> Config -> Const (Maybe Text) Config)
-> (Maybe Text -> Const (Maybe Text) (Maybe Text))
-> ChatResources
-> Const (Maybe Text) ChatResources
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe Text -> Const (Maybe Text) (Maybe Text))
-> Config -> Const (Maybe Text) Config
Lens' Config (Maybe Text)
configActivityNotifyCommandL)
    case Maybe Text
notifyCommand of
        Maybe Text
Nothing -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just Text
cmd ->
            AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Preempt (IO (Maybe (MH ())) -> MH ()) -> IO (Maybe (MH ())) -> MH ()
forall a b. (a -> b) -> a -> b
$ do
                let messageString :: String
messageString = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ UserText -> Text
sanitizeUserText (UserText -> Text) -> UserText -> Text
forall a b. (a -> b) -> a -> b
$ Post -> UserText
postMessage Post
post
                    notified :: String
notified = if Bool
mentioned then String
"1" else String
"2"
                    sender :: String
sender = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ ChatState -> Post -> Text
maybePostUsername ChatState
st Post
post
                TChan ProgramOutput
-> String
-> [String]
-> Maybe String
-> Maybe (MVar ProgramOutput)
-> IO ()
runLoggedCommand TChan ProgramOutput
outputChan (Text -> String
T.unpack Text
cmd)
                                 [String
notified, String
sender, String
messageString] Maybe String
forall a. Maybe a
Nothing Maybe (MVar ProgramOutput)
forall a. Maybe a
Nothing
                Maybe (MH ()) -> IO (Maybe (MH ()))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MH ())
forall a. Maybe a
Nothing

maybePostUsername :: ChatState -> Post -> T.Text
maybePostUsername :: ChatState -> Post -> Text
maybePostUsername ChatState
st Post
p =
    Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
T.empty (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ do
        UserId
uId <- Post -> Maybe UserId
postUserId Post
p
        UserId -> ChatState -> Maybe Text
usernameForUserId UserId
uId ChatState
st

-- | Fetches additional message history for the current channel.  This
-- is generally called when in ChannelScroll mode, in which state the
-- output is cached and seen via a scrolling viewport; new messages
-- received in this mode are not normally shown, but this explicit
-- user-driven fetch should be displayed, so this also invalidates the
-- cache.
--
-- This function assumes it is being called to add "older" messages to
-- the message history (i.e. near the beginning of the known
-- messages).  It will normally try to overlap the fetch with the
-- known existing messages so that when the fetch results are
-- processed (which should be a contiguous set of messages as provided
-- by the server) there will be an overlap with existing messages; if
-- there is no overlap, then a special "gap" must be inserted in the
-- area between the existing messages and the newly fetched messages
-- to indicate that this client does not know if there are missing
-- messages there or not.
--
-- In order to achieve an overlap, this code attempts to get the
-- second oldest messages as the message ID to pass to the server as
-- the "older than" marker ('postQueryBefore'), so that the oldest
-- message here overlaps with the fetched results to ensure no gap
-- needs to be inserted.  However, there may already be a gap between
-- the oldest and second-oldest messages, so this code must actually
-- search for the first set of two *contiguous* messages it is aware
-- of to avoid adding additional gaps. (It's OK if gaps are added, but
-- the user must explicitly request a check for messages in order to
-- eliminate them, so it's better to avoid adding them in the first
-- place).  This code is nearly always used to extend the older
-- history of a channel that information has already been retrieved
-- from, so it's almost certain that there are at least two contiguous
-- messages to use as a starting point, but exceptions are new
-- channels and empty channels.
asyncFetchMoreMessages :: MH ()
asyncFetchMoreMessages :: MH ()
asyncFetchMoreMessages = do
    TeamId
tId <- Getting TeamId ChatState TeamId -> MH TeamId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting TeamId ChatState TeamId
SimpleGetter ChatState TeamId
csCurrentTeamId
    ChannelId
cId <- Getting ChannelId ChatState ChannelId -> MH ChannelId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> SimpleGetter ChatState ChannelId
csCurrentChannelId TeamId
tId)
    ChannelId -> (ClientChannel -> MH ()) -> MH ()
withChannel ChannelId
cId ((ClientChannel -> MH ()) -> MH ())
-> (ClientChannel -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \ClientChannel
chan ->
        let offset :: Int
offset = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Messages -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (ClientChannel
chanClientChannel
-> Getting Messages ClientChannel Messages -> Messages
forall s a. s -> Getting a s a -> a
^.(ChannelContents -> Const Messages ChannelContents)
-> ClientChannel -> Const Messages ClientChannel
Lens' ClientChannel ChannelContents
ccContents((ChannelContents -> Const Messages ChannelContents)
 -> ClientChannel -> Const Messages ClientChannel)
-> ((Messages -> Const Messages Messages)
    -> ChannelContents -> Const Messages ChannelContents)
-> Getting Messages ClientChannel Messages
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Const Messages Messages)
-> ChannelContents -> Const Messages ChannelContents
Lens' ChannelContents Messages
cdMessages) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2
            page :: Int
page = Int
offset Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
pageAmount
            usefulMsgs :: Maybe (Message, Message)
usefulMsgs = Maybe Message -> RetrogradeMessages -> Maybe (Message, Message)
forall dir.
SeqDirection dir =>
Maybe Message
-> DirectionalSeq dir Message -> Maybe (Message, Message)
getTwoContiguousPosts Maybe Message
forall a. Maybe a
Nothing (ClientChannel
chanClientChannel
-> Getting RetrogradeMessages ClientChannel RetrogradeMessages
-> RetrogradeMessages
forall s a. s -> Getting a s a -> a
^.(ChannelContents -> Const RetrogradeMessages ChannelContents)
-> ClientChannel -> Const RetrogradeMessages ClientChannel
Lens' ClientChannel ChannelContents
ccContents((ChannelContents -> Const RetrogradeMessages ChannelContents)
 -> ClientChannel -> Const RetrogradeMessages ClientChannel)
-> ((RetrogradeMessages
     -> Const RetrogradeMessages RetrogradeMessages)
    -> ChannelContents -> Const RetrogradeMessages ChannelContents)
-> Getting RetrogradeMessages ClientChannel RetrogradeMessages
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Const RetrogradeMessages Messages)
-> ChannelContents -> Const RetrogradeMessages ChannelContents
Lens' ChannelContents Messages
cdMessages((Messages -> Const RetrogradeMessages Messages)
 -> ChannelContents -> Const RetrogradeMessages ChannelContents)
-> ((RetrogradeMessages
     -> Const RetrogradeMessages RetrogradeMessages)
    -> Messages -> Const RetrogradeMessages Messages)
-> (RetrogradeMessages
    -> Const RetrogradeMessages RetrogradeMessages)
-> ChannelContents
-> Const RetrogradeMessages ChannelContents
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> RetrogradeMessages)
-> SimpleGetter Messages RetrogradeMessages
forall s a. (s -> a) -> SimpleGetter s a
to Messages -> RetrogradeMessages
reverseMessages)
            sndOldestId :: Maybe PostId
sndOldestId = (Message -> Maybe PostId
messagePostId (Message -> Maybe PostId)
-> ((Message, Message) -> Message)
-> (Message, Message)
-> Maybe PostId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Message, Message) -> Message
forall a b. (a, b) -> b
snd) ((Message, Message) -> Maybe PostId)
-> Maybe (Message, Message) -> Maybe PostId
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (Message, Message)
usefulMsgs
            query :: PostQuery
query = PostQuery
MM.defaultPostQuery
                      { postQueryPage :: Maybe Int
MM.postQueryPage = Maybe Int -> (PostId -> Maybe Int) -> Maybe PostId -> Maybe Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
page) (Maybe Int -> PostId -> Maybe Int
forall a b. a -> b -> a
const Maybe Int
forall a. Maybe a
Nothing) Maybe PostId
sndOldestId
                      , postQueryPerPage :: Maybe Int
MM.postQueryPerPage = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
pageAmount
                      , postQueryBefore :: Maybe PostId
MM.postQueryBefore = Maybe PostId
sndOldestId
                      }
            addTrailingGap :: Bool
addTrailingGap = PostQuery -> Maybe PostId
MM.postQueryBefore PostQuery
query Maybe PostId -> Maybe PostId -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe PostId
forall a. Maybe a
Nothing Bool -> Bool -> Bool
&&
                             PostQuery -> Maybe Int
MM.postQueryPage PostQuery
query Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0
        in DoAsyncChannelMM Posts
forall a. DoAsyncChannelMM a
doAsyncChannelMM AsyncPriority
Preempt ChannelId
cId
               (\Session
s ChannelId
c -> ChannelId -> PostQuery -> Session -> IO Posts
MM.mmGetPostsForChannel ChannelId
c PostQuery
query Session
s)
               (\ChannelId
c Posts
p -> MH () -> Maybe (MH ())
forall a. a -> Maybe a
Just (MH () -> Maybe (MH ())) -> MH () -> Maybe (MH ())
forall a b. (a -> b) -> a -> b
$ do
                   PostProcessMessageAdd
pp <- ChannelId -> Int -> Bool -> Posts -> MH PostProcessMessageAdd
addObtainedMessages ChannelId
c (-Int
pageAmount) Bool
addTrailingGap Posts
p
                   PostProcessMessageAdd -> MH ()
postProcessMessageAdd PostProcessMessageAdd
pp
                   EventM Name () -> MH ()
forall a. EventM Name a -> MH a
mh (EventM Name () -> MH ()) -> EventM Name () -> MH ()
forall a b. (a -> b) -> a -> b
$ Name -> EventM Name ()
forall n. Ord n => n -> EventM n ()
invalidateCacheEntry (ChannelId -> Name
ChannelMessages ChannelId
cId))


-- | Given a starting point and a direction to move from that point,
-- returns the closest two adjacent messages on that direction (as a
-- tuple of closest and next-closest), or Nothing if there are no
-- adjacent messages in the indicated direction.
getTwoContiguousPosts :: SeqDirection dir =>
                         Maybe Message
                      -> DirectionalSeq dir Message
                      -> Maybe (Message, Message)
getTwoContiguousPosts :: Maybe Message
-> DirectionalSeq dir Message -> Maybe (Message, Message)
getTwoContiguousPosts Maybe Message
startMsg DirectionalSeq dir Message
msgs =
  let go :: Maybe Message -> Maybe (Message, Message)
go Maybe Message
start =
        do Message
anchor <- Maybe MessageId -> DirectionalSeq dir Message -> Maybe Message
forall dir.
SeqDirection dir =>
Maybe MessageId -> DirectionalSeq dir Message -> Maybe Message
getRelMessageId (Message -> Maybe MessageId
_mMessageId (Message -> Maybe MessageId) -> Maybe Message -> Maybe MessageId
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Message
start) DirectionalSeq dir Message
msgs
           Message
hinge <- Maybe MessageId -> DirectionalSeq dir Message -> Maybe Message
forall dir.
SeqDirection dir =>
Maybe MessageId -> DirectionalSeq dir Message -> Maybe Message
getRelMessageId (Message
anchorMessage
-> Getting (Maybe MessageId) Message (Maybe MessageId)
-> Maybe MessageId
forall s a. s -> Getting a s a -> a
^.Getting (Maybe MessageId) Message (Maybe MessageId)
Lens' Message (Maybe MessageId)
mMessageId) DirectionalSeq dir Message
msgs
           if Message -> Bool
isGap Message
anchor Bool -> Bool -> Bool
|| Message -> Bool
isGap Message
hinge
             then Maybe Message -> Maybe (Message, Message)
go (Maybe Message -> Maybe (Message, Message))
-> Maybe Message -> Maybe (Message, Message)
forall a b. (a -> b) -> a -> b
$ Message -> Maybe Message
forall a. a -> Maybe a
Just Message
anchor
             else (Message, Message) -> Maybe (Message, Message)
forall a. a -> Maybe a
Just (Message
anchor, Message
hinge)
  in Maybe Message -> Maybe (Message, Message)
go Maybe Message
startMsg


asyncFetchMessagesForGap :: ChannelId -> Message -> MH ()
asyncFetchMessagesForGap :: ChannelId -> Message -> MH ()
asyncFetchMessagesForGap ChannelId
cId Message
gapMessage =
  Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Message -> Bool
isGap Message
gapMessage) (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$
  ChannelId -> (ClientChannel -> MH ()) -> MH ()
withChannel ChannelId
cId ((ClientChannel -> MH ()) -> MH ())
-> (ClientChannel -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \ClientChannel
chan ->
    let offset :: Int
offset = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Messages -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (ClientChannel
chanClientChannel
-> Getting Messages ClientChannel Messages -> Messages
forall s a. s -> Getting a s a -> a
^.(ChannelContents -> Const Messages ChannelContents)
-> ClientChannel -> Const Messages ClientChannel
Lens' ClientChannel ChannelContents
ccContents((ChannelContents -> Const Messages ChannelContents)
 -> ClientChannel -> Const Messages ClientChannel)
-> ((Messages -> Const Messages Messages)
    -> ChannelContents -> Const Messages ChannelContents)
-> Getting Messages ClientChannel Messages
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Const Messages Messages)
-> ChannelContents -> Const Messages ChannelContents
Lens' ChannelContents Messages
cdMessages) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2
        page :: Int
page = Int
offset Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
pageAmount
        chanMsgs :: Messages
chanMsgs = ClientChannel
chanClientChannel
-> Getting Messages ClientChannel Messages -> Messages
forall s a. s -> Getting a s a -> a
^.(ChannelContents -> Const Messages ChannelContents)
-> ClientChannel -> Const Messages ClientChannel
Lens' ClientChannel ChannelContents
ccContents((ChannelContents -> Const Messages ChannelContents)
 -> ClientChannel -> Const Messages ClientChannel)
-> ((Messages -> Const Messages Messages)
    -> ChannelContents -> Const Messages ChannelContents)
-> Getting Messages ClientChannel Messages
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Const Messages Messages)
-> ChannelContents -> Const Messages ChannelContents
Lens' ChannelContents Messages
cdMessages
        fromMsg :: Maybe Message
fromMsg = Message -> Maybe Message
forall a. a -> Maybe a
Just Message
gapMessage
        fetchNewer :: Bool
fetchNewer = case Message
gapMessageMessage -> Getting MessageType Message MessageType -> MessageType
forall s a. s -> Getting a s a -> a
^.Getting MessageType Message MessageType
Lens' Message MessageType
mType of
                       C ClientMessageType
UnknownGapAfter -> Bool
True
                       C ClientMessageType
UnknownGapBefore -> Bool
False
                       MessageType
_ -> String -> Bool
forall a. HasCallStack => String -> a
error String
"fetch gap messages: unknown gap message type"
        baseId :: Maybe PostId
baseId = Message -> Maybe PostId
messagePostId (Message -> Maybe PostId)
-> ((Message, Message) -> Message)
-> (Message, Message)
-> Maybe PostId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Message, Message) -> Message
forall a b. (a, b) -> b
snd ((Message, Message) -> Maybe PostId)
-> Maybe (Message, Message) -> Maybe PostId
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
                 case Message
gapMessageMessage -> Getting MessageType Message MessageType -> MessageType
forall s a. s -> Getting a s a -> a
^.Getting MessageType Message MessageType
Lens' Message MessageType
mType of
                    C ClientMessageType
UnknownGapAfter -> Maybe Message -> RetrogradeMessages -> Maybe (Message, Message)
forall dir.
SeqDirection dir =>
Maybe Message
-> DirectionalSeq dir Message -> Maybe (Message, Message)
getTwoContiguousPosts Maybe Message
fromMsg (RetrogradeMessages -> Maybe (Message, Message))
-> RetrogradeMessages -> Maybe (Message, Message)
forall a b. (a -> b) -> a -> b
$
                                         Messages -> RetrogradeMessages
reverseMessages Messages
chanMsgs
                    C ClientMessageType
UnknownGapBefore -> Maybe Message -> Messages -> Maybe (Message, Message)
forall dir.
SeqDirection dir =>
Maybe Message
-> DirectionalSeq dir Message -> Maybe (Message, Message)
getTwoContiguousPosts Maybe Message
fromMsg Messages
chanMsgs
                    MessageType
_ -> String -> Maybe (Message, Message)
forall a. HasCallStack => String -> a
error String
"fetch gap messages: unknown gap message type"
        query :: PostQuery
query = PostQuery
MM.defaultPostQuery
                { postQueryPage :: Maybe Int
MM.postQueryPage = Maybe Int -> (PostId -> Maybe Int) -> Maybe PostId -> Maybe Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
page) (Maybe Int -> PostId -> Maybe Int
forall a b. a -> b -> a
const Maybe Int
forall a. Maybe a
Nothing) Maybe PostId
baseId
                , postQueryPerPage :: Maybe Int
MM.postQueryPerPage = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
pageAmount
                , postQueryBefore :: Maybe PostId
MM.postQueryBefore = if Bool
fetchNewer then Maybe PostId
forall a. Maybe a
Nothing else Maybe PostId
baseId
                , postQueryAfter :: Maybe PostId
MM.postQueryAfter = if Bool
fetchNewer then Maybe PostId
baseId else Maybe PostId
forall a. Maybe a
Nothing
                }
        addTrailingGap :: Bool
addTrailingGap = PostQuery -> Maybe PostId
MM.postQueryBefore PostQuery
query Maybe PostId -> Maybe PostId -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe PostId
forall a. Maybe a
Nothing Bool -> Bool -> Bool
&&
                         PostQuery -> Maybe Int
MM.postQueryPage PostQuery
query Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0
    in DoAsyncChannelMM Posts
forall a. DoAsyncChannelMM a
doAsyncChannelMM AsyncPriority
Preempt ChannelId
cId
       (\Session
s ChannelId
c -> ChannelId -> PostQuery -> Session -> IO Posts
MM.mmGetPostsForChannel ChannelId
c PostQuery
query Session
s)
       (\ChannelId
c Posts
p -> MH () -> Maybe (MH ())
forall a. a -> Maybe a
Just (MH () -> Maybe (MH ())) -> MH () -> Maybe (MH ())
forall a b. (a -> b) -> a -> b
$ do
           MH PostProcessMessageAdd -> MH ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (MH PostProcessMessageAdd -> MH ())
-> MH PostProcessMessageAdd -> MH ()
forall a b. (a -> b) -> a -> b
$ ChannelId -> Int -> Bool -> Posts -> MH PostProcessMessageAdd
addObtainedMessages ChannelId
c (-Int
pageAmount) Bool
addTrailingGap Posts
p
           EventM Name () -> MH ()
forall a. EventM Name a -> MH a
mh (EventM Name () -> MH ()) -> EventM Name () -> MH ()
forall a b. (a -> b) -> a -> b
$ Name -> EventM Name ()
forall n. Ord n => n -> EventM n ()
invalidateCacheEntry (ChannelId -> Name
ChannelMessages ChannelId
cId))

-- | Given a particular message ID, this fetches n messages before and
-- after immediately before and after the specified message in order
-- to establish some context for that message.  This is frequently
-- used as a background operation when looking at search or flag
-- results so that jumping to message select mode for one of those
-- messages will show a bit of context (and it also prevents showing
-- gap messages for adjacent targets).
--
-- The result will be adding at most 2n messages to the channel, with
-- the input post ID being somewhere in the middle of the added
-- messages.
--
-- Note that this fetch will add messages to the channel, but it
-- performs no notifications or updates of new-unread indicators
-- because it is assumed to be used for non-current (previously-seen)
-- messages in background mode.
asyncFetchMessagesSurrounding :: ChannelId -> PostId -> MH ()
asyncFetchMessagesSurrounding :: ChannelId -> PostId -> MH ()
asyncFetchMessagesSurrounding ChannelId
cId PostId
pId = do
    let query :: PostQuery
query = PostQuery
MM.defaultPostQuery
          { postQueryBefore :: Maybe PostId
MM.postQueryBefore = PostId -> Maybe PostId
forall a. a -> Maybe a
Just PostId
pId
          , postQueryPerPage :: Maybe Int
MM.postQueryPerPage = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
reqAmt
          }
        reqAmt :: Int
reqAmt = Int
5  -- both before and after
    DoAsyncChannelMM Posts
forall a. DoAsyncChannelMM a
doAsyncChannelMM AsyncPriority
Preempt ChannelId
cId
      -- first get some messages before the target, no overlap
      (\Session
s ChannelId
c -> ChannelId -> PostQuery -> Session -> IO Posts
MM.mmGetPostsForChannel ChannelId
c PostQuery
query Session
s)
      (\ChannelId
c Posts
p -> MH () -> Maybe (MH ())
forall a. a -> Maybe a
Just (MH () -> Maybe (MH ())) -> MH () -> Maybe (MH ())
forall a b. (a -> b) -> a -> b
$ do
          let last2ndId :: Maybe PostId
last2ndId = Posts -> Maybe PostId
secondToLastPostId Posts
p
          MH PostProcessMessageAdd -> MH ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (MH PostProcessMessageAdd -> MH ())
-> MH PostProcessMessageAdd -> MH ()
forall a b. (a -> b) -> a -> b
$ ChannelId -> Int -> Bool -> Posts -> MH PostProcessMessageAdd
addObtainedMessages ChannelId
c (-Int
reqAmt) Bool
False Posts
p
          EventM Name () -> MH ()
forall a. EventM Name a -> MH a
mh (EventM Name () -> MH ()) -> EventM Name () -> MH ()
forall a b. (a -> b) -> a -> b
$ Name -> EventM Name ()
forall n. Ord n => n -> EventM n ()
invalidateCacheEntry (ChannelId -> Name
ChannelMessages ChannelId
cId)
          -- now start 2nd from end of this fetch to fetch some
          -- messages forward, also overlapping with this fetch and
          -- the original message ID to eliminate all gaps in this
          -- surrounding set of messages.
          let query' :: PostQuery
query' = PostQuery
MM.defaultPostQuery
                       { postQueryAfter :: Maybe PostId
MM.postQueryAfter = Maybe PostId
last2ndId
                       , postQueryPerPage :: Maybe Int
MM.postQueryPerPage = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int
reqAmt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2
                       }
          DoAsyncChannelMM Posts
forall a. DoAsyncChannelMM a
doAsyncChannelMM AsyncPriority
Preempt ChannelId
cId
            (\Session
s' ChannelId
c' -> ChannelId -> PostQuery -> Session -> IO Posts
MM.mmGetPostsForChannel ChannelId
c' PostQuery
query' Session
s')
            (\ChannelId
c' Posts
p' -> MH () -> Maybe (MH ())
forall a. a -> Maybe a
Just (MH () -> Maybe (MH ())) -> MH () -> Maybe (MH ())
forall a b. (a -> b) -> a -> b
$ do
                MH PostProcessMessageAdd -> MH ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (MH PostProcessMessageAdd -> MH ())
-> MH PostProcessMessageAdd -> MH ()
forall a b. (a -> b) -> a -> b
$ ChannelId -> Int -> Bool -> Posts -> MH PostProcessMessageAdd
addObtainedMessages ChannelId
c' (Int
reqAmt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Bool
False Posts
p'
                EventM Name () -> MH ()
forall a. EventM Name a -> MH a
mh (EventM Name () -> MH ()) -> EventM Name () -> MH ()
forall a b. (a -> b) -> a -> b
$ Name -> EventM Name ()
forall n. Ord n => n -> EventM n ()
invalidateCacheEntry (ChannelId -> Name
ChannelMessages ChannelId
cId)
            )
      )
      where secondToLastPostId :: Posts -> Maybe PostId
secondToLastPostId Posts
posts =
              let pl :: [PostId]
pl = Seq PostId -> [PostId]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq PostId -> [PostId]) -> Seq PostId -> [PostId]
forall a b. (a -> b) -> a -> b
$ Posts -> Seq PostId
postsOrder Posts
posts
              in if [PostId] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PostId]
pl Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 then PostId -> Maybe PostId
forall a. a -> Maybe a
Just (PostId -> Maybe PostId) -> PostId -> Maybe PostId
forall a b. (a -> b) -> a -> b
$ [PostId] -> PostId
forall a. [a] -> a
last ([PostId] -> PostId) -> [PostId] -> PostId
forall a b. (a -> b) -> a -> b
$ [PostId] -> [PostId]
forall a. [a] -> [a]
init [PostId]
pl else Maybe PostId
forall a. Maybe a
Nothing


fetchVisibleIfNeeded :: MH ()
fetchVisibleIfNeeded :: MH ()
fetchVisibleIfNeeded = do
    ConnectionStatus
sts <- Getting ConnectionStatus ChatState ConnectionStatus
-> MH ConnectionStatus
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting ConnectionStatus ChatState ConnectionStatus
Lens' ChatState ConnectionStatus
csConnectionStatus
    Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ConnectionStatus
sts ConnectionStatus -> ConnectionStatus -> Bool
forall a. Eq a => a -> a -> Bool
== ConnectionStatus
Connected) (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ do
        TeamId
tId <- Getting TeamId ChatState TeamId -> MH TeamId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting TeamId ChatState TeamId
SimpleGetter ChatState TeamId
csCurrentTeamId
        ChannelId
cId <- Getting ChannelId ChatState ChannelId -> MH ChannelId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> SimpleGetter ChatState ChannelId
csCurrentChannelId TeamId
tId)
        ChannelId -> (ClientChannel -> MH ()) -> MH ()
withChannel ChannelId
cId ((ClientChannel -> MH ()) -> MH ())
-> (ClientChannel -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \ClientChannel
chan ->
            let msgs :: RetrogradeMessages
msgs = ClientChannel
chanClientChannel
-> Getting RetrogradeMessages ClientChannel RetrogradeMessages
-> RetrogradeMessages
forall s a. s -> Getting a s a -> a
^.(ChannelContents -> Const RetrogradeMessages ChannelContents)
-> ClientChannel -> Const RetrogradeMessages ClientChannel
Lens' ClientChannel ChannelContents
ccContents((ChannelContents -> Const RetrogradeMessages ChannelContents)
 -> ClientChannel -> Const RetrogradeMessages ClientChannel)
-> ((RetrogradeMessages
     -> Const RetrogradeMessages RetrogradeMessages)
    -> ChannelContents -> Const RetrogradeMessages ChannelContents)
-> Getting RetrogradeMessages ClientChannel RetrogradeMessages
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Const RetrogradeMessages Messages)
-> ChannelContents -> Const RetrogradeMessages ChannelContents
Lens' ChannelContents Messages
cdMessages((Messages -> Const RetrogradeMessages Messages)
 -> ChannelContents -> Const RetrogradeMessages ChannelContents)
-> ((RetrogradeMessages
     -> Const RetrogradeMessages RetrogradeMessages)
    -> Messages -> Const RetrogradeMessages Messages)
-> (RetrogradeMessages
    -> Const RetrogradeMessages RetrogradeMessages)
-> ChannelContents
-> Const RetrogradeMessages ChannelContents
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> RetrogradeMessages)
-> SimpleGetter Messages RetrogradeMessages
forall s a. (s -> a) -> SimpleGetter s a
to Messages -> RetrogradeMessages
reverseMessages
                (Int
numRemaining, Bool
gapInDisplayable, Maybe MessageId
_, Maybe MessageId
rel'pId, Int
overlap) =
                    ((Int, Bool, Maybe MessageId, Maybe MessageId, Int)
 -> Message -> (Int, Bool, Maybe MessageId, Maybe MessageId, Int))
-> (Int, Bool, Maybe MessageId, Maybe MessageId, Int)
-> RetrogradeMessages
-> (Int, Bool, Maybe MessageId, Maybe MessageId, Int)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (Int, Bool, Maybe MessageId, Maybe MessageId, Int)
-> Message -> (Int, Bool, Maybe MessageId, Maybe MessageId, Int)
forall a a.
(Eq a, Num a, Num a) =>
(a, Bool, Maybe MessageId, Maybe MessageId, a)
-> Message -> (a, Bool, Maybe MessageId, Maybe MessageId, a)
gapTrail (Int
numScrollbackPosts, Bool
False, Maybe MessageId
forall a. Maybe a
Nothing, Maybe MessageId
forall a. Maybe a
Nothing, Int
2) RetrogradeMessages
msgs
                gapTrail :: (a, Bool, Maybe MessageId, Maybe MessageId, a)
-> Message -> (a, Bool, Maybe MessageId, Maybe MessageId, a)
gapTrail a :: (a, Bool, Maybe MessageId, Maybe MessageId, a)
a@(a
_,  Bool
True, Maybe MessageId
_, Maybe MessageId
_, a
_) Message
_ = (a, Bool, Maybe MessageId, Maybe MessageId, a)
a
                gapTrail a :: (a, Bool, Maybe MessageId, Maybe MessageId, a)
a@(a
0,     Bool
_, Maybe MessageId
_, Maybe MessageId
_, a
_) Message
_ = (a, Bool, Maybe MessageId, Maybe MessageId, a)
a
                gapTrail   (a
a, Bool
False, Maybe MessageId
b, Maybe MessageId
c, a
d) Message
m | Message -> Bool
isGap Message
m = (a
a, Bool
True, Maybe MessageId
b, Maybe MessageId
c, a
d)
                gapTrail (a
remCnt, Bool
_, Maybe MessageId
prev'pId, Maybe MessageId
prev''pId, a
ovl) Message
msg =
                    (a
remCnt a -> a -> a
forall a. Num a => a -> a -> a
- a
1, Bool
False, Message
msgMessage
-> Getting (Maybe MessageId) Message (Maybe MessageId)
-> Maybe MessageId
forall s a. s -> Getting a s a -> a
^.Getting (Maybe MessageId) Message (Maybe MessageId)
Lens' Message (Maybe MessageId)
mMessageId Maybe MessageId -> Maybe MessageId -> Maybe MessageId
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe MessageId
prev'pId, Maybe MessageId
prev'pId Maybe MessageId -> Maybe MessageId -> Maybe MessageId
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe MessageId
prev''pId,
                     a
ovl a -> a -> a
forall a. Num a => a -> a -> a
+ if Bool -> Bool
not (Message -> Bool
isPostMessage Message
msg) then a
1 else a
0)
                numToReq :: Int
numToReq = Int
numRemaining Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
overlap
                query :: PostQuery
query = PostQuery
MM.defaultPostQuery
                        { postQueryPage :: Maybe Int
MM.postQueryPage    = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0
                        , postQueryPerPage :: Maybe Int
MM.postQueryPerPage = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
numToReq
                        }
                finalQuery :: PostQuery
finalQuery = case Maybe MessageId
rel'pId of
                               Just (MessagePostId PostId
pid) -> PostQuery
query { postQueryBefore :: Maybe PostId
MM.postQueryBefore = PostId -> Maybe PostId
forall a. a -> Maybe a
Just PostId
pid }
                               Maybe MessageId
_ -> PostQuery
query
                op :: Session -> ChannelId -> IO Posts
op = \Session
s ChannelId
c -> ChannelId -> PostQuery -> Session -> IO Posts
MM.mmGetPostsForChannel ChannelId
c PostQuery
finalQuery Session
s
                addTrailingGap :: Bool
addTrailingGap = PostQuery -> Maybe PostId
MM.postQueryBefore PostQuery
finalQuery Maybe PostId -> Maybe PostId -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe PostId
forall a. Maybe a
Nothing Bool -> Bool -> Bool
&&
                                 PostQuery -> Maybe Int
MM.postQueryPage PostQuery
finalQuery Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0
            in Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ClientChannel
chanClientChannel -> Getting Bool ClientChannel Bool -> Bool
forall s a. s -> Getting a s a -> a
^.(ChannelContents -> Const Bool ChannelContents)
-> ClientChannel -> Const Bool ClientChannel
Lens' ClientChannel ChannelContents
ccContents((ChannelContents -> Const Bool ChannelContents)
 -> ClientChannel -> Const Bool ClientChannel)
-> ((Bool -> Const Bool Bool)
    -> ChannelContents -> Const Bool ChannelContents)
-> Getting Bool ClientChannel Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Const Bool Bool)
-> ChannelContents -> Const Bool ChannelContents
Lens' ChannelContents Bool
cdFetchPending) Bool -> Bool -> Bool
&& Bool
gapInDisplayable) (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ do
                      ChannelId -> Traversal' ChatState ClientChannel
csChannel(ChannelId
cId)((ClientChannel -> Identity ClientChannel)
 -> ChatState -> Identity ChatState)
-> ((Bool -> Identity Bool)
    -> ClientChannel -> Identity ClientChannel)
-> (Bool -> Identity Bool)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChannelContents -> Identity ChannelContents)
-> ClientChannel -> Identity ClientChannel
Lens' ClientChannel ChannelContents
ccContents((ChannelContents -> Identity ChannelContents)
 -> ClientChannel -> Identity ClientChannel)
-> ((Bool -> Identity Bool)
    -> ChannelContents -> Identity ChannelContents)
-> (Bool -> Identity Bool)
-> ClientChannel
-> Identity ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Identity Bool)
-> ChannelContents -> Identity ChannelContents
Lens' ChannelContents Bool
cdFetchPending ((Bool -> Identity Bool) -> ChatState -> Identity ChatState)
-> Bool -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
                      DoAsyncChannelMM Posts
forall a. DoAsyncChannelMM a
doAsyncChannelMM AsyncPriority
Preempt ChannelId
cId Session -> ChannelId -> IO Posts
op
                          (\ChannelId
c Posts
p -> MH () -> Maybe (MH ())
forall a. a -> Maybe a
Just (MH () -> Maybe (MH ())) -> MH () -> Maybe (MH ())
forall a b. (a -> b) -> a -> b
$ do
                              ChannelId -> Int -> Bool -> Posts -> MH PostProcessMessageAdd
addObtainedMessages ChannelId
c (-Int
numToReq) Bool
addTrailingGap Posts
p MH PostProcessMessageAdd
-> (PostProcessMessageAdd -> MH ()) -> MH ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PostProcessMessageAdd -> MH ()
postProcessMessageAdd
                              ChannelId -> Traversal' ChatState ClientChannel
csChannel(ChannelId
c)((ClientChannel -> Identity ClientChannel)
 -> ChatState -> Identity ChatState)
-> ((Bool -> Identity Bool)
    -> ClientChannel -> Identity ClientChannel)
-> (Bool -> Identity Bool)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChannelContents -> Identity ChannelContents)
-> ClientChannel -> Identity ClientChannel
Lens' ClientChannel ChannelContents
ccContents((ChannelContents -> Identity ChannelContents)
 -> ClientChannel -> Identity ClientChannel)
-> ((Bool -> Identity Bool)
    -> ChannelContents -> Identity ChannelContents)
-> (Bool -> Identity Bool)
-> ClientChannel
-> Identity ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Identity Bool)
-> ChannelContents -> Identity ChannelContents
Lens' ChannelContents Bool
cdFetchPending ((Bool -> Identity Bool) -> ChatState -> Identity ChatState)
-> Bool -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
False)

asyncFetchAttachments :: Post -> MH ()
asyncFetchAttachments :: Post -> MH ()
asyncFetchAttachments Post
p = do
    let cId :: ChannelId
cId = Post
pPost -> Getting ChannelId Post ChannelId -> ChannelId
forall s a. s -> Getting a s a -> a
^.Getting ChannelId Post ChannelId
Lens' Post ChannelId
postChannelIdL
        pId :: PostId
pId = Post
pPost -> Getting PostId Post PostId -> PostId
forall s a. s -> Getting a s a -> a
^.Getting PostId Post PostId
Lens' Post PostId
postIdL
    Session
session <- MH Session
getSession
    Text
host <- Getting Text ChatState Text -> MH Text
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((ChatResources -> Const Text ChatResources)
-> ChatState -> Const Text ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Const Text ChatResources)
 -> ChatState -> Const Text ChatState)
-> ((Text -> Const Text Text)
    -> ChatResources -> Const Text ChatResources)
-> Getting Text ChatState Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ConnectionData -> Const Text ConnectionData)
-> ChatResources -> Const Text ChatResources
Lens' ChatResources ConnectionData
crConn((ConnectionData -> Const Text ConnectionData)
 -> ChatResources -> Const Text ChatResources)
-> ((Text -> Const Text Text)
    -> ConnectionData -> Const Text ConnectionData)
-> (Text -> Const Text Text)
-> ChatResources
-> Const Text ChatResources
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Text -> Const Text Text)
-> ConnectionData -> Const Text ConnectionData
Lens' ConnectionData Text
cdHostnameL)
    Seq FileId -> (FileId -> MH ()) -> MH ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
F.forM_ (Post
pPost -> Getting (Seq FileId) Post (Seq FileId) -> Seq FileId
forall s a. s -> Getting a s a -> a
^.Getting (Seq FileId) Post (Seq FileId)
Lens' Post (Seq FileId)
postFileIdsL) ((FileId -> MH ()) -> MH ()) -> (FileId -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \FileId
fId -> AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Normal (IO (Maybe (MH ())) -> MH ()) -> IO (Maybe (MH ())) -> MH ()
forall a b. (a -> b) -> a -> b
$ do
        FileInfo
info <- FileId -> Session -> IO FileInfo
MM.mmGetMetadataForFile FileId
fId Session
session
        let scheme :: Text
scheme = Text
"https://"
            attUrl :: Text
attUrl = Text
scheme Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
host Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FileId -> Text
urlForFile FileId
fId
            attachment :: Attachment
attachment = Text -> Text -> FileId -> Attachment
mkAttachment (FileInfo -> Text
fileInfoName FileInfo
info) Text
attUrl FileId
fId
            addIfMissing :: a -> Seq a -> Seq a
addIfMissing a
a Seq a
as =
                if Maybe Int -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe Int -> Bool) -> Maybe Int -> Bool
forall a b. (a -> b) -> a -> b
$ a -> Seq a -> Maybe Int
forall a. Eq a => a -> Seq a -> Maybe Int
Seq.elemIndexL a
a Seq a
as
                then a
a a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
Seq.<| Seq a
as
                else Seq a
as
            addAttachment :: Message -> Message
addAttachment Message
m
                | Message
mMessage
-> Getting (Maybe MessageId) Message (Maybe MessageId)
-> Maybe MessageId
forall s a. s -> Getting a s a -> a
^.Getting (Maybe MessageId) Message (Maybe MessageId)
Lens' Message (Maybe MessageId)
mMessageId Maybe MessageId -> Maybe MessageId -> Bool
forall a. Eq a => a -> a -> Bool
== MessageId -> Maybe MessageId
forall a. a -> Maybe a
Just (PostId -> MessageId
MessagePostId PostId
pId) =
                    Message
m Message -> (Message -> Message) -> Message
forall a b. a -> (a -> b) -> b
& (Seq Attachment -> Identity (Seq Attachment))
-> Message -> Identity Message
Lens' Message (Seq Attachment)
mAttachments ((Seq Attachment -> Identity (Seq Attachment))
 -> Message -> Identity Message)
-> (Seq Attachment -> Seq Attachment) -> Message -> Message
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Attachment -> Seq Attachment -> Seq Attachment
forall a. Eq a => a -> Seq a -> Seq a
addIfMissing Attachment
attachment)
                | Bool
otherwise =
                    Message
m
        Maybe (MH ()) -> IO (Maybe (MH ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MH ()) -> IO (Maybe (MH ())))
-> Maybe (MH ()) -> IO (Maybe (MH ()))
forall a b. (a -> b) -> a -> b
$ MH () -> Maybe (MH ())
forall a. a -> Maybe a
Just (MH () -> Maybe (MH ())) -> MH () -> Maybe (MH ())
forall a b. (a -> b) -> a -> b
$ do
            ChannelId -> Traversal' ChatState ClientChannel
csChannel(ChannelId
cId)((ClientChannel -> Identity ClientChannel)
 -> ChatState -> Identity ChatState)
-> ((Message -> Identity Message)
    -> ClientChannel -> Identity ClientChannel)
-> (Message -> Identity Message)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChannelContents -> Identity ChannelContents)
-> ClientChannel -> Identity ClientChannel
Lens' ClientChannel ChannelContents
ccContents((ChannelContents -> Identity ChannelContents)
 -> ClientChannel -> Identity ClientChannel)
-> ((Message -> Identity Message)
    -> ChannelContents -> Identity ChannelContents)
-> (Message -> Identity Message)
-> ClientChannel
-> Identity ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Identity Messages)
-> ChannelContents -> Identity ChannelContents
Lens' ChannelContents Messages
cdMessages((Messages -> Identity Messages)
 -> ChannelContents -> Identity ChannelContents)
-> ((Message -> Identity Message) -> Messages -> Identity Messages)
-> (Message -> Identity Message)
-> ChannelContents
-> Identity ChannelContents
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Message -> Identity Message) -> Messages -> Identity Messages
forall (f :: * -> *) a b.
Traversable f =>
Traversal (f a) (f b) a b
traversed ((Message -> Identity Message) -> ChatState -> Identity ChatState)
-> (Message -> Message) -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Message -> Message
addAttachment
            EventM Name () -> MH ()
forall a. EventM Name a -> MH a
mh (EventM Name () -> MH ()) -> EventM Name () -> MH ()
forall a b. (a -> b) -> a -> b
$ Name -> EventM Name ()
forall n. Ord n => n -> EventM n ()
invalidateCacheEntry (Name -> EventM Name ()) -> Name -> EventM Name ()
forall a b. (a -> b) -> a -> b
$ ChannelId -> Name
ChannelMessages ChannelId
cId

-- | Given a post ID, switch to that post's channel and select the post
-- in message selection mode.
--
-- This function will do what it can to honor the request even when we
-- don't know about the post because it hasn't been fetched, or when
-- the post is in a channel that we aren't a member of. In each case a
-- reasonable effort will be made (fetch the post, join the channel)
-- before giving up.
jumpToPost :: PostId -> MH ()
jumpToPost :: PostId -> MH ()
jumpToPost PostId
pId = do
    ChatState
st <- Getting ChatState ChatState ChatState -> MH ChatState
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting ChatState ChatState ChatState
forall a. a -> a
id
    case ChatState -> PostId -> Maybe Message
getMessageForPostId ChatState
st PostId
pId of
      Just Message
msg ->
        case Message
msg Message
-> Getting (Maybe ChannelId) Message (Maybe ChannelId)
-> Maybe ChannelId
forall s a. s -> Getting a s a -> a
^. Getting (Maybe ChannelId) Message (Maybe ChannelId)
Lens' Message (Maybe ChannelId)
mChannelId of
          Just ChannelId
cId -> do
              -- Are we a member of the channel?
              case ChannelId -> ClientChannels -> Maybe ClientChannel
findChannelById ChannelId
cId (ChatState
stChatState
-> Getting ClientChannels ChatState ClientChannels
-> ClientChannels
forall s a. s -> Getting a s a -> a
^.Getting ClientChannels ChatState ClientChannels
Lens' ChatState ClientChannels
csChannels) of
                  Maybe ClientChannel
Nothing ->
                      ChannelId -> Maybe (MH ()) -> MH ()
joinChannel' ChannelId
cId (MH () -> Maybe (MH ())
forall a. a -> Maybe a
Just (MH () -> Maybe (MH ())) -> MH () -> Maybe (MH ())
forall a b. (a -> b) -> a -> b
$ PostId -> MH ()
jumpToPost PostId
pId)
                  Just ClientChannel
_ -> do
                      ChannelId -> MH ()
setFocus ChannelId
cId
                      Mode -> MH ()
setMode Mode
MessageSelect
                      (TeamState -> Identity TeamState)
-> ChatState -> Identity ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Identity TeamState)
 -> ChatState -> Identity ChatState)
-> ((MessageSelectState -> Identity MessageSelectState)
    -> TeamState -> Identity TeamState)
-> (MessageSelectState -> Identity MessageSelectState)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MessageSelectState -> Identity MessageSelectState)
-> TeamState -> Identity TeamState
Lens' TeamState MessageSelectState
tsMessageSelect ((MessageSelectState -> Identity MessageSelectState)
 -> ChatState -> Identity ChatState)
-> MessageSelectState -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe MessageId -> MessageSelectState
MessageSelectState (Message
msgMessage
-> Getting (Maybe MessageId) Message (Maybe MessageId)
-> Maybe MessageId
forall s a. s -> Getting a s a -> a
^.Getting (Maybe MessageId) Message (Maybe MessageId)
Lens' Message (Maybe MessageId)
mMessageId)
          Maybe ChannelId
Nothing ->
            String -> MH ()
forall a. HasCallStack => String -> a
error String
"INTERNAL: selected Post ID not associated with a channel"
      Maybe Message
Nothing -> do
          Session
session <- MH Session
getSession
          AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Preempt (IO (Maybe (MH ())) -> MH ()) -> IO (Maybe (MH ())) -> MH ()
forall a b. (a -> b) -> a -> b
$ do
              Either SomeException Post
result <- IO Post -> IO (Either SomeException Post)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO Post -> IO (Either SomeException Post))
-> IO Post -> IO (Either SomeException Post)
forall a b. (a -> b) -> a -> b
$ PostId -> Session -> IO Post
MM.mmGetPost PostId
pId Session
session
              Maybe (MH ()) -> IO (Maybe (MH ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MH ()) -> IO (Maybe (MH ())))
-> Maybe (MH ()) -> IO (Maybe (MH ()))
forall a b. (a -> b) -> a -> b
$ MH () -> Maybe (MH ())
forall a. a -> Maybe a
Just (MH () -> Maybe (MH ())) -> MH () -> Maybe (MH ())
forall a b. (a -> b) -> a -> b
$ do
                  case Either SomeException Post
result of
                      Right Post
p -> do
                          -- Are we a member of the channel?
                          case ChannelId -> ClientChannels -> Maybe ClientChannel
findChannelById (Post -> ChannelId
postChannelId Post
p) (ChatState
stChatState
-> Getting ClientChannels ChatState ClientChannels
-> ClientChannels
forall s a. s -> Getting a s a -> a
^.Getting ClientChannels ChatState ClientChannels
Lens' ChatState ClientChannels
csChannels) of
                              -- If not, join it and then try jumping to
                              -- the post if the channel join is successful.
                              Maybe ClientChannel
Nothing -> do
                                  ChannelId -> Maybe (MH ()) -> MH ()
joinChannel' (Post -> ChannelId
postChannelId Post
p) (MH () -> Maybe (MH ())
forall a. a -> Maybe a
Just (MH () -> Maybe (MH ())) -> MH () -> Maybe (MH ())
forall a b. (a -> b) -> a -> b
$ PostId -> MH ()
jumpToPost PostId
pId)
                              -- Otherwise add the post to the state and
                              -- then jump.
                              Just ClientChannel
_ -> do
                                  MH PostProcessMessageAdd -> MH ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (MH PostProcessMessageAdd -> MH ())
-> MH PostProcessMessageAdd -> MH ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> PostToAdd -> MH PostProcessMessageAdd
addMessageToState Bool
True Bool
True (Post -> PostToAdd
OldPost Post
p)
                                  PostId -> MH ()
jumpToPost PostId
pId
                      Left (SomeException
_::SomeException) ->
                          Text -> MH ()
postErrorMessage' Text
"Could not fetch linked post"