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
                ]


-- | Update the UI to reflect the flagged/unflagged state of a
-- message. This __does not__ talk to the Mattermost server, but
-- rather is the function we call when the Mattermost server notifies
-- us of flagged or unflagged messages.
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
              -- Update the thread window for this team, if its channel
              -- is the one that the post is in.
              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 ()

              -- We also want to update the post window if this happens
              -- while we're we're observing it
              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)

                  -- deleting here is tricky, because it means that we
                  -- need to move the focus somewhere: we'll try moving
                  -- it _up_ unless we can't, in which case we'll try
                  -- moving it down.
                  | 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 ()