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 (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 (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 (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 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
.(ChannelContents -> Identity ChannelContents)
-> ClientChannel -> Identity ClientChannel
Lens' ClientChannel ChannelContents
ccContents((ChannelContents -> Identity ChannelContents)
 -> ClientChannel -> Identity ClientChannel)
-> ((Bool -> Identity Bool)
    -> ChannelContents -> Identity ChannelContents)
-> (Bool -> Identity Bool)
-> ClientChannel
-> Identity ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Identity Messages)
-> ChannelContents -> Identity ChannelContents
Lens' ChannelContents Messages
cdMessages((Messages -> Identity Messages)
 -> ChannelContents -> Identity ChannelContents)
-> ((Bool -> Identity Bool) -> Messages -> Identity Messages)
-> (Bool -> Identity Bool)
-> ChannelContents
-> Identity ChannelContents
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)
-> ((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

      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
          updatePostOverlay :: TeamId -> MH ()
          updatePostOverlay :: TeamId -> MH ()
updatePostOverlay TeamId
tId = do
              -- We also want to update the post overlay if this happens
              -- while we're we're observing it
              Mode
mode <- Getting Mode ChatState Mode -> MH Mode
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> Lens' ChatState TeamState
csTeam TeamId
tId((TeamState -> Const Mode TeamState)
 -> ChatState -> Const Mode ChatState)
-> ((Mode -> Const Mode Mode) -> TeamState -> Const Mode TeamState)
-> Getting Mode ChatState Mode
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Mode -> Const Mode Mode) -> TeamState -> Const Mode TeamState
Lens' TeamState Mode
tsMode)
              case Mode
mode of
                PostListOverlay 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
.(PostListOverlayState -> Identity PostListOverlayState)
-> TeamState -> Identity TeamState
Lens' TeamState PostListOverlayState
tsPostListOverlay((PostListOverlayState -> Identity PostListOverlayState)
 -> TeamState -> Identity TeamState)
-> ((Messages -> Identity Messages)
    -> PostListOverlayState -> Identity PostListOverlayState)
-> (Messages -> Identity Messages)
-> TeamState
-> Identity TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Identity Messages)
-> PostListOverlayState -> Identity PostListOverlayState
Lens' PostListOverlayState 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)

                  -- 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 <- 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
.(PostListOverlayState -> Const (Maybe PostId) PostListOverlayState)
-> TeamState -> Const (Maybe PostId) TeamState
Lens' TeamState PostListOverlayState
tsPostListOverlay((PostListOverlayState
  -> Const (Maybe PostId) PostListOverlayState)
 -> TeamState -> Const (Maybe PostId) TeamState)
-> ((Maybe PostId -> Const (Maybe PostId) (Maybe PostId))
    -> PostListOverlayState
    -> Const (Maybe PostId) PostListOverlayState)
-> (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))
-> PostListOverlayState
-> Const (Maybe PostId) PostListOverlayState
Lens' PostListOverlayState (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
.(PostListOverlayState -> Const Messages PostListOverlayState)
-> TeamState -> Const Messages TeamState
Lens' TeamState PostListOverlayState
tsPostListOverlay((PostListOverlayState -> Const Messages PostListOverlayState)
 -> TeamState -> Const Messages TeamState)
-> ((Messages -> Const Messages Messages)
    -> PostListOverlayState -> Const Messages PostListOverlayState)
-> (Messages -> Const Messages Messages)
-> TeamState
-> Const Messages TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Const Messages Messages)
-> PostListOverlayState -> Const Messages PostListOverlayState
Lens' PostListOverlayState 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
.(PostListOverlayState -> Identity PostListOverlayState)
-> TeamState -> Identity TeamState
Lens' TeamState PostListOverlayState
tsPostListOverlay((PostListOverlayState -> Identity PostListOverlayState)
 -> TeamState -> Identity TeamState)
-> ((Maybe PostId -> Identity (Maybe PostId))
    -> PostListOverlayState -> Identity PostListOverlayState)
-> (Maybe PostId -> Identity (Maybe PostId))
-> TeamState
-> Identity TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe PostId -> Identity (Maybe PostId))
-> PostListOverlayState -> Identity PostListOverlayState
Lens' PostListOverlayState (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
.(PostListOverlayState -> Identity PostListOverlayState)
-> TeamState -> Identity TeamState
Lens' TeamState PostListOverlayState
tsPostListOverlay((PostListOverlayState -> Identity PostListOverlayState)
 -> TeamState -> Identity TeamState)
-> ((Messages -> Identity Messages)
    -> PostListOverlayState -> Identity PostListOverlayState)
-> (Messages -> Identity Messages)
-> TeamState
-> Identity TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Identity Messages)
-> PostListOverlayState -> Identity PostListOverlayState
Lens' PostListOverlayState 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 (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 ()
updatePostOverlay
          Just TeamId
tId -> TeamId -> MH ()
updatePostOverlay TeamId
tId

    Maybe Message
_ -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()