{-# LANGUAGE MultiWayIf #-}

module Matterhorn.State.Messages
  ( PostToAdd(..)
  , lastMsg
  , sendMessage
  , editMessage
  , deleteMessage
  , addNewPostedMessage
  , addObtainedMessages
  , asyncFetchMoreMessages
  , asyncFetchMessagesForGap
  , asyncFetchMessagesSurrounding
  , fetchVisibleIfNeeded
  , disconnectChannels
  , toggleMessageTimestamps
  , toggleVerbatimBlockTruncation
  , jumpToPost
  , addMessageToState
  )
where

import           Prelude ()
import           Matterhorn.Prelude

import           Brick.Main ( getVtyHandle, invalidateCache )
import qualified Brick.Widgets.FileBrowser as FB
import           Control.Exception ( SomeException, try )
import qualified Data.Aeson as A
import qualified Data.ByteString.Lazy.Char8 as BL8
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, _Just )

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.ThreadWindow
import           Matterhorn.State.MessageSelect
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
                        ChannelId -> MH ()
invalidateChannelRenderingCache 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

defaultVerbatimTruncateHeight :: Int
defaultVerbatimTruncateHeight :: Int
defaultVerbatimTruncateHeight = Int
25

toggleVerbatimBlockTruncation :: MH ()
toggleVerbatimBlockTruncation :: MH ()
toggleVerbatimBlockTruncation = do
    EventM Name () -> MH ()
forall a. EventM Name a -> MH a
mh EventM Name ()
forall n. Ord n => EventM n ()
invalidateCache
    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
    -- Restore the configured setting, or a default if the configuration
    -- does not specify a setting.
    let toggle :: Maybe a -> Maybe Int
toggle Maybe a
Nothing = (ChatState
stChatState -> Getting (Maybe Int) ChatState (Maybe Int) -> Maybe Int
forall s a. s -> Getting a s a -> a
^.(ChatResources -> Const (Maybe Int) ChatResources)
-> ChatState -> Const (Maybe Int) ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Const (Maybe Int) ChatResources)
 -> ChatState -> Const (Maybe Int) ChatState)
-> ((Maybe Int -> Const (Maybe Int) (Maybe Int))
    -> ChatResources -> Const (Maybe Int) ChatResources)
-> Getting (Maybe Int) ChatState (Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Config -> Const (Maybe Int) Config)
-> ChatResources -> Const (Maybe Int) ChatResources
Lens' ChatResources Config
crConfiguration((Config -> Const (Maybe Int) Config)
 -> ChatResources -> Const (Maybe Int) ChatResources)
-> ((Maybe Int -> Const (Maybe Int) (Maybe Int))
    -> Config -> Const (Maybe Int) Config)
-> (Maybe Int -> Const (Maybe Int) (Maybe Int))
-> ChatResources
-> Const (Maybe Int) ChatResources
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe Int -> Const (Maybe Int) (Maybe Int))
-> Config -> Const (Maybe Int) Config
Lens' Config (Maybe Int)
configTruncateVerbatimBlocksL) Maybe Int -> Maybe Int -> Maybe Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                         Int -> Maybe Int
forall a. a -> Maybe a
Just Int
defaultVerbatimTruncateHeight
        toggle (Just a
_) = Maybe Int
forall a. Maybe a
Nothing
    (Maybe Int -> Identity (Maybe Int))
-> ChatState -> Identity ChatState
Lens' ChatState (Maybe Int)
csVerbatimTruncateSetting ((Maybe Int -> Identity (Maybe Int))
 -> ChatState -> Identity ChatState)
-> (Maybe Int -> Maybe Int) -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Maybe Int -> Maybe Int
forall a. Maybe a -> Maybe Int
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
.(ChannelInfo -> Identity ChannelInfo)
-> ClientChannel -> Identity ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Identity ChannelInfo)
 -> ClientChannel -> Identity ClientChannel)
-> ((Bool -> Identity Bool) -> ChannelInfo -> Identity ChannelInfo)
-> (Bool -> Identity Bool)
-> ClientChannel
-> Identity ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Identity Bool) -> ChannelInfo -> Identity ChannelInfo
Lens' ChannelInfo 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
^.(MessageInterface Name ()
 -> Const (Maybe Message) (MessageInterface Name ()))
-> ClientChannel -> Const (Maybe Message) ClientChannel
Lens' ClientChannel (MessageInterface Name ())
ccMessageInterface((MessageInterface Name ()
  -> Const (Maybe Message) (MessageInterface Name ()))
 -> ClientChannel -> Const (Maybe Message) ClientChannel)
-> ((Maybe Message -> Const (Maybe Message) (Maybe Message))
    -> MessageInterface Name ()
    -> Const (Maybe Message) (MessageInterface Name ()))
-> Getting (Maybe Message) ClientChannel (Maybe Message)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Const (Maybe Message) Messages)
-> MessageInterface Name ()
-> Const (Maybe Message) (MessageInterface Name ())
forall n i. Lens' (MessageInterface n i) Messages
miMessages((Messages -> Const (Maybe Message) Messages)
 -> MessageInterface Name ()
 -> Const (Maybe Message) (MessageInterface Name ()))
-> ((Maybe Message -> Const (Maybe Message) (Maybe Message))
    -> Messages -> Const (Maybe Message) Messages)
