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 forall a b. (a -> b) -> a -> b
$ do
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ do
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 <- 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 Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources (Set PostId)
crFlaggedPosts forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall a. Ord a => a -> Set a -> Set a
Set.insert PostId
pId
else Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources (Set PostId)
crFlaggedPosts forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall a. Ord a => a -> Set a -> Set a
Set.delete PostId
pId
Maybe Message
msgMb <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (HashMap PostId Message)
csPostMapforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at(PostId
pId))
case Maybe Message
msgMb of
Just Message
msg
| Just ChannelId
cId <- Message
msgforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe ChannelId)
mChannelId -> ChannelId -> (ClientChannel -> MH ()) -> MH ()
withChannel ChannelId
cId forall a b. (a -> b) -> a -> b
$ \ClientChannel
chan -> do
let isTargetMessage :: Message -> Bool
isTargetMessage Message
m = Message
mforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe MessageId)
mMessageId forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just (PostId -> MessageId
MessagePostId PostId
pId)
ChannelId -> Traversal' ChatState Messages
csChannelMessages(ChannelId
cId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (f :: * -> *) a b.
Traversable f =>
Traversal (f a) (f b) a b
traversedforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. (a -> Bool) -> Traversal' a a
filtered Message -> Bool
isTargetMessageforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' Message Bool
mFlagged forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
f
Lens' ChatState (HashMap PostId Message)
csPostMapforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix(PostId
pId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' Message Bool
mFlagged 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
chanforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo (Maybe TeamId)
cdTeamId
updateTeam :: TeamId -> MH ()
updateTeam :: TeamId -> MH ()
updateTeam TeamId
tId = do
Maybe ThreadInterface
mTi <- forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse (HasCallStack => TeamId -> Traversal' ChatState ThreadInterface
threadInterface(TeamId
tId))
case Maybe ThreadInterface
mTi of
Just ThreadInterface
ti | ThreadInterface
tiforall s a. s -> Getting a s a -> a
^.forall n i. Lens' (MessageInterface n i) ChannelId
miChannelId forall a. Eq a => a -> a -> Bool
== ChannelId
cId ->
HasCallStack => TeamId -> Traversal' ChatState ThreadInterface
threadInterface(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) Messages
miMessagesforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (f :: * -> *) a b.
Traversable f =>
Traversal (f a) (f b) a b
traversedforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. (a -> Bool) -> Traversal' a a
filtered Message -> Bool
isTargetMessageforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' Message Bool
mFlagged forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
f
Maybe ThreadInterface
_ -> 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
tIdforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState PostListWindowState
tsPostListWindowforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' PostListWindowState Messages
postListPosts forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%=
forall a. MessageOps a => Message -> a -> a
addMessage (Message
msg forall a b. a -> (a -> b) -> b
& Lens' Message Bool
mFlagged forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True)
| Bool
otherwise -> do
Maybe PostId
selId <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> Lens' ChatState TeamState
csTeam TeamId
tIdforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState PostListWindowState
tsPostListWindowforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' PostListWindowState (Maybe PostId)
postListSelected)
Messages
posts <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> Lens' ChatState TeamState
csTeam TeamId
tIdforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState PostListWindowState
tsPostListWindowforall b c a. (b -> c) -> (a -> b) -> a -> c
.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 -> forall a. a -> Maybe a
Just PostId
x
TeamId -> Lens' ChatState TeamState
csTeam TeamId
tIdforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState PostListWindowState
tsPostListWindowforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' PostListWindowState (Maybe PostId)
postListSelected forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe PostId
nextId
TeamId -> Lens' ChatState TeamState
csTeam TeamId
tIdforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState PostListWindowState
tsPostListWindowforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' PostListWindowState Messages
postListPosts forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%=
forall seq a.
SeqDirection seq =>
(a -> Bool) -> DirectionalSeq seq a -> DirectionalSeq seq a
filterMessages ((forall a. Eq a => a -> a -> Bool
(/=) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Message -> Maybe MessageId
_mMessageId) Message
msg)
Mode
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
case Maybe TeamId
mTId of
Maybe TeamId
Nothing -> do
HashMap TeamId TeamState
ts <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' ChatState (HashMap TeamId TeamState)
csTeams
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall k v. HashMap k v -> [k]
HM.keys HashMap TeamId TeamState
ts) TeamId -> MH ()
updateTeam
Just TeamId
tId -> TeamId -> MH ()
updateTeam TeamId
tId
Maybe Message
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()