{-# 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.Interface ( ringTerminalBell )
import Lens.Micro.Platform ( Traversal', (.=), (%=), (%~), (.~)
, to, at, traversed, filtered, ix, _1, _Just )
import Network.Mattermost
import qualified Network.Mattermost.Endpoints as MM
import Network.Mattermost.Lenses
import Network.Mattermost.Types
import Matterhorn.Constants
import Matterhorn.State.Channels
import Matterhorn.State.Common
import Matterhorn.State.ThreadWindow
import Matterhorn.State.MessageSelect
import Matterhorn.State.Users
import Matterhorn.TimeUtils
import Matterhorn.Types
import Matterhorn.Types.Common ( sanitizeUserText )
import Matterhorn.Types.DirectionalSeq ( DirectionalSeq, SeqDirection )
addDisconnectGaps :: MH ()
addDisconnectGaps :: MH ()
addDisconnectGaps = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ChannelId -> MH ()
onEach forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ClientChannel -> Bool) -> ClientChannels -> [ChannelId]
filteredChannelIds (forall a b. a -> b -> a
const Bool
True) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use 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
forall a. EventM Name ChatState a -> MH a
mh forall n s. Ord n => EventM n s ()
invalidateCache
let toggle :: Config -> Config
toggle Config
c = Config
c { configShowMessageTimestamps :: Bool
configShowMessageTimestamps = Bool -> Bool
not (Config -> Bool
configShowMessageTimestamps Config
c)
}
Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources Config
crConfiguration 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
forall a. EventM Name ChatState a -> MH a
mh forall n s. Ord n => EventM n s ()
invalidateCache
ChatState
st <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a. a -> a
id
let toggle :: Maybe a -> Maybe Int
toggle Maybe a
Nothing = (ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources Config
crConfigurationforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' Config (Maybe Int)
configTruncateVerbatimBlocksL) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
forall a. a -> Maybe a
Just Int
defaultVerbatimTruncateHeight
toggle (Just a
_) = forall a. Maybe a
Nothing
Lens' ChatState (Maybe Int)
csVerbatimTruncateSetting forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall {a}. Maybe a -> Maybe Int
toggle
clearPendingFlags :: ChannelId -> MH ()
clearPendingFlags :: ChannelId -> MH ()
clearPendingFlags ChannelId
c = ChannelId -> Traversal' ChatState ClientChannel
csChannel(ChannelId
c)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo Bool
cdFetchPending 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 forall a b. (a -> b) -> a -> b
$ \ClientChannel
chan ->
let lastmsg_ :: Maybe Message
lastmsg_ = ClientChannel
chanforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel (MessageInterface Name ())
ccMessageInterfaceforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) Messages
miMessagesforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to Messages -> RetrogradeMessages
reverseMessagesforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to RetrogradeMessages -> Maybe Message
lastMsg
lastIsGap :: Bool
lastIsGap = 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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe ServerTime
t0 (ServerTime -> ServerTime
justAfter forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message -> ServerTime
_mDate) Maybe Message
lastmsg_
t0 :: ServerTime
t0 = UTCTime -> ServerTime
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 forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
lastIsGap
(Lens' ChatState ClientChannels
csChannels forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ChannelId
-> (ClientChannel -> ClientChannel)
-> ClientChannels
-> ClientChannels
modifyChannelById ChannelId
cId (Lens' ClientChannel (MessageInterface Name ())
ccMessageInterfaceforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) Messages
miMessages forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall a. MessageOps a => Message -> a -> a
addMessage Message
gapMsg))
lastMsg :: RetrogradeMessages -> Maybe Message
lastMsg :: RetrogradeMessages -> Maybe Message
lastMsg = forall dir r.
SeqDirection dir =>
(Message -> r) -> DirectionalSeq dir Message -> Maybe r
withFirstMessage 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 =
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Text -> Bool
shouldSkipMessage Text
msg) forall a b. (a -> b) -> a -> b
$ do
ConnectionStatus
status <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use 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 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 forall a b. (a -> b) -> a -> b
$ do
[UploadResponse]
fileInfos <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [AttachmentData]
attachments forall a b. (a -> b) -> a -> b
$ \AttachmentData
a -> do
ChannelId -> String -> ByteString -> Session -> IO UploadResponse
MM.mmUploadFile ChannelId
chanId (FileInfo -> String
FB.fileInfoFilename forall a b. (a -> b) -> a -> b
$ AttachmentData -> FileInfo
attachmentDataFileInfo AttachmentData
a)
(AttachmentData -> ByteString
attachmentDataBytes AttachmentData
a) Session
session
let fileIds :: Seq FileId
fileIds = forall a. [a] -> Seq a
Seq.fromList forall a b. (a -> b) -> a -> b
$
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FileInfo -> FileId
fileInfoId forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$
(forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. UploadResponse -> Seq FileInfo
MM.uploadResponseFileInfos) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [UploadResponse]
fileInfos
case EditMode
mode of
EditMode
NewPost -> do
let pendingPost :: RawPost
pendingPost = (Text -> ChannelId -> RawPost
rawPost Text
msg ChannelId
chanId) { rawPostFileIds :: Seq FileId
rawPostFileIds = Seq FileId
fileIds }
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ RawPost -> Session -> IO Post
MM.mmCreatePost RawPost
pendingPost Session
session
Replying Message
_ Post
p -> do
let pendingPost :: RawPost
pendingPost = (Text -> ChannelId -> RawPost
rawPost Text
msg ChannelId
chanId) { rawPostRootId :: Maybe PostId
rawPostRootId = Post -> Maybe PostId
postRootId Post
p forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Post -> PostId
postId Post
p)
, rawPostFileIds :: Seq FileId
rawPostFileIds = Seq FileId
fileIds
}
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ RawPost -> Session -> IO Post
MM.mmCreatePost RawPost
pendingPost Session
session
Editing Post
p MessageType
ty -> do
let body :: Text
body = case MessageType
ty of
CP ClientPostType
Emote -> Text -> Text
addEmoteFormatting Text
msg
MessageType
_ -> Text
msg
update :: PostUpdate
update = (Text -> PostUpdate
postUpdateBody Text
body) { postUpdateFileIds :: Maybe (Seq FileId)
postUpdateFileIds = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null Seq FileId
fileIds
then forall a. Maybe a
Nothing
else forall a. a -> Maybe a
Just Seq FileId
fileIds
}
forall (f :: * -> *) a. Functor f => f a -> f ()
void 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 (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 <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ChatState -> UserId
myUserId
ChannelId -> (ClientChannel -> MH ()) -> MH ()
withChannel (Post
newforall s a. s -> Getting a s a -> a
^.Lens' Post ChannelId
postChannelIdL) forall a b. (a -> b) -> a -> b
$ \ClientChannel
chan -> do
let mTId :: Maybe TeamId
mTId = ClientChannel
chanforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo (Maybe TeamId)
cdTeamId
Maybe TeamBaseURL
mBaseUrl <- case Maybe TeamId
mTId of
Maybe TeamId
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Just TeamId
tId -> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TeamId -> MH TeamBaseURL
getServerBaseUrl TeamId
tId
Text
hostname <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources ConnectionData
crConnforall b c a. (b -> c) -> (a -> b) -> a -> c
.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
newforall s a. s -> Getting a s a -> a
^.Lens' Post (Maybe PostId)
postRootIdL))
isEditedMessage :: Message -> Bool
isEditedMessage Message
m = Message
mforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe MessageId)
mMessageId forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just (PostId -> MessageId
MessagePostId forall a b. (a -> b) -> a -> b
$ Post
newforall s a. s -> Getting a s a -> a
^.Lens' Post PostId
postIdL)
ChannelId -> Traversal' ChatState ClientChannel
csChannel (Post
newforall s a. s -> Getting a s a -> a
^.Lens' Post ChannelId
postChannelIdL) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ClientChannel (MessageInterface Name ())
ccMessageInterfaceforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) Messages
miMessages forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b.
Traversable f =>
Traversal (f a) (f b) a b
traversed forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> Traversal' a a
filtered Message -> Bool
isEditedMessage forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Message
msg
ChannelId -> MH ()
invalidateChannelRenderingCache forall a b. (a -> b) -> a -> b
$ Post
newforall s a. s -> Getting a s a -> a
^.Lens' Post ChannelId
postChannelIdL
PostId -> MH ()
invalidateMessageRenderingCacheByPostId 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
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Post -> Maybe UserId
postUserId Post
new forall a. Eq a => a -> a -> Bool
/= forall a. a -> Maybe a
Just UserId
myId) forall a b. (a -> b) -> a -> b
$
ChannelId -> Traversal' ChatState ClientChannel
csChannel (Post
newforall s a. s -> Getting a s a -> a
^.Lens' Post ChannelId
postChannelIdL) forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Post -> ClientChannel -> ClientChannel
adjustEditedThreshold Post
new
Lens' ChatState (HashMap PostId Message)
csPostMapforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix(Post -> PostId
postId Post
new) 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
mforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe MessageId)
mMessageId forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just (PostId -> MessageId
MessagePostId forall a b. (a -> b) -> a -> b
$ Post
newforall s a. s -> Getting a s a -> a
^.Lens' Post PostId
postIdL) Bool -> Bool -> Bool
||
PostId -> Message -> Bool
isReplyTo (Post
newforall s a. s -> Getting a s a -> a
^.Lens' Post PostId
postIdL) Message
m
chan :: Traversal' ChatState ClientChannel
chan :: Traversal' ChatState ClientChannel
chan = ChannelId -> Traversal' ChatState ClientChannel
csChannel (Post
newforall s a. s -> Getting a s a -> a
^.Lens' Post ChannelId
postChannelIdL)
Traversal' ChatState ClientChannel
chanforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ClientChannel (MessageInterface Name ())
ccMessageInterfaceforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) Messages
miMessagesforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (f :: * -> *) a b.
Traversable f =>
Traversal (f a) (f b) a b
traversedforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. (a -> Bool) -> Traversal' a a
filtered Message -> Bool
isDeletedMessage forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (forall a b. a -> (a -> b) -> b
& Lens' Message Bool
mDeleted forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True)
Traversal' ChatState ClientChannel
chan 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
newforall s a. s -> Getting a s a -> a
^.Lens' Post ChannelId
postChannelIdL) forall a b. (a -> b) -> a -> b
$ \ClientChannel
ch -> do
case ClientChannel
chforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo (Maybe TeamId)
cdTeamId of
Maybe TeamId
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just TeamId
tId -> TeamId -> Post -> MH ()
deletePostFromOpenThread TeamId
tId Post
new
ChannelId -> MH ()
invalidateChannelRenderingCache forall a b. (a -> b) -> a -> b
$ Post
newforall s a. s -> Getting a s a -> a
^.Lens' Post ChannelId
postChannelIdL
PostId -> MH ()
invalidateMessageRenderingCacheByPostId 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
mforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe MessageId)
mMessageId forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just (PostId -> MessageId
MessagePostId forall a b. (a -> b) -> a -> b
$ Post
pforall s a. s -> Getting a s a -> a
^.Lens' Post PostId
postIdL) Bool -> Bool -> Bool
||
PostId -> Message -> Bool
isReplyTo (Post
pforall s a. s -> Getting a s a -> a
^.Lens' Post PostId
postIdL) Message
m
TeamId -> ChannelId -> (Message -> Bool) -> MH ()
threadInterfaceDeleteWhere TeamId
tId (Post
pforall s a. s -> Getting a s a -> a
^.Lens' Post ChannelId
postChannelIdL) Message -> Bool
isDeletedMessage
Maybe ThreadInterface
ti <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState (Maybe ThreadInterface)
tsThreadInterface)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust Maybe ThreadInterface
ti) forall a b. (a -> b) -> a -> b
$ do
Bool
isEmpty <- TeamId -> MH Bool
threadInterfaceEmpty TeamId
tId
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isEmpty 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 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 forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ Posts
postsforall s a. s -> Getting a s a -> a
^.Lens' Posts (Seq PostId)
postsOrderL
then do forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
addTrailingGap forall a b. (a -> b) -> a -> b
$
Lens' ChatState ClientChannels
csChannels forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ChannelId
-> (ClientChannel -> ClientChannel)
-> ClientChannels
-> ClientChannels
modifyChannelById ChannelId
cId
(Lens' ClientChannel (MessageInterface Name ())
ccMessageInterfaceforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) Messages
miMessages forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~
\Messages
msgs -> let startPoint :: Maybe MessageId
startPoint = forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ Message -> Maybe MessageId
_mMessageId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Messages -> Maybe Message
getLatestPostMsg Messages
msgs
in forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ (Message -> Bool)
-> Maybe MessageId
-> Maybe MessageId
-> Messages
-> (Messages, Messages)
removeMatchesFromSubset Message -> Bool
isGap Maybe MessageId
startPoint forall a. Maybe a
Nothing Messages
msgs)
forall (m :: * -> *) a. Monad m => a -> m a
return PostProcessMessageAdd
NoAction
else
forall a. ChannelId -> a -> (ClientChannel -> MH a) -> MH a
withChannelOrDefault ChannelId
cId PostProcessMessageAdd
NoAction forall a b. (a -> b) -> a -> b
$ \ClientChannel
chan -> do
let pIdList :: [PostId]
pIdList = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Posts
postsforall s a. s -> Getting a s a -> a
^.Lens' Posts (Seq PostId)
postsOrderL)
mTId :: Maybe TeamId
mTId = ClientChannel
chanforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo (Maybe TeamId)
cdTeamId
earliestPId :: PostId
earliestPId = forall a. [a] -> a
last [PostId]
pIdList
latestPId :: PostId
latestPId = forall a. [a] -> a
head [PostId]
pIdList
earliestDate :: ServerTime
earliestDate = Post -> ServerTime
postCreateAt forall a b. (a -> b) -> a -> b
$ (Posts
postsforall s a. s -> Getting a s a -> a
^.Lens' Posts (HashMap PostId Post)
postsPostsL) forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HM.! PostId
earliestPId
latestDate :: ServerTime
latestDate = Post -> ServerTime
postCreateAt forall a b. (a -> b) -> a -> b
$ (Posts
postsforall s a. s -> Getting a s a -> a
^.Lens' Posts (HashMap PostId Post)
postsPostsL) forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HM.! PostId
latestPId
localMessages :: Messages
localMessages = ClientChannel
chanforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel (MessageInterface Name ())
ccMessageInterfaceforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) Messages
miMessages
match :: Messages
match = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ (Message -> Bool)
-> Maybe MessageId
-> Maybe MessageId
-> Messages
-> (Messages, Messages)
removeMatchesFromSubset
(\Message
m -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (\PostId
p -> PostId
p forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PostId]
pIdList) (Message -> Maybe PostId
messagePostId Message
m))
(forall a. a -> Maybe a
Just (PostId -> MessageId
MessagePostId PostId
earliestPId))
(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 forall a. a -> [a] -> [a]
: [PostId]
l
Maybe PostId
Nothing -> [PostId]
l
dupPIds :: [PostId]
dupPIds = 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 " forall a. Semigroup a => a -> a -> a
<>
(if Bool
isOlder then Text
"older" else Text
"newer") forall a. Semigroup a => a -> a -> a
<>
Text
" messages" 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
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> MessageType -> ServerTime -> Message
newMessageOfType Text
txt MessageType
ty ServerTime
d
forall a b. a -> (a -> b) -> b
& Lens' Message (Maybe MessageId)
mMessageId forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> Maybe a
Just (UUID -> MessageId
MessageUUID UUID
uuid))
addingAtEnd :: Bool
addingAtEnd = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (ServerTime
latestDate forall a. Ord a => a -> a -> Bool
>=) forall a b. (a -> b) -> a -> b
$
(forall s a. s -> Getting a s a -> a
^.Lens' Message ServerTime
mDate) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Messages -> Maybe Message
getLatestPostMsg Messages
localMessages
addingAtStart :: Bool
addingAtStart = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (ServerTime
earliestDate forall a. Ord a => a -> a -> Bool
<=) forall a b. (a -> b) -> a -> b
$
(forall s a. s -> Getting a s a -> a
^.Lens' Message ServerTime
mDate) 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 forall a. Maybe a
Nothing
else 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 forall a. Maybe a
Nothing
else forall a. a -> Maybe a
Just (PostId -> MessageId
MessagePostId PostId
latestPId)
noMoreBefore :: Bool
noMoreBefore = Int
reqCnt forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Int
length [PostId]
pIdList forall a. Ord a => a -> a -> Bool
< (-Int
reqCnt)
noMoreAfter :: Bool
noMoreAfter = Bool
addTrailingGap Bool -> Bool -> Bool
|| Int
reqCnt forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Int
length [PostId]
pIdList forall a. Ord a => a -> a -> Bool
< Int
reqCnt
reAddGapBefore :: Bool
reAddGapBefore = PostId
earliestPId forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PostId]
dupPIds Bool -> Bool -> Bool
|| Bool
noMoreBefore
reAddGapAfter :: Bool
reAddGapAfter = PostId
latestPId forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PostId]
dupPIds Bool -> Bool -> Bool
|| Bool
noMoreAfter
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Maybe TeamId -> Posts -> MH Messages
installMessagesFromPosts Maybe TeamId
mTId Posts
posts
PostProcessMessageAdd
action <- forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr PostProcessMessageAdd
-> PostProcessMessageAdd -> PostProcessMessageAdd
andProcessWith PostProcessMessageAdd
NoAction forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Bool -> Bool -> PostToAdd -> MH PostProcessMessageAdd
addMessageToState Bool
False Bool
False forall b c a. (b -> c) -> (a -> b) -> a -> c
. Post -> PostToAdd
OldPost)
[ (Posts
postsforall s a. s -> Getting a s a -> a
^.Lens' Posts (HashMap PostId Post)
postsPostsL) forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HM.! PostId
p
| PostId
p <- forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Posts
postsforall s a. s -> Getting a s a -> a
^.Lens' Posts (Seq PostId)
postsOrderL)
, Bool -> Bool
not (PostId
p forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PostId]
dupPIds)
]
forall a. ChannelId -> a -> (ClientChannel -> MH a) -> MH a
withChannelOrDefault ChannelId
cId () forall a b. (a -> b) -> a -> b
$ \ClientChannel
updchan -> do
let updMsgs :: Messages
updMsgs = ClientChannel
updchan forall s a. s -> Getting a s a -> a
^. Lens' ClientChannel (MessageInterface Name ())
ccMessageInterfaceforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) Messages
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
Lens' ChatState ClientChannels
csChannels forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ChannelId
-> (ClientChannel -> ClientChannel)
-> ClientChannels
-> ClientChannels
modifyChannelById ChannelId
cId
(Lens' ClientChannel (MessageInterface Name ())
ccMessageInterfaceforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) Messages
miMessages 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 <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (ChannelId -> Lens' ChatState MessageSelectState
channelMessageSelect(ChannelId
cId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Message
rmvdSel
case Maybe Message
rmvdSel of
Maybe Message
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just Message
rm ->
if Message -> Bool
isGap Message
rm
then forall (m :: * -> *) a. Monad m => a -> m a
return ()
else do
TeamId -> MH ()
popMode TeamId
tId
ChannelId -> Lens' ChatState MessageSelectState
channelMessageSelect(ChannelId
cId) forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe MessageId -> MessageSelectState
MessageSelectState 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) forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe MessageId -> MessageSelectState
MessageSelectState (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ PostId -> MessageId
MessagePostId PostId
earliestPId)
Maybe MessageType
_ -> 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
Lens' ChatState ClientChannels
csChannels forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ChannelId
-> (ClientChannel -> ClientChannel)
-> ClientChannels
-> ClientChannels
modifyChannelById ChannelId
cId
(Lens' ClientChannel (MessageInterface Name ())
ccMessageInterfaceforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) Messages
miMessages forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ 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) forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe MessageId -> MessageSelectState
MessageSelectState (Message
gapMsgforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe MessageId)
mMessageId)
Maybe MessageType
_ -> 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) forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe MessageId -> MessageSelectState
MessageSelectState (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ PostId -> MessageId
MessagePostId PostId
latestPId)
Maybe MessageType
_ -> 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
Lens' ChatState ClientChannels
csChannels forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ChannelId
-> (ClientChannel -> ClientChannel)
-> ClientChannels
-> ClientChannels
modifyChannelById ChannelId
cId
(Lens' ClientChannel (MessageInterface Name ())
ccMessageInterfaceforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) Messages
miMessages forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ 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) forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe MessageId -> MessageSelectState
MessageSelectState (Message
gapMsgforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe MessageId)
mMessageId)
Maybe MessageType
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
case Maybe TeamId
mTId of
Maybe TeamId
Nothing -> do
HashMap TeamId TeamState
ts <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' ChatState (HashMap TeamId TeamState)
csTeams
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (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 = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Post
post Set UserId
s -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Set UserId
s (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Ord a => a -> Set a -> Set a
Set.insert Set UserId
s) (Post -> Maybe UserId
postUserId Post
post))
forall a. Set a
Set.empty (Posts
postsforall s a. s -> Getting a s a -> a
^.Lens' Posts (HashMap PostId Post)
postsPostsL)
addUnknownUsers :: Set UserId -> MH ()
addUnknownUsers Set UserId
inputUserIds = do
Set UserId
knownUserIds <- forall a. Ord a => [a] -> Set a
Set.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ChatState -> [UserId]
allUserIds
let unknownUsers :: Set UserId
unknownUsers = forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set UserId
inputUserIds Set UserId
knownUserIds
if forall a. Set a -> Bool
Set.null Set UserId
unknownUsers
then forall (m :: * -> *) a. Monad m => a -> m a
return ()
else Seq UserId -> MH () -> MH ()
handleNewUsers (forall a. [a] -> Seq a
Seq.fromList forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set UserId
unknownUsers) (forall (m :: * -> *) a. Monad m => a -> m a
return ())
Set UserId -> MH ()
addUnknownUsers Set UserId
users
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 <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources ConnectionData
crConnforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ConnectionData Text
cdHostnameL)
ChatState
st <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a. a -> a
id
case ChatState
st 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 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
ncforall s a. s -> Getting a s a -> a
^.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 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Bool
False -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ do
if Type
chType 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
PostProcessMessageAdd -> MH ()
postProcessMessageAdd
forall (m :: * -> *) a. Monad m => a -> m a
return PostProcessMessageAdd
NoAction
Just ClientChannel
ch -> do
let mTId :: Maybe TeamId
mTId = ClientChannel
chforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo (Maybe TeamId)
cdTeamId
Maybe TeamBaseURL
mBaseUrl <- case Maybe TeamId
mTId of
Maybe TeamId
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Just TeamId
tId -> forall a. a -> Maybe a
Just 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
newforall s a. s -> Getting a s a -> a
^.Lens' Post (Maybe PostId)
postRootIdL)
fromMe :: Bool
fromMe = (ClientPost
cpforall s a. s -> Getting a s a -> a
^.Lens' ClientPost (Maybe UserId)
cpUser forall a. Eq a => a -> a -> Bool
== (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ChatState -> UserId
myUserId ChatState
st)) Bool -> Bool -> Bool
&&
(forall a. Maybe a -> Bool
isNothing forall a b. (a -> b) -> a -> b
$ ClientPost
cpforall s a. s -> Getting a s a -> a
^.Lens' ClientPost (Maybe Text)
cpUserOverride)
userPrefs :: UserPreferences
userPrefs = ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources UserPreferences
crUserPreferences
isJoinOrLeave :: Bool
isJoinOrLeave = case ClientPost
cpforall s a. s -> Getting a s a -> a
^.Lens' ClientPost ClientPostType
cpType of
ClientPostType
Join -> Bool
True
ClientPostType
Leave -> Bool
True
ClientPostType
_ -> Bool
False
ignoredJoinLeaveMessage :: Bool
ignoredJoinLeaveMessage =
Bool -> Bool
not (UserPreferences
userPrefsforall s a. s -> Getting a s a -> a
^.Lens' UserPreferences Bool
userPrefShowJoinLeave) Bool -> Bool -> Bool
&& Bool
isJoinOrLeave
cId :: ChannelId
cId = Post -> ChannelId
postChannelId Post
new
doAddMessage :: MH PostProcessMessageAdd
doAddMessage = do
case ClientPost
cpforall s a. s -> Getting a s a -> a
^.Lens' ClientPost (Maybe UserId)
cpUser of
Maybe UserId
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just UserId
authorId -> forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
fetchAuthor forall a b. (a -> b) -> a -> b
$ do
Maybe UserInfo
authorResult <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (UserId -> ChatState -> Maybe UserInfo
userById UserId
authorId)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isNothing Maybe UserInfo
authorResult) forall a b. (a -> b) -> a -> b
$
Seq UserId -> MH () -> MH ()
handleNewUsers (forall a. a -> Seq a
Seq.singleton UserId
authorId) (forall (m :: * -> *) a. Monad m => a -> m a
return ())
Maybe TeamId
mcurTId <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use SimpleGetter ChatState (Maybe TeamId)
csCurrentTeamId
Maybe ChannelId
currCId <- case Maybe TeamId
mcurTId of
Maybe TeamId
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Just TeamId
curTId -> 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 <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources (Set PostId)
crFlaggedPosts)
let (Message
msg', Set MentionedUser
mentionedUsers) = ClientPost -> (Message, Set MentionedUser)
clientPostToMessage ClientPost
cp
forall a b. a -> (a -> b) -> b
& forall s t a b. Field1 s t a b => Lens s t a b
_1forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' Message Bool
mFlagged forall s t a b. ASetter s t a b -> b -> s -> t
.~ ((ClientPost
cpforall s a. s -> Getting a s a -> a
^.Lens' ClientPost PostId
cpPostId) forall a. Ord a => a -> Set a -> Bool
`Set.member` Set PostId
flags)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
doFetchMentionedUsers forall a b. (a -> b) -> a -> b
$
Set MentionedUser -> MH ()
fetchMentionedUsers Set MentionedUser
mentionedUsers
Lens' ChatState (HashMap PostId Message)
csPostMapforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at(Post -> PostId
postId Post
new) forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. a -> Maybe a
Just Message
msg'
ChannelId -> MH ()
invalidateChannelRenderingCache ChannelId
cId
PostId -> MH ()
invalidateMessageRenderingCacheByPostId forall a b. (a -> b) -> a -> b
$ Post -> PostId
postId Post
new
Lens' ChatState ClientChannels
csChannels forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ChannelId
-> (ClientChannel -> ClientChannel)
-> ClientChannels
-> ClientChannels
modifyChannelById ChannelId
cId
((Lens' ClientChannel (MessageInterface Name ())
ccMessageInterfaceforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) Messages
miMessages forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall a. MessageOps a => Message -> a -> a
addMessage Message
msg') forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(if Bool -> Bool
not Bool
ignoredJoinLeaveMessage then Post -> ClientChannel -> ClientChannel
adjustUpdated Post
new else forall a. a -> a
id) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(\ClientChannel
c -> if Maybe ChannelId
currCId forall a. Eq a => a -> a -> Bool
== 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) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(\ClientChannel
c -> if Bool
wasMentioned
then ClientChannel
c forall a b. a -> (a -> b) -> b
& Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo Int
cdMentionCount forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall a. Enum a => a -> a
succ
else ClientChannel
c)
)
Maybe TeamId -> Post -> Message -> MH ()
addPostToOpenThread (Maybe TeamId
mTId forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe TeamId
mcurTId) Post
new Message
msg'
MH PostProcessMessageAdd
postedChanMessage
doHandleAddedMessage :: MH PostProcessMessageAdd
doHandleAddedMessage = do
case ClientPost
cpforall s a. s -> Getting a s a -> a
^.Lens' ClientPost (Maybe PostId)
cpInReplyToPost of
Just PostId
parentId ->
case ChatState -> PostId -> Maybe Message
getMessageForPostId ChatState
st PostId
parentId of
Maybe Message
Nothing -> do
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 -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Maybe TeamId -> Posts -> MH ()
updatePostMap Maybe TeamId
mTId Posts
p)
Maybe Message
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Maybe PostId
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
MH PostProcessMessageAdd
doAddMessage
postedChanMessage :: MH PostProcessMessageAdd
postedChanMessage =
forall a. ChannelId -> a -> (ClientChannel -> MH a) -> MH a
withChannelOrDefault (Post -> ChannelId
postChannelId Post
new) PostProcessMessageAdd
NoAction forall a b. (a -> b) -> a -> b
$ \ClientChannel
chan -> do
Maybe TeamId
mcurrTid <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use SimpleGetter ChatState (Maybe TeamId)
csCurrentTeamId
case Maybe TeamId
mcurrTid of
Maybe TeamId
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return PostProcessMessageAdd
NoAction
Just TeamId
currTid -> do
Maybe ChannelId
currCId <- 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 forall a. a -> Maybe a
Just (Post -> ChannelId
postChannelId Post
new) 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 forall a. Eq a => a -> a -> Bool
== NotifyOption
NotifyOptionAll -> [PostToAdd] -> PostProcessMessageAdd
NotifyUser [PostToAdd
newPostData]
| NotifyOption
notifyPref forall a. Eq a => a -> a -> Bool
== NotifyOption
NotifyOptionMention
Bool -> Bool -> Bool
&& Bool
wasMentioned -> [PostToAdd] -> PostProcessMessageAdd
NotifyUser [PostToAdd
newPostData]
| Bool
otherwise -> PostProcessMessageAdd
NoAction
forall (m :: * -> *) a. Monad m => a -> m a
return 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
_ = 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just PostId
parentId -> do
Maybe PostId
mRoot <- forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse (TeamId -> Lens' ChatState (Maybe ThreadInterface)
maybeThreadInterface(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a a'. Traversal (Maybe a) (Maybe a') a a'
_Justforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i1 i2.
Lens (MessageInterface n i1) (MessageInterface n i2) i1 i2
miRootPostId)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe PostId
mRoot forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just PostId
parentId) forall a b. (a -> b) -> a -> b
$
TeamId -> ChannelId -> (Messages -> Messages) -> MH ()
modifyThreadMessages TeamId
tId (Post
newforall s a. s -> Getting a s a -> a
^.Lens' Post ChannelId
postChannelIdL) (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
_ = 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just PostId
parentId -> do
Maybe PostId
mRoot <- forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse (TeamId -> Lens' ChatState (Maybe ThreadInterface)
maybeThreadInterface(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a a'. Traversal (Maybe a) (Maybe a') a a'
_Justforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i1 i2.
Lens (MessageInterface n i1) (MessageInterface n i2) i1 i2
miRootPostId)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe PostId
mRoot forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just PostId
parentId) 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
mforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe MessageId)
mMessageId forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just (PostId -> MessageId
MessagePostId forall a b. (a -> b) -> a -> b
$ Post
newforall s a. s -> Getting a s a -> a
^.Lens' Post PostId
postIdL)
TeamId -> ChannelId -> (Message -> Message) -> MH ()
modifyEachThreadMessage TeamId
tId (Post
newforall s a. s -> Getting a s a -> a
^.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 forall a. Semigroup a => a -> a -> a
<> [PostToAdd]
p2)
andProcessWith (NotifyUserAndServer [PostToAdd]
p1) (NotifyUserAndServer [PostToAdd]
p2) = [PostToAdd] -> PostProcessMessageAdd
NotifyUserAndServer ([PostToAdd]
p1 forall a. Semigroup a => a -> a -> a
<> [PostToAdd]
p2)
andProcessWith (NotifyUser [PostToAdd]
p1) (NotifyUserAndServer [PostToAdd]
p2) = [PostToAdd] -> PostProcessMessageAdd
NotifyUser ([PostToAdd]
p1 forall a. Semigroup a => a -> a -> a
<> [PostToAdd]
p2)
andProcessWith (NotifyUser [PostToAdd]
p1) (NotifyUser [PostToAdd]
p2) = [PostToAdd] -> PostProcessMessageAdd
NotifyUser ([PostToAdd]
p1 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 = forall (m :: * -> *) a. Monad m => a -> m a
return ()
postOp PostProcessMessageAdd
UpdateServerViewed = Bool -> MH ()
updateViewed Bool
False
postOp (NotifyUser [PostToAdd]
p) = MH ()
maybeRingBell forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MH ()
maybeRingBell forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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
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 <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources Config
crConfigurationforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' Config Bool
configActivityBellL)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
doBell forall a b. (a -> b) -> a -> b
$ do
Vty
vty <- forall a. EventM Name ChatState a -> MH a
mh forall n s. EventM n s Vty
getVtyHandle
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Output -> IO ()
ringTerminalBell 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NotificationV2] -> ShowS
$cshowList :: [NotificationV2] -> ShowS
show :: NotificationV2 -> String
$cshow :: NotificationV2 -> String
showsPrec :: Int -> NotificationV2 -> ShowS
$cshowsPrec :: Int -> NotificationV2 -> ShowS
Show)
instance A.ToJSON NotificationV2 where
toJSON :: NotificationV2 -> Value
toJSON (NotificationV2 Int
vers Text
msg Bool
mentioned Text
sender) =
[Pair] -> Value
A.object [ Key
"version" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Int
vers
, Key
"message" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
msg
, Key
"mention" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Bool
mentioned
, Key
"from" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NotificationV3] -> ShowS
$cshowList :: [NotificationV3] -> ShowS
show :: NotificationV3 -> String
$cshow :: NotificationV3 -> String
showsPrec :: Int -> NotificationV3 -> ShowS
$cshowsPrec :: Int -> 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" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Int
vers
, Key
"message" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
msg
, Key
"mention" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Bool
mentioned
, Key
"from" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
sender
, Key
"messageType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
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 forall (m :: * -> *) a. Monad m => a -> m a
return 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
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. ToJSON a => a -> ByteString
A.encode NotificationV2
notification)
where
msg :: Text
msg = UserText -> Text
sanitizeUserText 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
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. ToJSON a => a -> ByteString
A.encode NotificationV3
notification)
where
msg :: Text
msg = UserText -> Text
sanitizeUserText 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 <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources (TChan ProgramOutput)
crSubprocessLog)
ChatState
st <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a. a -> a
id
Maybe Text
notifyCommand <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources Config
crConfigurationforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' Config (Maybe Text)
configActivityNotifyCommandL)
case Maybe Text
notifyCommand of
Maybe Text
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just Text
cmd ->
AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Preempt forall a b. (a -> b) -> a -> b
$ do
let messageString :: String
messageString = Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ UserText -> Text
sanitizeUserText 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 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] forall a. Maybe a
Nothing forall a. Maybe a
Nothing
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
handleNotifyCommand Post
post Bool
mentioned NotificationVersion
NotifyV2 = do
TChan ProgramOutput
outputChan <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources (TChan ProgramOutput)
crSubprocessLog)
ChatState
st <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use 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 <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources Config
crConfigurationforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' Config (Maybe Text)
configActivityNotifyCommandL)
case Maybe Text
notifyCommand of
Maybe Text
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just Text
cmd ->
AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Preempt 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 forall a. Maybe a
Nothing
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
handleNotifyCommand Post
post Bool
mentioned NotificationVersion
NotifyV3 = do
TChan ProgramOutput
outputChan <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources (TChan ProgramOutput)
crSubprocessLog)
ChatState
st <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use 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 <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources Config
crConfigurationforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' Config (Maybe Text)
configActivityNotifyCommandL)
case Maybe Text
notifyCommand of
Maybe Text
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just Text
cmd ->
AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Preempt 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 forall a. Maybe a
Nothing
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
runNotifyCommand :: Post -> Bool -> MH ()
runNotifyCommand :: Post -> Bool -> MH ()
runNotifyCommand Post
post Bool
mentioned = do
NotificationVersion
notifyVersion <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources Config
crConfigurationforall b c a. (b -> c) -> (a -> b) -> a -> c
.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 =
forall a. a -> Maybe a -> a
fromMaybe Text
T.empty 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 forall a b. (a -> b) -> a -> b
$ \TeamId
tId ->
TeamId -> (ChannelId -> ClientChannel -> MH ()) -> MH ()
withCurrentChannel TeamId
tId forall a b. (a -> b) -> a -> b
$ \ChannelId
cId ClientChannel
chan -> do
let offset :: Int
offset = forall a. Ord a => a -> a -> a
max Int
0 forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length (ClientChannel
chanforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel (MessageInterface Name ())
ccMessageInterfaceforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) Messages
miMessages) forall a. Num a => a -> a -> a
- Int
2
page :: Int
page = Int
offset forall a. Integral a => a -> a -> a
`div` Int
pageAmount
usefulMsgs :: Maybe (Message, Message)
usefulMsgs = forall dir.
SeqDirection dir =>
Maybe Message
-> DirectionalSeq dir Message -> Maybe (Message, Message)
getTwoContiguousPosts forall a. Maybe a
Nothing (ClientChannel
chanforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel (MessageInterface Name ())
ccMessageInterfaceforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) Messages
miMessagesforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to Messages -> RetrogradeMessages
reverseMessages)
sndOldestId :: Maybe PostId
sndOldestId = (Message -> Maybe PostId
messagePostId forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (Message, Message)
usefulMsgs
query :: PostQuery
query = PostQuery
MM.defaultPostQuery
{ postQueryPage :: Maybe Int
MM.postQueryPage = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. a -> Maybe a
Just Int
page) (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) Maybe PostId
sndOldestId
, postQueryPerPage :: Maybe Int
MM.postQueryPerPage = forall a. a -> Maybe a
Just Int
pageAmount
, postQueryBefore :: Maybe PostId
MM.postQueryBefore = Maybe PostId
sndOldestId
}
addTrailingGap :: Bool
addTrailingGap = PostQuery -> Maybe PostId
MM.postQueryBefore PostQuery
query forall a. Eq a => a -> a -> Bool
== forall a. Maybe a
Nothing Bool -> Bool -> Bool
&&
PostQuery -> Maybe Int
MM.postQueryPage PostQuery
query forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Int
0
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 -> forall a. a -> Maybe a
Just 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 <- forall dir.
SeqDirection dir =>
Maybe MessageId -> DirectionalSeq dir Message -> Maybe Message
getRelMessageId (Message -> Maybe MessageId
_mMessageId forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Message
start) DirectionalSeq dir Message
msgs
Message
hinge <- forall dir.
SeqDirection dir =>
Maybe MessageId -> DirectionalSeq dir Message -> Maybe Message
getRelMessageId (Message
anchorforall s a. s -> Getting a s a -> a
^.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 forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Message
anchor
else 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 =
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Message -> Bool
isGap Message
gapMessage) forall a b. (a -> b) -> a -> b
$
ChannelId -> (ClientChannel -> MH ()) -> MH ()
withChannel ChannelId
cId forall a b. (a -> b) -> a -> b
$ \ClientChannel
chan ->
let offset :: Int
offset = forall a. Ord a => a -> a -> a
max Int
0 forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length (ClientChannel
chanforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel (MessageInterface Name ())
ccMessageInterfaceforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) Messages
miMessages) forall a. Num a => a -> a -> a
- Int
2
page :: Int
page = Int
offset forall a. Integral a => a -> a -> a
`div` Int
pageAmount
chanMsgs :: Messages
chanMsgs = ClientChannel
chanforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel (MessageInterface Name ())
ccMessageInterfaceforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) Messages
miMessages
fromMsg :: Maybe Message
fromMsg = forall a. a -> Maybe a
Just Message
gapMessage
fetchNewer :: Bool
fetchNewer = case Message
gapMessageforall s a. s -> Getting a s a -> a
^.Lens' Message MessageType
mType of
C ClientMessageType
UnknownGapAfter -> Bool
True
C ClientMessageType
UnknownGapBefore -> Bool
False
MessageType
_ -> forall a. HasCallStack => String -> a
error String
"fetch gap messages: unknown gap message type"
baseId :: Maybe PostId
baseId = Message -> Maybe PostId
messagePostId forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
case Message
gapMessageforall s a. s -> Getting a s a -> a
^.Lens' Message MessageType
mType of
C ClientMessageType
UnknownGapAfter -> forall dir.
SeqDirection dir =>
Maybe Message
-> DirectionalSeq dir Message -> Maybe (Message, Message)
getTwoContiguousPosts Maybe Message
fromMsg forall a b. (a -> b) -> a -> b
$
Messages -> RetrogradeMessages
reverseMessages Messages
chanMsgs
C ClientMessageType
UnknownGapBefore -> forall dir.
SeqDirection dir =>
Maybe Message
-> DirectionalSeq dir Message -> Maybe (Message, Message)
getTwoContiguousPosts Maybe Message
fromMsg Messages
chanMsgs
MessageType
_ -> forall a. HasCallStack => String -> a
error String
"fetch gap messages: unknown gap message type"
query :: PostQuery
query = PostQuery
MM.defaultPostQuery
{ postQueryPage :: Maybe Int
MM.postQueryPage = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. a -> Maybe a
Just Int
page) (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) Maybe PostId
baseId
, postQueryPerPage :: Maybe Int
MM.postQueryPerPage = forall a. a -> Maybe a
Just Int
pageAmount
, postQueryBefore :: Maybe PostId
MM.postQueryBefore = if Bool
fetchNewer then forall a. Maybe a
Nothing else Maybe PostId
baseId
, postQueryAfter :: Maybe PostId
MM.postQueryAfter = if Bool
fetchNewer then Maybe PostId
baseId else forall a. Maybe a
Nothing
}
addTrailingGap :: Bool
addTrailingGap = PostQuery -> Maybe PostId
MM.postQueryBefore PostQuery
query forall a. Eq a => a -> a -> Bool
== forall a. Maybe a
Nothing Bool -> Bool -> Bool
&&
PostQuery -> Maybe Int
MM.postQueryPage PostQuery
query forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Int
0
in 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 -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ do
forall (f :: * -> *) a. Functor f => f a -> f ()
void 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
{ postQueryBefore :: Maybe PostId
MM.postQueryBefore = forall a. a -> Maybe a
Just PostId
pId
, postQueryPerPage :: Maybe Int
MM.postQueryPerPage = forall a. a -> Maybe a
Just Int
reqAmt
}
reqAmt :: Int
reqAmt = Int
5
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 -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ do
let last2ndId :: Maybe PostId
last2ndId = Posts -> Maybe PostId
secondToLastPostId Posts
p
forall (f :: * -> *) a. Functor f => f a -> f ()
void 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
{ postQueryAfter :: Maybe PostId
MM.postQueryAfter = Maybe PostId
last2ndId
, postQueryPerPage :: Maybe Int
MM.postQueryPerPage = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Int
reqAmt forall a. Num a => a -> a -> a
+ Int
2
}
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' -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ do
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ ChannelId -> Int -> Bool -> Posts -> MH PostProcessMessageAdd
addObtainedMessages ChannelId
c' (Int
reqAmt 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 = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ Posts -> Seq PostId
postsOrder Posts
posts
in if forall (t :: * -> *) a. Foldable t => t a -> Int
length [PostId]
pl forall a. Ord a => a -> a -> Bool
> Int
1 then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
last forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
init [PostId]
pl else forall a. Maybe a
Nothing
fetchVisibleIfNeeded :: TeamId -> MH ()
fetchVisibleIfNeeded :: TeamId -> MH ()
fetchVisibleIfNeeded TeamId
tId = do
ConnectionStatus
sts <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' ChatState ConnectionStatus
csConnectionStatus
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ConnectionStatus
sts forall a. Eq a => a -> a -> Bool
== ConnectionStatus
Connected) forall a b. (a -> b) -> a -> b
$ do
TeamId -> (ChannelId -> ClientChannel -> MH ()) -> MH ()
withCurrentChannel TeamId
tId forall a b. (a -> b) -> a -> b
$ \ChannelId
cId ClientChannel
chan -> do
let msgs :: RetrogradeMessages
msgs = ClientChannel
chanforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel (MessageInterface Name ())
ccMessageInterfaceforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) Messages
miMessagesforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to Messages -> RetrogradeMessages
reverseMessages
(Int
numRemaining, Bool
gapInDisplayable, Maybe MessageId
_, Maybe MessageId
rel'pId, Int
overlap) =
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, forall a. Maybe a
Nothing, 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 forall a. Num a => a -> a -> a
- Int
1, Bool
False, Message
msgforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe MessageId)
mMessageId forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe MessageId
prev'pId, Maybe MessageId
prev'pId forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe MessageId
prev''pId,
Int
ovl 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 forall a. Num a => a -> a -> a
+ Int
overlap
query :: PostQuery
query = PostQuery
MM.defaultPostQuery
{ postQueryPage :: Maybe Int
MM.postQueryPage = forall a. a -> Maybe a
Just Int
0
, postQueryPerPage :: Maybe Int
MM.postQueryPerPage = forall a. a -> Maybe a
Just Int
numToRequest
}
finalQuery :: PostQuery
finalQuery = case Maybe MessageId
rel'pId of
Just (MessagePostId PostId
pid) -> PostQuery
query { postQueryBefore :: Maybe PostId
MM.postQueryBefore = forall a. a -> Maybe a
Just PostId
pid }
Maybe MessageId
_ -> PostQuery
query
op :: Session -> ChannelId -> IO Posts
op = \Session
s ChannelId
c -> ChannelId -> PostQuery -> Session -> IO Posts
MM.mmGetPostsForChannel ChannelId
c PostQuery
finalQuery Session
s
addTrailingGap :: Bool
addTrailingGap = PostQuery -> Maybe PostId
MM.postQueryBefore PostQuery
finalQuery forall a. Eq a => a -> a -> Bool
== forall a. Maybe a
Nothing Bool -> Bool -> Bool
&&
PostQuery -> Maybe Int
MM.postQueryPage PostQuery
finalQuery forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Int
0
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ ClientChannel
chanforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo Bool
cdFetchPending) Bool -> Bool -> Bool
&& Bool
gapInDisplayable) forall a b. (a -> b) -> a -> b
$ do
ChannelId -> Traversal' ChatState ClientChannel
csChannel(ChannelId
cId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo Bool
cdFetchPending forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
forall a. DoAsyncChannelMM a
doAsyncChannelMM AsyncPriority
Preempt ChannelId
cId Session -> ChannelId -> IO Posts
op
(\ChannelId
c Posts
p -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ do
ChannelId -> Traversal' ChatState ClientChannel
csChannel(ChannelId
c)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo Bool
cdFetchPending 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 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 forall a b. (a -> b) -> a -> b
$ \TeamId
tId -> do
ChatState
st <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a. a -> a
id
case ChatState -> PostId -> Maybe Message
getMessageForPostId ChatState
st PostId
pId of
Just Message
msg ->
case Message
msg forall s a. s -> Getting a s a -> a
^. Lens' Message (Maybe ChannelId)
mChannelId of
Just ChannelId
cId -> do
case ChannelId -> ClientChannels -> Maybe ClientChannel
findChannelById ChannelId
cId (ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState ClientChannels
csChannels) of
Maybe ClientChannel
Nothing ->
TeamId -> ChannelId -> Maybe (MH ()) -> MH ()
joinChannel' TeamId
tId ChannelId
cId (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ PostId -> MH ()
jumpToPost PostId
pId)
Just ClientChannel
_ -> do
TeamId -> ChannelId -> MH ()
setFocus TeamId
tId ChannelId
cId
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) forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe MessageId -> MessageSelectState
MessageSelectState (Message
msgforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe MessageId)
mMessageId)
Maybe ChannelId
Nothing ->
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 forall a b. (a -> b) -> a -> b
$ do
Either SomeException Post
result <- forall e a. Exception e => IO a -> IO (Either e a)
try forall a b. (a -> b) -> a -> b
$ PostId -> Session -> IO Post
MM.mmGetPost PostId
pId Session
session
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just 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
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState ClientChannels
csChannels) of
Maybe ClientChannel
Nothing -> do
TeamId -> ChannelId -> Maybe (MH ()) -> MH ()
joinChannel' TeamId
tId (Post -> ChannelId
postChannelId Post
p) (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ PostId -> MH ()
jumpToPost PostId
pId)
Just ClientChannel
_ -> do
forall (f :: * -> *) a. Functor f => f a -> f ()
void 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"