-> (Maybe Message -> Const (Maybe Message) (Maybe Message))
-> MessageInterface Name ()
-> Const (Maybe Message) (MessageInterface Name ())
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 ((MessageInterface Name () -> Identity (MessageInterface Name ()))
-> ClientChannel -> Identity ClientChannel
Lens' ClientChannel (MessageInterface Name ())
ccMessageInterface((MessageInterface Name () -> Identity (MessageInterface Name ()))
 -> ClientChannel -> Identity ClientChannel)
-> ((Messages -> Identity Messages)
    -> MessageInterface Name () -> Identity (MessageInterface Name ()))
-> (Messages -> Identity Messages)
-> ClientChannel
-> Identity ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Identity Messages)
-> MessageInterface Name () -> Identity (MessageInterface Name ())
forall n i. Lens' (MessageInterface n i) Messages
miMessages ((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
. (MessageInterface Name () -> Identity (MessageInterface Name ()))
-> ClientChannel -> Identity ClientChannel
Lens' ClientChannel (MessageInterface Name ())
ccMessageInterface((MessageInterface Name () -> Identity (MessageInterface Name ()))
 -> ClientChannel -> Identity ClientChannel)
-> ((Message -> Identity Message)
    -> MessageInterface Name () -> Identity (MessageInterface Name ()))
-> (Message -> Identity Message)
-> ClientChannel
-> Identity ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Identity Messages)
-> MessageInterface Name () -> Identity (MessageInterface Name ())
forall n i. Lens' (MessageInterface n i) Messages
miMessages ((Messages -> Identity Messages)
 -> MessageInterface Name () -> Identity (MessageInterface Name ()))
-> ((Message -> Identity Message) -> Messages -> Identity Messages)
-> (Message -> Identity Message)
-> MessageInterface Name ()
-> Identity (MessageInterface Name ())
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

        ChannelId -> MH ()
invalidateChannelRenderingCache (ChannelId -> MH ()) -> ChannelId -> MH ()
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
        PostId -> MH ()
invalidateMessageRenderingCacheByPostId (PostId -> MH ()) -> PostId -> MH ()
forall a b. (a -> b) -> a -> b
$ Post -> PostId
postId Post
new

        Maybe TeamId -> Post -> Message -> MH ()
editPostInOpenThread Maybe TeamId
mTId Post
new Message
msg

        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
.(MessageInterface Name () -> Identity (MessageInterface Name ()))
-> ClientChannel -> Identity ClientChannel
Lens' ClientChannel (MessageInterface Name ())
ccMessageInterface((MessageInterface Name () -> Identity (MessageInterface Name ()))
 -> ClientChannel -> Identity ClientChannel)
-> ((Message -> Identity Message)
    -> MessageInterface Name () -> Identity (MessageInterface Name ()))
-> (Message -> Identity Message)
-> ClientChannel
-> Identity ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Identity Messages)
-> MessageInterface Name () -> Identity (MessageInterface Name ())
forall n i. Lens' (MessageInterface n i) Messages
miMessages((Messages -> Identity Messages)
 -> MessageInterface Name () -> Identity (MessageInterface Name ()))
-> ((Message -> Identity Message) -> Messages -> Identity Messages)
-> (Message -> Identity Message)
-> MessageInterface Name ()
-> Identity (MessageInterface Name ())
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

    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
ch -> do
        case 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 of
            Maybe TeamId
Nothing -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Just TeamId
tId -> TeamId -> Post -> MH ()
deletePostFromOpenThread TeamId
tId Post
new

    ChannelId -> MH ()
invalidateChannelRenderingCache (ChannelId -> MH ()) -> ChannelId -> MH ()
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
    PostId -> MH ()
invalidateMessageRenderingCacheByPostId (PostId -> MH ()) -> PostId -> MH ()
forall a b. (a -> b) -> a -> b
$ Post -> PostId
postId Post
new

deletePostFromOpenThread :: TeamId -> Post -> MH ()
deletePostFromOpenThread :: TeamId -> Post -> MH ()
deletePostFromOpenThread TeamId
tId Post
p = 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
pPost -> 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
pPost -> Getting PostId Post PostId -> PostId
forall s a. s -> Getting a s a -> a
^.Getting PostId Post PostId
Lens' Post PostId
postIdL) Message
m

    -- If the post being deleted is in the thread, we just need to
    -- remove it from the thread view. But if this effectively empties
    -- the thread, that's because this was the root. In that case we
    -- need to close down the window.
    TeamId -> ChannelId -> (Message -> Bool) -> MH ()
threadInterfaceDeleteWhere TeamId
tId (Post
pPost -> Getting ChannelId Post ChannelId -> ChannelId
forall s a. s -> Getting a s a -> a
^.Getting ChannelId Post ChannelId
Lens' Post ChannelId
postChannelIdL) Message -> Bool
isDeletedMessage

    Maybe ThreadInterface
ti <- Getting (Maybe ThreadInterface) ChatState (Maybe ThreadInterface)
-> MH (Maybe ThreadInterface)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)((TeamState -> Const (Maybe ThreadInterface) TeamState)
 -> ChatState -> Const (Maybe ThreadInterface) ChatState)
-> ((Maybe ThreadInterface
     -> Const (Maybe ThreadInterface) (Maybe ThreadInterface))
    -> TeamState -> Const (Maybe ThreadInterface) TeamState)
-> Getting
     (Maybe ThreadInterface) ChatState (Maybe ThreadInterface)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe ThreadInterface
 -> Const (Maybe ThreadInterface) (Maybe ThreadInterface))
