{-# LANGUAGE MultiWayIf #-}
module Matterhorn.State.Messages
( PostToAdd(..)
, lastMsg
, sendMessage
, editMessage
, deleteMessage
, addNewPostedMessage
, addObtainedMessages
, asyncFetchMoreMessages
, asyncFetchMessagesForGap
, asyncFetchMessagesSurrounding
, fetchVisibleIfNeeded
, disconnectChannels
, toggleMessageTimestamps
, toggleVerbatimBlockTruncation
, jumpToPost
, addMessageToState
)
where
import Prelude ()
import Matterhorn.Prelude
import Brick.Main ( getVtyHandle, invalidateCache )
import qualified Brick.Widgets.FileBrowser as FB
import Control.Exception ( SomeException, try )
import qualified Data.Aeson as A
import qualified Data.ByteString.Lazy.Char8 as BL8
import qualified Data.Foldable as F
import qualified Data.HashMap.Strict as HM
import qualified Data.Set as Set
import qualified Data.Sequence as Seq
import qualified Data.Text as T
import Graphics.Vty ( outputIface )
import Graphics.Vty.Output.Interface ( ringTerminalBell )
import Lens.Micro.Platform ( Traversal', (.=), (%=), (%~), (.~)
, to, at, traversed, filtered, ix, _1, _Just )
import Network.Mattermost
import qualified Network.Mattermost.Endpoints as MM
import Network.Mattermost.Lenses
import Network.Mattermost.Types
import Matterhorn.Constants
import Matterhorn.State.Channels
import Matterhorn.State.Common
import Matterhorn.State.ThreadWindow
import Matterhorn.State.MessageSelect
import Matterhorn.State.Reactions
import Matterhorn.State.Users
import Matterhorn.TimeUtils
import Matterhorn.Types
import Matterhorn.Types.Common ( sanitizeUserText )
import Matterhorn.Types.DirectionalSeq ( DirectionalSeq, SeqDirection )
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 () -> MH ()
forall a. EventM Name a -> MH a
mh EventM Name ()
forall n. Ord n => EventM n ()
invalidateCache
let toggle :: Config -> Config
toggle Config
c = Config
c { configShowMessageTimestamps :: Bool
configShowMessageTimestamps = Bool -> Bool
not (Config -> Bool
configShowMessageTimestamps Config
c)
}
(ChatResources -> Identity ChatResources)
-> ChatState -> Identity ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Identity ChatResources)
-> ChatState -> Identity ChatState)
-> ((Config -> Identity Config)
-> ChatResources -> Identity ChatResources)
-> (Config -> Identity Config)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Config -> Identity Config)
-> ChatResources -> Identity ChatResources
Lens' ChatResources Config
crConfiguration ((Config -> Identity Config) -> ChatState -> Identity ChatState)
-> (Config -> Config) -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Config -> Config
toggle
defaultVerbatimTruncateHeight :: Int
defaultVerbatimTruncateHeight :: Int
defaultVerbatimTruncateHeight = Int
25
toggleVerbatimBlockTruncation :: MH ()
toggleVerbatimBlockTruncation :: MH ()
toggleVerbatimBlockTruncation = do
EventM Name () -> MH ()
forall a. EventM Name a -> MH a
mh EventM Name ()
forall n. Ord n => EventM n ()
invalidateCache
ChatState
st <- Getting ChatState ChatState ChatState -> MH ChatState
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting ChatState ChatState ChatState
forall a. a -> a
id
let toggle :: Maybe a -> Maybe Int
toggle Maybe a
Nothing = (ChatState
stChatState -> Getting (Maybe Int) ChatState (Maybe Int) -> Maybe Int
forall s a. s -> Getting a s a -> a
^.(ChatResources -> Const (Maybe Int) ChatResources)
-> ChatState -> Const (Maybe Int) ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Const (Maybe Int) ChatResources)
-> ChatState -> Const (Maybe Int) ChatState)
-> ((Maybe Int -> Const (Maybe Int) (Maybe Int))
-> ChatResources -> Const (Maybe Int) ChatResources)
-> Getting (Maybe Int) ChatState (Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Config -> Const (Maybe Int) Config)
-> ChatResources -> Const (Maybe Int) ChatResources
Lens' ChatResources Config
crConfiguration((Config -> Const (Maybe Int) Config)
-> ChatResources -> Const (Maybe Int) ChatResources)
-> ((Maybe Int -> Const (Maybe Int) (Maybe Int))
-> Config -> Const (Maybe Int) Config)
-> (Maybe Int -> Const (Maybe Int) (Maybe Int))
-> ChatResources
-> Const (Maybe Int) ChatResources
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe Int -> Const (Maybe Int) (Maybe Int))
-> Config -> Const (Maybe Int) Config
Lens' Config (Maybe Int)
configTruncateVerbatimBlocksL) Maybe Int -> Maybe Int -> Maybe Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
Int -> Maybe Int
forall a. a -> Maybe a
Just Int
defaultVerbatimTruncateHeight
toggle (Just a
_) = Maybe Int
forall a. Maybe a
Nothing
(Maybe Int -> Identity (Maybe Int))
-> ChatState -> Identity ChatState
Lens' ChatState (Maybe Int)
csVerbatimTruncateSetting ((Maybe Int -> Identity (Maybe Int))
-> ChatState -> Identity ChatState)
-> (Maybe Int -> Maybe Int) -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Maybe Int -> Maybe Int
forall a. Maybe a -> Maybe Int
toggle
clearPendingFlags :: ChannelId -> MH ()
clearPendingFlags :: ChannelId -> MH ()
clearPendingFlags ChannelId
c = ChannelId -> Traversal' ChatState ClientChannel
csChannel(ChannelId
c)((ClientChannel -> Identity ClientChannel)
-> ChatState -> Identity ChatState)
-> ((Bool -> Identity Bool)
-> ClientChannel -> Identity ClientChannel)
-> (Bool -> Identity Bool)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChannelInfo -> Identity ChannelInfo)
-> ClientChannel -> Identity ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Identity ChannelInfo)
-> ClientChannel -> Identity ClientChannel)
-> ((Bool -> Identity Bool) -> ChannelInfo -> Identity ChannelInfo)
-> (Bool -> Identity Bool)
-> ClientChannel
-> Identity ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Identity Bool) -> ChannelInfo -> Identity ChannelInfo
Lens' ChannelInfo Bool
cdFetchPending ((Bool -> Identity Bool) -> ChatState -> Identity ChatState)
-> Bool -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
False
addEndGap :: ChannelId -> MH ()
addEndGap :: ChannelId -> MH ()
addEndGap ChannelId
cId = ChannelId -> (ClientChannel -> MH ()) -> MH ()
withChannel ChannelId
cId ((ClientChannel -> MH ()) -> MH ())
-> (ClientChannel -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \ClientChannel
chan ->
let lastmsg_ :: Maybe Message
lastmsg_ = ClientChannel
chanClientChannel
-> Getting (Maybe Message) ClientChannel (Maybe Message)
-> Maybe Message
forall s a. s -> Getting a s a -> a
^.(MessageInterface Name ()
-> Const (Maybe Message) (MessageInterface Name ()))
-> ClientChannel -> Const (Maybe Message) ClientChannel
Lens' ClientChannel (MessageInterface Name ())
ccMessageInterface((MessageInterface Name ()
-> Const (Maybe Message) (MessageInterface Name ()))
-> ClientChannel -> Const (Maybe Message) ClientChannel)
-> ((Maybe Message -> Const (Maybe Message) (Maybe Message))
-> MessageInterface Name ()
-> Const (Maybe Message) (MessageInterface Name ()))
-> Getting (Maybe Message) ClientChannel (Maybe Message)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Const (Maybe Message) Messages)
-> MessageInterface Name ()
-> Const (Maybe Message) (MessageInterface Name ())
forall n i. Lens' (MessageInterface n i) Messages
miMessages((Messages -> Const (Maybe Message) Messages)
-> MessageInterface Name ()
-> Const (Maybe Message) (MessageInterface Name ()))
-> ((Maybe Message -> Const (Maybe Message) (Maybe Message))
-> Messages -> Const (Maybe Message) Messages)
-> (Maybe Message -> Const (Maybe Message) (Maybe Message))
-> MessageInterface Name ()
-> Const (Maybe Message) (MessageInterface Name ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> RetrogradeMessages)
-> SimpleGetter Messages RetrogradeMessages
forall s a. (s -> a) -> SimpleGetter s a
to Messages -> RetrogradeMessages
reverseMessagesGetting (Maybe Message) Messages RetrogradeMessages
-> ((Maybe Message -> Const (Maybe Message) (Maybe Message))
-> RetrogradeMessages -> Const (Maybe Message) RetrogradeMessages)
-> (Maybe Message -> Const (Maybe Message) (Maybe Message))
-> Messages
-> Const (Maybe Message) Messages
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(RetrogradeMessages -> Maybe Message)
-> SimpleGetter RetrogradeMessages (Maybe Message)
forall s a. (s -> a) -> SimpleGetter s a
to RetrogradeMessages -> Maybe Message
lastMsg
lastIsGap :: Bool
lastIsGap = Bool -> (Message -> Bool) -> Maybe Message -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Message -> Bool
isGap Maybe Message
lastmsg_
gapMsg :: Message
gapMsg = ServerTime -> Message
newGapMessage ServerTime
timeJustAfterLast
timeJustAfterLast :: ServerTime
timeJustAfterLast = ServerTime
-> (Message -> ServerTime) -> Maybe Message -> ServerTime
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ServerTime
t0 (ServerTime -> ServerTime
justAfter (ServerTime -> ServerTime)
-> (Message -> ServerTime) -> Message -> ServerTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message -> ServerTime
_mDate) Maybe Message
lastmsg_
t0 :: ServerTime
t0 = UTCTime -> ServerTime
ServerTime (UTCTime -> ServerTime) -> UTCTime -> ServerTime
forall a b. (a -> b) -> a -> b
$ UTCTime
originTime
newGapMessage :: ServerTime -> Message
newGapMessage = Text -> MessageType -> ServerTime -> Message
newMessageOfType
(String -> Text
T.pack String
"Disconnected. Will refresh when connected.")
(ClientMessageType -> MessageType
C ClientMessageType
UnknownGapAfter)
in Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
lastIsGap
((ClientChannels -> Identity ClientChannels)
-> ChatState -> Identity ChatState
Lens' ChatState ClientChannels
csChannels ((ClientChannels -> Identity ClientChannels)
-> ChatState -> Identity ChatState)
-> (ClientChannels -> ClientChannels) -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ChannelId
-> (ClientChannel -> ClientChannel)
-> ClientChannels
-> ClientChannels
modifyChannelById ChannelId
cId ((MessageInterface Name () -> Identity (MessageInterface Name ()))
-> ClientChannel -> Identity ClientChannel
Lens' ClientChannel (MessageInterface Name ())
ccMessageInterface((MessageInterface Name () -> Identity (MessageInterface Name ()))
-> ClientChannel -> Identity ClientChannel)
-> ((Messages -> Identity Messages)
-> MessageInterface Name () -> Identity (MessageInterface Name ()))
-> (Messages -> Identity Messages)
-> ClientChannel
-> Identity ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Identity Messages)
-> MessageInterface Name () -> Identity (MessageInterface Name ())
forall n i. Lens' (MessageInterface n i) Messages
miMessages ((Messages -> Identity Messages)
-> ClientChannel -> Identity ClientChannel)
-> (Messages -> Messages) -> ClientChannel -> ClientChannel
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Message -> Messages -> Messages
forall a. MessageOps a => Message -> a -> a
addMessage Message
gapMsg))
lastMsg :: RetrogradeMessages -> Maybe Message
lastMsg :: RetrogradeMessages -> Maybe Message
lastMsg = (Message -> Message) -> RetrogradeMessages -> Maybe Message
forall dir r.
SeqDirection dir =>
(Message -> r) -> DirectionalSeq dir Message -> Maybe r
withFirstMessage Message -> Message
forall a. a -> a
id
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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FileInfo -> FileId
fileInfoId ([FileInfo] -> [FileId]) -> [FileInfo] -> [FileId]
forall a b. (a -> b) -> a -> b
$
[[FileInfo]] -> [FileInfo]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[FileInfo]] -> [FileInfo]) -> [[FileInfo]] -> [FileInfo]
forall a b. (a -> b) -> a -> b
$
(Seq FileInfo -> [FileInfo]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (Seq FileInfo -> [FileInfo])
-> (UploadResponse -> Seq FileInfo) -> UploadResponse -> [FileInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UploadResponse -> Seq FileInfo
MM.uploadResponseFileInfos) (UploadResponse -> [FileInfo]) -> [UploadResponse] -> [[FileInfo]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [UploadResponse]
fileInfos
case EditMode
mode of
EditMode
NewPost -> do
let pendingPost :: RawPost
pendingPost = (Text -> ChannelId -> RawPost
rawPost Text
msg ChannelId
chanId) { rawPostFileIds :: Seq FileId
rawPostFileIds = Seq FileId
fileIds }
IO Post -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Post -> IO ()) -> IO Post -> IO ()
forall a b. (a -> b) -> a -> b
$ RawPost -> Session -> IO Post
MM.mmCreatePost RawPost
pendingPost Session
session
Replying Message
_ Post
p -> do
let pendingPost :: RawPost
pendingPost = (Text -> ChannelId -> RawPost
rawPost Text
msg ChannelId
chanId) { rawPostRootId :: Maybe PostId
rawPostRootId = Post -> Maybe PostId
postRootId Post
p Maybe PostId -> Maybe PostId -> Maybe PostId
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (PostId -> Maybe PostId
forall a. a -> Maybe a
Just (PostId -> Maybe PostId) -> PostId -> Maybe PostId
forall a b. (a -> b) -> a -> b
$ Post -> PostId
postId Post
p)
, rawPostFileIds :: Seq FileId
rawPostFileIds = Seq FileId
fileIds
}
IO Post -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Post -> IO ()) -> IO Post -> IO ()
forall a b. (a -> b) -> a -> b
$ RawPost -> Session -> IO Post
MM.mmCreatePost RawPost
pendingPost Session
session
Editing Post
p MessageType
ty -> do
let body :: Text
body = case MessageType
ty of
CP ClientPostType
Emote -> Text -> Text
addEmoteFormatting Text
msg
MessageType
_ -> Text
msg
update :: PostUpdate
update = (Text -> PostUpdate
postUpdateBody Text
body) { postUpdateFileIds :: Maybe (Seq FileId)
postUpdateFileIds = if Seq FileId -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Seq FileId
fileIds
then Maybe (Seq FileId)
forall a. Maybe a
Nothing
else Seq FileId -> Maybe (Seq FileId)
forall a. a -> Maybe a
Just Seq FileId
fileIds
}
IO Post -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Post -> IO ()) -> IO Post -> IO ()
forall a b. (a -> b) -> a -> b
$ PostId -> PostUpdate -> Session -> IO Post
MM.mmPatchPost (Post -> PostId
postId Post
p) PostUpdate
update Session
session
shouldSkipMessage :: Text -> Bool
shouldSkipMessage :: Text -> Bool
shouldSkipMessage Text
"" = Bool
True
shouldSkipMessage Text
s = (Char -> Bool) -> Text -> Bool
T.all (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
" \t"::String)) Text
s
editMessage :: Post -> MH ()
editMessage :: Post -> MH ()
editMessage Post
new = do
UserId
myId <- (ChatState -> UserId) -> MH UserId
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ChatState -> UserId
myUserId
ChannelId -> (ClientChannel -> MH ()) -> MH ()
withChannel (Post
newPost -> Getting ChannelId Post ChannelId -> ChannelId
forall s a. s -> Getting a s a -> a
^.Getting ChannelId Post ChannelId
Lens' Post ChannelId
postChannelIdL) ((ClientChannel -> MH ()) -> MH ())
-> (ClientChannel -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \ClientChannel
chan -> do
let mTId :: Maybe TeamId
mTId = ClientChannel
chanClientChannel
-> Getting (Maybe TeamId) ClientChannel (Maybe TeamId)
-> Maybe TeamId
forall s a. s -> Getting a s a -> a
^.(ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
-> ClientChannel -> Const (Maybe TeamId) ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
-> ClientChannel -> Const (Maybe TeamId) ClientChannel)
-> ((Maybe TeamId -> Const (Maybe TeamId) (Maybe TeamId))
-> ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
-> Getting (Maybe TeamId) ClientChannel (Maybe TeamId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe TeamId -> Const (Maybe TeamId) (Maybe TeamId))
-> ChannelInfo -> Const (Maybe TeamId) ChannelInfo
Lens' ChannelInfo (Maybe TeamId)
cdTeamId
Maybe TeamBaseURL
mBaseUrl <- case Maybe TeamId
mTId of
Maybe TeamId
Nothing -> Maybe TeamBaseURL -> MH (Maybe TeamBaseURL)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TeamBaseURL
forall a. Maybe a
Nothing
Just TeamId
tId -> TeamBaseURL -> Maybe TeamBaseURL
forall a. a -> Maybe a
Just (TeamBaseURL -> Maybe TeamBaseURL)
-> MH TeamBaseURL -> MH (Maybe TeamBaseURL)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TeamId -> MH TeamBaseURL
getServerBaseUrl TeamId
tId
let (Message
msg, Set MentionedUser
mentionedUsers) = ClientPost -> (Message, Set MentionedUser)
clientPostToMessage (Maybe TeamBaseURL -> Post -> Maybe PostId -> ClientPost
toClientPost Maybe TeamBaseURL
mBaseUrl Post
new (Post
newPost -> Getting (Maybe PostId) Post (Maybe PostId) -> Maybe PostId
forall s a. s -> Getting a s a -> a
^.Getting (Maybe PostId) Post (Maybe PostId)
Lens' Post (Maybe PostId)
postRootIdL))
isEditedMessage :: Message -> Bool
isEditedMessage Message
m = Message
mMessage
-> Getting (Maybe MessageId) Message (Maybe MessageId)
-> Maybe MessageId
forall s a. s -> Getting a s a -> a
^.Getting (Maybe MessageId) Message (Maybe MessageId)
Lens' Message (Maybe MessageId)
mMessageId Maybe MessageId -> Maybe MessageId -> Bool
forall a. Eq a => a -> a -> Bool
== MessageId -> Maybe MessageId
forall a. a -> Maybe a
Just (PostId -> MessageId
MessagePostId (PostId -> MessageId) -> PostId -> MessageId
forall a b. (a -> b) -> a -> b
$ Post
newPost -> Getting PostId Post PostId -> PostId
forall s a. s -> Getting a s a -> a
^.Getting PostId Post PostId
Lens' Post PostId
postIdL)
ChannelId -> Traversal' ChatState ClientChannel
csChannel (Post
newPost -> Getting ChannelId Post ChannelId -> ChannelId
forall s a. s -> Getting a s a -> a
^.Getting ChannelId Post ChannelId
Lens' Post ChannelId
postChannelIdL) ((ClientChannel -> Identity ClientChannel)
-> ChatState -> Identity ChatState)
-> ((Message -> Identity Message)
-> ClientChannel -> Identity ClientChannel)
-> (Message -> Identity Message)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MessageInterface Name () -> Identity (MessageInterface Name ()))
-> ClientChannel -> Identity ClientChannel
Lens' ClientChannel (MessageInterface Name ())
ccMessageInterface((MessageInterface Name () -> Identity (MessageInterface Name ()))
-> ClientChannel -> Identity ClientChannel)
-> ((Message -> Identity Message)
-> MessageInterface Name () -> Identity (MessageInterface Name ()))
-> (Message -> Identity Message)
-> ClientChannel
-> Identity ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Identity Messages)
-> MessageInterface Name () -> Identity (MessageInterface Name ())
forall n i. Lens' (MessageInterface n i) Messages
miMessages ((Messages -> Identity Messages)
-> MessageInterface Name () -> Identity (MessageInterface Name ()))
-> ((Message -> Identity Message) -> Messages -> Identity Messages)
-> (Message -> Identity Message)
-> MessageInterface Name ()
-> Identity (MessageInterface Name ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Message -> Identity Message) -> Messages -> Identity Messages
forall (f :: * -> *) a b.
Traversable f =>
Traversal (f a) (f b) a b
traversed ((Message -> Identity Message) -> Messages -> Identity Messages)
-> ((Message -> Identity Message) -> Message -> Identity Message)
-> (Message -> Identity Message)
-> Messages
-> Identity Messages
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Message -> Bool) -> Traversal' Message Message
forall a. (a -> Bool) -> Traversal' a a
filtered Message -> Bool
isEditedMessage ((Message -> Identity Message) -> ChatState -> Identity ChatState)
-> Message -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Message
msg
ChannelId -> MH ()
invalidateChannelRenderingCache (ChannelId -> MH ()) -> ChannelId -> MH ()
forall a b. (a -> b) -> a -> b
$ Post
newPost -> Getting ChannelId Post ChannelId -> ChannelId
forall s a. s -> Getting a s a -> a
^.Getting ChannelId Post ChannelId
Lens' Post ChannelId
postChannelIdL
PostId -> MH ()
invalidateMessageRenderingCacheByPostId (PostId -> MH ()) -> PostId -> MH ()
forall a b. (a -> b) -> a -> b
$ Post -> PostId
postId Post
new
Maybe TeamId -> Post -> Message -> MH ()
editPostInOpenThread Maybe TeamId
mTId Post
new Message
msg
Set MentionedUser -> MH ()
fetchMentionedUsers Set MentionedUser
mentionedUsers
Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Post -> Maybe UserId
postUserId Post
new Maybe UserId -> Maybe UserId -> Bool
forall a. Eq a => a -> a -> Bool
/= UserId -> Maybe UserId
forall a. a -> Maybe a
Just UserId
myId) (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$
ChannelId -> Traversal' ChatState ClientChannel
csChannel (Post
newPost -> Getting ChannelId Post ChannelId -> ChannelId
forall s a. s -> Getting a s a -> a
^.Getting ChannelId Post ChannelId
Lens' Post ChannelId
postChannelIdL) ((ClientChannel -> Identity ClientChannel)
-> ChatState -> Identity ChatState)
-> (ClientChannel -> ClientChannel) -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Post -> ClientChannel -> ClientChannel
adjustEditedThreshold Post
new
(HashMap PostId Message -> Identity (HashMap PostId Message))
-> ChatState -> Identity ChatState
Lens' ChatState (HashMap PostId Message)
csPostMap((HashMap PostId Message -> Identity (HashMap PostId Message))
-> ChatState -> Identity ChatState)
-> ((Message -> Identity Message)
-> HashMap PostId Message -> Identity (HashMap PostId Message))
-> (Message -> Identity Message)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Index (HashMap PostId Message)
-> Traversal'
(HashMap PostId Message) (IxValue (HashMap PostId Message))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix(Post -> PostId
postId Post
new) ((Message -> Identity Message) -> ChatState -> Identity ChatState)
-> Message -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Message
msg
ChannelId -> Post -> MH ()
asyncFetchReactionsForPost (Post -> ChannelId
postChannelId Post
new) Post
new
Post -> MH ()
asyncFetchAttachments Post
new
deleteMessage :: Post -> MH ()
deleteMessage :: Post -> MH ()
deleteMessage Post
new = do
let isDeletedMessage :: Message -> Bool
isDeletedMessage Message
m = Message
mMessage
-> Getting (Maybe MessageId) Message (Maybe MessageId)
-> Maybe MessageId
forall s a. s -> Getting a s a -> a
^.Getting (Maybe MessageId) Message (Maybe MessageId)
Lens' Message (Maybe MessageId)
mMessageId Maybe MessageId -> Maybe MessageId -> Bool
forall a. Eq a => a -> a -> Bool
== MessageId -> Maybe MessageId
forall a. a -> Maybe a
Just (PostId -> MessageId
MessagePostId (PostId -> MessageId) -> PostId -> MessageId
forall a b. (a -> b) -> a -> b
$ Post
newPost -> Getting PostId Post PostId -> PostId
forall s a. s -> Getting a s a -> a
^.Getting PostId Post PostId
Lens' Post PostId
postIdL) Bool -> Bool -> Bool
||
PostId -> Message -> Bool
isReplyTo (Post
newPost -> Getting PostId Post PostId -> PostId
forall s a. s -> Getting a s a -> a
^.Getting PostId Post PostId
Lens' Post PostId
postIdL) Message
m
chan :: Traversal' ChatState ClientChannel
chan :: (ClientChannel -> f ClientChannel) -> ChatState -> f ChatState
chan = ChannelId -> Traversal' ChatState ClientChannel
csChannel (Post
newPost -> Getting ChannelId Post ChannelId -> ChannelId
forall s a. s -> Getting a s a -> a
^.Getting ChannelId Post ChannelId
Lens' Post ChannelId
postChannelIdL)
(ClientChannel -> Identity ClientChannel)
-> ChatState -> Identity ChatState
Traversal' ChatState ClientChannel
chan((ClientChannel -> Identity ClientChannel)
-> ChatState -> Identity ChatState)
-> ((Message -> Identity Message)
-> ClientChannel -> Identity ClientChannel)
-> (Message -> Identity Message)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MessageInterface Name () -> Identity (MessageInterface Name ()))
-> ClientChannel -> Identity ClientChannel
Lens' ClientChannel (MessageInterface Name ())
ccMessageInterface((MessageInterface Name () -> Identity (MessageInterface Name ()))
-> ClientChannel -> Identity ClientChannel)
-> ((Message -> Identity Message)
-> MessageInterface Name () -> Identity (MessageInterface Name ()))
-> (Message -> Identity Message)
-> ClientChannel
-> Identity ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Identity Messages)
-> MessageInterface Name () -> Identity (MessageInterface Name ())
forall n i. Lens' (MessageInterface n i) Messages
miMessages((Messages -> Identity Messages)
-> MessageInterface Name () -> Identity (MessageInterface Name ()))
-> ((Message -> Identity Message) -> Messages -> Identity Messages)
-> (Message -> Identity Message)
-> MessageInterface Name ()
-> Identity (MessageInterface Name ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Message -> Identity Message) -> Messages -> Identity Messages
forall (f :: * -> *) a b.
Traversable f =>
Traversal (f a) (f b) a b
traversed((Message -> Identity Message) -> Messages -> Identity Messages)
-> ((Message -> Identity Message) -> Message -> Identity Message)
-> (Message -> Identity Message)
-> Messages
-> Identity Messages
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Message -> Bool) -> Traversal' Message Message
forall a. (a -> Bool) -> Traversal' a a
filtered Message -> Bool
isDeletedMessage ((Message -> Identity Message) -> ChatState -> Identity ChatState)
-> (Message -> Message) -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Message -> (Message -> Message) -> Message
forall a b. a -> (a -> b) -> b
& (Bool -> Identity Bool) -> Message -> Identity Message
Lens' Message Bool
mDeleted ((Bool -> Identity Bool) -> Message -> Identity Message)
-> Bool -> Message -> Message
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True)
(ClientChannel -> Identity ClientChannel)
-> ChatState -> Identity ChatState
Traversal' ChatState ClientChannel
chan ((ClientChannel -> Identity ClientChannel)
-> ChatState -> Identity ChatState)
-> (ClientChannel -> ClientChannel) -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Post -> ClientChannel -> ClientChannel
adjustUpdated Post
new
ChannelId -> (ClientChannel -> MH ()) -> MH ()
withChannel (Post
newPost -> Getting ChannelId Post ChannelId -> ChannelId
forall s a. s -> Getting a s a -> a
^.Getting ChannelId Post ChannelId
Lens' Post ChannelId
postChannelIdL) ((ClientChannel -> MH ()) -> MH ())
-> (ClientChannel -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \ClientChannel
ch -> do
case ClientChannel
chClientChannel
-> Getting (Maybe TeamId) ClientChannel (Maybe TeamId)
-> Maybe TeamId
forall s a. s -> Getting a s a -> a
^.(ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
-> ClientChannel -> Const (Maybe TeamId) ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
-> ClientChannel -> Const (Maybe TeamId) ClientChannel)
-> ((Maybe TeamId -> Const (Maybe TeamId) (Maybe TeamId))
-> ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
-> Getting (Maybe TeamId) ClientChannel (Maybe TeamId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe TeamId -> Const (Maybe TeamId) (Maybe TeamId))
-> ChannelInfo -> Const (Maybe TeamId) ChannelInfo
Lens' ChannelInfo (Maybe TeamId)
cdTeamId of
Maybe TeamId
Nothing -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just TeamId
tId -> TeamId -> Post -> MH ()
deletePostFromOpenThread TeamId
tId Post
new
ChannelId -> MH ()
invalidateChannelRenderingCache (ChannelId -> MH ()) -> ChannelId -> MH ()
forall a b. (a -> b) -> a -> b
$ Post
newPost -> Getting ChannelId Post ChannelId -> ChannelId
forall s a. s -> Getting a s a -> a
^.Getting ChannelId Post ChannelId
Lens' Post ChannelId
postChannelIdL
PostId -> MH ()
invalidateMessageRenderingCacheByPostId (PostId -> MH ()) -> PostId -> MH ()
forall a b. (a -> b) -> a -> b
$ Post -> PostId
postId Post
new
deletePostFromOpenThread :: TeamId -> Post -> MH ()
deletePostFromOpenThread :: TeamId -> Post -> MH ()
deletePostFromOpenThread TeamId
tId Post
p = do
let isDeletedMessage :: Message -> Bool
isDeletedMessage Message
m = Message
mMessage
-> Getting (Maybe MessageId) Message (Maybe MessageId)
-> Maybe MessageId
forall s a. s -> Getting a s a -> a
^.Getting (Maybe MessageId) Message (Maybe MessageId)
Lens' Message (Maybe MessageId)
mMessageId Maybe MessageId -> Maybe MessageId -> Bool
forall a. Eq a => a -> a -> Bool
== MessageId -> Maybe MessageId
forall a. a -> Maybe a
Just (PostId -> MessageId
MessagePostId (PostId -> MessageId) -> PostId -> MessageId
forall a b. (a -> b) -> a -> b
$ Post
pPost -> Getting PostId Post PostId -> PostId
forall s a. s -> Getting a s a -> a
^.Getting PostId Post PostId
Lens' Post PostId
postIdL) Bool -> Bool -> Bool
||
PostId -> Message -> Bool
isReplyTo (Post
pPost -> Getting PostId Post PostId -> PostId
forall s a. s -> Getting a s a -> a
^.Getting PostId Post PostId
Lens' Post PostId
postIdL) Message
m
TeamId -> ChannelId -> (Message -> Bool) -> MH ()
threadInterfaceDeleteWhere TeamId
tId (Post
pPost -> Getting ChannelId Post ChannelId -> ChannelId
forall s a. s -> Getting a s a -> a
^.Getting ChannelId Post ChannelId
Lens' Post ChannelId
postChannelIdL) Message -> Bool
isDeletedMessage
Maybe ThreadInterface
ti <- Getting (Maybe ThreadInterface) ChatState (Maybe ThreadInterface)
-> MH (Maybe ThreadInterface)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)((TeamState -> Const (Maybe ThreadInterface) TeamState)
-> ChatState -> Const (Maybe ThreadInterface) ChatState)
-> ((Maybe ThreadInterface
-> Const (Maybe ThreadInterface) (Maybe ThreadInterface))
-> TeamState -> Const (Maybe ThreadInterface) TeamState)
-> Getting
(Maybe ThreadInterface) ChatState (Maybe ThreadInterface)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe ThreadInterface
-> Const (Maybe ThreadInterface) (Maybe ThreadInterface))
-> TeamState -> Const (Maybe ThreadInterface) TeamState
Lens' TeamState (Maybe ThreadInterface)
tsThreadInterface)
Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe ThreadInterface -> Bool
forall a. Maybe a -> Bool
isJust Maybe ThreadInterface
ti) (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ do
Bool
isEmpty <- TeamId -> MH Bool
threadInterfaceEmpty TeamId
tId
Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isEmpty (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ do
TeamId -> MH ()
closeThreadWindow TeamId
tId
Text -> MH ()
postInfoMessage Text
"The thread you were viewing was deleted."
addNewPostedMessage :: PostToAdd -> MH ()
addNewPostedMessage :: PostToAdd -> MH ()
addNewPostedMessage PostToAdd
p =
Bool -> Bool -> PostToAdd -> MH PostProcessMessageAdd
addMessageToState Bool
True Bool
True PostToAdd
p MH PostProcessMessageAdd
-> (PostProcessMessageAdd -> MH ()) -> MH ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PostProcessMessageAdd -> MH ()
postProcessMessageAdd
addObtainedMessages :: ChannelId -> Int -> Bool -> Posts -> MH PostProcessMessageAdd
addObtainedMessages :: ChannelId -> Int -> Bool -> Posts -> MH PostProcessMessageAdd
addObtainedMessages ChannelId
cId Int
reqCnt Bool
addTrailingGap Posts
posts = do
ChannelId -> MH ()
invalidateChannelRenderingCache ChannelId
cId
if Seq PostId -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Seq PostId -> Bool) -> Seq PostId -> Bool
forall a b. (a -> b) -> a -> b
$ Posts
postsPosts -> Getting (Seq PostId) Posts (Seq PostId) -> Seq PostId
forall s a. s -> Getting a s a -> a
^.Getting (Seq PostId) Posts (Seq PostId)
Lens' Posts (Seq PostId)
postsOrderL
then do Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
addTrailingGap (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$
(ClientChannels -> Identity ClientChannels)
-> ChatState -> Identity ChatState
Lens' ChatState ClientChannels
csChannels ((ClientChannels -> Identity ClientChannels)
-> ChatState -> Identity ChatState)
-> (ClientChannels -> ClientChannels) -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ChannelId
-> (ClientChannel -> ClientChannel)
-> ClientChannels
-> ClientChannels
modifyChannelById ChannelId
cId
((MessageInterface Name () -> Identity (MessageInterface Name ()))
-> ClientChannel -> Identity ClientChannel
Lens' ClientChannel (MessageInterface Name ())
ccMessageInterface((MessageInterface Name () -> Identity (MessageInterface Name ()))
-> ClientChannel -> Identity ClientChannel)
-> ((Messages -> Identity Messages)
-> MessageInterface Name () -> Identity (MessageInterface Name ()))
-> (Messages -> Identity Messages)
-> ClientChannel
-> Identity ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Identity Messages)
-> MessageInterface Name () -> Identity (MessageInterface Name ())
forall n i. Lens' (MessageInterface n i) Messages
miMessages ((Messages -> Identity Messages)
-> ClientChannel -> Identity ClientChannel)
-> (Messages -> Messages) -> ClientChannel -> ClientChannel
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~
\Messages
msgs -> let startPoint :: Maybe MessageId
startPoint = Maybe (Maybe MessageId) -> Maybe MessageId
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe MessageId) -> Maybe MessageId)
-> Maybe (Maybe MessageId) -> Maybe MessageId
forall a b. (a -> b) -> a -> b
$ Message -> Maybe MessageId
_mMessageId (Message -> Maybe MessageId)
-> Maybe Message -> Maybe (Maybe MessageId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Messages -> Maybe Message
getLatestPostMsg Messages
msgs
in (Messages, Messages) -> Messages
forall a b. (a, b) -> a
fst ((Messages, Messages) -> Messages)
-> (Messages, Messages) -> Messages
forall a b. (a -> b) -> a -> b
$ (Message -> Bool)
-> Maybe MessageId
-> Maybe MessageId
-> Messages
-> (Messages, Messages)
removeMatchesFromSubset Message -> Bool
isGap Maybe MessageId
startPoint Maybe MessageId
forall a. Maybe a
Nothing Messages
msgs)
PostProcessMessageAdd -> MH PostProcessMessageAdd
forall (m :: * -> *) a. Monad m => a -> m a
return PostProcessMessageAdd
NoAction
else
ChannelId
-> PostProcessMessageAdd
-> (ClientChannel -> MH PostProcessMessageAdd)
-> MH PostProcessMessageAdd
forall a. ChannelId -> a -> (ClientChannel -> MH a) -> MH a
withChannelOrDefault ChannelId
cId PostProcessMessageAdd
NoAction ((ClientChannel -> MH PostProcessMessageAdd)
-> MH PostProcessMessageAdd)
-> (ClientChannel -> MH PostProcessMessageAdd)
-> MH PostProcessMessageAdd
forall a b. (a -> b) -> a -> b
$ \ClientChannel
chan -> do
let pIdList :: [PostId]
pIdList = Seq PostId -> [PostId]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Posts
postsPosts -> Getting (Seq PostId) Posts (Seq PostId) -> Seq PostId
forall s a. s -> Getting a s a -> a
^.Getting (Seq PostId) Posts (Seq PostId)
Lens' Posts (Seq PostId)
postsOrderL)
mTId :: Maybe TeamId
mTId = ClientChannel
chanClientChannel
-> Getting (Maybe TeamId) ClientChannel (Maybe TeamId)
-> Maybe TeamId
forall s a. s -> Getting a s a -> a
^.(ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
-> ClientChannel -> Const (Maybe TeamId) ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
-> ClientChannel -> Const (Maybe TeamId) ClientChannel)
-> ((Maybe TeamId -> Const (Maybe TeamId) (Maybe TeamId))
-> ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
-> Getting (Maybe TeamId) ClientChannel (Maybe TeamId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe TeamId -> Const (Maybe TeamId) (Maybe TeamId))
-> ChannelInfo -> Const (Maybe TeamId) ChannelInfo
Lens' ChannelInfo (Maybe TeamId)
cdTeamId
earliestPId :: PostId
earliestPId = [PostId] -> PostId
forall a. [a] -> a
last [PostId]
pIdList
latestPId :: PostId
latestPId = [PostId] -> PostId
forall a. [a] -> a
head [PostId]
pIdList
earliestDate :: ServerTime
earliestDate = Post -> ServerTime
postCreateAt (Post -> ServerTime) -> Post -> ServerTime
forall a b. (a -> b) -> a -> b
$ (Posts
postsPosts
-> Getting (HashMap PostId Post) Posts (HashMap PostId Post)
-> HashMap PostId Post
forall s a. s -> Getting a s a -> a
^.Getting (HashMap PostId Post) Posts (HashMap PostId Post)
Lens' Posts (HashMap PostId Post)
postsPostsL) HashMap PostId Post -> PostId -> Post
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HM.! PostId
earliestPId
latestDate :: ServerTime
latestDate = Post -> ServerTime
postCreateAt (Post -> ServerTime) -> Post -> ServerTime
forall a b. (a -> b) -> a -> b
$ (Posts
postsPosts
-> Getting (HashMap PostId Post) Posts (HashMap PostId Post)
-> HashMap PostId Post
forall s a. s -> Getting a s a -> a
^.Getting (HashMap PostId Post) Posts (HashMap PostId Post)
Lens' Posts (HashMap PostId Post)
postsPostsL) HashMap PostId Post -> PostId -> Post
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HM.! PostId
latestPId
localMessages :: Messages
localMessages = ClientChannel
chanClientChannel
-> Getting Messages ClientChannel Messages -> Messages
forall s a. s -> Getting a s a -> a
^.(MessageInterface Name ()
-> Const Messages (MessageInterface Name ()))
-> ClientChannel -> Const Messages ClientChannel
Lens' ClientChannel (MessageInterface Name ())
ccMessageInterface((MessageInterface Name ()
-> Const Messages (MessageInterface Name ()))
-> ClientChannel -> Const Messages ClientChannel)
-> ((Messages -> Const Messages Messages)
-> MessageInterface Name ()
-> Const Messages (MessageInterface Name ()))
-> Getting Messages ClientChannel Messages
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Const Messages Messages)
-> MessageInterface Name ()
-> Const Messages (MessageInterface Name ())
forall n i. Lens' (MessageInterface n i) Messages
miMessages
match :: Messages
match = (Messages, Messages) -> Messages
forall a b. (a, b) -> b
snd ((Messages, Messages) -> Messages)
-> (Messages, Messages) -> Messages
forall a b. (a -> b) -> a -> b
$ (Message -> Bool)
-> Maybe MessageId
-> Maybe MessageId
-> Messages
-> (Messages, Messages)
removeMatchesFromSubset
(\Message
m -> Bool -> (PostId -> Bool) -> Maybe PostId -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (\PostId
p -> PostId
p PostId -> [PostId] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PostId]
pIdList) (Message -> Maybe PostId
messagePostId Message
m))
(MessageId -> Maybe MessageId
forall a. a -> Maybe a
Just (PostId -> MessageId
MessagePostId PostId
earliestPId))
(MessageId -> Maybe MessageId
forall a. a -> Maybe a
Just (PostId -> MessageId
MessagePostId PostId
latestPId))
Messages
localMessages
accum :: Message -> [PostId] -> [PostId]
accum Message
m [PostId]
l =
case Message -> Maybe PostId
messagePostId Message
m of
Just PostId
pId -> PostId
pId PostId -> [PostId] -> [PostId]
forall a. a -> [a] -> [a]
: [PostId]
l
Maybe PostId
Nothing -> [PostId]
l
dupPIds :: [PostId]
dupPIds = (Message -> [PostId] -> [PostId])
-> [PostId] -> Messages -> [PostId]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Message -> [PostId] -> [PostId]
accum [] Messages
match
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 (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 (t :: * -> *) a. Foldable t => t a -> Int
length [PostId]
pIdList Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< (-Int
reqCnt)
noMoreAfter :: Bool
noMoreAfter = Bool
addTrailingGap Bool -> Bool -> Bool
|| Int
reqCnt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& [PostId] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PostId]
pIdList Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
reqCnt
reAddGapBefore :: Bool
reAddGapBefore = PostId
earliestPId PostId -> [PostId] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PostId]
dupPIds Bool -> Bool -> Bool
|| Bool
noMoreBefore
reAddGapAfter :: Bool
reAddGapAfter = PostId
latestPId PostId -> [PostId] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PostId]
dupPIds Bool -> Bool -> Bool
|| 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 (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr PostProcessMessageAdd
-> PostProcessMessageAdd -> PostProcessMessageAdd
andProcessWith PostProcessMessageAdd
NoAction ([PostProcessMessageAdd] -> PostProcessMessageAdd)
-> MH [PostProcessMessageAdd] -> MH PostProcessMessageAdd
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(Post -> MH PostProcessMessageAdd)
-> [Post] -> MH [PostProcessMessageAdd]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Bool -> Bool -> PostToAdd -> MH PostProcessMessageAdd
addMessageToState Bool
False Bool
False (PostToAdd -> MH PostProcessMessageAdd)
-> (Post -> PostToAdd) -> Post -> MH PostProcessMessageAdd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Post -> PostToAdd
OldPost)
[ (Posts
postsPosts
-> Getting (HashMap PostId Post) Posts (HashMap PostId Post)
-> HashMap PostId Post
forall s a. s -> Getting a s a -> a
^.Getting (HashMap PostId Post) Posts (HashMap PostId Post)
Lens' Posts (HashMap PostId Post)
postsPostsL) HashMap PostId Post -> PostId -> Post
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HM.! PostId
p
| PostId
p <- Seq PostId -> [PostId]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Posts
postsPosts -> Getting (Seq PostId) Posts (Seq PostId) -> Seq PostId
forall s a. s -> Getting a s a -> a
^.Getting (Seq PostId) Posts (Seq PostId)
Lens' Posts (Seq PostId)
postsOrderL)
, Bool -> Bool
not (PostId
p PostId -> [PostId] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PostId]
dupPIds)
]
ChannelId -> () -> (ClientChannel -> MH ()) -> MH ()
forall a. ChannelId -> a -> (ClientChannel -> MH a) -> MH a
withChannelOrDefault ChannelId
cId () ((ClientChannel -> MH ()) -> MH ())
-> (ClientChannel -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \ClientChannel
updchan -> do
let updMsgs :: Messages
updMsgs = ClientChannel
updchan ClientChannel
-> Getting Messages ClientChannel Messages -> Messages
forall s a. s -> Getting a s a -> a
^. (MessageInterface Name ()
-> Const Messages (MessageInterface Name ()))
-> ClientChannel -> Const Messages ClientChannel
Lens' ClientChannel (MessageInterface Name ())
ccMessageInterface((MessageInterface Name ()
-> Const Messages (MessageInterface Name ()))
-> ClientChannel -> Const Messages ClientChannel)
-> ((Messages -> Const Messages Messages)
-> MessageInterface Name ()
-> Const Messages (MessageInterface Name ()))
-> Getting Messages ClientChannel Messages
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Const Messages Messages)
-> MessageInterface Name ()
-> Const Messages (MessageInterface Name ())
forall n i. Lens' (MessageInterface n i) Messages
miMessages
let (Messages
resultMessages, Messages
removedMessages) =
(Message -> Bool)
-> Maybe MessageId
-> Maybe MessageId
-> Messages
-> (Messages, Messages)
removeMatchesFromSubset Message -> Bool
isGap Maybe MessageId
removeStart Maybe MessageId
removeEnd Messages
updMsgs
(ClientChannels -> Identity ClientChannels)
-> ChatState -> Identity ChatState
Lens' ChatState ClientChannels
csChannels ((ClientChannels -> Identity ClientChannels)
-> ChatState -> Identity ChatState)
-> (ClientChannels -> ClientChannels) -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ChannelId
-> (ClientChannel -> ClientChannel)
-> ClientChannels
-> ClientChannels
modifyChannelById ChannelId
cId
((MessageInterface Name () -> Identity (MessageInterface Name ()))
-> ClientChannel -> Identity ClientChannel
Lens' ClientChannel (MessageInterface Name ())
ccMessageInterface((MessageInterface Name () -> Identity (MessageInterface Name ()))
-> ClientChannel -> Identity ClientChannel)
-> ((Messages -> Identity Messages)
-> MessageInterface Name () -> Identity (MessageInterface Name ()))
-> (Messages -> Identity Messages)
-> ClientChannel
-> Identity ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Identity Messages)
-> MessageInterface Name () -> Identity (MessageInterface Name ())
forall n i. Lens' (MessageInterface n i) Messages
miMessages ((Messages -> Identity Messages)
-> ClientChannel -> Identity ClientChannel)
-> Messages -> ClientChannel -> ClientChannel
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Messages
resultMessages)
let processTeam :: TeamId -> MH ()
processTeam TeamId
tId = do
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 (m :: * -> *) a. Monad m => a -> m a
return ()
Just Message
rm ->
if Message -> Bool
isGap Message
rm
then () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
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 (f :: * -> *) a. Applicative f => a -> f a
pure (MessageId -> Maybe MessageId) -> MessageId -> Maybe MessageId
forall a b. (a -> b) -> a -> b
$ PostId -> MessageId
MessagePostId PostId
earliestPId)
Maybe MessageType
_ -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else do
Message
gapMsg <- ServerTime -> Bool -> MH Message
newGapMessage (ServerTime -> ServerTime
justBefore ServerTime
earliestDate) Bool
True
(ClientChannels -> Identity ClientChannels)
-> ChatState -> Identity ChatState
Lens' ChatState ClientChannels
csChannels ((ClientChannels -> Identity ClientChannels)
-> ChatState -> Identity ChatState)
-> (ClientChannels -> ClientChannels) -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ChannelId
-> (ClientChannel -> ClientChannel)
-> ClientChannels
-> ClientChannels
modifyChannelById ChannelId
cId
((MessageInterface Name () -> Identity (MessageInterface Name ()))
-> ClientChannel -> Identity ClientChannel
Lens' ClientChannel (MessageInterface Name ())
ccMessageInterface((MessageInterface Name () -> Identity (MessageInterface Name ()))
-> ClientChannel -> Identity ClientChannel)
-> ((Messages -> Identity Messages)
-> MessageInterface Name () -> Identity (MessageInterface Name ()))
-> (Messages -> Identity Messages)
-> ClientChannel
-> Identity ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Identity Messages)
-> MessageInterface Name () -> Identity (MessageInterface Name ())
forall n i. Lens' (MessageInterface n i) Messages
miMessages ((Messages -> Identity Messages)
-> ClientChannel -> Identity ClientChannel)
-> (Messages -> Messages) -> ClientChannel -> ClientChannel
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Message -> Messages -> Messages
forall a. MessageOps a => Message -> a -> a
addMessage Message
gapMsg)
case Maybe MessageType
rmvdSelType of
Just (C ClientMessageType
UnknownGapBefore) -> do
ChannelId -> Lens' ChatState MessageSelectState
channelMessageSelect(ChannelId
cId) ((MessageSelectState -> Identity MessageSelectState)
-> ChatState -> Identity ChatState)
-> MessageSelectState -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe MessageId -> MessageSelectState
MessageSelectState (Message
gapMsgMessage
-> Getting (Maybe MessageId) Message (Maybe MessageId)
-> Maybe MessageId
forall s a. s -> Getting a s a -> a
^.Getting (Maybe MessageId) Message (Maybe MessageId)
Lens' Message (Maybe MessageId)
mMessageId)
Maybe MessageType
_ -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
if Bool
reAddGapAfter
then
case Maybe MessageType
rmvdSelType of
Just (C ClientMessageType
UnknownGapAfter) ->
ChannelId -> Lens' ChatState MessageSelectState
channelMessageSelect(ChannelId
cId) ((MessageSelectState -> Identity MessageSelectState)
-> ChatState -> Identity ChatState)
-> MessageSelectState -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe MessageId -> MessageSelectState
MessageSelectState (MessageId -> Maybe MessageId
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MessageId -> Maybe MessageId) -> MessageId -> Maybe MessageId
forall a b. (a -> b) -> a -> b
$ PostId -> MessageId
MessagePostId PostId
latestPId)
Maybe MessageType
_ -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else do
Message
gapMsg <- ServerTime -> Bool -> MH Message
newGapMessage (ServerTime -> ServerTime
justAfter ServerTime
latestDate) Bool
False
(ClientChannels -> Identity ClientChannels)
-> ChatState -> Identity ChatState
Lens' ChatState ClientChannels
csChannels ((ClientChannels -> Identity ClientChannels)
-> ChatState -> Identity ChatState)
-> (ClientChannels -> ClientChannels) -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ChannelId
-> (ClientChannel -> ClientChannel)
-> ClientChannels
-> ClientChannels
modifyChannelById ChannelId
cId
((MessageInterface Name () -> Identity (MessageInterface Name ()))
-> ClientChannel -> Identity ClientChannel
Lens' ClientChannel (MessageInterface Name ())
ccMessageInterface((MessageInterface Name () -> Identity (MessageInterface Name ()))
-> ClientChannel -> Identity ClientChannel)
-> ((Messages -> Identity Messages)
-> MessageInterface Name () -> Identity (MessageInterface Name ()))
-> (Messages -> Identity Messages)
-> ClientChannel
-> Identity ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Identity Messages)
-> MessageInterface Name () -> Identity (MessageInterface Name ())
forall n i. Lens' (MessageInterface n i) Messages
miMessages ((Messages -> Identity Messages)
-> ClientChannel -> Identity ClientChannel)
-> (Messages -> Messages) -> ClientChannel -> ClientChannel
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Message -> Messages -> Messages
forall a. MessageOps a => Message -> a -> a
addMessage Message
gapMsg)
case Maybe MessageType
rmvdSelType of
Just (C ClientMessageType
UnknownGapAfter) ->
ChannelId -> Lens' ChatState MessageSelectState
channelMessageSelect(ChannelId
cId) ((MessageSelectState -> Identity MessageSelectState)
-> ChatState -> Identity ChatState)
-> MessageSelectState -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe MessageId -> MessageSelectState
MessageSelectState (Message
gapMsgMessage
-> Getting (Maybe MessageId) Message (Maybe MessageId)
-> Maybe MessageId
forall s a. s -> Getting a s a -> a
^.Getting (Maybe MessageId) Message (Maybe MessageId)
Lens' Message (Maybe MessageId)
mMessageId)
Maybe MessageType
_ -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
case Maybe TeamId
mTId of
Maybe TeamId
Nothing -> do
HashMap TeamId TeamState
ts <- Getting
(HashMap TeamId TeamState) ChatState (HashMap TeamId TeamState)
-> MH (HashMap TeamId TeamState)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting
(HashMap TeamId TeamState) ChatState (HashMap TeamId TeamState)
Lens' ChatState (HashMap TeamId TeamState)
csTeams
[TeamId] -> (TeamId -> MH ()) -> MH ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (HashMap TeamId TeamState -> [TeamId]
forall k v. HashMap k v -> [k]
HM.keys HashMap TeamId TeamState
ts) TeamId -> MH ()
processTeam
Just TeamId
tId -> TeamId -> MH ()
processTeam TeamId
tId
let users :: Set UserId
users = (Post -> Set UserId -> Set UserId)
-> Set UserId -> HashMap PostId Post -> Set UserId
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Post
post Set UserId
s -> Set UserId -> (UserId -> Set UserId) -> Maybe UserId -> Set UserId
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Set UserId
s ((UserId -> Set UserId -> Set UserId)
-> Set UserId -> UserId -> Set UserId
forall a b c. (a -> b -> c) -> b -> a -> c
flip UserId -> Set UserId -> Set UserId
forall a. Ord a => a -> Set a -> Set a
Set.insert Set UserId
s) (Post -> Maybe UserId
postUserId Post
post))
Set UserId
forall a. Set a
Set.empty (Posts
postsPosts
-> Getting (HashMap PostId Post) Posts (HashMap PostId Post)
-> HashMap PostId Post
forall s a. s -> Getting a s a -> a
^.Getting (HashMap PostId Post) Posts (HashMap PostId Post)
Lens' Posts (HashMap PostId Post)
postsPostsL)
addUnknownUsers :: Set UserId -> MH ()
addUnknownUsers Set UserId
inputUserIds = do
Set UserId
knownUserIds <- [UserId] -> Set UserId
forall a. Ord a => [a] -> Set a
Set.fromList ([UserId] -> Set UserId) -> MH [UserId] -> MH (Set UserId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ChatState -> [UserId]) -> MH [UserId]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ChatState -> [UserId]
allUserIds
let unknownUsers :: Set UserId
unknownUsers = Set UserId -> Set UserId -> Set UserId
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set UserId
inputUserIds Set UserId
knownUserIds
if Set UserId -> Bool
forall a. Set a -> Bool
Set.null Set UserId
unknownUsers
then () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else Seq UserId -> MH () -> MH ()
handleNewUsers ([UserId] -> Seq UserId
forall a. [a] -> Seq a
Seq.fromList ([UserId] -> Seq UserId) -> [UserId] -> Seq UserId
forall a b. (a -> b) -> a -> b
$ Set UserId -> [UserId]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set UserId
unknownUsers) (() -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
Set UserId -> MH ()
addUnknownUsers Set UserId
users
PostProcessMessageAdd -> MH PostProcessMessageAdd
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)
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 (m :: * -> *) a. Monad m => a -> m a
return Maybe (MH ())
forall a. Maybe a
Nothing
Bool
False -> Maybe (MH ()) -> IO (Maybe (MH ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MH ()) -> IO (Maybe (MH ())))
-> Maybe (MH ()) -> IO (Maybe (MH ()))
forall a b. (a -> b) -> a -> b
$ MH () -> Maybe (MH ())
forall a. a -> Maybe a
Just (MH () -> Maybe (MH ())) -> MH () -> Maybe (MH ())
forall a b. (a -> b) -> a -> b
$ do
if Type
chType Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== Type
Group
then Preference -> MH ()
applyPreferenceChange Preference
pref
else SidebarUpdate -> Channel -> ChannelMember -> MH ()
refreshChannel SidebarUpdate
SidebarUpdateImmediate Channel
nc ChannelMember
member
Bool -> Bool -> PostToAdd -> MH PostProcessMessageAdd
addMessageToState Bool
doFetchMentionedUsers Bool
fetchAuthor PostToAdd
newPostData MH PostProcessMessageAdd
-> (PostProcessMessageAdd -> MH ()) -> MH ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
PostProcessMessageAdd -> MH ()
postProcessMessageAdd
PostProcessMessageAdd -> MH PostProcessMessageAdd
forall (m :: * -> *) a. Monad m => a -> m a
return PostProcessMessageAdd
NoAction
Just ClientChannel
ch -> do
let mTId :: Maybe TeamId
mTId = ClientChannel
chClientChannel
-> Getting (Maybe TeamId) ClientChannel (Maybe TeamId)
-> Maybe TeamId
forall s a. s -> Getting a s a -> a
^.(ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
-> ClientChannel -> Const (Maybe TeamId) ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
-> ClientChannel -> Const (Maybe TeamId) ClientChannel)
-> ((Maybe TeamId -> Const (Maybe TeamId) (Maybe TeamId))
-> ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
-> Getting (Maybe TeamId) ClientChannel (Maybe TeamId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe TeamId -> Const (Maybe TeamId) (Maybe TeamId))
-> ChannelInfo -> Const (Maybe TeamId) ChannelInfo
Lens' ChannelInfo (Maybe TeamId)
cdTeamId
Maybe TeamBaseURL
mBaseUrl <- case Maybe TeamId
mTId of
Maybe TeamId
Nothing -> Maybe TeamBaseURL -> MH (Maybe TeamBaseURL)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TeamBaseURL
forall a. Maybe a
Nothing
Just TeamId
tId -> TeamBaseURL -> Maybe TeamBaseURL
forall a. a -> Maybe a
Just (TeamBaseURL -> Maybe TeamBaseURL)
-> MH TeamBaseURL -> MH (Maybe TeamBaseURL)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TeamId -> MH TeamBaseURL
getServerBaseUrl TeamId
tId
let cp :: ClientPost
cp = Maybe TeamBaseURL -> Post -> Maybe PostId -> ClientPost
toClientPost Maybe TeamBaseURL
mBaseUrl Post
new (Post
newPost -> Getting (Maybe PostId) Post (Maybe PostId) -> Maybe PostId
forall s a. s -> Getting a s a -> a
^.Getting (Maybe PostId) Post (Maybe PostId)
Lens' Post (Maybe PostId)
postRootIdL)
fromMe :: Bool
fromMe = (ClientPost
cpClientPost
-> Getting (Maybe UserId) ClientPost (Maybe UserId) -> Maybe UserId
forall s a. s -> Getting a s a -> a
^.Getting (Maybe UserId) ClientPost (Maybe UserId)
Lens' ClientPost (Maybe UserId)
cpUser Maybe UserId -> Maybe UserId -> Bool
forall a. Eq a => a -> a -> Bool
== (UserId -> Maybe UserId
forall a. a -> Maybe a
Just (UserId -> Maybe UserId) -> UserId -> Maybe UserId
forall a b. (a -> b) -> a -> b
$ ChatState -> UserId
myUserId ChatState
st)) Bool -> Bool -> Bool
&&
(Maybe Text -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe Text -> Bool) -> Maybe Text -> Bool
forall a b. (a -> b) -> a -> b
$ ClientPost
cpClientPost
-> Getting (Maybe Text) ClientPost (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^.Getting (Maybe Text) ClientPost (Maybe Text)
Lens' ClientPost (Maybe Text)
cpUserOverride)
userPrefs :: UserPreferences
userPrefs = ChatState
stChatState
-> Getting UserPreferences ChatState UserPreferences
-> UserPreferences
forall s a. s -> Getting a s a -> a
^.(ChatResources -> Const UserPreferences ChatResources)
-> ChatState -> Const UserPreferences ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Const UserPreferences ChatResources)
-> ChatState -> Const UserPreferences ChatState)
-> ((UserPreferences -> Const UserPreferences UserPreferences)
-> ChatResources -> Const UserPreferences ChatResources)
-> Getting UserPreferences ChatState UserPreferences
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(UserPreferences -> Const UserPreferences UserPreferences)
-> ChatResources -> Const UserPreferences ChatResources
Lens' ChatResources UserPreferences
crUserPreferences
isJoinOrLeave :: Bool
isJoinOrLeave = case ClientPost
cpClientPost
-> Getting ClientPostType ClientPost ClientPostType
-> ClientPostType
forall s a. s -> Getting a s a -> a
^.Getting ClientPostType ClientPost ClientPostType
Lens' ClientPost ClientPostType
cpType of
ClientPostType
Join -> Bool
True
ClientPostType
Leave -> Bool
True
ClientPostType
_ -> Bool
False
ignoredJoinLeaveMessage :: Bool
ignoredJoinLeaveMessage =
Bool -> Bool
not (UserPreferences
userPrefsUserPreferences -> Getting Bool UserPreferences Bool -> Bool
forall s a. s -> Getting a s a -> a
^.Getting Bool UserPreferences Bool
Lens' UserPreferences Bool
userPrefShowJoinLeave) Bool -> Bool -> Bool
&& Bool
isJoinOrLeave
cId :: ChannelId
cId = Post -> ChannelId
postChannelId Post
new
doAddMessage :: MH PostProcessMessageAdd
doAddMessage = do
case ClientPost
cpClientPost
-> Getting (Maybe UserId) ClientPost (Maybe UserId) -> Maybe UserId
forall s a. s -> Getting a s a -> a
^.Getting (Maybe UserId) ClientPost (Maybe UserId)
Lens' ClientPost (Maybe UserId)
cpUser of
Maybe UserId
Nothing -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just UserId
authorId -> Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
fetchAuthor (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ do
Maybe UserInfo
authorResult <- (ChatState -> Maybe UserInfo) -> MH (Maybe UserInfo)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (UserId -> ChatState -> Maybe UserInfo
userById UserId
authorId)
Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe UserInfo -> Bool
forall a. Maybe a -> Bool
isNothing Maybe UserInfo
authorResult) (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$
Seq UserId -> MH () -> MH ()
handleNewUsers (UserId -> Seq UserId
forall a. a -> Seq a
Seq.singleton UserId
authorId) (() -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
Maybe TeamId
mcurTId <- Getting (Maybe TeamId) ChatState (Maybe TeamId)
-> MH (Maybe TeamId)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Maybe TeamId) ChatState (Maybe TeamId)
SimpleGetter ChatState (Maybe TeamId)
csCurrentTeamId
Maybe ChannelId
currCId <- case Maybe TeamId
mcurTId of
Maybe TeamId
Nothing -> Maybe ChannelId -> MH (Maybe ChannelId)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ChannelId
forall a. Maybe a
Nothing
Just TeamId
curTId -> Getting (Maybe ChannelId) ChatState (Maybe ChannelId)
-> MH (Maybe ChannelId)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> SimpleGetter ChatState (Maybe ChannelId)
csCurrentChannelId TeamId
curTId)
Set PostId
flags <- Getting (Set PostId) ChatState (Set PostId) -> MH (Set PostId)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((ChatResources -> Const (Set PostId) ChatResources)
-> ChatState -> Const (Set PostId) ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Const (Set PostId) ChatResources)
-> ChatState -> Const (Set PostId) ChatState)
-> ((Set PostId -> Const (Set PostId) (Set PostId))
-> ChatResources -> Const (Set PostId) ChatResources)
-> Getting (Set PostId) ChatState (Set PostId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Set PostId -> Const (Set PostId) (Set PostId))
-> ChatResources -> Const (Set PostId) ChatResources
Lens' ChatResources (Set PostId)
crFlaggedPosts)
let (Message
msg', Set MentionedUser
mentionedUsers) = ClientPost -> (Message, Set MentionedUser)
clientPostToMessage ClientPost
cp
(Message, Set MentionedUser)
-> ((Message, Set MentionedUser) -> (Message, Set MentionedUser))
-> (Message, Set MentionedUser)
forall a b. a -> (a -> b) -> b
& (Message -> Identity Message)
-> (Message, Set MentionedUser)
-> Identity (Message, Set MentionedUser)
forall s t a b. Field1 s t a b => Lens s t a b
_1((Message -> Identity Message)
-> (Message, Set MentionedUser)
-> Identity (Message, Set MentionedUser))
-> ((Bool -> Identity Bool) -> Message -> Identity Message)
-> (Bool -> Identity Bool)
-> (Message, Set MentionedUser)
-> Identity (Message, Set MentionedUser)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Identity Bool) -> Message -> Identity Message
Lens' Message Bool
mFlagged ((Bool -> Identity Bool)
-> (Message, Set MentionedUser)
-> Identity (Message, Set MentionedUser))
-> Bool
-> (Message, Set MentionedUser)
-> (Message, Set MentionedUser)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ((ClientPost
cpClientPost -> Getting PostId ClientPost PostId -> PostId
forall s a. s -> Getting a s a -> a
^.Getting PostId ClientPost PostId
Lens' ClientPost PostId
cpPostId) PostId -> Set PostId -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set PostId
flags)
Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
doFetchMentionedUsers (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$
Set MentionedUser -> MH ()
fetchMentionedUsers Set MentionedUser
mentionedUsers
(HashMap PostId Message -> Identity (HashMap PostId Message))
-> ChatState -> Identity ChatState
Lens' ChatState (HashMap PostId Message)
csPostMap((HashMap PostId Message -> Identity (HashMap PostId Message))
-> ChatState -> Identity ChatState)
-> ((Maybe Message -> Identity (Maybe Message))
-> HashMap PostId Message -> Identity (HashMap PostId Message))
-> (Maybe Message -> Identity (Maybe Message))
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Index (HashMap PostId Message)
-> Lens'
(HashMap PostId Message) (Maybe (IxValue (HashMap PostId Message)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at(Post -> PostId
postId Post
new) ((Maybe Message -> Identity (Maybe Message))
-> ChatState -> Identity ChatState)
-> Maybe Message -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Message -> Maybe Message
forall a. a -> Maybe a
Just Message
msg'
ChannelId -> MH ()
invalidateChannelRenderingCache ChannelId
cId
PostId -> MH ()
invalidateMessageRenderingCacheByPostId (PostId -> MH ()) -> PostId -> MH ()
forall a b. (a -> b) -> a -> b
$ Post -> PostId
postId Post
new
(ClientChannels -> Identity ClientChannels)
-> ChatState -> Identity ChatState
Lens' ChatState ClientChannels
csChannels ((ClientChannels -> Identity ClientChannels)
-> ChatState -> Identity ChatState)
-> (ClientChannels -> ClientChannels) -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ChannelId
-> (ClientChannel -> ClientChannel)
-> ClientChannels
-> ClientChannels
modifyChannelById ChannelId
cId
(((MessageInterface Name () -> Identity (MessageInterface Name ()))
-> ClientChannel -> Identity ClientChannel
Lens' ClientChannel (MessageInterface Name ())
ccMessageInterface((MessageInterface Name () -> Identity (MessageInterface Name ()))
-> ClientChannel -> Identity ClientChannel)
-> ((Messages -> Identity Messages)
-> MessageInterface Name () -> Identity (MessageInterface Name ()))
-> (Messages -> Identity Messages)
-> ClientChannel
-> Identity ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Identity Messages)
-> MessageInterface Name () -> Identity (MessageInterface Name ())
forall n i. Lens' (MessageInterface n i) Messages
miMessages ((Messages -> Identity Messages)
-> ClientChannel -> Identity ClientChannel)
-> (Messages -> Messages) -> ClientChannel -> ClientChannel
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Message -> Messages -> Messages
forall a. MessageOps a => Message -> a -> a
addMessage Message
msg') (ClientChannel -> ClientChannel)
-> (ClientChannel -> ClientChannel)
-> ClientChannel
-> ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(if Bool -> Bool
not Bool
ignoredJoinLeaveMessage then Post -> ClientChannel -> ClientChannel
adjustUpdated Post
new else ClientChannel -> ClientChannel
forall a. a -> a
id) (ClientChannel -> ClientChannel)
-> (ClientChannel -> ClientChannel)
-> ClientChannel
-> ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(\ClientChannel
c -> if Maybe ChannelId
currCId Maybe ChannelId -> Maybe ChannelId -> Bool
forall a. Eq a => a -> a -> Bool
== ChannelId -> Maybe ChannelId
forall a. a -> Maybe a
Just ChannelId
cId
then ClientChannel
c
else case PostToAdd
newPostData of
OldPost Post
_ -> ClientChannel
c
RecentPost Post
_ Bool
_ ->
Post -> ClientChannel -> ClientChannel
updateNewMessageIndicator Post
new ClientChannel
c) (ClientChannel -> ClientChannel)
-> (ClientChannel -> ClientChannel)
-> ClientChannel
-> ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(\ClientChannel
c -> if Bool
wasMentioned
then ClientChannel
c ClientChannel -> (ClientChannel -> ClientChannel) -> ClientChannel
forall a b. a -> (a -> b) -> b
& (ChannelInfo -> Identity ChannelInfo)
-> ClientChannel -> Identity ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Identity ChannelInfo)
-> ClientChannel -> Identity ClientChannel)
-> ((Int -> Identity Int) -> ChannelInfo -> Identity ChannelInfo)
-> (Int -> Identity Int)
-> ClientChannel
-> Identity ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> Identity Int) -> ChannelInfo -> Identity ChannelInfo
Lens' ChannelInfo Int
cdMentionCount ((Int -> Identity Int) -> ClientChannel -> Identity ClientChannel)
-> (Int -> Int) -> ClientChannel -> ClientChannel
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Int -> Int
forall a. Enum a => a -> a
succ
else ClientChannel
c)
)
Maybe TeamId -> Post -> Message -> MH ()
addPostToOpenThread Maybe TeamId
mTId Post
new Message
msg'
ChannelId -> Post -> MH ()
asyncFetchReactionsForPost ChannelId
cId Post
new
Post -> MH ()
asyncFetchAttachments Post
new
MH PostProcessMessageAdd
postedChanMessage
doHandleAddedMessage :: MH PostProcessMessageAdd
doHandleAddedMessage = do
case ClientPost
cpClientPost
-> Getting (Maybe PostId) ClientPost (Maybe PostId) -> Maybe PostId
forall s a. s -> Getting a s a -> a
^.Getting (Maybe PostId) ClientPost (Maybe PostId)
Lens' ClientPost (Maybe PostId)
cpInReplyToPost of
Just PostId
parentId ->
case ChatState -> PostId -> Maybe Message
getMessageForPostId ChatState
st PostId
parentId of
Maybe Message
Nothing -> do
DoAsyncChannelMM Posts
forall a. DoAsyncChannelMM a
doAsyncChannelMM AsyncPriority
Preempt ChannelId
cId
(\Session
s ChannelId
_ -> PostId -> Session -> IO Posts
MM.mmGetThread PostId
parentId Session
s)
(\ChannelId
_ Posts
p -> MH () -> Maybe (MH ())
forall a. a -> Maybe a
Just (MH () -> Maybe (MH ())) -> MH () -> Maybe (MH ())
forall a b. (a -> b) -> a -> b
$ Maybe TeamId -> Posts -> MH ()
updatePostMap Maybe TeamId
mTId Posts
p)
Maybe Message
_ -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Maybe PostId
_ -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
MH PostProcessMessageAdd
doAddMessage
postedChanMessage :: MH PostProcessMessageAdd
postedChanMessage =
ChannelId
-> PostProcessMessageAdd
-> (ClientChannel -> MH PostProcessMessageAdd)
-> MH PostProcessMessageAdd
forall a. ChannelId -> a -> (ClientChannel -> MH a) -> MH a
withChannelOrDefault (Post -> ChannelId
postChannelId Post
new) PostProcessMessageAdd
NoAction ((ClientChannel -> MH PostProcessMessageAdd)
-> MH PostProcessMessageAdd)
-> (ClientChannel -> MH PostProcessMessageAdd)
-> MH PostProcessMessageAdd
forall a b. (a -> b) -> a -> b
$ \ClientChannel
chan -> do
Maybe TeamId
mcurrTid <- Getting (Maybe TeamId) ChatState (Maybe TeamId)
-> MH (Maybe TeamId)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Maybe TeamId) ChatState (Maybe TeamId)
SimpleGetter ChatState (Maybe TeamId)
csCurrentTeamId
case Maybe TeamId
mcurrTid of
Maybe TeamId
Nothing -> PostProcessMessageAdd -> MH PostProcessMessageAdd
forall (m :: * -> *) a. Monad m => a -> m a
return PostProcessMessageAdd
NoAction
Just TeamId
currTid -> do
Maybe ChannelId
currCId <- Getting (Maybe ChannelId) ChatState (Maybe ChannelId)
-> MH (Maybe ChannelId)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> SimpleGetter ChatState (Maybe ChannelId)
csCurrentChannelId TeamId
currTid)
let notifyPref :: NotifyOption
notifyPref = User -> ClientChannel -> NotifyOption
notifyPreference (ChatState -> User
myUser ChatState
st) ClientChannel
chan
curChannelAction :: PostProcessMessageAdd
curChannelAction = if ChannelId -> Maybe ChannelId
forall a. a -> Maybe a
Just (Post -> ChannelId
postChannelId Post
new) Maybe ChannelId -> Maybe ChannelId -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe ChannelId
currCId
then PostProcessMessageAdd
UpdateServerViewed
else PostProcessMessageAdd
NoAction
originUserAction :: PostProcessMessageAdd
originUserAction =
if | Bool
fromMe -> PostProcessMessageAdd
NoAction
| Bool
ignoredJoinLeaveMessage -> PostProcessMessageAdd
NoAction
| NotifyOption
notifyPref NotifyOption -> NotifyOption -> Bool
forall a. Eq a => a -> a -> Bool
== NotifyOption
NotifyOptionAll -> [PostToAdd] -> PostProcessMessageAdd
NotifyUser [PostToAdd
newPostData]
| NotifyOption
notifyPref NotifyOption -> NotifyOption -> Bool
forall a. Eq a => a -> a -> Bool
== NotifyOption
NotifyOptionMention
Bool -> Bool -> Bool
&& Bool
wasMentioned -> [PostToAdd] -> PostProcessMessageAdd
NotifyUser [PostToAdd
newPostData]
| Bool
otherwise -> PostProcessMessageAdd
NoAction
PostProcessMessageAdd -> MH PostProcessMessageAdd
forall (m :: * -> *) a. Monad m => a -> m a
return (PostProcessMessageAdd -> MH PostProcessMessageAdd)
-> PostProcessMessageAdd -> MH PostProcessMessageAdd
forall a b. (a -> b) -> a -> b
$ PostProcessMessageAdd
curChannelAction PostProcessMessageAdd
-> PostProcessMessageAdd -> PostProcessMessageAdd
`andProcessWith` PostProcessMessageAdd
originUserAction
MH PostProcessMessageAdd
doHandleAddedMessage
addPostToOpenThread :: Maybe TeamId -> Post -> Message -> MH ()
addPostToOpenThread :: Maybe TeamId -> Post -> Message -> MH ()
addPostToOpenThread Maybe TeamId
Nothing Post
_ Message
_ = () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
addPostToOpenThread (Just TeamId
tId) Post
new Message
msg =
case Post -> Maybe PostId
postRootId Post
new of
Maybe PostId
Nothing -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just PostId
parentId -> do
Maybe PostId
mRoot <- Getting (First PostId) ChatState PostId -> MH (Maybe PostId)
forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse (TeamId -> Lens' ChatState (Maybe ThreadInterface)
maybeThreadInterface(TeamId
tId)((Maybe ThreadInterface
-> Const (First PostId) (Maybe ThreadInterface))
-> ChatState -> Const (First PostId) ChatState)
-> ((PostId -> Const (First PostId) PostId)
-> Maybe ThreadInterface
-> Const (First PostId) (Maybe ThreadInterface))
-> Getting (First PostId) ChatState PostId
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ThreadInterface -> Const (First PostId) ThreadInterface)
-> Maybe ThreadInterface
-> Const (First PostId) (Maybe ThreadInterface)
forall a a'. Traversal (Maybe a) (Maybe a') a a'
_Just((ThreadInterface -> Const (First PostId) ThreadInterface)
-> Maybe ThreadInterface
-> Const (First PostId) (Maybe ThreadInterface))
-> ((PostId -> Const (First PostId) PostId)
-> ThreadInterface -> Const (First PostId) ThreadInterface)
-> (PostId -> Const (First PostId) PostId)
-> Maybe ThreadInterface
-> Const (First PostId) (Maybe ThreadInterface)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(PostId -> Const (First PostId) PostId)
-> ThreadInterface -> Const (First PostId) ThreadInterface
forall n i i2.
Lens (MessageInterface n i) (MessageInterface n i2) i i2
miRootPostId)
Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe PostId
mRoot Maybe PostId -> Maybe PostId -> Bool
forall a. Eq a => a -> a -> Bool
== PostId -> Maybe PostId
forall a. a -> Maybe a
Just PostId
parentId) (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$
TeamId -> ChannelId -> (Messages -> Messages) -> MH ()
modifyThreadMessages TeamId
tId (Post
newPost -> Getting ChannelId Post ChannelId -> ChannelId
forall s a. s -> Getting a s a -> a
^.Getting ChannelId Post ChannelId
Lens' Post ChannelId
postChannelIdL) (Message -> Messages -> Messages
forall a. MessageOps a => Message -> a -> a
addMessage Message
msg)
editPostInOpenThread :: Maybe TeamId -> Post -> Message -> MH ()
editPostInOpenThread :: Maybe TeamId -> Post -> Message -> MH ()
editPostInOpenThread Maybe TeamId
Nothing Post
_ Message
_ = () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
editPostInOpenThread (Just TeamId
tId) Post
new Message
msg =
case Post -> Maybe PostId
postRootId Post
new of
Maybe PostId
Nothing -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just PostId
parentId -> do
Maybe PostId
mRoot <- Getting (First PostId) ChatState PostId -> MH (Maybe PostId)
forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse (TeamId -> Lens' ChatState (Maybe ThreadInterface)
maybeThreadInterface(TeamId
tId)((Maybe ThreadInterface
-> Const (First PostId) (Maybe ThreadInterface))
-> ChatState -> Const (First PostId) ChatState)
-> ((PostId -> Const (First PostId) PostId)
-> Maybe ThreadInterface
-> Const (First PostId) (Maybe ThreadInterface))
-> Getting (First PostId) ChatState PostId
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ThreadInterface -> Const (First PostId) ThreadInterface)
-> Maybe ThreadInterface
-> Const (First PostId) (Maybe ThreadInterface)
forall a a'. Traversal (Maybe a) (Maybe a') a a'
_Just((ThreadInterface -> Const (First PostId) ThreadInterface)
-> Maybe ThreadInterface
-> Const (First PostId) (Maybe ThreadInterface))
-> ((PostId -> Const (First PostId) PostId)
-> ThreadInterface -> Const (First PostId) ThreadInterface)
-> (PostId -> Const (First PostId) PostId)
-> Maybe ThreadInterface
-> Const (First PostId) (Maybe ThreadInterface)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(PostId -> Const (First PostId) PostId)
-> ThreadInterface -> Const (First PostId) ThreadInterface
forall n i i2.
Lens (MessageInterface n i) (MessageInterface n i2) i i2
miRootPostId)
Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe PostId
mRoot Maybe PostId -> Maybe PostId -> Bool
forall a. Eq a => a -> a -> Bool
== PostId -> Maybe PostId
forall a. a -> Maybe a
Just PostId
parentId) (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ do
LogCategory -> Text -> MH ()
mhLog LogCategory
LogGeneral Text
"editPostInOpenThread: updating message"
let isEditedMessage :: Message -> Bool
isEditedMessage Message
m = Message
mMessage
-> Getting (Maybe MessageId) Message (Maybe MessageId)
-> Maybe MessageId
forall s a. s -> Getting a s a -> a
^.Getting (Maybe MessageId) Message (Maybe MessageId)
Lens' Message (Maybe MessageId)
mMessageId Maybe MessageId -> Maybe MessageId -> Bool
forall a. Eq a => a -> a -> Bool
== MessageId -> Maybe MessageId
forall a. a -> Maybe a
Just (PostId -> MessageId
MessagePostId (PostId -> MessageId) -> PostId -> MessageId
forall a b. (a -> b) -> a -> b
$ Post
newPost -> Getting PostId Post PostId -> PostId
forall s a. s -> Getting a s a -> a
^.Getting PostId Post PostId
Lens' Post PostId
postIdL)
TeamId -> ChannelId -> (Message -> Message) -> MH ()
modifyEachThreadMessage TeamId
tId (Post
newPost -> Getting ChannelId Post ChannelId -> ChannelId
forall s a. s -> Getting a s a -> a
^.Getting ChannelId Post ChannelId
Lens' Post ChannelId
postChannelIdL)
(\Message
m -> if Message -> Bool
isEditedMessage Message
m then Message
msg else Message
m)
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 (m :: * -> *) a. Monad m => a -> m a
return ()
postOp PostProcessMessageAdd
UpdateServerViewed = Bool -> MH ()
updateViewed Bool
False
postOp (NotifyUser [PostToAdd]
p) = MH ()
maybeRingBell MH () -> MH () -> MH ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (PostToAdd -> MH ()) -> [PostToAdd] -> MH ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ PostToAdd -> MH ()
maybeNotify [PostToAdd]
p
postOp (NotifyUserAndServer [PostToAdd]
p) = Bool -> MH ()
updateViewed Bool
False MH () -> MH () -> MH ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MH ()
maybeRingBell MH () -> MH () -> MH ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (PostToAdd -> MH ()) -> [PostToAdd] -> MH ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ PostToAdd -> MH ()
maybeNotify [PostToAdd]
p
maybeNotify :: PostToAdd -> MH ()
maybeNotify :: PostToAdd -> MH ()
maybeNotify (OldPost Post
_) = do
() -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
maybeNotify (RecentPost Post
post Bool
mentioned) = Post -> Bool -> MH ()
runNotifyCommand Post
post Bool
mentioned
maybeRingBell :: MH ()
maybeRingBell :: MH ()
maybeRingBell = do
Bool
doBell <- Getting Bool ChatState Bool -> MH Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((ChatResources -> Const Bool ChatResources)
-> ChatState -> Const Bool ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Const Bool ChatResources)
-> ChatState -> Const Bool ChatState)
-> ((Bool -> Const Bool Bool)
-> ChatResources -> Const Bool ChatResources)
-> Getting Bool ChatState Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Config -> Const Bool Config)
-> ChatResources -> Const Bool ChatResources
Lens' ChatResources Config
crConfiguration((Config -> Const Bool Config)
-> ChatResources -> Const Bool ChatResources)
-> ((Bool -> Const Bool Bool) -> Config -> Const Bool Config)
-> (Bool -> Const Bool Bool)
-> ChatResources
-> Const Bool ChatResources
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Const Bool Bool) -> Config -> Const Bool Config
Lens' Config Bool
configActivityBellL)
Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
doBell (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ do
Vty
vty <- EventM Name Vty -> MH Vty
forall a. EventM Name a -> MH a
mh EventM Name Vty
forall n. EventM n Vty
getVtyHandle
IO () -> MH ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> MH ()) -> IO () -> MH ()
forall a b. (a -> b) -> a -> b
$ Output -> IO ()
ringTerminalBell (Output -> IO ()) -> Output -> IO ()
forall a b. (a -> b) -> a -> b
$ Vty -> Output
outputIface Vty
vty
data PostToAdd =
OldPost Post
| RecentPost Post Bool
encodeToJSONstring :: A.ToJSON a => a -> String
encodeToJSONstring :: a -> String
encodeToJSONstring a
a = ByteString -> String
BL8.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ a -> ByteString
forall a. ToJSON a => a -> ByteString
A.encode a
a
data NotificationV2 = NotificationV2
{ NotificationV2 -> Int
version :: Int
, NotificationV2 -> Text
message :: Text
, NotificationV2 -> Bool
mention :: Bool
, NotificationV2 -> Text
from :: Text
} deriving (Int -> NotificationV2 -> ShowS
[NotificationV2] -> ShowS
NotificationV2 -> String
(Int -> NotificationV2 -> ShowS)
-> (NotificationV2 -> String)
-> ([NotificationV2] -> ShowS)
-> Show NotificationV2
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NotificationV2] -> ShowS
$cshowList :: [NotificationV2] -> ShowS
show :: NotificationV2 -> String
$cshow :: NotificationV2 -> String
showsPrec :: Int -> NotificationV2 -> ShowS
$cshowsPrec :: Int -> NotificationV2 -> ShowS
Show)
instance A.ToJSON NotificationV2 where
toJSON :: NotificationV2 -> Value
toJSON (NotificationV2 Int
vers Text
msg Bool
mentioned Text
sender) =
[Pair] -> Value
A.object [ Key
"version" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Int
vers
, Key
"message" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
msg
, Key
"mention" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Bool
mentioned
, Key
"from" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
sender
]
notifyGetPayload :: NotificationVersion -> ChatState -> Post -> Bool -> Maybe String
notifyGetPayload :: NotificationVersion -> ChatState -> Post -> Bool -> Maybe String
notifyGetPayload NotificationVersion
NotifyV1 ChatState
_ Post
_ Bool
_ = do String -> Maybe String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
notifyGetPayload NotificationVersion
NotifyV2 ChatState
st Post
post Bool
mentioned = do
let notification :: NotificationV2
notification = Int -> Text -> Bool -> Text -> NotificationV2
NotificationV2 Int
2 Text
msg Bool
mentioned Text
sender
String -> Maybe String
forall (m :: * -> *) a. Monad m => a -> m a
return (NotificationV2 -> String
forall a. ToJSON a => a -> String
encodeToJSONstring NotificationV2
notification)
where
msg :: Text
msg = UserText -> Text
sanitizeUserText (UserText -> Text) -> UserText -> Text
forall a b. (a -> b) -> a -> b
$ Post -> UserText
postMessage Post
post
sender :: Text
sender = ChatState -> Post -> Text
maybePostUsername ChatState
st Post
post
handleNotifyCommand :: Post -> Bool -> NotificationVersion -> MH ()
handleNotifyCommand :: Post -> Bool -> NotificationVersion -> MH ()
handleNotifyCommand Post
post Bool
mentioned NotificationVersion
NotifyV1 = do
TChan ProgramOutput
outputChan <- Getting (TChan ProgramOutput) ChatState (TChan ProgramOutput)
-> MH (TChan ProgramOutput)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((ChatResources -> Const (TChan ProgramOutput) ChatResources)
-> ChatState -> Const (TChan ProgramOutput) ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Const (TChan ProgramOutput) ChatResources)
-> ChatState -> Const (TChan ProgramOutput) ChatState)
-> ((TChan ProgramOutput
-> Const (TChan ProgramOutput) (TChan ProgramOutput))
-> ChatResources -> Const (TChan ProgramOutput) ChatResources)
-> Getting (TChan ProgramOutput) ChatState (TChan ProgramOutput)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(TChan ProgramOutput
-> Const (TChan ProgramOutput) (TChan ProgramOutput))
-> ChatResources -> Const (TChan ProgramOutput) ChatResources
Lens' ChatResources (TChan ProgramOutput)
crSubprocessLog)
ChatState
st <- Getting ChatState ChatState ChatState -> MH ChatState
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting ChatState ChatState ChatState
forall a. a -> a
id
Maybe Text
notifyCommand <- Getting (Maybe Text) ChatState (Maybe Text) -> MH (Maybe Text)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((ChatResources -> Const (Maybe Text) ChatResources)
-> ChatState -> Const (Maybe Text) ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Const (Maybe Text) ChatResources)
-> ChatState -> Const (Maybe Text) ChatState)
-> ((Maybe Text -> Const (Maybe Text) (Maybe Text))
-> ChatResources -> Const (Maybe Text) ChatResources)
-> Getting (Maybe Text) ChatState (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Config -> Const (Maybe Text) Config)
-> ChatResources -> Const (Maybe Text) ChatResources
Lens' ChatResources Config
crConfiguration((Config -> Const (Maybe Text) Config)
-> ChatResources -> Const (Maybe Text) ChatResources)
-> ((Maybe Text -> Const (Maybe Text) (Maybe Text))
-> Config -> Const (Maybe Text) Config)
-> (Maybe Text -> Const (Maybe Text) (Maybe Text))
-> ChatResources
-> Const (Maybe Text) ChatResources
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe Text -> Const (Maybe Text) (Maybe Text))
-> Config -> Const (Maybe Text) Config
Lens' Config (Maybe Text)
configActivityNotifyCommandL)
case Maybe Text
notifyCommand of
Maybe Text
Nothing -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just Text
cmd ->
AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Preempt (IO (Maybe (MH ())) -> MH ()) -> IO (Maybe (MH ())) -> MH ()
forall a b. (a -> b) -> a -> b
$ do
let messageString :: String
messageString = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ UserText -> Text
sanitizeUserText (UserText -> Text) -> UserText -> Text
forall a b. (a -> b) -> a -> b
$ Post -> UserText
postMessage Post
post
notified :: String
notified = if Bool
mentioned then String
"1" else String
"2"
sender :: String
sender = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ ChatState -> Post -> Text
maybePostUsername ChatState
st Post
post
TChan ProgramOutput
-> String
-> [String]
-> Maybe String
-> Maybe (MVar ProgramOutput)
-> IO ()
runLoggedCommand TChan ProgramOutput
outputChan (Text -> String
T.unpack Text
cmd)
[String
notified, String
sender, String
messageString] Maybe String
forall a. Maybe a
Nothing Maybe (MVar ProgramOutput)
forall a. Maybe a
Nothing
Maybe (MH ()) -> IO (Maybe (MH ()))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MH ())
forall a. Maybe a
Nothing
handleNotifyCommand Post
post Bool
mentioned NotificationVersion
NotifyV2 = do
TChan ProgramOutput
outputChan <- Getting (TChan ProgramOutput) ChatState (TChan ProgramOutput)
-> MH (TChan ProgramOutput)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((ChatResources -> Const (TChan ProgramOutput) ChatResources)
-> ChatState -> Const (TChan ProgramOutput) ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Const (TChan ProgramOutput) ChatResources)
-> ChatState -> Const (TChan ProgramOutput) ChatState)
-> ((TChan ProgramOutput
-> Const (TChan ProgramOutput) (TChan ProgramOutput))
-> ChatResources -> Const (TChan ProgramOutput) ChatResources)
-> Getting (TChan ProgramOutput) ChatState (TChan ProgramOutput)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(TChan ProgramOutput
-> Const (TChan ProgramOutput) (TChan ProgramOutput))
-> ChatResources -> Const (TChan ProgramOutput) ChatResources
Lens' ChatResources (TChan ProgramOutput)
crSubprocessLog)
ChatState
st <- Getting ChatState ChatState ChatState -> MH ChatState
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting ChatState ChatState ChatState
forall a. a -> a
id
let payload :: Maybe String
payload = NotificationVersion -> ChatState -> Post -> Bool -> Maybe String
notifyGetPayload NotificationVersion
NotifyV2 ChatState
st Post
post Bool
mentioned
Maybe Text
notifyCommand <- Getting (Maybe Text) ChatState (Maybe Text) -> MH (Maybe Text)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((ChatResources -> Const (Maybe Text) ChatResources)
-> ChatState -> Const (Maybe Text) ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Const (Maybe Text) ChatResources)
-> ChatState -> Const (Maybe Text) ChatState)
-> ((Maybe Text -> Const (Maybe Text) (Maybe Text))
-> ChatResources -> Const (Maybe Text) ChatResources)
-> Getting (Maybe Text) ChatState (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Config -> Const (Maybe Text) Config)
-> ChatResources -> Const (Maybe Text) ChatResources
Lens' ChatResources Config
crConfiguration((Config -> Const (Maybe Text) Config)
-> ChatResources -> Const (Maybe Text) ChatResources)
-> ((Maybe Text -> Const (Maybe Text) (Maybe Text))
-> Config -> Const (Maybe Text) Config)
-> (Maybe Text -> Const (Maybe Text) (Maybe Text))
-> ChatResources
-> Const (Maybe Text) ChatResources
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe Text -> Const (Maybe Text) (Maybe Text))
-> Config -> Const (Maybe Text) Config
Lens' Config (Maybe Text)
configActivityNotifyCommandL)
case Maybe Text
notifyCommand of
Maybe Text
Nothing -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just Text
cmd ->
AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Preempt (IO (Maybe (MH ())) -> MH ()) -> IO (Maybe (MH ())) -> MH ()
forall a b. (a -> b) -> a -> b
$ do
TChan ProgramOutput
-> String
-> [String]
-> Maybe String
-> Maybe (MVar ProgramOutput)
-> IO ()
runLoggedCommand TChan ProgramOutput
outputChan (Text -> String
T.unpack Text
cmd) [] Maybe String
payload Maybe (MVar ProgramOutput)
forall a. Maybe a
Nothing
Maybe (MH ()) -> IO (Maybe (MH ()))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MH ())
forall a. Maybe a
Nothing
runNotifyCommand :: Post -> Bool -> MH ()
runNotifyCommand :: Post -> Bool -> MH ()
runNotifyCommand Post
post Bool
mentioned = do
NotificationVersion
notifyVersion <- Getting NotificationVersion ChatState NotificationVersion
-> MH NotificationVersion
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((ChatResources -> Const NotificationVersion ChatResources)
-> ChatState -> Const NotificationVersion ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Const NotificationVersion ChatResources)
-> ChatState -> Const NotificationVersion ChatState)
-> ((NotificationVersion
-> Const NotificationVersion NotificationVersion)
-> ChatResources -> Const NotificationVersion ChatResources)
-> Getting NotificationVersion ChatState NotificationVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Config -> Const NotificationVersion Config)
-> ChatResources -> Const NotificationVersion ChatResources
Lens' ChatResources Config
crConfiguration((Config -> Const NotificationVersion Config)
-> ChatResources -> Const NotificationVersion ChatResources)
-> ((NotificationVersion
-> Const NotificationVersion NotificationVersion)
-> Config -> Const NotificationVersion Config)
-> (NotificationVersion
-> Const NotificationVersion NotificationVersion)
-> ChatResources
-> Const NotificationVersion ChatResources
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(NotificationVersion
-> Const NotificationVersion NotificationVersion)
-> Config -> Const NotificationVersion Config
Lens' Config NotificationVersion
configActivityNotifyVersionL)
case NotificationVersion
notifyVersion of
NotificationVersion
NotifyV1 -> Post -> Bool -> NotificationVersion -> MH ()
handleNotifyCommand Post
post Bool
mentioned NotificationVersion
NotifyV1
NotificationVersion
NotifyV2 -> Post -> Bool -> NotificationVersion -> MH ()
handleNotifyCommand Post
post Bool
mentioned NotificationVersion
NotifyV2
maybePostUsername :: ChatState -> Post -> T.Text
maybePostUsername :: ChatState -> Post -> Text
maybePostUsername ChatState
st Post
p =
Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
T.empty (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ do
UserId
uId <- Post -> Maybe UserId
postUserId Post
p
UserId -> ChatState -> Maybe Text
usernameForUserId UserId
uId ChatState
st
asyncFetchMoreMessages :: MH ()
asyncFetchMoreMessages :: MH ()
asyncFetchMoreMessages =
(TeamId -> MH ()) -> MH ()
withCurrentTeam ((TeamId -> MH ()) -> MH ()) -> (TeamId -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \TeamId
tId ->
TeamId -> (ChannelId -> ClientChannel -> MH ()) -> MH ()
withCurrentChannel TeamId
tId ((ChannelId -> ClientChannel -> MH ()) -> MH ())
-> (ChannelId -> ClientChannel -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \ChannelId
cId ClientChannel
chan -> do
let offset :: Int
offset = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Messages -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (ClientChannel
chanClientChannel
-> Getting Messages ClientChannel Messages -> Messages
forall s a. s -> Getting a s a -> a
^.(MessageInterface Name ()
-> Const Messages (MessageInterface Name ()))
-> ClientChannel -> Const Messages ClientChannel
Lens' ClientChannel (MessageInterface Name ())
ccMessageInterface((MessageInterface Name ()
-> Const Messages (MessageInterface Name ()))
-> ClientChannel -> Const Messages ClientChannel)
-> ((Messages -> Const Messages Messages)
-> MessageInterface Name ()
-> Const Messages (MessageInterface Name ()))
-> Getting Messages ClientChannel Messages
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Const Messages Messages)
-> MessageInterface Name ()
-> Const Messages (MessageInterface Name ())
forall n i. Lens' (MessageInterface n i) Messages
miMessages) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2
page :: Int
page = Int
offset Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
pageAmount
usefulMsgs :: Maybe (Message, Message)
usefulMsgs = Maybe Message -> RetrogradeMessages -> Maybe (Message, Message)
forall dir.
SeqDirection dir =>
Maybe Message
-> DirectionalSeq dir Message -> Maybe (Message, Message)
getTwoContiguousPosts Maybe Message
forall a. Maybe a
Nothing (ClientChannel
chanClientChannel
-> Getting RetrogradeMessages ClientChannel RetrogradeMessages
-> RetrogradeMessages
forall s a. s -> Getting a s a -> a
^.(MessageInterface Name ()
-> Const RetrogradeMessages (MessageInterface Name ()))
-> ClientChannel -> Const RetrogradeMessages ClientChannel
Lens' ClientChannel (MessageInterface Name ())
ccMessageInterface((MessageInterface Name ()
-> Const RetrogradeMessages (MessageInterface Name ()))
-> ClientChannel -> Const RetrogradeMessages ClientChannel)
-> ((RetrogradeMessages
-> Const RetrogradeMessages RetrogradeMessages)
-> MessageInterface Name ()
-> Const RetrogradeMessages (MessageInterface Name ()))
-> Getting RetrogradeMessages ClientChannel RetrogradeMessages
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Const RetrogradeMessages Messages)
-> MessageInterface Name ()
-> Const RetrogradeMessages (MessageInterface Name ())
forall n i. Lens' (MessageInterface n i) Messages
miMessages((Messages -> Const RetrogradeMessages Messages)
-> MessageInterface Name ()
-> Const RetrogradeMessages (MessageInterface Name ()))
-> ((RetrogradeMessages
-> Const RetrogradeMessages RetrogradeMessages)
-> Messages -> Const RetrogradeMessages Messages)
-> (RetrogradeMessages
-> Const RetrogradeMessages RetrogradeMessages)
-> MessageInterface Name ()
-> Const RetrogradeMessages (MessageInterface Name ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> RetrogradeMessages)
-> SimpleGetter Messages RetrogradeMessages
forall s a. (s -> a) -> SimpleGetter s a
to Messages -> RetrogradeMessages
reverseMessages)
sndOldestId :: Maybe PostId
sndOldestId = (Message -> Maybe PostId
messagePostId (Message -> Maybe PostId)
-> ((Message, Message) -> Message)
-> (Message, Message)
-> Maybe PostId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Message, Message) -> Message
forall a b. (a, b) -> b
snd) ((Message, Message) -> Maybe PostId)
-> Maybe (Message, Message) -> Maybe PostId
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (Message, Message)
usefulMsgs
query :: PostQuery
query = PostQuery
MM.defaultPostQuery
{ postQueryPage :: Maybe Int
MM.postQueryPage = Maybe Int -> (PostId -> Maybe Int) -> Maybe PostId -> Maybe Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
page) (Maybe Int -> PostId -> Maybe Int
forall a b. a -> b -> a
const Maybe Int
forall a. Maybe a
Nothing) Maybe PostId
sndOldestId
, postQueryPerPage :: Maybe Int
MM.postQueryPerPage = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
pageAmount
, postQueryBefore :: Maybe PostId
MM.postQueryBefore = Maybe PostId
sndOldestId
}
addTrailingGap :: Bool
addTrailingGap = PostQuery -> Maybe PostId
MM.postQueryBefore PostQuery
query Maybe PostId -> Maybe PostId -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe PostId
forall a. Maybe a
Nothing Bool -> Bool -> Bool
&&
PostQuery -> Maybe Int
MM.postQueryPage PostQuery
query Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0
DoAsyncChannelMM Posts
forall a. DoAsyncChannelMM a
doAsyncChannelMM AsyncPriority
Preempt ChannelId
cId
(\Session
s ChannelId
c -> ChannelId -> PostQuery -> Session -> IO Posts
MM.mmGetPostsForChannel ChannelId
c PostQuery
query Session
s)
(\ChannelId
c Posts
p -> MH () -> Maybe (MH ())
forall a. a -> Maybe a
Just (MH () -> Maybe (MH ())) -> MH () -> Maybe (MH ())
forall a b. (a -> b) -> a -> b
$ do
PostProcessMessageAdd
pp <- ChannelId -> Int -> Bool -> Posts -> MH PostProcessMessageAdd
addObtainedMessages ChannelId
c (-Int
pageAmount) Bool
addTrailingGap Posts
p
PostProcessMessageAdd -> MH ()
postProcessMessageAdd PostProcessMessageAdd
pp)
getTwoContiguousPosts :: SeqDirection dir =>
Maybe Message
-> DirectionalSeq dir Message
-> Maybe (Message, Message)
getTwoContiguousPosts :: Maybe Message
-> DirectionalSeq dir Message -> Maybe (Message, Message)
getTwoContiguousPosts Maybe Message
startMsg DirectionalSeq dir Message
msgs =
let go :: Maybe Message -> Maybe (Message, Message)
go Maybe Message
start =
do Message
anchor <- Maybe MessageId -> DirectionalSeq dir Message -> Maybe Message
forall dir.
SeqDirection dir =>
Maybe MessageId -> DirectionalSeq dir Message -> Maybe Message
getRelMessageId (Message -> Maybe MessageId
_mMessageId (Message -> Maybe MessageId) -> Maybe Message -> Maybe MessageId
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Message
start) DirectionalSeq dir Message
msgs
Message
hinge <- Maybe MessageId -> DirectionalSeq dir Message -> Maybe Message
forall dir.
SeqDirection dir =>
Maybe MessageId -> DirectionalSeq dir Message -> Maybe Message
getRelMessageId (Message
anchorMessage
-> Getting (Maybe MessageId) Message (Maybe MessageId)
-> Maybe MessageId
forall s a. s -> Getting a s a -> a
^.Getting (Maybe MessageId) Message (Maybe MessageId)
Lens' Message (Maybe MessageId)
mMessageId) DirectionalSeq dir Message
msgs
if Message -> Bool
isGap Message
anchor Bool -> Bool -> Bool
|| Message -> Bool
isGap Message
hinge
then Maybe Message -> Maybe (Message, Message)
go (Maybe Message -> Maybe (Message, Message))
-> Maybe Message -> Maybe (Message, Message)
forall a b. (a -> b) -> a -> b
$ Message -> Maybe Message
forall a. a -> Maybe a
Just Message
anchor
else (Message, Message) -> Maybe (Message, Message)
forall a. a -> Maybe a
Just (Message
anchor, Message
hinge)
in Maybe Message -> Maybe (Message, Message)
go Maybe Message
startMsg
asyncFetchMessagesForGap :: ChannelId -> Message -> MH ()
asyncFetchMessagesForGap :: ChannelId -> Message -> MH ()
asyncFetchMessagesForGap ChannelId
cId Message
gapMessage =
Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Message -> Bool
isGap Message
gapMessage) (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$
ChannelId -> (ClientChannel -> MH ()) -> MH ()
withChannel ChannelId
cId ((ClientChannel -> MH ()) -> MH ())
-> (ClientChannel -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \ClientChannel
chan ->
let offset :: Int
offset = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Messages -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (ClientChannel
chanClientChannel
-> Getting Messages ClientChannel Messages -> Messages
forall s a. s -> Getting a s a -> a
^.(MessageInterface Name ()
-> Const Messages (MessageInterface Name ()))
-> ClientChannel -> Const Messages ClientChannel
Lens' ClientChannel (MessageInterface Name ())
ccMessageInterface((MessageInterface Name ()
-> Const Messages (MessageInterface Name ()))
-> ClientChannel -> Const Messages ClientChannel)
-> ((Messages -> Const Messages Messages)
-> MessageInterface Name ()
-> Const Messages (MessageInterface Name ()))
-> Getting Messages ClientChannel Messages
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Const Messages Messages)
-> MessageInterface Name ()
-> Const Messages (MessageInterface Name ())
forall n i. Lens' (MessageInterface n i) Messages
miMessages) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2
page :: Int
page = Int
offset Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
pageAmount
chanMsgs :: Messages
chanMsgs = ClientChannel
chanClientChannel
-> Getting Messages ClientChannel Messages -> Messages
forall s a. s -> Getting a s a -> a
^.(MessageInterface Name ()
-> Const Messages (MessageInterface Name ()))
-> ClientChannel -> Const Messages ClientChannel
Lens' ClientChannel (MessageInterface Name ())
ccMessageInterface((MessageInterface Name ()
-> Const Messages (MessageInterface Name ()))
-> ClientChannel -> Const Messages ClientChannel)
-> ((Messages -> Const Messages Messages)
-> MessageInterface Name ()
-> Const Messages (MessageInterface Name ()))
-> Getting Messages ClientChannel Messages
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Const Messages Messages)
-> MessageInterface Name ()
-> Const Messages (MessageInterface Name ())
forall n i. Lens' (MessageInterface n i) Messages
miMessages
fromMsg :: Maybe Message
fromMsg = Message -> Maybe Message
forall a. a -> Maybe a
Just Message
gapMessage
fetchNewer :: Bool
fetchNewer = case Message
gapMessageMessage -> Getting MessageType Message MessageType -> MessageType
forall s a. s -> Getting a s a -> a
^.Getting MessageType Message MessageType
Lens' Message MessageType
mType of
C ClientMessageType
UnknownGapAfter -> Bool
True
C ClientMessageType
UnknownGapBefore -> Bool
False
MessageType
_ -> String -> Bool
forall a. HasCallStack => String -> a
error String
"fetch gap messages: unknown gap message type"
baseId :: Maybe PostId
baseId = Message -> Maybe PostId
messagePostId (Message -> Maybe PostId)
-> ((Message, Message) -> Message)
-> (Message, Message)
-> Maybe PostId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Message, Message) -> Message
forall a b. (a, b) -> b
snd ((Message, Message) -> Maybe PostId)
-> Maybe (Message, Message) -> Maybe PostId
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
case Message
gapMessageMessage -> Getting MessageType Message MessageType -> MessageType
forall s a. s -> Getting a s a -> a
^.Getting MessageType Message MessageType
Lens' Message MessageType
mType of
C ClientMessageType
UnknownGapAfter -> Maybe Message -> RetrogradeMessages -> Maybe (Message, Message)
forall dir.
SeqDirection dir =>
Maybe Message
-> DirectionalSeq dir Message -> Maybe (Message, Message)
getTwoContiguousPosts Maybe Message
fromMsg (RetrogradeMessages -> Maybe (Message, Message))
-> RetrogradeMessages -> Maybe (Message, Message)
forall a b. (a -> b) -> a -> b
$
Messages -> RetrogradeMessages
reverseMessages Messages
chanMsgs
C ClientMessageType
UnknownGapBefore -> Maybe Message -> Messages -> Maybe (Message, Message)
forall dir.
SeqDirection dir =>
Maybe Message
-> DirectionalSeq dir Message -> Maybe (Message, Message)
getTwoContiguousPosts Maybe Message
fromMsg Messages
chanMsgs
MessageType
_ -> String -> Maybe (Message, Message)
forall a. HasCallStack => String -> a
error String
"fetch gap messages: unknown gap message type"
query :: PostQuery
query = PostQuery
MM.defaultPostQuery
{ postQueryPage :: Maybe Int
MM.postQueryPage = Maybe Int -> (PostId -> Maybe Int) -> Maybe PostId -> Maybe Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
page) (Maybe Int -> PostId -> Maybe Int
forall a b. a -> b -> a
const Maybe Int
forall a. Maybe a
Nothing) Maybe PostId
baseId
, postQueryPerPage :: Maybe Int
MM.postQueryPerPage = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
pageAmount
, postQueryBefore :: Maybe PostId
MM.postQueryBefore = if Bool
fetchNewer then Maybe PostId
forall a. Maybe a
Nothing else Maybe PostId
baseId
, postQueryAfter :: Maybe PostId
MM.postQueryAfter = if Bool
fetchNewer then Maybe PostId
baseId else Maybe PostId
forall a. Maybe a
Nothing
}
addTrailingGap :: Bool
addTrailingGap = PostQuery -> Maybe PostId
MM.postQueryBefore PostQuery
query Maybe PostId -> Maybe PostId -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe PostId
forall a. Maybe a
Nothing Bool -> Bool -> Bool
&&
PostQuery -> Maybe Int
MM.postQueryPage PostQuery
query Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0
in DoAsyncChannelMM Posts
forall a. DoAsyncChannelMM a
doAsyncChannelMM AsyncPriority
Preempt ChannelId
cId
(\Session
s ChannelId
c -> ChannelId -> PostQuery -> Session -> IO Posts
MM.mmGetPostsForChannel ChannelId
c PostQuery
query Session
s)
(\ChannelId
c Posts
p -> MH () -> Maybe (MH ())
forall a. a -> Maybe a
Just (MH () -> Maybe (MH ())) -> MH () -> Maybe (MH ())
forall a b. (a -> b) -> a -> b
$ do
MH PostProcessMessageAdd -> MH ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (MH PostProcessMessageAdd -> MH ())
-> MH PostProcessMessageAdd -> MH ()
forall a b. (a -> b) -> a -> b
$ ChannelId -> Int -> Bool -> Posts -> MH PostProcessMessageAdd
addObtainedMessages ChannelId
c (-Int
pageAmount) Bool
addTrailingGap Posts
p)
asyncFetchMessagesSurrounding :: ChannelId -> PostId -> MH ()
asyncFetchMessagesSurrounding :: ChannelId -> PostId -> MH ()
asyncFetchMessagesSurrounding ChannelId
cId PostId
pId = do
let query :: PostQuery
query = PostQuery
MM.defaultPostQuery
{ postQueryBefore :: Maybe PostId
MM.postQueryBefore = PostId -> Maybe PostId
forall a. a -> Maybe a
Just PostId
pId
, postQueryPerPage :: Maybe Int
MM.postQueryPerPage = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
reqAmt
}
reqAmt :: Int
reqAmt = Int
5
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
{ postQueryAfter :: Maybe PostId
MM.postQueryAfter = Maybe PostId
last2ndId
, postQueryPerPage :: Maybe Int
MM.postQueryPerPage = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int
reqAmt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2
}
DoAsyncChannelMM Posts
forall a. DoAsyncChannelMM a
doAsyncChannelMM AsyncPriority
Preempt ChannelId
cId
(\Session
s' ChannelId
c' -> ChannelId -> PostQuery -> Session -> IO Posts
MM.mmGetPostsForChannel ChannelId
c' PostQuery
query' Session
s')
(\ChannelId
c' Posts
p' -> MH () -> Maybe (MH ())
forall a. a -> Maybe a
Just (MH () -> Maybe (MH ())) -> MH () -> Maybe (MH ())
forall a b. (a -> b) -> a -> b
$ do
MH PostProcessMessageAdd -> MH ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (MH PostProcessMessageAdd -> MH ())
-> MH PostProcessMessageAdd -> MH ()
forall a b. (a -> b) -> a -> b
$ ChannelId -> Int -> Bool -> Posts -> MH PostProcessMessageAdd
addObtainedMessages ChannelId
c' (Int
reqAmt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Bool
False Posts
p'
)
)
where secondToLastPostId :: Posts -> Maybe PostId
secondToLastPostId Posts
posts =
let pl :: [PostId]
pl = Seq PostId -> [PostId]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq PostId -> [PostId]) -> Seq PostId -> [PostId]
forall a b. (a -> b) -> a -> b
$ Posts -> Seq PostId
postsOrder Posts
posts
in if [PostId] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PostId]
pl Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 then PostId -> Maybe PostId
forall a. a -> Maybe a
Just (PostId -> Maybe PostId) -> PostId -> Maybe PostId
forall a b. (a -> b) -> a -> b
$ [PostId] -> PostId
forall a. [a] -> a
last ([PostId] -> PostId) -> [PostId] -> PostId
forall a b. (a -> b) -> a -> b
$ [PostId] -> [PostId]
forall a. [a] -> [a]
init [PostId]
pl else Maybe PostId
forall a. Maybe a
Nothing
fetchVisibleIfNeeded :: TeamId -> MH ()
fetchVisibleIfNeeded :: TeamId -> MH ()
fetchVisibleIfNeeded TeamId
tId = do
ConnectionStatus
sts <- Getting ConnectionStatus ChatState ConnectionStatus
-> MH ConnectionStatus
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting ConnectionStatus ChatState ConnectionStatus
Lens' ChatState ConnectionStatus
csConnectionStatus
Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ConnectionStatus
sts ConnectionStatus -> ConnectionStatus -> Bool
forall a. Eq a => a -> a -> Bool
== ConnectionStatus
Connected) (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ do
TeamId -> (ChannelId -> ClientChannel -> MH ()) -> MH ()
withCurrentChannel TeamId
tId ((ChannelId -> ClientChannel -> MH ()) -> MH ())
-> (ChannelId -> ClientChannel -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \ChannelId
cId ClientChannel
chan -> do
let msgs :: RetrogradeMessages
msgs = ClientChannel
chanClientChannel
-> Getting RetrogradeMessages ClientChannel RetrogradeMessages
-> RetrogradeMessages
forall s a. s -> Getting a s a -> a
^.(MessageInterface Name ()
-> Const RetrogradeMessages (MessageInterface Name ()))
-> ClientChannel -> Const RetrogradeMessages ClientChannel
Lens' ClientChannel (MessageInterface Name ())
ccMessageInterface((MessageInterface Name ()
-> Const RetrogradeMessages (MessageInterface Name ()))
-> ClientChannel -> Const RetrogradeMessages ClientChannel)
-> ((RetrogradeMessages
-> Const RetrogradeMessages RetrogradeMessages)
-> MessageInterface Name ()
-> Const RetrogradeMessages (MessageInterface Name ()))
-> Getting RetrogradeMessages ClientChannel RetrogradeMessages
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Const RetrogradeMessages Messages)
-> MessageInterface Name ()
-> Const RetrogradeMessages (MessageInterface Name ())
forall n i. Lens' (MessageInterface n i) Messages
miMessages((Messages -> Const RetrogradeMessages Messages)
-> MessageInterface Name ()
-> Const RetrogradeMessages (MessageInterface Name ()))
-> ((RetrogradeMessages
-> Const RetrogradeMessages RetrogradeMessages)
-> Messages -> Const RetrogradeMessages Messages)
-> (RetrogradeMessages
-> Const RetrogradeMessages RetrogradeMessages)
-> MessageInterface Name ()
-> Const RetrogradeMessages (MessageInterface Name ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> RetrogradeMessages)
-> SimpleGetter Messages RetrogradeMessages
forall s a. (s -> a) -> SimpleGetter s a
to Messages -> RetrogradeMessages
reverseMessages
(Int
numRemaining, Bool
gapInDisplayable, Maybe MessageId
_, Maybe MessageId
rel'pId, Int
overlap) =
((Int, Bool, Maybe MessageId, Maybe MessageId, Int)
-> Message -> (Int, Bool, Maybe MessageId, Maybe MessageId, Int))
-> (Int, Bool, Maybe MessageId, Maybe MessageId, Int)
-> RetrogradeMessages
-> (Int, Bool, Maybe MessageId, Maybe MessageId, Int)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (Int, Bool, Maybe MessageId, Maybe MessageId, Int)
-> Message -> (Int, Bool, Maybe MessageId, Maybe MessageId, Int)
gapTrail (Int
numScrollbackPosts, Bool
False, Maybe MessageId
forall a. Maybe a
Nothing, Maybe MessageId
forall a. Maybe a
Nothing, Int
2) RetrogradeMessages
msgs
gapTrail :: (Int, Bool, Maybe MessageId, Maybe MessageId, Int)
-> Message
-> (Int, Bool, Maybe MessageId, Maybe MessageId, Int)
gapTrail :: (Int, Bool, Maybe MessageId, Maybe MessageId, Int)
-> Message -> (Int, Bool, Maybe MessageId, Maybe MessageId, Int)
gapTrail a :: (Int, Bool, Maybe MessageId, Maybe MessageId, Int)
a@(Int
_, Bool
True, Maybe MessageId
_, Maybe MessageId
_, Int
_) Message
_ = (Int, Bool, Maybe MessageId, Maybe MessageId, Int)
a
gapTrail a :: (Int, Bool, Maybe MessageId, Maybe MessageId, Int)
a@(Int
0, Bool
_, Maybe MessageId
_, Maybe MessageId
_, Int
_) Message
_ = (Int, Bool, Maybe MessageId, Maybe MessageId, Int)
a
gapTrail (Int
a, Bool
False, Maybe MessageId
b, Maybe MessageId
c, Int
d) Message
m | Message -> Bool
isGap Message
m = (Int
a, Bool
True, Maybe MessageId
b, Maybe MessageId
c, Int
d)
gapTrail (Int
remCnt, Bool
_, Maybe MessageId
prev'pId, Maybe MessageId
prev''pId, Int
ovl) Message
msg =
(Int
remCnt Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1, Bool
False, Message
msgMessage
-> Getting (Maybe MessageId) Message (Maybe MessageId)
-> Maybe MessageId
forall s a. s -> Getting a s a -> a
^.Getting (Maybe MessageId) Message (Maybe MessageId)
Lens' Message (Maybe MessageId)
mMessageId Maybe MessageId -> Maybe MessageId -> Maybe MessageId
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe MessageId
prev'pId, Maybe MessageId
prev'pId Maybe MessageId -> Maybe MessageId -> Maybe MessageId
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe MessageId
prev''pId,
Int
ovl Int -> Int -> Int
forall a. Num a => a -> a -> a
+ if Bool -> Bool
not (Message -> Bool
isPostMessage Message
msg) then Int
1 else Int
0)
numToRequest :: Int
numToRequest = Int
numRemaining Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
overlap
query :: PostQuery
query = PostQuery
MM.defaultPostQuery
{ postQueryPage :: Maybe Int
MM.postQueryPage = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0
, postQueryPerPage :: Maybe Int
MM.postQueryPerPage = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
numToRequest
}
finalQuery :: PostQuery
finalQuery = case Maybe MessageId
rel'pId of
Just (MessagePostId PostId
pid) -> PostQuery
query { postQueryBefore :: Maybe PostId
MM.postQueryBefore = PostId -> Maybe PostId
forall a. a -> Maybe a
Just PostId
pid }
Maybe MessageId
_ -> PostQuery
query
op :: Session -> ChannelId -> IO Posts
op = \Session
s ChannelId
c -> ChannelId -> PostQuery -> Session -> IO Posts
MM.mmGetPostsForChannel ChannelId
c PostQuery
finalQuery Session
s
addTrailingGap :: Bool
addTrailingGap = PostQuery -> Maybe PostId
MM.postQueryBefore PostQuery
finalQuery Maybe PostId -> Maybe PostId -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe PostId
forall a. Maybe a
Nothing Bool -> Bool -> Bool
&&
PostQuery -> Maybe Int
MM.postQueryPage PostQuery
finalQuery Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0
Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ClientChannel
chanClientChannel -> Getting Bool ClientChannel Bool -> Bool
forall s a. s -> Getting a s a -> a
^.(ChannelInfo -> Const Bool ChannelInfo)
-> ClientChannel -> Const Bool ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Const Bool ChannelInfo)
-> ClientChannel -> Const Bool ClientChannel)
-> ((Bool -> Const Bool Bool)
-> ChannelInfo -> Const Bool ChannelInfo)
-> Getting Bool ClientChannel Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Const Bool Bool) -> ChannelInfo -> Const Bool ChannelInfo
Lens' ChannelInfo Bool
cdFetchPending) Bool -> Bool -> Bool
&& Bool
gapInDisplayable) (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ do
ChannelId -> Traversal' ChatState ClientChannel
csChannel(ChannelId
cId)((ClientChannel -> Identity ClientChannel)
-> ChatState -> Identity ChatState)
-> ((Bool -> Identity Bool)
-> ClientChannel -> Identity ClientChannel)
-> (Bool -> Identity Bool)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChannelInfo -> Identity ChannelInfo)
-> ClientChannel -> Identity ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Identity ChannelInfo)
-> ClientChannel -> Identity ClientChannel)
-> ((Bool -> Identity Bool) -> ChannelInfo -> Identity ChannelInfo)
-> (Bool -> Identity Bool)
-> ClientChannel
-> Identity ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Identity Bool) -> ChannelInfo -> Identity ChannelInfo
Lens' ChannelInfo Bool
cdFetchPending ((Bool -> Identity Bool) -> ChatState -> Identity ChatState)
-> Bool -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
DoAsyncChannelMM Posts
forall a. DoAsyncChannelMM a
doAsyncChannelMM AsyncPriority
Preempt ChannelId
cId Session -> ChannelId -> IO Posts
op
(\ChannelId
c Posts
p -> MH () -> Maybe (MH ())
forall a. a -> Maybe a
Just (MH () -> Maybe (MH ())) -> MH () -> Maybe (MH ())
forall a b. (a -> b) -> a -> b
$ do
ChannelId -> Traversal' ChatState ClientChannel
csChannel(ChannelId
c)((ClientChannel -> Identity ClientChannel)
-> ChatState -> Identity ChatState)
-> ((Bool -> Identity Bool)
-> ClientChannel -> Identity ClientChannel)
-> (Bool -> Identity Bool)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChannelInfo -> Identity ChannelInfo)
-> ClientChannel -> Identity ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Identity ChannelInfo)
-> ClientChannel -> Identity ClientChannel)
-> ((Bool -> Identity Bool) -> ChannelInfo -> Identity ChannelInfo)
-> (Bool -> Identity Bool)
-> ClientChannel
-> Identity ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Identity Bool) -> ChannelInfo -> Identity ChannelInfo
Lens' ChannelInfo Bool
cdFetchPending ((Bool -> Identity Bool) -> ChatState -> Identity ChatState)
-> Bool -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
False
ChannelId -> Int -> Bool -> Posts -> MH PostProcessMessageAdd
addObtainedMessages ChannelId
c (-Int
numToRequest) Bool
addTrailingGap Posts
p MH PostProcessMessageAdd
-> (PostProcessMessageAdd -> MH ()) -> MH ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PostProcessMessageAdd -> MH ()
postProcessMessageAdd)
asyncFetchAttachments :: Post -> MH ()
asyncFetchAttachments :: Post -> MH ()
asyncFetchAttachments Post
p = do
let cId :: ChannelId
cId = Post
pPost -> Getting ChannelId Post ChannelId -> ChannelId
forall s a. s -> Getting a s a -> a
^.Getting ChannelId Post ChannelId
Lens' Post ChannelId
postChannelIdL
pId :: PostId
pId = Post
pPost -> Getting PostId Post PostId -> PostId
forall s a. s -> Getting a s a -> a
^.Getting PostId Post PostId
Lens' Post PostId
postIdL
Session
session <- MH Session
getSession
Text
host <- Getting Text ChatState Text -> MH Text
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((ChatResources -> Const Text ChatResources)
-> ChatState -> Const Text ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Const Text ChatResources)
-> ChatState -> Const Text ChatState)
-> ((Text -> Const Text Text)
-> ChatResources -> Const Text ChatResources)
-> Getting Text ChatState Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ConnectionData -> Const Text ConnectionData)
-> ChatResources -> Const Text ChatResources
Lens' ChatResources ConnectionData
crConn((ConnectionData -> Const Text ConnectionData)
-> ChatResources -> Const Text ChatResources)
-> ((Text -> Const Text Text)
-> ConnectionData -> Const Text ConnectionData)
-> (Text -> Const Text Text)
-> ChatResources
-> Const Text ChatResources
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Text -> Const Text Text)
-> ConnectionData -> Const Text ConnectionData
Lens' ConnectionData Text
cdHostnameL)
Seq FileId -> (FileId -> MH ()) -> MH ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
F.forM_ (Post
pPost -> Getting (Seq FileId) Post (Seq FileId) -> Seq FileId
forall s a. s -> Getting a s a -> a
^.Getting (Seq FileId) Post (Seq FileId)
Lens' Post (Seq FileId)
postFileIdsL) ((FileId -> MH ()) -> MH ()) -> (FileId -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \FileId
fId -> AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Normal (IO (Maybe (MH ())) -> MH ()) -> IO (Maybe (MH ())) -> MH ()
forall a b. (a -> b) -> a -> b
$ do
FileInfo
info <- FileId -> Session -> IO FileInfo
MM.mmGetMetadataForFile FileId
fId Session
session
let scheme :: Text
scheme = Text
"https://"
attUrl :: Text
attUrl = Text
scheme Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
host Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FileId -> Text
urlForFile FileId
fId
attachment :: Attachment
attachment = Text -> Text -> FileId -> Attachment
mkAttachment (FileInfo -> Text
fileInfoName FileInfo
info) Text
attUrl FileId
fId
addIfMissing :: a -> Seq a -> Seq a
addIfMissing a
a Seq a
as =
if Maybe Int -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe Int -> Bool) -> Maybe Int -> Bool
forall a b. (a -> b) -> a -> b
$ a -> Seq a -> Maybe Int
forall a. Eq a => a -> Seq a -> Maybe Int
Seq.elemIndexL a
a Seq a
as
then a
a a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
Seq.<| Seq a
as
else Seq a
as
addAttachment :: Message -> Message
addAttachment Message
m
| Message
mMessage
-> Getting (Maybe MessageId) Message (Maybe MessageId)
-> Maybe MessageId
forall s a. s -> Getting a s a -> a
^.Getting (Maybe MessageId) Message (Maybe MessageId)
Lens' Message (Maybe MessageId)
mMessageId Maybe MessageId -> Maybe MessageId -> Bool
forall a. Eq a => a -> a -> Bool
== MessageId -> Maybe MessageId
forall a. a -> Maybe a
Just (PostId -> MessageId
MessagePostId PostId
pId) =
Message
m Message -> (Message -> Message) -> Message
forall a b. a -> (a -> b) -> b
& (Seq Attachment -> Identity (Seq Attachment))
-> Message -> Identity Message
Lens' Message (Seq Attachment)
mAttachments ((Seq Attachment -> Identity (Seq Attachment))
-> Message -> Identity Message)
-> (Seq Attachment -> Seq Attachment) -> Message -> Message
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Attachment -> Seq Attachment -> Seq Attachment
forall a. Eq a => a -> Seq a -> Seq a
addIfMissing Attachment
attachment)
| Bool
otherwise =
Message
m
Maybe (MH ()) -> IO (Maybe (MH ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MH ()) -> IO (Maybe (MH ())))
-> Maybe (MH ()) -> IO (Maybe (MH ()))
forall a b. (a -> b) -> a -> b
$ MH () -> Maybe (MH ())
forall a. a -> Maybe a
Just (MH () -> Maybe (MH ())) -> MH () -> Maybe (MH ())
forall a b. (a -> b) -> a -> b
$ do
ChannelId -> Traversal' ChatState Messages
csChannelMessages(ChannelId
cId)((Messages -> Identity Messages)
-> ChatState -> Identity ChatState)
-> ((Message -> Identity Message) -> Messages -> Identity Messages)
-> (Message -> Identity Message)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Message -> Identity Message) -> Messages -> Identity Messages
forall (f :: * -> *) a b.
Traversable f =>
Traversal (f a) (f b) a b
traversed ((Message -> Identity Message) -> ChatState -> Identity ChatState)
-> (Message -> Message) -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Message -> Message
addAttachment
Maybe TeamId
curTId <- Getting (Maybe TeamId) ChatState (Maybe TeamId)
-> MH (Maybe TeamId)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Maybe TeamId) ChatState (Maybe TeamId)
SimpleGetter ChatState (Maybe TeamId)
csCurrentTeamId
ChannelId -> (ClientChannel -> MH ()) -> MH ()
withChannel ChannelId
cId ((ClientChannel -> MH ()) -> MH ())
-> (ClientChannel -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \ClientChannel
chan -> do
let mTId :: Maybe TeamId
mTId = ClientChannel
chanClientChannel
-> Getting (Maybe TeamId) ClientChannel (Maybe TeamId)
-> Maybe TeamId
forall s a. s -> Getting a s a -> a
^.(ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
-> ClientChannel -> Const (Maybe TeamId) ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
-> ClientChannel -> Const (Maybe TeamId) ClientChannel)
-> ((Maybe TeamId -> Const (Maybe TeamId) (Maybe TeamId))
-> ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
-> Getting (Maybe TeamId) ClientChannel (Maybe TeamId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe TeamId -> Const (Maybe TeamId) (Maybe TeamId))
-> ChannelInfo -> Const (Maybe TeamId) ChannelInfo
Lens' ChannelInfo (Maybe TeamId)
cdTeamId Maybe TeamId -> Maybe TeamId -> Maybe TeamId
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe TeamId
curTId
case Maybe TeamId
mTId of
Maybe TeamId
Nothing -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just TeamId
tId -> TeamId -> ChannelId -> (Message -> Message) -> MH ()
modifyEachThreadMessage TeamId
tId ChannelId
cId Message -> Message
addAttachment
ChannelId -> MH ()
invalidateChannelRenderingCache ChannelId
cId
PostId -> MH ()
invalidateMessageRenderingCacheByPostId PostId
pId
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 (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"