module Matterhorn.State.Flagging
( loadFlaggedMessages
, updateMessageFlag
)
where
import Prelude ()
import Matterhorn.Prelude
import Data.Function ( on )
import qualified Data.Set as Set
import qualified Data.HashMap.Strict as HM
import Lens.Micro.Platform
import Network.Mattermost.Types
import Matterhorn.State.Common
import Matterhorn.Types
loadFlaggedMessages :: Seq FlaggedPost -> ChatState -> IO ()
loadFlaggedMessages :: Seq FlaggedPost -> ChatState -> IO ()
loadFlaggedMessages Seq FlaggedPost
prefs ChatState
st = AsyncPriority -> ChatState -> IO (Maybe (MH ())) -> IO ()
doAsyncWithIO AsyncPriority
Normal ChatState
st (IO (Maybe (MH ())) -> IO ()) -> IO (Maybe (MH ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Maybe (MH ()) -> IO (Maybe (MH ()))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MH ()) -> IO (Maybe (MH ())))
-> Maybe (MH ()) -> IO (Maybe (MH ()))
forall a b. (a -> b) -> a -> b
$ MH () -> Maybe (MH ())
forall a. a -> Maybe a
Just (MH () -> Maybe (MH ())) -> MH () -> Maybe (MH ())
forall a b. (a -> b) -> a -> b
$ do
[MH ()] -> MH ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [ PostId -> Bool -> MH ()
updateMessageFlag (FlaggedPost -> PostId
flaggedPostId FlaggedPost
fp) Bool
True
| FlaggedPost
fp <- Seq FlaggedPost -> [FlaggedPost]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq FlaggedPost
prefs
, FlaggedPost -> Bool
flaggedPostStatus FlaggedPost
fp
]
updateMessageFlag :: PostId -> Bool -> MH ()
updateMessageFlag :: PostId -> Bool -> MH ()
updateMessageFlag PostId
pId Bool
f = do
if Bool
f
then (ChatResources -> Identity ChatResources)
-> ChatState -> Identity ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Identity ChatResources)
-> ChatState -> Identity ChatState)
-> ((Set PostId -> Identity (Set PostId))
-> ChatResources -> Identity ChatResources)
-> (Set PostId -> Identity (Set PostId))
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Set PostId -> Identity (Set PostId))
-> ChatResources -> Identity ChatResources
Lens' ChatResources (Set PostId)
crFlaggedPosts ((Set PostId -> Identity (Set PostId))
-> ChatState -> Identity ChatState)
-> (Set PostId -> Set PostId) -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= PostId -> Set PostId -> Set PostId
forall a. Ord a => a -> Set a -> Set a
Set.insert PostId
pId
else (ChatResources -> Identity ChatResources)
-> ChatState -> Identity ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Identity ChatResources)
-> ChatState -> Identity ChatState)
-> ((Set PostId -> Identity (Set PostId))
-> ChatResources -> Identity ChatResources)
-> (Set PostId -> Identity (Set PostId))
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Set PostId -> Identity (Set PostId))
-> ChatResources -> Identity ChatResources
Lens' ChatResources (Set PostId)
crFlaggedPosts ((Set PostId -> Identity (Set PostId))
-> ChatState -> Identity ChatState)
-> (Set PostId -> Set PostId) -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= PostId -> Set PostId -> Set PostId
forall a. Ord a => a -> Set a -> Set a
Set.delete PostId
pId
Maybe Message
msgMb <- Getting (Maybe Message) ChatState (Maybe Message)
-> MH (Maybe Message)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((HashMap PostId Message
-> Const (Maybe Message) (HashMap PostId Message))
-> ChatState -> Const (Maybe Message) ChatState
Lens' ChatState (HashMap PostId Message)
csPostMap((HashMap PostId Message
-> Const (Maybe Message) (HashMap PostId Message))
-> ChatState -> Const (Maybe Message) ChatState)
-> ((Maybe Message -> Const (Maybe Message) (Maybe Message))
-> HashMap PostId Message
-> Const (Maybe Message) (HashMap PostId Message))
-> Getting (Maybe Message) ChatState (Maybe Message)
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(PostId
Index (HashMap PostId Message)
pId))
case Maybe Message
msgMb of
Just Message
msg
| Just ChannelId
cId <- Message
msgMessage
-> 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 -> ChannelId -> (ClientChannel -> MH ()) -> MH ()
withChannel ChannelId
cId ((ClientChannel -> MH ()) -> MH ())
-> (ClientChannel -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \ClientChannel
chan -> do
let isTargetMessage :: Message -> Bool
isTargetMessage 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)
ChannelId -> Traversal' ChatState Messages
csChannelMessages(ChannelId
cId)((Messages -> Identity Messages)
-> ChatState -> Identity ChatState)
-> ((Bool -> Identity Bool) -> Messages -> Identity Messages)
-> (Bool -> Identity Bool)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Message -> Identity Message) -> Messages -> Identity Messages
Traversal Messages Messages Message Message
forall (f :: * -> *) a b.
Traversable f =>
Traversal (f a) (f b) a b
traversed((Message -> Identity Message) -> Messages -> Identity Messages)
-> ((Bool -> Identity Bool) -> Message -> Identity Message)
-> (Bool -> Identity Bool)
-> 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
isTargetMessage((Message -> Identity Message) -> Message -> Identity Message)
-> ((Bool -> Identity Bool) -> Message -> Identity Message)
-> (Bool -> Identity Bool)
-> Message
-> Identity Message
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Identity Bool) -> Message -> Identity Message
Lens' Message Bool
mFlagged ((Bool -> Identity Bool) -> ChatState -> Identity ChatState)
-> Bool -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
f
(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)
-> ((Bool -> Identity Bool)
-> HashMap PostId Message -> Identity (HashMap PostId Message))
-> (Bool -> Identity Bool)
-> 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(PostId
Index (HashMap PostId Message)
pId)((Message -> Identity Message)
-> HashMap PostId Message -> Identity (HashMap PostId Message))
-> ((Bool -> Identity Bool) -> Message -> Identity Message)
-> (Bool -> Identity Bool)
-> HashMap PostId Message
-> Identity (HashMap PostId Message)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Identity Bool) -> Message -> Identity Message
Lens' Message Bool
mFlagged ((Bool -> Identity Bool) -> ChatState -> Identity ChatState)
-> Bool -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
f
ChannelId -> MH ()
invalidateChannelRenderingCache ChannelId
cId
PostId -> MH ()
invalidateMessageRenderingCacheByPostId PostId
pId
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
updateTeam :: TeamId -> MH ()
updateTeam :: TeamId -> MH ()
updateTeam TeamId
tId = do
Maybe ThreadInterface
mTi <- Getting (First ThreadInterface) ChatState ThreadInterface
-> MH (Maybe ThreadInterface)
forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse (HasCallStack => TeamId -> Traversal' ChatState ThreadInterface
TeamId -> Traversal' ChatState ThreadInterface
threadInterface(TeamId
tId))
case Maybe ThreadInterface
mTi of
Just ThreadInterface
ti | ThreadInterface
tiThreadInterface
-> Getting ChannelId ThreadInterface ChannelId -> ChannelId
forall s a. s -> Getting a s a -> a
^.Getting ChannelId ThreadInterface ChannelId
forall n i (f :: * -> *).
Functor f =>
(ChannelId -> f ChannelId)
-> MessageInterface n i -> f (MessageInterface n i)
miChannelId ChannelId -> ChannelId -> Bool
forall a. Eq a => a -> a -> Bool
== ChannelId
cId ->
HasCallStack => TeamId -> Traversal' ChatState ThreadInterface
TeamId -> Traversal' ChatState ThreadInterface
threadInterface(TeamId
tId)((ThreadInterface -> Identity ThreadInterface)
-> ChatState -> Identity ChatState)
-> ((Bool -> Identity Bool)
-> ThreadInterface -> Identity ThreadInterface)
-> (Bool -> Identity Bool)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Identity Messages)
-> ThreadInterface -> Identity ThreadInterface
forall n i (f :: * -> *).
Functor f =>
(Messages -> f Messages)
-> MessageInterface n i -> f (MessageInterface n i)
miMessages((Messages -> Identity Messages)
-> ThreadInterface -> Identity ThreadInterface)
-> ((Bool -> Identity Bool) -> Messages -> Identity Messages)
-> (Bool -> Identity Bool)
-> ThreadInterface
-> Identity ThreadInterface
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Message -> Identity Message) -> Messages -> Identity Messages
Traversal Messages Messages Message Message
forall (f :: * -> *) a b.
Traversable f =>
Traversal (f a) (f b) a b
traversed((Message -> Identity Message) -> Messages -> Identity Messages)
-> ((Bool -> Identity Bool) -> Message -> Identity Message)
-> (Bool -> Identity Bool)
-> 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
isTargetMessage((Message -> Identity Message) -> Message -> Identity Message)
-> ((Bool -> Identity Bool) -> Message -> Identity Message)
-> (Bool -> Identity Bool)
-> Message
-> Identity Message
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Identity Bool) -> Message -> Identity Message
Lens' Message Bool
mFlagged ((Bool -> Identity Bool) -> ChatState -> Identity ChatState)
-> Bool -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
f
Maybe ThreadInterface
_ -> () -> MH ()
forall a. a -> MH a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Mode
mode <- TeamId -> MH Mode
getTeamMode TeamId
tId
case Mode
mode of
PostListWindow PostListContents
PostListFlagged
| Bool
f ->
TeamId -> Lens' ChatState TeamState
csTeam TeamId
tId((TeamState -> Identity TeamState)
-> ChatState -> Identity ChatState)
-> ((Messages -> Identity Messages)
-> TeamState -> Identity TeamState)
-> (Messages -> Identity Messages)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(PostListWindowState -> Identity PostListWindowState)
-> TeamState -> Identity TeamState
Lens' TeamState PostListWindowState
tsPostListWindow((PostListWindowState -> Identity PostListWindowState)
-> TeamState -> Identity TeamState)
-> ((Messages -> Identity Messages)
-> PostListWindowState -> Identity PostListWindowState)
-> (Messages -> Identity Messages)
-> TeamState
-> Identity TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Identity Messages)
-> PostListWindowState -> Identity PostListWindowState
Lens' PostListWindowState Messages
postListPosts ((Messages -> Identity Messages)
-> ChatState -> Identity ChatState)
-> (Messages -> Messages) -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%=
Message -> Messages -> Messages
forall a. MessageOps a => Message -> a -> a
addMessage (Message
msg Message -> (Message -> Message) -> Message
forall a b. a -> (a -> b) -> b
& (Bool -> Identity Bool) -> Message -> Identity Message
Lens' Message Bool
mFlagged ((Bool -> Identity Bool) -> Message -> Identity Message)
-> Bool -> Message -> Message
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True)
| Bool
otherwise -> do
Maybe PostId
selId <- Getting (Maybe PostId) ChatState (Maybe PostId)
-> MH (Maybe PostId)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> Lens' ChatState TeamState
csTeam TeamId
tId((TeamState -> Const (Maybe PostId) TeamState)
-> ChatState -> Const (Maybe PostId) ChatState)
-> ((Maybe PostId -> Const (Maybe PostId) (Maybe PostId))
-> TeamState -> Const (Maybe PostId) TeamState)
-> Getting (Maybe PostId) ChatState (Maybe PostId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(PostListWindowState -> Const (Maybe PostId) PostListWindowState)
-> TeamState -> Const (Maybe PostId) TeamState
Lens' TeamState PostListWindowState
tsPostListWindow((PostListWindowState -> Const (Maybe PostId) PostListWindowState)
-> TeamState -> Const (Maybe PostId) TeamState)
-> ((Maybe PostId -> Const (Maybe PostId) (Maybe PostId))
-> PostListWindowState -> Const (Maybe PostId) PostListWindowState)
-> (Maybe PostId -> Const (Maybe PostId) (Maybe PostId))
-> TeamState
-> Const (Maybe PostId) TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe PostId -> Const (Maybe PostId) (Maybe PostId))
-> PostListWindowState -> Const (Maybe PostId) PostListWindowState
Lens' PostListWindowState (Maybe PostId)
postListSelected)
Messages
posts <- Getting Messages ChatState Messages -> MH Messages
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> Lens' ChatState TeamState
csTeam TeamId
tId((TeamState -> Const Messages TeamState)
-> ChatState -> Const Messages ChatState)
-> ((Messages -> Const Messages Messages)
-> TeamState -> Const Messages TeamState)
-> Getting Messages ChatState Messages
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(PostListWindowState -> Const Messages PostListWindowState)
-> TeamState -> Const Messages TeamState
Lens' TeamState PostListWindowState
tsPostListWindow((PostListWindowState -> Const Messages PostListWindowState)
-> TeamState -> Const Messages TeamState)
-> ((Messages -> Const Messages Messages)
-> PostListWindowState -> Const Messages PostListWindowState)
-> (Messages -> Const Messages Messages)
-> TeamState
-> Const Messages TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Const Messages Messages)
-> PostListWindowState -> Const Messages PostListWindowState
Lens' PostListWindowState Messages
postListPosts)
let nextId :: Maybe PostId
nextId = case Maybe PostId -> Messages -> Maybe PostId
getNextPostId Maybe PostId
selId Messages
posts of
Maybe PostId
Nothing -> Maybe PostId -> Messages -> Maybe PostId
getPrevPostId Maybe PostId
selId Messages
posts
Just PostId
x -> PostId -> Maybe PostId
forall a. a -> Maybe a
Just PostId
x
TeamId -> Lens' ChatState TeamState
csTeam TeamId
tId((TeamState -> Identity TeamState)
-> ChatState -> Identity ChatState)
-> ((Maybe PostId -> Identity (Maybe PostId))
-> TeamState -> Identity TeamState)
-> (Maybe PostId -> Identity (Maybe PostId))
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(PostListWindowState -> Identity PostListWindowState)
-> TeamState -> Identity TeamState
Lens' TeamState PostListWindowState
tsPostListWindow((PostListWindowState -> Identity PostListWindowState)
-> TeamState -> Identity TeamState)
-> ((Maybe PostId -> Identity (Maybe PostId))
-> PostListWindowState -> Identity PostListWindowState)
-> (Maybe PostId -> Identity (Maybe PostId))
-> TeamState
-> Identity TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe PostId -> Identity (Maybe PostId))
-> PostListWindowState -> Identity PostListWindowState
Lens' PostListWindowState (Maybe PostId)
postListSelected ((Maybe PostId -> Identity (Maybe PostId))
-> ChatState -> Identity ChatState)
-> Maybe PostId -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe PostId
nextId
TeamId -> Lens' ChatState TeamState
csTeam TeamId
tId((TeamState -> Identity TeamState)
-> ChatState -> Identity ChatState)
-> ((Messages -> Identity Messages)
-> TeamState -> Identity TeamState)
-> (Messages -> Identity Messages)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(PostListWindowState -> Identity PostListWindowState)
-> TeamState -> Identity TeamState
Lens' TeamState PostListWindowState
tsPostListWindow((PostListWindowState -> Identity PostListWindowState)
-> TeamState -> Identity TeamState)
-> ((Messages -> Identity Messages)
-> PostListWindowState -> Identity PostListWindowState)
-> (Messages -> Identity Messages)
-> TeamState
-> Identity TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Identity Messages)
-> PostListWindowState -> Identity PostListWindowState
Lens' PostListWindowState Messages
postListPosts ((Messages -> Identity Messages)
-> ChatState -> Identity ChatState)
-> (Messages -> Messages) -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%=
(Message -> Bool) -> Messages -> Messages
forall seq a.
SeqDirection seq =>
(a -> Bool) -> DirectionalSeq seq a -> DirectionalSeq seq a
filterMessages ((Maybe MessageId -> Maybe MessageId -> Bool
forall a. Eq a => a -> a -> Bool
(/=) (Maybe MessageId -> Maybe MessageId -> Bool)
-> (Message -> Maybe MessageId) -> Message -> Message -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Message -> Maybe MessageId
_mMessageId) Message
msg)
Mode
_ -> () -> MH ()
forall a. a -> MH a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
case Maybe TeamId
mTId of
Maybe TeamId
Nothing -> do
HashMap TeamId TeamState
ts <- Getting
(HashMap TeamId TeamState) ChatState (HashMap TeamId TeamState)
-> MH (HashMap TeamId TeamState)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting
(HashMap TeamId TeamState) ChatState (HashMap TeamId TeamState)
Lens' ChatState (HashMap TeamId TeamState)
csTeams
[TeamId] -> (TeamId -> MH ()) -> MH ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (HashMap TeamId TeamState -> [TeamId]
forall k v. HashMap k v -> [k]
HM.keys HashMap TeamId TeamState
ts) TeamId -> MH ()
updateTeam
Just TeamId
tId -> TeamId -> MH ()
updateTeam TeamId
tId
Maybe Message
_ -> () -> MH ()
forall a. a -> MH a
forall (m :: * -> *) a. Monad m => a -> m a
return ()