-> TeamState -> Const (Maybe ThreadInterface) TeamState
Lens' TeamState (Maybe ThreadInterface)
tsThreadInterface)
    Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe ThreadInterface -> Bool
forall a. Maybe a -> Bool
isJust Maybe ThreadInterface
ti) (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ do
        Bool
isEmpty <- TeamId -> MH Bool
threadInterfaceEmpty TeamId
tId
        Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isEmpty (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ do
            TeamId -> MH ()
closeThreadWindow TeamId
tId
            Text -> MH ()
postInfoMessage Text
"The thread you were viewing was deleted."

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 = do
  ChannelId -> MH ()
invalidateChannelRenderingCache ChannelId
cId
  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
              ((MessageInterface Name () -> Identity (MessageInterface Name ()))
-> ClientChannel -> Identity ClientChannel
Lens' ClientChannel (MessageInterface Name ())
ccMessageInterface((MessageInterface Name () -> Identity (MessageInterface Name ()))
 -> ClientChannel -> Identity ClientChannel)
-> ((Messages -> Identity Messages)
    -> MessageInterface Name () -> Identity (MessageInterface Name ()))
-> (Messages -> Identity Messages)
-> ClientChannel
-> Identity ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Identity Messages)
-> MessageInterface Name () -> Identity (MessageInterface Name ())
forall n i. Lens' (MessageInterface n i) Messages
miMessages ((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
^.(MessageInterface Name ()
 -> Const Messages (MessageInterface Name ()))
-> ClientChannel -> Const Messages ClientChannel
Lens' ClientChannel (MessageInterface Name ())
ccMessageInterface((MessageInterface Name ()
  -> Const Messages (MessageInterface Name ()))
 -> ClientChannel -> Const Messages ClientChannel)
-> ((Messages -> Const Messages Messages)
    -> MessageInterface Name ()
    -> Const Messages (MessageInterface Name ()))
-> Getting Messages ClientChannel Messages
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Const Messages Messages)
-> MessageInterface Name ()
-> Const Messages (MessageInterface Name ())
forall n i. Lens' (MessageInterface n i) Messages
miMessages

            -- 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
^. (MessageInterface Name ()
 -> Const Messages (MessageInterface Name ()))
-> ClientChannel -> Const Messages ClientChannel
Lens' ClientChannel (MessageInterface Name ())
ccMessageInterface((MessageInterface Name ()
  -> Const Messages (MessageInterface Name ()))
 -> ClientChannel -> Const Messages ClientChannel)
-> ((Messages -> Const Messages Messages)
    -> MessageInterface Name ()
    -> Const Messages (MessageInterface Name ()))
-> Getting Messages ClientChannel Messages
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Const Messages Messages)
-> MessageInterface Name ()
-> Const Messages (MessageInterface Name ())
forall n i. Lens' (MessageInterface n i) Messages
miMessages

          -- 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
            ((MessageInterface Name () -> Identity (MessageInterface Name ()))
-> ClientChannel -> Identity ClientChannel
Lens' ClientChannel (MessageInterface Name ())
ccMessageInterface((MessageInterface Name () -> Identity (MessageInterface Name ()))
 -> ClientChannel -> Identity ClientChannel)
-> ((Messages -> Identity Messages)
    -> MessageInterface Name () -> Identity (MessageInterface Name ()))
-> (Messages -> Identity Messages)
-> ClientChannel
-> Identity ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Identity Messages)
-> MessageInterface Name () -> Identity (MessageInterface Name ())
forall n i. Lens' (MessageInterface n i) Messages
miMessages ((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 (ChannelId -> Lens' ChatState MessageSelectState
channelMessageSelect(ChannelId
cId)((MessageSelectState -> Const (Maybe MessageId) MessageSelectState)
 -> ChatState -> Const (Maybe MessageId) ChatState)
-> ((Maybe MessageId -> Const (Maybe MessageId) (Maybe MessageId))
    -> MessageSelectState
    -> Const (Maybe MessageId) MessageSelectState)
-> Getting (Maybe MessageId) ChatState (Maybe MessageId)
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.
                      TeamId -> MH ()
popMode TeamId
tId
                      ChannelId -> Lens' ChatState MessageSelectState
channelMessageSelect(ChannelId
cId) ((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) ->
                        ChannelId -> Lens' ChatState MessageSelectState
channelMessageSelect(ChannelId
cId) ((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
                      ((MessageInterface Name () -> Identity (MessageInterface Name ()))
-> ClientChannel -> Identity ClientChannel
Lens' ClientChannel (MessageInterface Name ())
ccMessageInterface((MessageInterface Name () -> Identity (MessageInterface Name ()))
 -> ClientChannel -> Identity ClientChannel)
-> ((Messages -> Identity Messages)
    -> MessageInterface Name () -> Identity (MessageInterface Name ()))
-> (Messages -> Identity Messages)
-> ClientChannel
-> Identity ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Identity Messages)
-> MessageInterface Name () -> Identity (MessageInterface Name ())
forall n i. Lens' (MessageInterface n i) Messages
miMessages ((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
                        ChannelId -> Lens' ChatState MessageSelectState
channelMessageSelect(ChannelId
cId) ((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) ->
                        ChannelId -> Lens' ChatState MessageSelectState
channelMessageSelect(ChannelId
cId) ((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
                      ((MessageInterface Name () -> Identity (MessageInterface Name ()))
-> ClientChannel -> Identity ClientChannel
Lens' ClientChannel (MessageInterface Name ())
ccMessageInterface((MessageInterface Name () -> Identity (MessageInterface Name ()))
 -> ClientChannel -> Identity ClientChannel)
-> ((Messages -> Identity Messages)
    -> MessageInterface Name () -> Identity (MessageInterface Name ()))
-> (Messages -> Identity Messages)
-> ClientChannel
-> Identity ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Identity Messages)
-> MessageInterface Name () -> Identity (MessageInterface Name ())
forall n i. Lens' (MessageInterface n i) Messages
miMessages ((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) ->
                        ChannelId -> Lens' ChatState MessageSelectState
channelMessageSelect(ChannelId
cId) ((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 ())

                    Maybe TeamId
mcurTId <- Getting (Maybe TeamId) ChatState (Maybe TeamId)
-> MH (Maybe TeamId)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Maybe TeamId) ChatState (Maybe TeamId)
SimpleGetter ChatState (Maybe TeamId)
csCurrentTeamId
                    Maybe ChannelId
currCId <- case Maybe TeamId
mcurTId of
                        Maybe TeamId
Nothing -> Maybe ChannelId -> MH (Maybe ChannelId)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ChannelId
forall a. Maybe a
Nothing
                        Just TeamId
curTId -> Getting (Maybe ChannelId) ChatState (Maybe ChannelId)
-> MH (Maybe ChannelId)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> SimpleGetter ChatState (Maybe 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'
                    ChannelId -> MH ()
invalidateChannelRenderingCache ChannelId
cId
                    PostId -> MH ()
invalidateMessageRenderingCacheByPostId (PostId -> MH ()) -> PostId -> MH ()
forall a b. (a -> b) -> a -> b
$ Post -> PostId
postId Post
new
                    (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
                      (((MessageInterface Name () -> Identity (MessageInterface Name ()))
-> ClientChannel -> Identity ClientChannel
Lens' ClientChannel (MessageInterface Name ())
ccMessageInterface((MessageInterface Name () -> Identity (MessageInterface Name ()))
 -> ClientChannel -> Identity ClientChannel)
-> ((Messages -> Identity Messages)
    -> MessageInterface Name () -> Identity (MessageInterface Name ()))
-> (Messages -> Identity Messages)
-> ClientChannel
-> Identity ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Identity Messages)
-> MessageInterface Name () -> Identity (MessageInterface Name ())
forall n i. Lens' (MessageInterface n i) Messages
miMessages ((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 Maybe ChannelId
currCId Maybe ChannelId -> Maybe ChannelId -> Bool
forall a. Eq a => a -> a -> Bool
== ChannelId -> Maybe ChannelId
forall a. a -> Maybe a
Just 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)
                      )

                    -- Check for whether the post is part of a thread
                    -- being viewed. If so, add the post to that thread
                    -- window as well.
                    Maybe TeamId -> Post -> Message -> MH ()
addPostToOpenThread Maybe TeamId
mTId Post
new Message
msg'

                    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
                      Maybe TeamId
mcurrTid <- Getting (Maybe TeamId) ChatState (Maybe TeamId)
-> MH (Maybe TeamId)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Maybe TeamId) ChatState (Maybe TeamId)
SimpleGetter ChatState (Maybe TeamId)
csCurrentTeamId
                      case Maybe TeamId
mcurrTid of
                          Maybe TeamId
Nothing -> PostProcessMessageAdd -> MH PostProcessMessageAdd
forall (m :: * -> *) a. Monad m => a -> m a
return PostProcessMessageAdd
NoAction
                          Just TeamId
currTid -> do
                              Maybe ChannelId
currCId <- Getting (Maybe ChannelId) ChatState (Maybe ChannelId)
-> MH (Maybe ChannelId)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> SimpleGetter ChatState (Maybe ChannelId)
csCurrentChannelId TeamId
currTid)

                              let notifyPref :: NotifyOption
notifyPref = User -> ClientChannel -> NotifyOption
notifyPreference (ChatState -> User
myUser ChatState
st) ClientChannel
chan
                                  curChannelAction :: PostProcessMessageAdd
curChannelAction = if ChannelId -> Maybe ChannelId
forall a. a -> Maybe a
Just (Post -> ChannelId
postChannelId Post
new) Maybe ChannelId -> Maybe ChannelId -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe 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

addPostToOpenThread :: Maybe TeamId -> Post -> Message -> MH ()
addPostToOpenThread :: Maybe TeamId -> Post -> Message -> MH ()
addPostToOpenThread Maybe TeamId
Nothing Post
_ Message
_ = () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
addPostToOpenThread (Just TeamId
tId) Post
new Message
msg =
    case Post -> Maybe PostId
postRootId Post
new of
        Maybe PostId
Nothing -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just PostId
parentId -> do
            Maybe PostId
mRoot <- Getting (First PostId) ChatState PostId -> MH (Maybe PostId)
forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse (TeamId -> Lens' ChatState (Maybe ThreadInterface)
maybeThreadInterface(TeamId
tId)((Maybe ThreadInterface
  -> Const (First PostId) (Maybe ThreadInterface))
 -> ChatState -> Const (First PostId) ChatState)
-> ((PostId -> Const (First PostId) PostId)
    -> Maybe ThreadInterface
    -> Const (First PostId) (Maybe ThreadInterface))
-> Getting (First PostId) ChatState PostId
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ThreadInterface -> Const (First PostId) ThreadInterface)
-> Maybe ThreadInterface
-> Const (First PostId) (Maybe ThreadInterface)
forall a a'. Traversal (Maybe a) (Maybe a') a a'
_Just((ThreadInterface -> Const (First PostId) ThreadInterface)
 -> Maybe ThreadInterface
 -> Const (First PostId) (Maybe ThreadInterface))
-> ((PostId -> Const (First PostId) PostId)
    -> ThreadInterface -> Const (First PostId) ThreadInterface)
-> (PostId -> Const (First PostId) PostId)
-> Maybe ThreadInterface
-> Const (First PostId) (Maybe ThreadInterface)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(PostId -> Const (First PostId) PostId)
-> ThreadInterface -> Const (First PostId) ThreadInterface
forall n i i2.
Lens (MessageInterface n i) (MessageInterface n i2) i i2
miRootPostId)
            Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe PostId
mRoot Maybe PostId -> Maybe PostId -> Bool
forall a. Eq a => a -> a -> Bool
== PostId -> Maybe PostId
forall a. a -> Maybe a
Just PostId
parentId) (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$
                TeamId -> ChannelId -> (Messages -> Messages) -> MH ()
modifyThreadMessages TeamId
tId (Post
newPost -> Getting ChannelId Post ChannelId -> ChannelId
forall s a. s -> Getting a s a -> a
^.Getting ChannelId Post ChannelId
Lens' Post ChannelId
postChannelIdL) (Message -> Messages -> Messages
forall a. MessageOps a => Message -> a -> a
addMessage Message
msg)

editPostInOpenThread :: Maybe TeamId -> Post -> Message -> MH ()
editPostInOpenThread :: Maybe TeamId -> Post -> Message -> MH ()
editPostInOpenThread Maybe TeamId
Nothing Post
_ Message
_ = () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
editPostInOpenThread (Just TeamId
tId) Post
new Message
msg =
     case Post -> Maybe PostId
postRootId Post
new of
        Maybe PostId
Nothing -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just PostId
parentId -> do
            Maybe PostId
mRoot <- Getting (First PostId) ChatState PostId -> MH (Maybe PostId)
forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse (TeamId -> Lens' ChatState (Maybe ThreadInterface)
maybeThreadInterface(TeamId
tId)((Maybe ThreadInterface
  -> Const (First PostId) (Maybe ThreadInterface))
 -> ChatState -> Const (First PostId) ChatState)
-> ((PostId -> Const (First PostId) PostId)
    -> Maybe ThreadInterface
    -> Const (First PostId) (Maybe ThreadInterface))
-> Getting (First PostId) ChatState PostId
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ThreadInterface -> Const (First PostId) ThreadInterface)
-> Maybe ThreadInterface
-> Const (First PostId) (Maybe ThreadInterface)
forall a a'. Traversal (Maybe a) (Maybe a') a a'
_Just((ThreadInterface -> Const (First PostId) ThreadInterface)
 -> Maybe ThreadInterface
 -> Const (First PostId) (Maybe ThreadInterface))
-> ((PostId -> Const (First PostId) PostId)
    -> ThreadInterface -> Const (First PostId) ThreadInterface)
-> (PostId -> Const (First PostId) PostId)
-> Maybe ThreadInterface
-> Const (First PostId) (Maybe ThreadInterface)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(PostId -> Const (First PostId) PostId)
-> ThreadInterface -> Const (First PostId) ThreadInterface
forall n i i2.
Lens (MessageInterface n i) (MessageInterface n i2) i i2
miRootPostId)
            Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe PostId
mRoot Maybe PostId -> Maybe PostId -> Bool
forall a. Eq a => a -> a -> Bool
== PostId -> Maybe PostId
forall a. a -> Maybe a
Just PostId
parentId) (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ do
                LogCategory -> Text -> MH ()
mhLog LogCategory
LogGeneral Text
"editPostInOpenThread: updating message"
                let 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)
                TeamId -> ChannelId -> (Message -> Message) -> MH ()
modifyEachThreadMessage TeamId
tId (Post
newPost -> Getting ChannelId Post ChannelId -> ChannelId
forall s a. s -> Getting a s a -> a
^.Getting ChannelId Post ChannelId
Lens' Post ChannelId
postChannelIdL)
                    (\Message
m -> if Message -> Bool
isEditedMessage Message
m then Message
msg else Message
m)

-- | 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).

encodeToJSONstring :: A.ToJSON a => a -> String
encodeToJSONstring :: a -> String
encodeToJSONstring a
a = ByteString -> String
BL8.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ a -> ByteString
forall a. ToJSON a => a -> ByteString
A.encode a
a

-- Notification Version 2 payload definition
data NotificationV2 = NotificationV2
    { NotificationV2 -> Int
version :: Int
    , NotificationV2 -> Text
message :: Text
    , NotificationV2 -> Bool
mention :: Bool
    , NotificationV2 -> Text
from :: Text
    } deriving (Int -> NotificationV2 -> ShowS
[NotificationV2] -> ShowS
NotificationV2 -> String
(Int -> NotificationV2 -> ShowS)
-> (NotificationV2 -> String)
-> ([NotificationV2] -> ShowS)
-> Show NotificationV2
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NotificationV2] -> ShowS
$cshowList :: [NotificationV2] -> ShowS
show :: NotificationV2 -> String
$cshow :: NotificationV2 -> String
showsPrec :: Int -> NotificationV2 -> ShowS
$cshowsPrec :: Int -> NotificationV2 -> ShowS
Show)
instance A.ToJSON NotificationV2 where
    toJSON :: NotificationV2 -> Value
toJSON (NotificationV2 Int
vers Text
msg Bool
mentioned Text
sender) =
        [Pair] -> Value
A.object [ Key
"version"  Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Int
vers
                 , Key
"message"  Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
msg
                 , Key
"mention"  Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Bool
mentioned
                 , Key
"from"     Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
sender
                 ]

-- We define a notifyGetPayload for each notification version.
notifyGetPayload :: NotificationVersion -> ChatState -> Post -> Bool -> Maybe String
notifyGetPayload :: NotificationVersion -> ChatState -> Post -> Bool -> Maybe String
notifyGetPayload NotificationVersion
NotifyV1 ChatState
_ Post
_ Bool
_ = do String -> Maybe String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
notifyGetPayload NotificationVersion
NotifyV2 ChatState
st Post
post Bool
mentioned = do
    let notification :: NotificationV2
notification = Int -> Text -> Bool -> Text -> NotificationV2
NotificationV2 Int
2 Text
msg Bool
mentioned Text
sender
    String -> Maybe String
forall (m :: * -> *) a. Monad m => a -> m a
return (NotificationV2 -> String
forall a. ToJSON a => a -> String
encodeToJSONstring NotificationV2
notification)
        where
            msg :: Text
msg = UserText -> Text
sanitizeUserText (UserText -> Text) -> UserText -> Text
forall a b. (a -> b) -> a -> b
$ Post -> UserText
postMessage Post
post
            sender :: Text
sender = ChatState -> Post -> Text
maybePostUsername ChatState
st Post
post

handleNotifyCommand :: Post -> Bool -> NotificationVersion -> MH ()
handleNotifyCommand :: Post -> Bool -> NotificationVersion -> MH ()
handleNotifyCommand Post
post Bool
mentioned NotificationVersion
NotifyV1 = 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
handleNotifyCommand Post
post Bool
mentioned NotificationVersion
NotifyV2 = 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
    let payload :: Maybe String
payload = NotificationVersion -> ChatState -> Post -> Bool -> Maybe String
notifyGetPayload NotificationVersion
NotifyV2 ChatState
st Post
post Bool
mentioned
    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
                TChan ProgramOutput
-> String
-> [String]
-> Maybe String
-> Maybe (MVar ProgramOutput)
-> IO ()
runLoggedCommand TChan ProgramOutput
outputChan (Text -> String
T.unpack Text
cmd) [] Maybe String
payload 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

runNotifyCommand :: Post -> Bool -> MH ()
runNotifyCommand :: Post -> Bool -> MH ()
runNotifyCommand Post
post Bool
mentioned = do
    NotificationVersion
notifyVersion <- Getting NotificationVersion ChatState NotificationVersion
-> MH NotificationVersion
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((ChatResources -> Const NotificationVersion ChatResources)
-> ChatState -> Const NotificationVersion ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Const NotificationVersion ChatResources)
 -> ChatState -> Const NotificationVersion ChatState)
-> ((NotificationVersion
     -> Const NotificationVersion NotificationVersion)
    -> ChatResources -> Const NotificationVersion ChatResources)
-> Getting NotificationVersion ChatState NotificationVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Config -> Const NotificationVersion Config)
-> ChatResources -> Const NotificationVersion ChatResources
Lens' ChatResources Config
crConfiguration((Config -> Const NotificationVersion Config)
 -> ChatResources -> Const NotificationVersion ChatResources)
-> ((NotificationVersion
     -> Const NotificationVersion NotificationVersion)
    -> Config -> Const NotificationVersion Config)
-> (NotificationVersion
    -> Const NotificationVersion NotificationVersion)
-> ChatResources
-> Const NotificationVersion ChatResources
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(NotificationVersion
 -> Const NotificationVersion NotificationVersion)
-> Config -> Const NotificationVersion Config
Lens' Config NotificationVersion
configActivityNotifyVersionL)
    case NotificationVersion
notifyVersion of
        NotificationVersion
NotifyV1 -> Post -> Bool -> NotificationVersion -> MH ()
handleNotifyCommand Post
post Bool
mentioned NotificationVersion
NotifyV1
        NotificationVersion
NotifyV2 -> Post -> Bool -> NotificationVersion -> MH ()
handleNotifyCommand Post
post Bool
mentioned NotificationVersion
NotifyV2

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 =
    (TeamId -> MH ()) -> MH ()
withCurrentTeam ((TeamId -> MH ()) -> MH ()) -> (TeamId -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \TeamId
tId ->
        TeamId -> (ChannelId -> ClientChannel -> MH ()) -> MH ()
withCurrentChannel TeamId
tId ((ChannelId -> ClientChannel -> MH ()) -> MH ())
-> (ChannelId -> ClientChannel -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \ChannelId
cId ClientChannel
chan -> do
            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
^.(MessageInterface Name ()
 -> Const Messages (MessageInterface Name ()))
-> ClientChannel -> Const Messages ClientChannel
Lens' ClientChannel (MessageInterface Name ())
ccMessageInterface((MessageInterface Name ()
  -> Const Messages (MessageInterface Name ()))
 -> ClientChannel -> Const Messages ClientChannel)
-> ((Messages -> Const Messages Messages)
    -> MessageInterface Name ()
    -> Const Messages (MessageInterface Name ()))
-> Getting Messages ClientChannel Messages
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Const Messages Messages)
-> MessageInterface Name ()
-> Const Messages (MessageInterface Name ())
forall n i. Lens' (MessageInterface n i) Messages
miMessages) 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
^.(MessageInterface Name ()
 -> Const RetrogradeMessages (MessageInterface Name ()))
-> ClientChannel -> Const RetrogradeMessages ClientChannel
Lens' ClientChannel (MessageInterface Name ())
ccMessageInterface((MessageInterface Name ()
  -> Const RetrogradeMessages (MessageInterface Name ()))
 -> ClientChannel -> Const RetrogradeMessages ClientChannel)
-> ((RetrogradeMessages
     -> Const RetrogradeMessages RetrogradeMessages)
    -> MessageInterface Name ()
    -> Const RetrogradeMessages (MessageInterface Name ()))
-> Getting RetrogradeMessages ClientChannel RetrogradeMessages
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Const RetrogradeMessages Messages)
-> MessageInterface Name ()
-> Const RetrogradeMessages (MessageInterface Name ())
forall n i. Lens' (MessageInterface n i) Messages
miMessages((Messages -> Const RetrogradeMessages Messages)
 -> MessageInterface Name ()
 -> Const RetrogradeMessages (MessageInterface Name ()))
-> ((RetrogradeMessages
     -> Const RetrogradeMessages RetrogradeMessages)
    -> Messages -> Const RetrogradeMessages Messages)
-> (RetrogradeMessages
    -> Const RetrogradeMessages RetrogradeMessages)
-> MessageInterface Name ()
-> Const RetrogradeMessages (MessageInterface Name ())
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
            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)

-- | 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
^.(MessageInterface Name ()
 -> Const Messages (MessageInterface Name ()))
-> ClientChannel -> Const Messages ClientChannel
Lens' ClientChannel (MessageInterface Name ())
ccMessageInterface((MessageInterface Name ()
  -> Const Messages (MessageInterface Name ()))
 -> ClientChannel -> Const Messages ClientChannel)
-> ((Messages -> Const Messages Messages)
    -> MessageInterface Name ()
    -> Const Messages (MessageInterface Name ()))
-> Getting Messages ClientChannel Messages
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Const Messages Messages)
-> MessageInterface Name ()
-> Const Messages (MessageInterface Name ())
forall n i. Lens' (MessageInterface n i) Messages
miMessages) 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
^.(MessageInterface Name ()
 -> Const Messages (MessageInterface Name ()))
-> ClientChannel -> Const Messages ClientChannel
Lens' ClientChannel (MessageInterface Name ())
ccMessageInterface((MessageInterface Name ()
  -> Const Messages (MessageInterface Name ()))
 -> ClientChannel -> Const Messages ClientChannel)
-> ((Messages -> Const Messages Messages)
    -> MessageInterface Name ()
    -> Const Messages (MessageInterface Name ()))
-> Getting Messages ClientChannel Messages
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Const Messages Messages)
-> MessageInterface Name ()
-> Const Messages (MessageInterface Name ())
forall n i. Lens' (MessageInterface n i) Messages
miMessages
        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)

