module Matterhorn.Events.Mouse
  ( mouseHandlerByMode
  )
where

import           Prelude ()
import           Matterhorn.Prelude

import           Brick

import           Network.Mattermost.Types ( TeamId )

import           Matterhorn.State.Channels
import           Matterhorn.State.Teams ( setTeam )
import           Matterhorn.State.ListWindow ( listWindowActivate )
import           Matterhorn.Types

import           Matterhorn.Events.EditNotifyPrefs ( handleEditNotifyPrefsEvent )
import           Matterhorn.State.MessageSelect ( exitMessageSelect )
import           Matterhorn.State.Reactions ( toggleReaction )
import           Matterhorn.State.Links ( openLinkTarget )

-- The top-level mouse click handler. This dispatches to specific
-- handlers for some modes, or the global mouse handler when the mode is
-- not important (or when it is important that we ignore the mode).
mouseHandlerByMode :: TeamId -> Mode -> BrickEvent Name MHEvent -> MH ()
mouseHandlerByMode :: TeamId -> Mode -> BrickEvent Name MHEvent -> MH ()
mouseHandlerByMode TeamId
tId Mode
mode =
    case Mode
mode of
        Mode
ChannelSelect            -> TeamId -> BrickEvent Name MHEvent -> MH ()
channelSelectMouseHandler TeamId
tId
        Mode
EditNotifyPrefs          -> MH Bool -> MH ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (MH Bool -> MH ())
-> (BrickEvent Name MHEvent -> MH Bool)
-> BrickEvent Name MHEvent
-> MH ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TeamId -> BrickEvent Name MHEvent -> MH Bool
handleEditNotifyPrefsEvent TeamId
tId
        Mode
ReactionEmojiListWindow -> TeamId -> BrickEvent Name MHEvent -> MH ()
reactionEmojiListMouseHandler TeamId
tId
        Mode
_                        -> TeamId -> BrickEvent Name MHEvent -> MH ()
globalMouseHandler TeamId
tId

-- Handle global mouse click events (when mode is not important).
--
-- Note that the handler for each case may need to check the application
-- mode before handling the click. This is because some mouse events
-- only make sense when the UI is displaying certain contents. While
-- it's true that we probably wouldn't even get the click events in the
-- first place (because the UI element would only cause a click event
-- to be reported if it was actually rendered), there are cases when we
-- can get clicks on UI elements that *are* clickable even though those
-- clicks don't make sense for the application mode. A concrete example
-- of this is when we display the current channel's contents in one
-- layer, in monochrome, and then display a modal dialog box on top of
-- that. We probably *should* ignore clicks on the lower layer because
-- that's not the mode the application is in, but getting that right
-- could be hard because we'd have to figure out all possible modes
-- where those lower-layer clicks would be nonsensical. We don't bother
-- doing that in the harder cases; instead we just handle the clicks
-- and do what we would ordinarily do, assuming that there's no real
-- harm done. The worst that could happen is that a user could click
-- accidentally on a grayed-out URL (in a message, say) next to a modal
-- dialog box and then see the URL get opened. That would be weird, but
-- it isn't the end of the world.
globalMouseHandler :: TeamId -> BrickEvent Name MHEvent -> MH ()
globalMouseHandler :: TeamId -> BrickEvent Name MHEvent -> MH ()
globalMouseHandler TeamId
tId (MouseDown Name
n Button
_ [Modifier]
_ Location
_) = 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 Name
n of
        ClickableChannelListEntry ChannelId
channelId -> do
            TeamId -> Mode -> MH () -> MH ()
