module Matterhorn.Windows.ViewMessage
( viewMessageWindowTemplate
, viewMessageKeybindings
, viewMessageKeyHandlers
, viewMessageReactionsKeybindings
, viewMessageReactionsKeyHandlers
)
where
import Prelude ()
import Matterhorn.Prelude
import Brick
import Brick.Keybindings
import Brick.Widgets.Border
import qualified Data.Set as S
import qualified Data.Map as M
import qualified Data.Text as T
import qualified Data.Foldable as F
import qualified Graphics.Vty as Vty
import Lens.Micro.Platform ( to )
import Network.Mattermost.Types ( TeamId, Post (postId) )
import Matterhorn.Constants
import Matterhorn.Themes
import Matterhorn.Types
import Matterhorn.Types.RichText ( Inline(EUser) )
import Matterhorn.Draw.RichText
import Matterhorn.Draw.Messages ( renderMessage, MessageData(..), printableNameForUserRef )
viewMessageWindowTemplate :: TeamId -> TabbedWindowTemplate ChatState MH Name ViewMessageWindowTab
viewMessageWindowTemplate :: TeamId
-> TabbedWindowTemplate ChatState MH Name ViewMessageWindowTab
viewMessageWindowTemplate TeamId
tId =
TabbedWindowTemplate { twtEntries :: [TabbedWindowEntry ChatState MH Name ViewMessageWindowTab]
twtEntries = [ TeamId -> TabbedWindowEntry ChatState MH Name ViewMessageWindowTab
messageEntry TeamId
tId
, TeamId -> TabbedWindowEntry ChatState MH Name ViewMessageWindowTab
reactionsEntry TeamId
tId
]
, twtTitle :: ViewMessageWindowTab -> Widget Name
twtTitle = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt Text
"View Message"
}
messageEntry :: TeamId -> TabbedWindowEntry ChatState MH Name ViewMessageWindowTab
messageEntry :: TeamId -> TabbedWindowEntry ChatState MH Name ViewMessageWindowTab
messageEntry TeamId
tId =
TabbedWindowEntry { tweValue :: ViewMessageWindowTab
tweValue = ViewMessageWindowTab
VMTabMessage
, tweRender :: ViewMessageWindowTab -> ChatState -> Widget Name
tweRender = TeamId -> ViewMessageWindowTab -> ChatState -> Widget Name
renderTab TeamId
tId
, tweHandleEvent :: ViewMessageWindowTab -> Event -> MH ()
tweHandleEvent = TeamId -> ViewMessageWindowTab -> Event -> MH ()
handleEvent TeamId
tId
, tweTitle :: ViewMessageWindowTab -> Bool -> Text
tweTitle = ViewMessageWindowTab -> Bool -> Text
tabTitle
, tweShowHandler :: ViewMessageWindowTab -> MH ()
tweShowHandler = TeamId -> ViewMessageWindowTab -> MH ()
onShow TeamId
tId
}
reactionsEntry :: TeamId -> TabbedWindowEntry ChatState MH Name ViewMessageWindowTab
reactionsEntry :: TeamId -> TabbedWindowEntry ChatState MH Name ViewMessageWindowTab
reactionsEntry TeamId
tId =
TabbedWindowEntry { tweValue :: ViewMessageWindowTab
tweValue = ViewMessageWindowTab
VMTabReactions
, tweRender :: ViewMessageWindowTab -> ChatState -> Widget Name
tweRender = TeamId -> ViewMessageWindowTab -> ChatState -> Widget Name
renderTab TeamId
tId
, tweHandleEvent :: ViewMessageWindowTab -> Event -> MH ()
tweHandleEvent = TeamId -> ViewMessageWindowTab -> Event -> MH ()
handleEvent TeamId
tId
, tweTitle :: ViewMessageWindowTab -> Bool -> Text
tweTitle = ViewMessageWindowTab -> Bool -> Text
tabTitle
, tweShowHandler :: ViewMessageWindowTab -> MH ()
tweShowHandler = TeamId -> ViewMessageWindowTab -> MH ()
onShow TeamId
tId
}
tabTitle :: ViewMessageWindowTab -> Bool -> T.Text
tabTitle :: ViewMessageWindowTab -> Bool -> Text
tabTitle ViewMessageWindowTab
VMTabMessage Bool
_ = Text
"Message"
tabTitle ViewMessageWindowTab
VMTabReactions Bool
_ = Text
"Reactions"
onShow :: TeamId -> ViewMessageWindowTab -> MH ()
onShow :: TeamId -> ViewMessageWindowTab -> MH ()
onShow TeamId
tId ViewMessageWindowTab
VMTabMessage = Name -> MH ()
resetVp forall a b. (a -> b) -> a -> b
$ TeamId -> Name
ViewMessageArea TeamId
tId
onShow TeamId
tId ViewMessageWindowTab
VMTabReactions = Name -> MH ()
resetVp forall a b. (a -> b) -> a -> b
$ TeamId -> Name
ViewMessageArea TeamId
tId
resetVp :: Name -> MH ()
resetVp :: Name -> MH ()
resetVp Name
n = do
let vs :: ViewportScroll Name
vs = forall n. n -> ViewportScroll n
viewportScroll Name
n
forall a. EventM Name ChatState a -> MH a
mh forall a b. (a -> b) -> a -> b
$ do
forall n. ViewportScroll n -> forall s. EventM n s ()
vScrollToBeginning ViewportScroll Name
vs
forall n. ViewportScroll n -> forall s. EventM n s ()
hScrollToBeginning ViewportScroll Name
vs
renderTab :: TeamId -> ViewMessageWindowTab -> ChatState -> Widget Name
renderTab :: TeamId -> ViewMessageWindowTab -> ChatState -> Widget Name
renderTab TeamId
tId ViewMessageWindowTab
tab ChatState
cs =
let mLatestMessage :: Maybe Message
mLatestMessage = case ChatState
csforall s a. s -> Getting a s a -> a
^.TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens'
TeamState
(Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab))
tsViewedMessage of
Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)
Nothing -> forall a. HasCallStack => [Char] -> a
error [Char]
"BUG: no message to show, please report!"
Just (Message
m, TabbedWindow ChatState MH Name ViewMessageWindowTab
_) -> ChatState -> TeamId -> Message -> Maybe Message
getLatestMessage ChatState
cs TeamId
tId Message
m
in case Maybe Message
mLatestMessage of
Maybe Message
Nothing -> forall n. Widget n
emptyWidget
Just Message
latestMessage ->
case ViewMessageWindowTab
tab of
ViewMessageWindowTab
VMTabMessage -> ChatState -> TeamId -> Message -> Widget Name
viewMessageBox ChatState
cs TeamId
tId Message
latestMessage
ViewMessageWindowTab
VMTabReactions -> ChatState -> TeamId -> Message -> Widget Name
reactionsText ChatState
cs TeamId
tId Message
latestMessage
getLatestMessage :: ChatState -> TeamId -> Message -> Maybe Message
getLatestMessage :: ChatState -> TeamId -> Message -> Maybe Message
getLatestMessage ChatState
cs TeamId
tId Message
m =
case Message
mforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe MessageId)
mMessageId of
Maybe MessageId
Nothing -> forall a. a -> Maybe a
Just Message
m
Just MessageId
mId -> do
ChannelId
cId <- ChatState
csforall s a. s -> Getting a s a -> a
^.TeamId -> SimpleGetter ChatState (Maybe ChannelId)
csCurrentChannelId(TeamId
tId)
ClientChannel
chan <- ChatState
csforall s a. s -> Getting (First a) s a -> Maybe a
^?ChannelId -> Traversal' ChatState ClientChannel
csChannel(ChannelId
cId)
MessageId -> Messages -> Maybe Message
findMessage MessageId
mId forall a b. (a -> b) -> a -> b
$ ClientChannel
chanforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel (MessageInterface Name ())
ccMessageInterfaceforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) Messages
miMessages
handleEvent :: TeamId -> ViewMessageWindowTab -> Vty.Event -> MH ()
handleEvent :: TeamId -> ViewMessageWindowTab -> Event -> MH ()
handleEvent TeamId
tId ViewMessageWindowTab
VMTabMessage =
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH)
-> Event -> MH Bool
mhHandleKeyboardEvent (TeamId -> KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH
viewMessageKeybindings TeamId
tId)
handleEvent TeamId
tId ViewMessageWindowTab
VMTabReactions =
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH)
-> Event -> MH Bool
mhHandleKeyboardEvent (TeamId -> KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH
viewMessageReactionsKeybindings TeamId
tId)
reactionsText :: ChatState -> TeamId -> Message -> Widget Name
reactionsText :: ChatState -> TeamId -> Message -> Widget Name
reactionsText ChatState
st TeamId
tId Message
m = forall n.
(Ord n, Show n) =>
n -> ViewportType -> Widget n -> Widget n
viewport Name
vpName ViewportType
Vertical Widget Name
body
where
vpName :: Name
vpName = TeamId -> Name
ViewMessageReactionsArea TeamId
tId
body :: Widget Name
body = case forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Text, Set UserId)]
reacList of
Bool
True -> forall n. Text -> Widget n
txt Text
"This message has no reactions."
Bool
False -> forall n. [Widget n] -> Widget n
vBox forall a b. (a -> b) -> a -> b
$ (Text, Set UserId) -> Widget Name
mkEntry forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Set UserId)]
reacList
reacList :: [(Text, Set UserId)]
reacList = forall k a. Map k a -> [(k, a)]
M.toList (Message
mforall s a. s -> Getting a s a -> a
^.Lens' Message (Map Text (Set UserId))
mReactions)
mkEntry :: (Text, Set UserId) -> Widget Name
mkEntry (Text
reactionName, Set UserId
userIdSet) =
let count :: Widget n
count = forall n. [Char] -> Widget n
str forall a b. (a -> b) -> a -> b
$ [Char]
"(" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show (forall a. Set a -> Int
S.size Set UserId
userIdSet) forall a. Semigroup a => a -> a -> a
<> [Char]
")"
name :: Widget n
name = forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
emojiAttr forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt forall a b. (a -> b) -> a -> b
$ Text
":" forall a. Semigroup a => a -> a -> a
<> Text
reactionName forall a. Semigroup a => a -> a -> a
<> Text
":"
clickableName :: Widget Name
clickableName = Widget Name -> Text -> Set UserId -> Widget Name
makeClickableName forall n. Widget n
name Text
reactionName Set UserId
userIdSet
usernameList :: Widget Name
usernameList = forall {t :: * -> *}. Foldable t => t UserId -> Widget Name
usernameText Set UserId
userIdSet
in (Widget Name
clickableName forall n. Widget n -> Widget n -> Widget n
<+> (forall n. Padding -> Widget n -> Widget n
padLeft (Int -> Padding
Pad Int
1) forall n. Widget n
count)) forall n. Widget n -> Widget n -> Widget n
<=>
(forall n. Padding -> Widget n -> Widget n
padLeft (Int -> Padding
Pad Int
2) Widget Name
usernameList)
hs :: HighlightSet
hs = ChatState -> TeamId -> HighlightSet
getHighlightSet ChatState
st TeamId
tId
clickableUsernames :: Int -> Inline -> Maybe Name
clickableUsernames Int
i (EUser Text
un) =
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Maybe MessageId -> Name -> Int -> Text -> Name
ClickableUsername forall a. Maybe a
Nothing Name
vpName Int
i Text
un
clickableUsernames Int
_ Inline
_ =
forall a. Maybe a
Nothing
usernameText :: t UserId -> Widget Name
usernameText t UserId
uids =
forall a.
SemEq a =>
Maybe TeamBaseURL
-> Text
-> HighlightSet
-> Maybe (Int -> Inline -> Maybe a)
-> Text
-> Widget a
renderText' forall a. Maybe a
Nothing (ChatState -> Text
myUsername ChatState
st) HighlightSet
hs (forall a. a -> Maybe a
Just Int -> Inline -> Maybe Name
clickableUsernames) forall a b. (a -> b) -> a -> b
$
Text -> [Text] -> Text
T.intercalate Text
", " forall a b. (a -> b) -> a -> b
$
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
addUserSigil forall a b. (a -> b) -> a -> b
$
forall a. [Maybe a] -> [a]
catMaybes (UserId -> Maybe Text
lookupUsername forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList t UserId
uids)
lookupUsername :: UserId -> Maybe Text
lookupUsername UserId
uid = UserId -> ChatState -> Maybe Text
usernameForUserId UserId
uid ChatState
st
makeName :: Text -> Set UserId -> Maybe Name
makeName Text
e Set UserId
us = do
PostId
pid <- Post -> PostId
postId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message
mforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe Post)
mOriginalPost
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ PostId -> Name -> Text -> Set UserId -> Name
ClickableReaction PostId
pid Name
vpName Text
e Set UserId
us
makeClickableName :: Widget Name -> Text -> Set UserId -> Widget Name
makeClickableName Widget Name
w Text
e Set UserId
us =
case Text -> Set UserId -> Maybe Name
makeName Text
e Set UserId
us of
Just Name
n -> forall n. Ord n => n -> Widget n -> Widget n
clickable Name
n Widget Name
w
Maybe Name
Nothing -> Widget Name
w
viewMessageBox :: ChatState -> TeamId -> Message -> Widget Name
viewMessageBox :: ChatState -> TeamId -> Message -> Widget Name
viewMessageBox ChatState
st TeamId
tId Message
msg =
let maybeWarn :: Widget n -> Widget n
maybeWarn = if Bool -> Bool
not (Message
msgforall s a. s -> Getting a s a -> a
^.Lens' Message Bool
mDeleted) then forall a. a -> a
id else forall {n}. Widget n -> Widget n
warn
warn :: Widget n -> Widget n
warn Widget n
w = forall n. [Widget n] -> Widget n
vBox [Widget n
w, forall n. Widget n
hBorder, forall n. Widget n
deleteWarning]
deleteWarning :: Widget n
deleteWarning = forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
errorMessageAttr forall a b. (a -> b) -> a -> b
$
forall n. Text -> Widget n
txtWrap forall a b. (a -> b) -> a -> b
$ Text
"Alert: this message has been deleted and " forall a. Semigroup a => a -> a -> a
<>
Text
"will no longer be accessible once this window " forall a. Semigroup a => a -> a -> a
<>
Text
"is closed."
mkBody :: Int -> Widget Name
mkBody Int
vpWidth =
let hs :: HighlightSet
hs = ChatState -> TeamId -> HighlightSet
getHighlightSet ChatState
st TeamId
tId
parent :: Maybe Message
parent = case Message
msgforall s a. s -> Getting a s a -> a
^.Lens' Message ReplyState
mInReplyToMsg of
ReplyState
NotAReply -> forall a. Maybe a
Nothing
InReplyTo PostId
pId -> ChatState -> PostId -> Maybe Message
getMessageForPostId ChatState
st PostId
pId
md :: MessageData
md = MessageData { mdEditThreshold :: Maybe ServerTime
mdEditThreshold = forall a. Maybe a
Nothing
, mdShowOlderEdits :: Bool
mdShowOlderEdits = Bool
False
, mdMessage :: Message
mdMessage = Message
msg
, mdUserName :: Maybe Text
mdUserName = Message
msgforall s a. s -> Getting a s a -> a
^.Lens' Message UserRef
mUserforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to (ChatState -> UserRef -> Maybe Text
printableNameForUserRef ChatState
st)
, mdParentMessage :: Maybe Message
mdParentMessage = Maybe Message
parent
, mdParentUserName :: Maybe Text
mdParentUserName = Maybe Message
parent forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall s a. s -> Getting a s a -> a
^.Lens' Message UserRef
mUserforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to (ChatState -> UserRef -> Maybe Text
printableNameForUserRef ChatState
st))
, mdRenderReplyParent :: Bool
mdRenderReplyParent = Bool
True
, mdHighlightSet :: HighlightSet
mdHighlightSet = HighlightSet
hs
, mdIndentBlocks :: Bool
mdIndentBlocks = Bool
True
, mdThreadState :: ThreadState
mdThreadState = ThreadState
NoThread
, mdShowReactions :: Bool
mdShowReactions = Bool
False
, mdMessageWidthLimit :: Maybe Int
mdMessageWidthLimit = forall a. a -> Maybe a
Just Int
vpWidth
, mdMyUsername :: Text
mdMyUsername = ChatState -> Text
myUsername ChatState
st
, mdMyUserId :: UserId
mdMyUserId = ChatState -> UserId
myUserId ChatState
st
, mdWrapNonhighlightedCodeBlocks :: Bool
mdWrapNonhighlightedCodeBlocks = Bool
False
, mdTruncateVerbatimBlocks :: Maybe Int
mdTruncateVerbatimBlocks = forall a. Maybe a
Nothing
, mdClickableNameTag :: Name
mdClickableNameTag = TeamId -> Name
ViewMessageArea TeamId
tId
, mdRenderReplyIndent :: Bool
mdRenderReplyIndent = Bool
False
}
in MessageData -> Widget Name
renderMessage MessageData
md
in forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Greedy Size
Greedy forall a b. (a -> b) -> a -> b
$ do
Context Name
ctx <- forall n. RenderM n (Context n)
getContext
forall n. Widget n -> RenderM n (Result n)
render forall a b. (a -> b) -> a -> b
$ forall {n}. Widget n -> Widget n
maybeWarn forall a b. (a -> b) -> a -> b
$ forall n.
(Ord n, Show n) =>
n -> ViewportType -> Widget n -> Widget n
viewport (TeamId -> Name
ViewMessageArea TeamId
tId) ViewportType
Both forall a b. (a -> b) -> a -> b
$ Int -> Widget Name
mkBody (Context Name
ctxforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Context n) Int
availWidthL)
viewMessageKeybindings :: TeamId -> KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH
viewMessageKeybindings :: TeamId -> KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH
viewMessageKeybindings TeamId
tId KeyConfig KeyEvent
kc = forall k (m :: * -> *).
Ord k =>
KeyConfig k -> [KeyEventHandler k m] -> KeyDispatcher k m
unsafeKeyDispatcher KeyConfig KeyEvent
kc (TeamId -> [MHKeyEventHandler]
viewMessageKeyHandlers TeamId
tId)
viewMessageKeyHandlers :: TeamId -> [MHKeyEventHandler]
viewMessageKeyHandlers :: TeamId -> [MHKeyEventHandler]
viewMessageKeyHandlers TeamId
tId =
let vs :: TeamId -> ViewportScroll Name
vs = forall n. n -> ViewportScroll n
viewportScroll forall b c a. (b -> c) -> (a -> b) -> a -> c
. TeamId -> Name
ViewMessageArea
in [ forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
PageUpEvent Text
"Page up" forall a b. (a -> b) -> a -> b
$ do
forall a. EventM Name ChatState a -> MH a
mh forall a b. (a -> b) -> a -> b
$ forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy (TeamId -> ViewportScroll Name
vs TeamId
tId) (-Int
1 forall a. Num a => a -> a -> a
* Int
pageAmount)
, forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
PageDownEvent Text
"Page down" forall a b. (a -> b) -> a -> b
$ do
forall a. EventM Name ChatState a -> MH a
mh forall a b. (a -> b) -> a -> b
$ forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy (TeamId -> ViewportScroll Name
vs TeamId
tId) Int
pageAmount
, forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
PageLeftEvent Text
"Page left" forall a b. (a -> b) -> a -> b
$ do
forall a. EventM Name ChatState a -> MH a
mh forall a b. (a -> b) -> a -> b
$ forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
hScrollBy (TeamId -> ViewportScroll Name
vs TeamId
tId) (-Int
2 forall a. Num a => a -> a -> a
* Int
pageAmount)
, forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
PageRightEvent Text
"Page right" forall a b. (a -> b) -> a -> b
$ do
forall a. EventM Name ChatState a -> MH a
mh forall a b. (a -> b) -> a -> b
$ forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
hScrollBy (TeamId -> ViewportScroll Name
vs TeamId
tId) (Int
2 forall a. Num a => a -> a -> a
* Int
pageAmount)
, forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
ScrollUpEvent Text
"Scroll up" forall a b. (a -> b) -> a -> b
$ do
forall a. EventM Name ChatState a -> MH a
mh forall a b. (a -> b) -> a -> b
$ forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy (TeamId -> ViewportScroll Name
vs TeamId
tId) (-Int
1)
, forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
ScrollDownEvent Text
"Scroll down" forall a b. (a -> b) -> a -> b
$ do
forall a. EventM Name ChatState a -> MH a
mh forall a b. (a -> b) -> a -> b
$ forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy (TeamId -> ViewportScroll Name
vs TeamId
tId) Int
1
, forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
ScrollLeftEvent Text
"Scroll left" forall a b. (a -> b) -> a -> b
$ do
forall a. EventM Name ChatState a -> MH a
mh forall a b. (a -> b) -> a -> b
$ forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
hScrollBy (TeamId -> ViewportScroll Name
vs TeamId
tId) (-Int
1)
, forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
ScrollRightEvent Text
"Scroll right" forall a b. (a -> b) -> a -> b
$ do
forall a. EventM Name ChatState a -> MH a
mh forall a b. (a -> b) -> a -> b
$ forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
hScrollBy (TeamId -> ViewportScroll Name
vs TeamId
tId) Int
1
, forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
ScrollBottomEvent Text
"Scroll to the end of the message" forall a b. (a -> b) -> a -> b
$ do
forall a. EventM Name ChatState a -> MH a
mh forall a b. (a -> b) -> a -> b
$ forall n. ViewportScroll n -> forall s. EventM n s ()
vScrollToEnd (TeamId -> ViewportScroll Name
vs TeamId
tId)
, forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
ScrollTopEvent Text
"Scroll to the beginning of the message" forall a b. (a -> b) -> a -> b
$ do
forall a. EventM Name ChatState a -> MH a
mh forall a b. (a -> b) -> a -> b
$ forall n. ViewportScroll n -> forall s. EventM n s ()
vScrollToBeginning (TeamId -> ViewportScroll Name
vs TeamId
tId)
]
viewMessageReactionsKeybindings :: TeamId -> KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH
viewMessageReactionsKeybindings :: TeamId -> KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH
viewMessageReactionsKeybindings TeamId
tId KeyConfig KeyEvent
kc = forall k (m :: * -> *).
Ord k =>
KeyConfig k -> [KeyEventHandler k m] -> KeyDispatcher k m
unsafeKeyDispatcher KeyConfig KeyEvent
kc (TeamId -> [MHKeyEventHandler]
viewMessageReactionsKeyHandlers TeamId
tId)
viewMessageReactionsKeyHandlers :: TeamId -> [MHKeyEventHandler]
viewMessageReactionsKeyHandlers :: TeamId -> [MHKeyEventHandler]
viewMessageReactionsKeyHandlers TeamId
tId =
let vs :: TeamId -> ViewportScroll Name
vs = forall n. n -> ViewportScroll n
viewportScroll forall b c a. (b -> c) -> (a -> b) -> a -> c
. TeamId -> Name
ViewMessageReactionsArea
in [ forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
PageUpEvent Text
"Page up" forall a b. (a -> b) -> a -> b
$ do
forall a. EventM Name ChatState a -> MH a
mh forall a b. (a -> b) -> a -> b
$ forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy (TeamId -> ViewportScroll Name
vs TeamId
tId) (-Int
1 forall a. Num a => a -> a -> a
* Int
pageAmount)
, forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
PageDownEvent Text
"Page down" forall a b. (a -> b) -> a -> b
$ do
forall a. EventM Name ChatState a -> MH a
mh forall a b. (a -> b) -> a -> b
$ forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy (TeamId -> ViewportScroll Name
vs TeamId
tId) Int
pageAmount
, forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
ScrollUpEvent Text
"Scroll up" forall a b. (a -> b) -> a -> b
$ do
forall a. EventM Name ChatState a -> MH a
mh forall a b. (a -> b) -> a -> b
$ forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy (TeamId -> ViewportScroll Name
vs TeamId
tId) (-Int
1)
, forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
ScrollDownEvent Text
"Scroll down" forall a b. (a -> b) -> a -> b
$ do
forall a. EventM Name ChatState a -> MH a
mh forall a b. (a -> b) -> a -> b
$ forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy (TeamId -> ViewportScroll Name
vs TeamId
tId) Int
1
, forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
ScrollBottomEvent Text
"Scroll to the end of the reactions list" forall a b. (a -> b) -> a -> b
$ do
forall a. EventM Name ChatState a -> MH a
mh forall a b. (a -> b) -> a -> b
$ forall n. ViewportScroll n -> forall s. EventM n s ()
vScrollToEnd (TeamId -> ViewportScroll Name
vs TeamId
tId)
, forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
ScrollTopEvent Text
"Scroll to the beginning of the reactions list" forall a b. (a -> b) -> a -> b
$ do
forall a. EventM Name ChatState a -> MH a
mh forall a b. (a -> b) -> a -> b
$ forall n. ViewportScroll n -> forall s. EventM n s ()
vScrollToBeginning (TeamId -> ViewportScroll Name
vs TeamId
tId)
]