-- | 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
          -- 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'
            )
      )
      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 :: TeamId -> MH ()
fetchVisibleIfNeeded :: TeamId -> MH ()
fetchVisibleIfNeeded TeamId
tId = 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 -> (ChannelId -> ClientChannel -> MH ()) -> MH ()
withCurrentChannel TeamId
tId ((ChannelId -> ClientChannel -> MH ()) -> MH ())
-> (ChannelId -> ClientChannel -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \ChannelId
cId ClientChannel
chan -> do
            let msgs :: RetrogradeMessages
msgs = ClientChannel
chanClientChannel
-> Getting RetrogradeMessages ClientChannel RetrogradeMessages
-> RetrogradeMessages
forall s a. s -> Getting a s a -> a
^.(MessageInterface Name ()
 -> Const RetrogradeMessages (MessageInterface Name ()))
-> ClientChannel -> Const RetrogradeMessages ClientChannel
Lens' ClientChannel (MessageInterface Name ())
ccMessageInterface((MessageInterface Name ()
  -> Const RetrogradeMessages (MessageInterface Name ()))
 -> ClientChannel -> Const RetrogradeMessages ClientChannel)
-> ((RetrogradeMessages
     -> Const RetrogradeMessages RetrogradeMessages)
    -> MessageInterface Name ()
    -> Const RetrogradeMessages (MessageInterface Name ()))
-> Getting RetrogradeMessages ClientChannel RetrogradeMessages
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Const RetrogradeMessages Messages)
-> MessageInterface Name ()
-> Const RetrogradeMessages (MessageInterface Name ())
forall n i. Lens' (MessageInterface n i) Messages
miMessages((Messages -> Const RetrogradeMessages Messages)
 -> MessageInterface Name ()
 -> Const RetrogradeMessages (MessageInterface Name ()))
