module Matterhorn.Events.Mouse
  ( mouseHandlerByMode
  )
where

import           Prelude ()
import           Matterhorn.Prelude

import           Brick

import           Matterhorn.State.Channels
import           Matterhorn.State.Teams ( setTeam )
import           Matterhorn.State.ListOverlay ( listOverlayActivate )
import           Matterhorn.Types

import           Matterhorn.Events.EditNotifyPrefs ( handleEditNotifyPrefsEvent )
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 :: Mode -> BrickEvent Name MHEvent -> MH ()
mouseHandlerByMode :: Mode -> BrickEvent Name MHEvent -> MH ()
mouseHandlerByMode Mode
mode =
    case Mode
mode of
        Mode
ChannelSelect            -> BrickEvent Name MHEvent -> MH ()
channelSelectMouseHandler
        Mode
EditNotifyPrefs          -> BrickEvent Name MHEvent -> MH ()
handleEditNotifyPrefsEvent
        Mode
ReactionEmojiListOverlay -> BrickEvent Name MHEvent -> MH ()
reactionEmojiListMouseHandler
        Mode
UrlSelect                -> BrickEvent Name MHEvent -> MH ()
urlListMouseHandler
        Mode
_                        -> BrickEvent Name MHEvent -> MH ()
globalMouseHandler

-- 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 :: BrickEvent Name MHEvent -> MH ()
globalMouseHandler :: BrickEvent Name MHEvent -> MH ()
globalMouseHandler (MouseDown Name
n Button
_ [Modifier]
_ Location
_) =
    case Name
n of
        ClickableChannelListEntry ChannelId
channelId -> do
            Mode -> MH () -> MH ()
whenMode Mode
Main (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ do
                MH ()
resetReturnChannel
                ChannelId -> MH ()
setFocus ChannelId
channelId
                Mode -> MH ()
setMode Mode
Main
        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
        ClickableURLInMessage MessageId
_ Int
_ LinkTarget
t ->
            MH Bool -> MH ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (MH Bool -> MH ()) -> MH Bool -> MH ()
forall a b. (a -> b) -> a -> b
$ LinkTarget -> MH Bool
openLinkTarget LinkTarget
t
        ClickableURL Name
_ Int
_ LinkTarget
t ->
            MH Bool -> MH ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (MH Bool -> MH ()) -> MH Bool -> MH ()
forall a b. (a -> b) -> a -> b
$ LinkTarget -> MH Bool
openLinkTarget LinkTarget
t
        ClickableUsernameInMessage MessageId
_ Int
_ Text
username ->
            Text -> MH ()
changeChannelByName (Text -> MH ()) -> Text -> MH ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
addUserSigil Text
username
        ClickableUsername Name
_ Int
_ Text
username ->
            Text -> MH ()
changeChannelByName (Text -> MH ()) -> Text -> MH ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
addUserSigil Text
username
        ClickableAttachment FileId
fId ->
            MH Bool -> MH ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (MH Bool -> MH ()) -> MH Bool -> MH ()
forall a b. (a -> b) -> a -> b
$ LinkTarget -> MH Bool
openLinkTarget (LinkTarget -> MH Bool) -> LinkTarget -> MH Bool
forall a b. (a -> b) -> a -> b
$ FileId -> LinkTarget
LinkFileId FileId
fId
        ClickableReactionInMessage PostId
pId 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
        ClickableReaction PostId
pId 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
        Name
_ ->
            () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
globalMouseHandler BrickEvent Name MHEvent
_ =
    () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

urlListMouseHandler :: BrickEvent Name MHEvent -> MH ()
urlListMouseHandler :: BrickEvent Name MHEvent -> MH ()
urlListMouseHandler (MouseDown (ClickableURLListEntry Int
_ LinkTarget
t) Button
_ [Modifier]
_ Location
_) =
    MH Bool -> MH ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (MH Bool -> MH ()) -> MH Bool -> MH ()
forall a b. (a -> b) -> a -> b
$ LinkTarget -> MH Bool
openLinkTarget LinkTarget
t
urlListMouseHandler BrickEvent Name MHEvent
_ =
    () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

channelSelectMouseHandler :: BrickEvent Name MHEvent -> MH ()
channelSelectMouseHandler :: BrickEvent Name MHEvent -> MH ()
channelSelectMouseHandler (MouseDown (ChannelSelectEntry ChannelSelectMatch
match) Button
_ [Modifier]
_ Location
_) = do
    Mode -> MH ()
setMode Mode
Main
    ChannelId -> MH ()
setFocus (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 BrickEvent Name MHEvent
_ =
    () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

reactionEmojiListMouseHandler :: BrickEvent Name MHEvent -> MH ()
reactionEmojiListMouseHandler :: BrickEvent Name MHEvent -> MH ()
reactionEmojiListMouseHandler (MouseDown (ReactionEmojiListOverlayEntry (Bool, Text)
val) Button
_ [Modifier]
_ Location
_) =
    Lens' ChatState (ListOverlayState (Bool, Text) ())
-> (Bool, Text) -> MH ()
forall a b. Lens' ChatState (ListOverlayState a b) -> a -> MH ()
listOverlayActivate ((TeamState -> f TeamState) -> ChatState -> f ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> f TeamState) -> ChatState -> f ChatState)
-> ((ListOverlayState (Bool, Text) ()
     -> f (ListOverlayState (Bool, Text) ()))
    -> TeamState -> f TeamState)
-> (ListOverlayState (Bool, Text) ()
    -> f (ListOverlayState (Bool, Text) ()))
-> ChatState
-> f ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ListOverlayState (Bool, Text) ()
 -> f (ListOverlayState (Bool, Text) ()))
-> TeamState -> f TeamState
Lens' TeamState (ListOverlayState (Bool, Text) ())
tsReactionEmojiListOverlay) (Bool, Text)
val
reactionEmojiListMouseHandler BrickEvent Name MHEvent
_ =
    () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()