whenMode TeamId
tId Mode
Main (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ do
                TeamId -> MH ()
resetReturnChannel TeamId
tId
                TeamId -> ChannelId -> MH ()
setFocus TeamId
tId ChannelId
channelId
        ClickableTeamListEntry TeamId
teamId ->
            -- We deliberately handle this event in all modes; this
            -- allows us to switch the UI to another team regardless of
            -- what state it is in, which is by design since all teams
            -- have their own UI states.
            TeamId -> MH ()
setTeam TeamId
teamId
        ClickableURL Maybe MessageId
_ Name
_ Int
_ LinkTarget
t ->
            MH () -> MH ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ LinkTarget -> MH ()
openLinkTarget LinkTarget
t
        ClickableUsername Maybe MessageId
_ Name
_ Int
_ Text
username | Text
username Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= ChatState -> Text
myUsername ChatState
st -> do
            TeamId -> Mode -> MH () -> MH ()
whenMode TeamId
tId Mode
ViewMessage (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ do
                -- Pop view message mode
                TeamId -> MH ()
popMode TeamId
tId
                -- Exit message select for the focused interface,
                -- since that is the only way we get into message
                -- view mode and we want to reset the focused message
                -- interface mode so that when we return to it from the
                -- DM channel, it's not still stuck in message selection
                -- mode.
                MessageInterfaceFocus
foc <- Getting MessageInterfaceFocus ChatState MessageInterfaceFocus
-> MH MessageInterfaceFocus
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)((TeamState -> Const MessageInterfaceFocus TeamState)
 -> ChatState -> Const MessageInterfaceFocus ChatState)
-> ((MessageInterfaceFocus
     -> Const MessageInterfaceFocus MessageInterfaceFocus)
    -> TeamState -> Const MessageInterfaceFocus TeamState)
-> Getting MessageInterfaceFocus ChatState MessageInterfaceFocus
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MessageInterfaceFocus
 -> Const MessageInterfaceFocus MessageInterfaceFocus)
-> TeamState -> Const MessageInterfaceFocus TeamState
Lens' TeamState MessageInterfaceFocus
tsMessageInterfaceFocus)
                case MessageInterfaceFocus
foc of
                    MessageInterfaceFocus
FocusThread ->
                        Lens' ChatState (MessageInterface Name PostId) -> MH ()
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
exitMessageSelect (Lens' ChatState (MessageInterface Name PostId) -> MH ())
-> Lens' ChatState (MessageInterface Name PostId) -> MH ()
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
TeamId -> Lens' ChatState (MessageInterface Name PostId)
TeamId -> Lens' ChatState (MessageInterface Name PostId)
unsafeThreadInterface TeamId
tId
                    MessageInterfaceFocus
FocusCurrentChannel -> do
                        Maybe ChannelId
mcId <- 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
tId))
                        case Maybe ChannelId
mcId of
                            Maybe ChannelId