-> ((RetrogradeMessages
     -> Const RetrogradeMessages RetrogradeMessages)
    -> Messages -> Const RetrogradeMessages Messages)
-> (RetrogradeMessages
    -> Const RetrogradeMessages RetrogradeMessages)
-> MessageInterface Name ()
-> Const RetrogradeMessages (MessageInterface Name ())
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)
gapTrail (Int
numScrollbackPosts, Bool
False, Maybe MessageId
forall a. Maybe a
Nothing, Maybe MessageId
forall a. Maybe a
Nothing, Int
2) RetrogradeMessages
msgs

                gapTrail :: (Int, Bool, Maybe MessageId, Maybe MessageId, Int)
                         -> Message
                         -> (Int, Bool, Maybe MessageId, Maybe MessageId, Int)
                gapTrail :: (Int, Bool, Maybe MessageId, Maybe MessageId, Int)
-> Message -> (Int, Bool, Maybe MessageId, Maybe MessageId, Int)
gapTrail a :: (Int, Bool, Maybe MessageId, Maybe MessageId, Int)
a@(Int
_,  Bool
True, Maybe MessageId
_, Maybe MessageId
_, Int
_) Message
_ = (Int, Bool, Maybe MessageId, Maybe MessageId, Int)
a
                gapTrail a :: (Int, Bool, Maybe MessageId, Maybe MessageId, Int)
