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 )

-- | The template for "View Message" windows triggered by message
-- selection mode.
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"

-- When we show the tabs, we need to reset the viewport scroll position
-- for viewports in that tab. This is because an older View Message
-- window used the same handle for the viewport and we don't want that
-- old state affecting this window. This also means that switching tabs
-- in an existing window resets this state, too.
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)
       ]