matterhorn-50200.17.0: src/Matterhorn/Events/Mouse.hs
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 tId mode =
case mode of
ChannelSelect -> channelSelectMouseHandler tId
EditNotifyPrefs -> void . handleEditNotifyPrefsEvent tId
ReactionEmojiListWindow -> reactionEmojiListMouseHandler tId
_ -> globalMouseHandler 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 tId (MouseDown n _ _ _) = do
st <- use id
case n of
ClickableChannelListEntry channelId -> do
whenMode tId Main $ do
resetReturnChannel tId
setFocus tId channelId
ClickableTeamListEntry 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.
setTeam teamId
ClickableURL _ _ _ t ->
void $ openLinkTarget t
ClickableUsername _ _ _ username | username /= myUsername st -> do
whenMode tId ViewMessage $ do
-- Pop view message mode
popMode 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.
foc <- use (csTeam(tId).tsMessageInterfaceFocus)
case foc of
FocusThread ->
exitMessageSelect $ unsafeThreadInterface tId
FocusCurrentChannel -> do
mcId <- use (csCurrentChannelId(tId))
case mcId of
Nothing -> return ()
Just cId -> exitMessageSelect $ csChannelMessageInterface cId
changeChannelByName tId $ addUserSigil username
ClickableAttachmentInMessage _ fId ->
void $ openLinkTarget $ LinkFileId fId
ClickableReaction pId _ t uIds ->
void $ toggleReaction pId t uIds
ClickableChannelListGroupHeading label ->
toggleChannelListGroupVisibility label
ClickableURLListEntry _ t ->
void $ openLinkTarget t
VScrollBar e vpName -> do
let vp = viewportScroll vpName
mh $ case e of
SBHandleBefore -> vScrollBy vp (-1)
SBHandleAfter -> vScrollBy vp 1
SBTroughBefore -> vScrollPage vp Up
SBTroughAfter -> vScrollPage vp Down
SBBar -> return ()
_ ->
return ()
globalMouseHandler _ _ =
return ()
channelSelectMouseHandler :: TeamId -> BrickEvent Name MHEvent -> MH ()
channelSelectMouseHandler tId (MouseDown (ClickableChannelSelectEntry match) _ _ _) = do
popMode tId
setFocus tId $ channelListEntryChannelId $ matchEntry match
channelSelectMouseHandler _ _ =
return ()
reactionEmojiListMouseHandler :: TeamId -> BrickEvent Name MHEvent -> MH ()
reactionEmojiListMouseHandler tId (MouseDown (ClickableReactionEmojiListWindowEntry val) _ _ _) =
listWindowActivate tId (csTeam(tId).tsReactionEmojiListWindow) val
reactionEmojiListMouseHandler _ _ =
return ()