a@(Int
0,     Bool
_, Maybe MessageId
_, Maybe MessageId
_, Int
_) Message
_ = (Int, Bool, Maybe MessageId, Maybe MessageId, Int)
a
                gapTrail   (Int
a, Bool
False, Maybe MessageId
b, Maybe MessageId
c, Int
d) Message
m | Message -> Bool
isGap Message
m = (Int
a, Bool
True, Maybe MessageId
b, Maybe MessageId
c, Int
d)
                gapTrail (Int
remCnt, Bool
_, Maybe MessageId
prev'pId, Maybe MessageId
prev''pId, Int
ovl) Message
msg =
                    (Int
remCnt Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
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,
                     Int
ovl Int -> Int -> Int
forall a. Num a => a -> a -> a
+ if Bool -> Bool
not (Message -> Bool
isPostMessage Message
msg) then Int
1 else Int
0)

                numToRequest :: Int
numToRequest = 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
numToRequest
                        }
                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
            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
^.(ChannelInfo -> Const Bool ChannelInfo)
-> ClientChannel -> Const Bool ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Const Bool ChannelInfo)
 -> ClientChannel -> Const Bool ClientChannel)
-> ((Bool -> Const Bool Bool)
    -> ChannelInfo -> Const Bool ChannelInfo)
-> Getting Bool ClientChannel Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Const Bool Bool) -> ChannelInfo -> Const Bool ChannelInfo
Lens' ChannelInfo 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
.(ChannelInfo -> Identity ChannelInfo)
-> ClientChannel -> Identity ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Identity ChannelInfo)
 -> ClientChannel -> Identity ClientChannel)
