matterhorn-50200.16.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.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 :: TeamId -> Mode -> BrickEvent Name MHEvent -> MH ()
mouseHandlerByMode tId mode =
case mode of
ChannelSelect -> channelSelectMouseHandler tId
EditNotifyPrefs -> handleEditNotifyPrefsEvent tId
ReactionEmojiListOverlay -> reactionEmojiListMouseHandler tId
UrlSelect -> urlListMouseHandler
_ -> 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
case n of
ClickableChannelListEntry channelId -> do
whenMode tId Main $ do
resetReturnChannel tId
setFocus tId channelId
setMode tId Main
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
ClickableURLInMessage _ _ t ->
void $ openLinkTarget t
ClickableURL _ _ t ->
void $ openLinkTarget t
ClickableUsernameInMessage _ _ username ->
changeChannelByName tId $ addUserSigil username
ClickableUsername _ _ username ->
changeChannelByName tId $ addUserSigil username
ClickableAttachment fId ->
void $ openLinkTarget $ LinkFileId fId
ClickableReactionInMessage pId t uIds ->
void $ toggleReaction pId t uIds
ClickableReaction pId t uIds ->
void $ toggleReaction pId t uIds
ClickableChannelListGroupHeading label ->
toggleChannelListGroupVisibility label
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 ()
urlListMouseHandler :: BrickEvent Name MHEvent -> MH ()
urlListMouseHandler (MouseDown (ClickableURLListEntry _ t) _ _ _) =
void $ openLinkTarget t
urlListMouseHandler _ =
return ()
channelSelectMouseHandler :: TeamId -> BrickEvent Name MHEvent -> MH ()
channelSelectMouseHandler tId (MouseDown (ChannelSelectEntry match) _ _ _) = do
setMode tId Main
setFocus tId $ channelListEntryChannelId $ matchEntry match
channelSelectMouseHandler _ _ =
return ()
reactionEmojiListMouseHandler :: TeamId -> BrickEvent Name MHEvent -> MH ()
reactionEmojiListMouseHandler tId (MouseDown (ReactionEmojiListOverlayEntry val) _ _ _) =
listOverlayActivate tId (csTeam(tId).tsReactionEmojiListOverlay) val
reactionEmojiListMouseHandler _ _ =
return ()