{-# 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 as BSL
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 ( 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.ChannelList ( updateSidebar )
import Matterhorn.State.Common
import Matterhorn.State.ThreadWindow
import Matterhorn.State.MessageSelect
import Matterhorn.State.Users
import Matterhorn.TimeUtils
import Matterhorn.Types
import Matterhorn.Types.Common ( sanitizeUserText )
import Matterhorn.Types.DirectionalSeq ( DirectionalSeq, SeqDirection )
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
disconnectChannels :: MH ()
disconnectChannels :: MH ()
disconnectChannels = MH ()
addDisconnectGaps
toggleMessageTimestamps :: MH ()
toggleMessageTimestamps :: MH ()
toggleMessageTimestamps = do
EventM Name ChatState () -> MH ()
forall a. EventM Name ChatState a -> MH a
mh EventM Name ChatState ()
forall n s. Ord n => EventM n s ()
invalidateCache
let toggle :: Config -> Config
toggle Config
c = Config
c { configShowMessageTimestamps = not (configShowMessageTimestamps 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 ChatState () -> MH ()
forall a. EventM Name ChatState a -> MH a
mh EventM Name ChatState ()
forall n s. Ord n => EventM n s ()
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
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 a. Maybe a -> Maybe a -> Maybe a
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 (f :: * -> *).
Functor f =>
(Messages -> f Messages)
-> MessageInterface n i -> f (MessageInterface n i)
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
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 (f :: * -> *).
Functor f =>
(Messages -> f Messages)
-> MessageInterface n i -> f (MessageInterface n i)
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
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
[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 a b. (a -> b) -> [a] -> [b]
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 a. Seq a -> [a]
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 = 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 = postRootId p <|> (Just $ postId p)
, rawPostFileIds = 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 = if null fileIds
then Nothing
else Just 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 a. Eq a => a -> [a] -> 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 a. a -> MH a
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
Text
hostname <- 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)
let (Message
msg, Set MentionedUser
mentionedUsers) = ClientPost -> (Message, Set MentionedUser)
clientPostToMessage (Text -> Maybe TeamBaseURL -> Post -> Maybe PostId -> ClientPost
toClientPost Text
hostname 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 (f :: * -> *).
Functor f =>
(Messages -> f Messages)
-> MessageInterface n i -> f (MessageInterface n i)
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
Traversal Messages Messages Message Message
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
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 :: Traversal' ChatState ClientChannel
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 (f :: * -> *).
Functor f =>
(Messages -> f Messages)
-> MessageInterface n i -> f (MessageInterface n i)
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
Traversal Messages Messages Message Message
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 a. a -> MH a
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
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 a b. MH a -> (a -> MH b) -> MH b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PostProcessMessageAdd -> MH ()
postProcessMessageAdd
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 a. Seq a -> 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
$
(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 (f :: * -> *).
Functor f =>
(Messages -> f Messages)
-> MessageInterface n i -> f (MessageInterface n i)
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 a. a -> MH a
forall (m :: * -> *) a. Monad m => a -> m a
return PostProcessMessageAdd
NoAction
else
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 a. Seq a -> [a]
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
earliestPId :: PostId
earliestPId = [PostId] -> PostId
forall a. HasCallStack => [a] -> a
last [PostId]
pIdList
latestPId :: PostId
latestPId = [PostId] -> PostId
forall a. HasCallStack => [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 (f :: * -> *).
Functor f =>
(Messages -> f Messages)
-> MessageInterface n i -> f (MessageInterface n i)
miMessages
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 a. Eq a => a -> [a] -> 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 a b.
(a -> b -> b) -> b -> DirectionalSeq Chronological a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Message -> [PostId] -> [PostId]
accum [] Messages
match
newGapMessage :: ServerTime -> Bool -> MH Message
newGapMessage ServerTime
d Bool
isOlder =
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 a. a -> MH a
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))
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 a. [a] -> 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 a. [a] -> 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 a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PostId]
dupPIds Bool -> Bool -> Bool
|| Bool
noMoreBefore
reAddGapAfter :: Bool
reAddGapAfter = PostId
latestPId PostId -> [PostId] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PostId]
dupPIds Bool -> Bool -> Bool
|| Bool
noMoreAfter
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
PostProcessMessageAdd
action <- (PostProcessMessageAdd
-> PostProcessMessageAdd -> PostProcessMessageAdd)
-> PostProcessMessageAdd
-> [PostProcessMessageAdd]
-> PostProcessMessageAdd
forall a b. (a -> b -> b) -> b -> [a] -> b
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 a. Seq a -> [a]
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 a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PostId]
dupPIds)
]
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 (f :: * -> *).
Functor f =>
(Messages -> f Messages)
-> MessageInterface n i -> f (MessageInterface n i)
miMessages
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 (f :: * -> *).
Functor f =>
(Messages -> f Messages)
-> MessageInterface n i -> f (MessageInterface n i)
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
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
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 a. a -> MH a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just Message
rm ->
if Message -> Bool
isGap Message
rm
then () -> MH ()
forall a. a -> MH a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else do
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
if Bool
reAddGapBefore
then
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 a. a -> Maybe a
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 a. a -> MH a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else do
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 (f :: * -> *).
Functor f =>
(Messages -> f Messages)
-> MessageInterface n i -> f (MessageInterface n i)
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)
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 a. a -> MH a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
if Bool
reAddGapAfter
then
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 a. a -> Maybe a
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 a. a -> MH a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else do
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 (f :: * -> *).
Functor f =>
(Messages -> f Messages)
-> MessageInterface n i -> f (MessageInterface n i)
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)
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 a. a -> MH a
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
let users :: Set UserId
users = (Post -> Set UserId -> Set UserId)
-> Set UserId -> HashMap PostId Post -> Set UserId
forall a b. (a -> b -> b) -> b -> HashMap PostId a -> b
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 a. a -> MH a
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 a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set UserId
unknownUsers) (() -> MH ()
forall a. a -> MH a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
Set UserId -> MH ()
addUnknownUsers Set UserId
users
PostProcessMessageAdd -> MH PostProcessMessageAdd
forall a. a -> MH a
forall (m :: * -> *) a. Monad m => a -> m a
return PostProcessMessageAdd
action
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
OldPost Post
p -> (Post
p, Bool
False)
RecentPost Post
p Bool
m -> (Post
p, Bool
m)
Text
hostname <- 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)
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)
case Channel -> Bool
channelDeleted Channel
nc of
Bool
True -> Maybe (MH ()) -> IO (Maybe (MH ()))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MH ())
forall a. Maybe a
Nothing
Bool
False -> Maybe (MH ()) -> IO (Maybe (MH ()))
forall a. a -> IO a
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 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 a b. MH a -> (a -> MH b) -> MH b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
PostProcessMessageAdd -> MH ()
postProcessMessageAdd
PostProcessMessageAdd -> MH PostProcessMessageAdd
forall a. a -> MH a
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 a. a -> MH a
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 = Text -> Maybe TeamBaseURL -> Post -> Maybe PostId -> ClientPost
toClientPost Text
hostname 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
maybeIncrementTotalMessageCount :: ClientChannel -> ClientChannel
maybeIncrementTotalMessageCount =
let shouldIncrement :: Bool
shouldIncrement = case PostToAdd
newPostData of
RecentPost {} ->
Bool
True
PostToAdd
_ ->
Bool
False
in if Bool
shouldIncrement
then ClientChannel -> ClientChannel
incrementTotalMessageCount
else ClientChannel -> ClientChannel
forall a. a -> a
id
maybeIncrementViewedMessageCount :: Maybe ChannelId -> ClientChannel -> ClientChannel
maybeIncrementViewedMessageCount Maybe ChannelId
currCId =
let shouldIncrement :: Bool
shouldIncrement = case PostToAdd
newPostData of
RecentPost {} ->
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
PostToAdd
_ ->
Bool
False
in if Bool
shouldIncrement
then ClientChannel -> ClientChannel
incrementViewedMessageCount
else ClientChannel -> ClientChannel
forall a. a -> a
id
maybeIncrementMessageCounts :: Maybe ChannelId -> ClientChannel -> ClientChannel
maybeIncrementMessageCounts Maybe ChannelId
currCId =
ClientChannel -> ClientChannel
maybeIncrementTotalMessageCount (ClientChannel -> ClientChannel)
-> (ClientChannel -> ClientChannel)
-> ClientChannel
-> ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Maybe ChannelId -> ClientChannel -> ClientChannel
maybeIncrementViewedMessageCount Maybe ChannelId
currCId
doAddMessage :: MH PostProcessMessageAdd
doAddMessage = do
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 a. a -> MH a
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 a. a -> MH a
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 a. a -> MH a
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
Lens
(Message, Set MentionedUser)
(Message, Set MentionedUser)
Message
Message
_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 (f :: * -> *).
Functor f =>
(Messages -> f Messages)
-> MessageInterface n i -> f (MessageInterface n i)
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
.
Maybe ChannelId -> ClientChannel -> ClientChannel
maybeIncrementMessageCounts Maybe ChannelId
currCId (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)
)
Maybe TeamId -> Post -> Message -> MH ()
addPostToOpenThread (Maybe TeamId
mTId Maybe TeamId -> Maybe TeamId -> Maybe TeamId
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe TeamId
mcurTId) Post
new Message
msg'
Maybe TeamId -> MH ()
updateSidebar Maybe TeamId
mTId
MH PostProcessMessageAdd
postedChanMessage
doHandleAddedMessage :: MH PostProcessMessageAdd
doHandleAddedMessage = do
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 a. a -> MH a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Maybe PostId
_ -> () -> MH ()
forall a. a -> MH a
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 a. a -> MH a
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 a. a -> MH a
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 a. a -> MH a
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 a. a -> MH a
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' (f :: * -> *).
Applicative f =>
(a -> f a') -> Maybe a -> f (Maybe 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 i1 i2 (f :: * -> *).
Functor f =>
(i1 -> f i2) -> MessageInterface n i1 -> f (MessageInterface n 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 a. a -> MH a
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 a. a -> MH a
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' (f :: * -> *).
Applicative f =>
(a -> f a') -> Maybe a -> f (Maybe 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 i1 i2 (f :: * -> *).
Functor f =>
(i1 -> f i2) -> MessageInterface n i1 -> f (MessageInterface n 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)
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 :: PostProcessMessageAdd -> MH ()
postProcessMessageAdd :: PostProcessMessageAdd -> MH ()
postProcessMessageAdd PostProcessMessageAdd
ppma = PostProcessMessageAdd -> MH ()
postOp PostProcessMessageAdd
ppma
where
postOp :: PostProcessMessageAdd -> MH ()
postOp PostProcessMessageAdd
NoAction = () -> MH ()
forall a. a -> MH a
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 a b. MH a -> MH b -> MH b
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 a b. MH a -> MH b -> MH b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MH ()
maybeRingBell MH () -> MH () -> MH ()
forall a b. MH a -> MH b -> MH b
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 a. a -> MH a
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 ChatState Vty -> MH Vty
forall a. EventM Name ChatState a -> MH a
mh EventM Name ChatState Vty
forall n s. EventM n s Vty
getVtyHandle
IO () -> MH ()
forall a. IO a -> MH a
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
data PostToAdd =
OldPost Post
| RecentPost Post Bool
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
$cshowsPrec :: Int -> NotificationV2 -> ShowS
showsPrec :: Int -> NotificationV2 -> ShowS
$cshow :: NotificationV2 -> String
show :: NotificationV2 -> String
$cshowList :: [NotificationV2] -> ShowS
showList :: [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
forall v. ToJSON v => Key -> v -> Pair
A..= Int
vers
, Key
"message" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
A..= Text
msg
, Key
"mention" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
A..= Bool
mentioned
, Key
"from" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
A..= Text
sender
]
data NotificationV3 = NotificationV3
{ NotificationV3 -> Int
notifyV3Version :: Int
, NotificationV3 -> Text
notifyV3Message :: Text
, NotificationV3 -> Bool
notifyV3Mention :: Bool
, NotificationV3 -> Text
notifyV3From :: Text
, NotificationV3 -> Text
notifyV3MessageType :: Text
} deriving (Int -> NotificationV3 -> ShowS
[NotificationV3] -> ShowS
NotificationV3 -> String
(Int -> NotificationV3 -> ShowS)
-> (NotificationV3 -> String)
-> ([NotificationV3] -> ShowS)
-> Show NotificationV3
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NotificationV3 -> ShowS
showsPrec :: Int -> NotificationV3 -> ShowS
$cshow :: NotificationV3 -> String
show :: NotificationV3 -> String
$cshowList :: [NotificationV3] -> ShowS
showList :: [NotificationV3] -> ShowS
Show)
instance A.ToJSON NotificationV3 where
toJSON :: NotificationV3 -> Value
toJSON (NotificationV3 Int
vers Text
msg Bool
mentioned Text
sender Text
msgTy) =
[Pair] -> Value
A.object [ Key
"version" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
A..= Int
vers
, Key
"message" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
A..= Text
msg
, Key
"mention" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
A..= Bool
mentioned
, Key
"from" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
A..= Text
sender
, Key
"messageType" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
A..= Text
msgTy
]
notifyGetPayload :: NotificationVersion -> ChatState -> Post -> Bool -> Maybe BSL.ByteString
notifyGetPayload :: NotificationVersion
-> ChatState -> Post -> Bool -> Maybe ByteString
notifyGetPayload NotificationVersion
NotifyV1 ChatState
_ Post
_ Bool
_ = do ByteString -> Maybe ByteString
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
forall a. Monoid a => a
mempty
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
ByteString -> Maybe ByteString
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (NotificationV2 -> ByteString
forall a. ToJSON a => a -> ByteString
A.encode 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
notifyGetPayload NotificationVersion
NotifyV3 ChatState
st Post
post Bool
mentioned = do
let notification :: NotificationV3
notification = Int -> Text -> Bool -> Text -> Text -> NotificationV3
NotificationV3 Int
3 Text
msg Bool
mentioned Text
sender Text
msgTy
ByteString -> Maybe ByteString
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (NotificationV3 -> ByteString
forall a. ToJSON a => a -> ByteString
A.encode NotificationV3
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
msgTy :: Text
msgTy = case Post -> PostType
postType Post
post of
PostType
PostTypeJoinChannel -> Text
"joinChannel"
PostType
PostTypeLeaveChannel -> Text
"leaveChannel"
PostType
PostTypeAddToChannel -> Text
"addToChannel"
PostType
PostTypeRemoveFromChannel -> Text
"removeFromChannel"
PostType
PostTypeHeaderChange -> Text
"headerChange"
PostType
PostTypeDisplayNameChange -> Text
"displayNameChange"
PostType
PostTypePurposeChange -> Text
"purposeChange"
PostType
PostTypeChannelDeleted -> Text
"channelDeleted"
PostType
PostTypeEphemeral -> Text
"ephemeral"
PostTypeUnknown Text
_ -> Text
"unknown"
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 a. a -> MH a
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 ByteString
-> Maybe (MVar ProgramOutput)
-> IO ()
runLoggedCommand TChan ProgramOutput
outputChan (Text -> String
T.unpack Text
cmd)
[String
notified, String
sender, String
messageString] Maybe ByteString
forall a. Maybe a
Nothing Maybe (MVar ProgramOutput)
forall a. Maybe a
Nothing
Maybe (MH ()) -> IO (Maybe (MH ()))
forall a. a -> IO a
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 ByteString
payload = NotificationVersion
-> ChatState -> Post -> Bool -> Maybe ByteString
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 a. a -> MH a
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 ByteString
-> Maybe (MVar ProgramOutput)
-> IO ()
runLoggedCommand TChan ProgramOutput
outputChan (Text -> String
T.unpack Text
cmd) [] Maybe ByteString
payload Maybe (MVar ProgramOutput)
forall a. Maybe a
Nothing
Maybe (MH ()) -> IO (Maybe (MH ()))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MH ())
forall a. Maybe a
Nothing
handleNotifyCommand Post
post Bool
mentioned NotificationVersion
NotifyV3 = 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 ByteString
payload = NotificationVersion
-> ChatState -> Post -> Bool -> Maybe ByteString
notifyGetPayload NotificationVersion
NotifyV3 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 a. a -> MH a
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 ByteString
-> Maybe (MVar ProgramOutput)
-> IO ()
runLoggedCommand TChan ProgramOutput
outputChan (Text -> String
T.unpack Text
cmd) [] Maybe ByteString
payload Maybe (MVar ProgramOutput)
forall a. Maybe a
Nothing
Maybe (MH ()) -> IO (Maybe (MH ()))
forall a. a -> IO a
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)
Post -> Bool -> NotificationVersion -> MH ()
handleNotifyCommand Post
post Bool
mentioned NotificationVersion
notifyVersion
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
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 a. DirectionalSeq Chronological a -> 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 (f :: * -> *).
Functor f =>
(Messages -> f Messages)
-> MessageInterface n i -> f (MessageInterface n i)
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 (f :: * -> *).
Functor f =>
(Messages -> f Messages)
-> MessageInterface n i -> f (MessageInterface n i)
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
{ MM.postQueryPage = maybe (Just page) (const Nothing) sndOldestId
, MM.postQueryPerPage = Just pageAmount
, MM.postQueryBefore = 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)
getTwoContiguousPosts :: SeqDirection dir =>
Maybe Message
-> DirectionalSeq dir Message
-> Maybe (Message, Message)
getTwoContiguousPosts :: forall dir.
SeqDirection dir =>
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 a. DirectionalSeq Chronological a -> 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 (f :: * -> *).
Functor f =>
(Messages -> f Messages)
-> MessageInterface n i -> f (MessageInterface n i)
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 (f :: * -> *).
Functor f =>
(Messages -> f Messages)
-> MessageInterface n i -> f (MessageInterface n i)
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
{ MM.postQueryPage = maybe (Just page) (const Nothing) baseId
, MM.postQueryPerPage = Just pageAmount
, MM.postQueryBefore = if fetchNewer then Nothing else baseId
, MM.postQueryAfter = if fetchNewer then baseId else 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)
asyncFetchMessagesSurrounding :: ChannelId -> PostId -> MH ()
asyncFetchMessagesSurrounding :: ChannelId -> PostId -> MH ()
asyncFetchMessagesSurrounding ChannelId
cId PostId
pId = do
let query :: PostQuery
query = PostQuery
MM.defaultPostQuery
{ MM.postQueryBefore = Just pId
, MM.postQueryPerPage = Just reqAmt
}
reqAmt :: Int
reqAmt = Int
5
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
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
let query' :: PostQuery
query' = PostQuery
MM.defaultPostQuery
{ MM.postQueryAfter = last2ndId
, MM.postQueryPerPage = Just $ reqAmt + 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 a. Seq a -> [a]
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 a. [a] -> 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. HasCallStack => [a] -> a
last ([PostId] -> PostId) -> [PostId] -> PostId
forall a b. (a -> b) -> a -> b
$ [PostId] -> [PostId]
forall a. HasCallStack => [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 (f :: * -> *).
Functor f =>
(Messages -> f Messages)
-> MessageInterface n i -> f (MessageInterface n i)
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 b a. (b -> a -> b) -> b -> DirectionalSeq Retrograde a -> b
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 a. Maybe a -> Maybe a -> Maybe a
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 a. Maybe a -> Maybe a -> Maybe a
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
{ MM.postQueryPage = Just 0
, MM.postQueryPerPage = Just numToRequest
}
finalQuery :: PostQuery
finalQuery = case Maybe MessageId
rel'pId of
Just (MessagePostId PostId
pid) -> PostQuery
query { MM.postQueryBefore = Just 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 a b. MH a -> (a -> MH b) -> MH b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PostProcessMessageAdd -> MH ()
postProcessMessageAdd)
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
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 a. a -> IO a
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
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
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)
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"