-> ((Bool -> Identity Bool) -> ChannelInfo -> Identity ChannelInfo)
-> (Bool -> Identity Bool)
-> ClientChannel
-> Identity ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Identity Bool) -> ChannelInfo -> Identity ChannelInfo
Lens' ChannelInfo 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 -> 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
.(ChannelInfo -> Identity ChannelInfo)
-> ClientChannel -> Identity ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Identity ChannelInfo)
 -> ClientChannel -> Identity ClientChannel)
-> ((Bool -> Identity Bool) -> ChannelInfo -> Identity ChannelInfo)
-> (Bool -> Identity Bool)
-> ClientChannel
-> Identity ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Identity Bool) -> ChannelInfo -> Identity ChannelInfo
Lens' ChannelInfo 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
                           ChannelId -> Int -> Bool -> Posts -> MH PostProcessMessageAdd
addObtainedMessages ChannelId
c (-Int
numToRequest) 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)

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 Messages
csChannelMessages(ChannelId
cId)((Messages -> Identity Messages)
 -> ChatState -> Identity ChatState)
-> ((Message -> Identity Message) -> Messages -> Identity Messages)
-> (Message -> Identity Message)
-> ChatState
-> Identity ChatState
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

            Maybe TeamId
curTId <- Getting (Maybe TeamId) ChatState (Maybe TeamId)
-> MH (Maybe TeamId)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Maybe TeamId) ChatState (Maybe TeamId)
SimpleGetter ChatState (Maybe TeamId)
csCurrentTeamId
            ChannelId -> (ClientChannel -> MH ()) -> MH ()