Nothing -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                            Just ChannelId
cId -> Lens' ChatState (MessageInterface Name ()) -> MH ()
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
exitMessageSelect (Lens' ChatState (MessageInterface Name ()) -> MH ())
-> Lens' ChatState (MessageInterface Name ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ ChannelId -> Lens' ChatState (MessageInterface Name ())
csChannelMessageInterface ChannelId
cId
            TeamId -> Text -> MH ()
changeChannelByName TeamId
tId (Text -> MH ()) -> Text -> MH ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
addUserSigil Text
username
        ClickableAttachmentInMessage Name
_ FileId
fId ->
            MH () -> MH ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ LinkTarget -> MH ()
openLinkTarget (LinkTarget -> MH ()) -> LinkTarget -> MH ()
forall a b. (a -> b) -> a -> b
$ FileId -> LinkTarget
LinkFileId FileId
fId
        ClickableReaction PostId
pId Name
_ Text
t Set UserId
uIds ->
            MH () -> MH ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ PostId -> Text -> Set UserId -> MH ()
toggleReaction PostId
pId Text
t Set UserId
uIds
        ClickableChannelListGroupHeading ChannelListGroupLabel
label ->
            ChannelListGroupLabel -> MH ()
toggleChannelListGroupVisibility ChannelListGroupLabel
label
        ClickableURLListEntry Int
_ LinkTarget
t ->
            MH () -> MH ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ LinkTarget -> MH ()
openLinkTarget LinkTarget
t
        VScrollBar ClickableScrollbarElement
e Name
vpName -> do
            let vp :: ViewportScroll Name
vp = Name -> ViewportScroll Name
forall n. n -> ViewportScroll n
viewportScroll Name
vpName
            EventM Name () -> MH ()
forall a. EventM Name a -> MH a
mh (EventM Name () -> MH ()) -> EventM Name () -> MH ()
forall a b. (a -> b) -> a -> b
$ case ClickableScrollbarElement
e of
                ClickableScrollbarElement
SBHandleBefore -> ViewportScroll Name -> Int -> EventM Name ()
forall n. ViewportScroll n -> Int -> EventM n ()
vScrollBy ViewportScroll Name
vp (-Int
1)
                ClickableScrollbarElement
SBHandleAfter  -> ViewportScroll Name -> Int -> EventM Name ()
forall n. ViewportScroll n -> Int -> EventM n ()
vScrollBy ViewportScroll Name
vp Int
1
                ClickableScrollbarElement
SBTroughBefore -> ViewportScroll Name -> Direction -> EventM Name ()
forall n. ViewportScroll n -> Direction -> EventM n ()
vScrollPage ViewportScroll Name
vp Direction
Up
                ClickableScrollbarElement
SBTroughAfter  -> ViewportScroll Name -> Direction -> EventM Name ()
forall n. ViewportScroll n -> Direction -> EventM n ()
vScrollPage ViewportScroll Name
vp Direction
Down
                ClickableScrollbarElement
SBBar          -> () -> EventM Name ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Name
_ ->
            () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
globalMouseHandler TeamId
_ BrickEvent Name MHEvent
_ =
    () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

channelSelectMouseHandler :: TeamId -> BrickEvent Name MHEvent -> MH ()
channelSelectMouseHandler :: TeamId -> BrickEvent Name MHEvent -> MH ()
channelSelectMouseHandler TeamId
tId (MouseDown (ClickableChannelSelectEntry ChannelSelectMatch
match) Button
_ [Modifier]
_ Location
_) = do
    TeamId -> MH ()
popMode TeamId
tId
    TeamId -> ChannelId -> MH ()
setFocus TeamId
tId (ChannelId -> MH ()) -> ChannelId -> MH ()
forall a b. (a -> b) -> a -> b
$ ChannelListEntry -> ChannelId
channelListEntryChannelId (ChannelListEntry -> ChannelId) -> ChannelListEntry -> ChannelId
forall a b. (a -> b) -> a -> b
$ ChannelSelectMatch -> ChannelListEntry
matchEntry ChannelSelectMatch
match
channelSelectMouseHandler TeamId
_ BrickEvent Name MHEvent
_ =
    () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

reactionEmojiListMouseHandler :: TeamId -> BrickEvent Name MHEvent -> MH ()
reactionEmojiListMouseHandler :: TeamId -> BrickEvent Name MHEvent -> MH ()
reactionEmojiListMouseHandler TeamId
tId (MouseDown (ClickableReactionEmojiListWindowEntry (Bool, Text)
val) Button
_ [Modifier]
_ Location
_) =
    TeamId
-> Lens' ChatState (ListWindowState (Bool, Text) ())
-> (Bool, Text)
-> MH ()
forall a b.
TeamId -> Lens' ChatState (ListWindowState a b) -> a -> MH ()
listWindowActivate TeamId
tId (TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)((TeamState -> f TeamState) -> ChatState -> f ChatState)
-> ((ListWindowState (Bool, Text) ()
     -> f (ListWindowState (Bool, Text) ()))
    -> TeamState -> f TeamState)
-> (ListWindowState (Bool, Text) ()
    -> f (ListWindowState (Bool, Text) ()))
-> ChatState
-> f ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ListWindowState (Bool, Text) ()
 -> f (ListWindowState (Bool, Text) ()))
-> TeamState -> f TeamState
Lens' TeamState (ListWindowState (Bool, Text) ())
tsReactionEmojiListWindow) (Bool, Text)
val
reactionEmojiListMouseHandler TeamId
_ BrickEvent Name MHEvent
_ =
    () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()