withChannel ChannelId
cId ((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 TeamId -> Maybe TeamId -> Maybe TeamId
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe TeamId
curTId
                case Maybe TeamId
mTId of
                    Maybe TeamId
Nothing -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                    Just TeamId
tId -> TeamId -> ChannelId -> (Message -> Message) -> MH ()
modifyEachThreadMessage TeamId
tId ChannelId
cId Message -> Message
addAttachment

            ChannelId -> MH ()
invalidateChannelRenderingCache ChannelId
cId
            PostId -> MH ()
invalidateMessageRenderingCacheByPostId PostId
pId

-- | 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 = (TeamId -> MH ()) -> MH ()
withCurrentTeam ((TeamId -> MH ()) -> MH ()) -> (TeamId -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \TeamId
tId -> 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 ->
                      TeamId -> ChannelId -> Maybe (MH ()) -> MH ()
joinChannel' TeamId
tId 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
                      TeamId -> ChannelId -> MH ()
setFocus TeamId
tId ChannelId
cId
                      Lens' ChatState (MessageInterface Name ()) -> MH ()
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
beginMessageSelect (ChannelId -> Lens' ChatState (MessageInterface Name ())
csChannelMessageInterface(ChannelId
cId))
                      ChannelId -> Lens' ChatState MessageSelectState
channelMessageSelect(ChannelId
cId) ((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
                                  TeamId -> ChannelId -> Maybe (MH ()) -> MH ()
joinChannel' TeamId
tId (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"