module Matterhorn.Windows.ViewMessage
  ( viewMessageWindowTemplate
  , viewMessageKeybindings
  , viewMessageKeyHandlers
  , viewMessageReactionsKeybindings
  , viewMessageReactionsKeyHandlers
  )
where

import           Prelude ()
import           Matterhorn.Prelude

import           Brick
import           Brick.Widgets.Border

import qualified Data.Set as S
import qualified Data.Map as M
import           Data.Maybe ( fromJust )
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 )

import           Matterhorn.Constants
import           Matterhorn.Events.Keybindings
import           Matterhorn.Themes
import           Matterhorn.Types
import           Matterhorn.Draw.RichText
import           Matterhorn.Draw.Messages ( renderMessage, MessageData(..), nameForUserRef )

-- | The template for "View Message" windows triggered by message
-- selection mode.
viewMessageWindowTemplate :: TeamId -> TabbedWindowTemplate ViewMessageWindowTab
viewMessageWindowTemplate :: TeamId -> TabbedWindowTemplate ViewMessageWindowTab
viewMessageWindowTemplate TeamId
tId =
    TabbedWindowTemplate :: forall a.
[TabbedWindowEntry a]
-> (a -> Widget Name) -> TabbedWindowTemplate a
TabbedWindowTemplate { twtEntries :: [TabbedWindowEntry ViewMessageWindowTab]
twtEntries = [ TeamId -> TabbedWindowEntry ViewMessageWindowTab
messageEntry TeamId
tId
                                        , TeamId -> TabbedWindowEntry ViewMessageWindowTab
reactionsEntry TeamId
tId
                                        ]
                         , twtTitle :: ViewMessageWindowTab -> Widget Name
twtTitle = Widget Name -> ViewMessageWindowTab -> Widget Name
forall a b. a -> b -> a
const (Widget Name -> ViewMessageWindowTab -> Widget Name)
-> Widget Name -> ViewMessageWindowTab -> Widget Name
forall a b. (a -> b) -> a -> b
$ Text -> Widget Name
forall n. Text -> Widget n
txt Text
"View Message"
                         }

messageEntry :: TeamId -> TabbedWindowEntry ViewMessageWindowTab
messageEntry :: TeamId -> TabbedWindowEntry ViewMessageWindowTab
messageEntry TeamId
tId =
    TabbedWindowEntry :: forall a.
a
-> (a -> ChatState -> Widget Name)
-> (a -> Event -> MH ())
-> (a -> Bool -> Text)
-> (a -> MH ())
-> TabbedWindowEntry a
TabbedWindowEntry { tweValue :: ViewMessageWindowTab
tweValue = ViewMessageWindowTab
VMTabMessage
                      , tweRender :: ViewMessageWindowTab -> ChatState -> Widget Name
tweRender = ViewMessageWindowTab -> ChatState -> Widget Name
renderTab
                      , tweHandleEvent :: ViewMessageWindowTab -> Event -> MH ()
tweHandleEvent = ViewMessageWindowTab -> Event -> MH ()
handleEvent
                      , tweTitle :: ViewMessageWindowTab -> Bool -> Text
tweTitle = ViewMessageWindowTab -> Bool -> Text
tabTitle
                      , tweShowHandler :: ViewMessageWindowTab -> MH ()
tweShowHandler = TeamId -> ViewMessageWindowTab -> MH ()
onShow TeamId
tId
                      }

reactionsEntry :: TeamId -> TabbedWindowEntry ViewMessageWindowTab
reactionsEntry :: TeamId -> TabbedWindowEntry ViewMessageWindowTab
reactionsEntry TeamId
tId =
    TabbedWindowEntry :: forall a.
a
-> (a -> ChatState -> Widget Name)
-> (a -> Event -> MH ())
-> (a -> Bool -> Text)
-> (a -> MH ())
-> TabbedWindowEntry a
TabbedWindowEntry { tweValue :: ViewMessageWindowTab
tweValue = ViewMessageWindowTab
VMTabReactions
                      , tweRender :: ViewMessageWindowTab -> ChatState -> Widget Name
tweRender = ViewMessageWindowTab -> ChatState -> Widget Name
renderTab
                      , tweHandleEvent :: ViewMessageWindowTab -> Event -> MH ()
tweHandleEvent = ViewMessageWindowTab -> Event -> MH ()
handleEvent
                      , 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 (Name -> MH ()) -> Name -> MH ()
forall a b. (a -> b) -> a -> b
$ TeamId -> Name
ViewMessageArea TeamId
tId
onShow TeamId
tId ViewMessageWindowTab
VMTabReactions = Name -> MH ()
resetVp (Name -> MH ()) -> Name -> MH ()
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 = Name -> ViewportScroll Name
forall n. n -> ViewportScroll n
viewportScroll Name
n
    EventM Name () -> MH ()
forall a. EventM Name a -> MH a
mh (EventM Name () -> MH ()) -> EventM Name () -> MH ()
forall a b. (a -> b) -> a -> b
$ do
        ViewportScroll Name -> EventM Name ()
forall n. ViewportScroll n -> EventM n ()
vScrollToBeginning ViewportScroll Name
vs
        ViewportScroll Name -> EventM Name ()
forall n. ViewportScroll n -> EventM n ()
hScrollToBeginning ViewportScroll Name
vs

renderTab :: ViewMessageWindowTab -> ChatState -> Widget Name
renderTab :: ViewMessageWindowTab -> ChatState -> Widget Name
renderTab ViewMessageWindowTab
tab ChatState
cs =
    let latestMessage :: Message
latestMessage = case ChatState
csChatState
-> Getting
     (Maybe (Message, TabbedWindow ViewMessageWindowTab))
     ChatState
     (Maybe (Message, TabbedWindow ViewMessageWindowTab))
-> Maybe (Message, TabbedWindow ViewMessageWindowTab)
forall s a. s -> Getting a s a -> a
^.(TeamState
 -> Const
      (Maybe (Message, TabbedWindow ViewMessageWindowTab)) TeamState)
-> ChatState
-> Const
     (Maybe (Message, TabbedWindow ViewMessageWindowTab)) ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState
  -> Const
       (Maybe (Message, TabbedWindow ViewMessageWindowTab)) TeamState)
 -> ChatState
 -> Const
      (Maybe (Message, TabbedWindow ViewMessageWindowTab)) ChatState)
-> ((Maybe (Message, TabbedWindow ViewMessageWindowTab)
     -> Const
          (Maybe (Message, TabbedWindow ViewMessageWindowTab))
          (Maybe (Message, TabbedWindow ViewMessageWindowTab)))
    -> TeamState
    -> Const
         (Maybe (Message, TabbedWindow ViewMessageWindowTab)) TeamState)
-> Getting
     (Maybe (Message, TabbedWindow ViewMessageWindowTab))
     ChatState
     (Maybe (Message, TabbedWindow ViewMessageWindowTab))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe (Message, TabbedWindow ViewMessageWindowTab)
 -> Const
      (Maybe (Message, TabbedWindow ViewMessageWindowTab))
      (Maybe (Message, TabbedWindow ViewMessageWindowTab)))
-> TeamState
-> Const
     (Maybe (Message, TabbedWindow ViewMessageWindowTab)) TeamState
Lens'
  TeamState (Maybe (Message, TabbedWindow ViewMessageWindowTab))
tsViewedMessage of
          Maybe (Message, TabbedWindow ViewMessageWindowTab)
Nothing -> [Char] -> Message
forall a. HasCallStack => [Char] -> a
error [Char]
"BUG: no message to show, please report!"
          Just (Message
m, TabbedWindow ViewMessageWindowTab
_) -> ChatState -> Message -> Message
getLatestMessage ChatState
cs Message
m
    in case ViewMessageWindowTab
tab of
        ViewMessageWindowTab
VMTabMessage -> ChatState -> Message -> Widget Name
viewMessageBox ChatState
cs Message
latestMessage
        ViewMessageWindowTab
VMTabReactions -> ChatState -> Message -> Widget Name
reactionsText ChatState
cs Message
latestMessage

getLatestMessage :: ChatState -> Message -> Message
getLatestMessage :: ChatState -> Message -> Message
getLatestMessage ChatState
cs Message
m =
    case Message
mMessage
-> Getting (Maybe MessageId) Message (Maybe MessageId)
-> Maybe MessageId
forall s a. s -> Getting a s a -> a
^.Getting (Maybe MessageId) Message (Maybe MessageId)
Lens' Message (Maybe MessageId)
mMessageId of
        Maybe MessageId
Nothing -> Message
m
        Just MessageId
mId -> Maybe Message -> Message
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Message -> Message) -> Maybe Message -> Message
forall a b. (a -> b) -> a -> b
$ MessageId -> Messages -> Maybe Message
findMessage MessageId
mId (Messages -> Maybe Message) -> Messages -> Maybe Message
forall a b. (a -> b) -> a -> b
$ ChatState
csChatState -> Getting Messages ChatState Messages -> Messages
forall s a. s -> Getting a s a -> a
^.(ClientChannel -> Const Messages ClientChannel)
-> ChatState -> Const Messages ChatState
Lens' ChatState ClientChannel
csCurrentChannel((ClientChannel -> Const Messages ClientChannel)
 -> ChatState -> Const Messages ChatState)
-> ((Messages -> Const Messages Messages)
    -> ClientChannel -> Const Messages ClientChannel)
-> Getting Messages ChatState Messages
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChannelContents -> Const Messages ChannelContents)
-> ClientChannel -> Const Messages ClientChannel
Lens' ClientChannel ChannelContents
ccContents((ChannelContents -> Const Messages ChannelContents)
 -> ClientChannel -> Const Messages ClientChannel)
-> ((Messages -> Const Messages Messages)
    -> ChannelContents -> Const Messages ChannelContents)
-> (Messages -> Const Messages Messages)
-> ClientChannel
-> Const Messages ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Const Messages Messages)
-> ChannelContents -> Const Messages ChannelContents
Lens' ChannelContents Messages
cdMessages

handleEvent :: ViewMessageWindowTab -> Vty.Event -> MH ()
handleEvent :: ViewMessageWindowTab -> Event -> MH ()
handleEvent ViewMessageWindowTab
VMTabMessage =
    MH Bool -> MH ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (MH Bool -> MH ()) -> (Event -> MH Bool) -> Event -> MH ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KeyConfig -> KeyHandlerMap)
-> (Event -> MH ()) -> Event -> MH Bool
handleKeyboardEvent KeyConfig -> KeyHandlerMap
viewMessageKeybindings (MH () -> Event -> MH ()
forall a b. a -> b -> a
const (MH () -> Event -> MH ()) -> MH () -> Event -> MH ()
forall a b. (a -> b) -> a -> b
$ () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
handleEvent ViewMessageWindowTab
VMTabReactions =
    MH Bool -> MH ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (MH Bool -> MH ()) -> (Event -> MH Bool) -> Event -> MH ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KeyConfig -> KeyHandlerMap)
-> (Event -> MH ()) -> Event -> MH Bool
handleKeyboardEvent KeyConfig -> KeyHandlerMap
viewMessageReactionsKeybindings (MH () -> Event -> MH ()
forall a b. a -> b -> a
const (MH () -> Event -> MH ()) -> MH () -> Event -> MH ()
forall a b. (a -> b) -> a -> b
$ () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())

reactionsText :: ChatState -> Message -> Widget Name
reactionsText :: ChatState -> Message -> Widget Name
reactionsText ChatState
st Message
m = Name -> ViewportType -> Widget Name -> Widget Name
forall n.
(Ord n, Show n) =>
n -> ViewportType -> Widget n -> Widget n
viewport (TeamId -> Name
ViewMessageReactionsArea TeamId
tId) ViewportType
Vertical Widget Name
forall n. Widget n
body
    where
        tId :: TeamId
tId = ChatState
stChatState -> Getting TeamId ChatState TeamId -> TeamId
forall s a. s -> Getting a s a -> a
^.Getting TeamId ChatState TeamId
SimpleGetter ChatState TeamId
csCurrentTeamId
        body :: Widget n
body = case [(Text, Set UserId)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Text, Set UserId)]
reacList of
            Bool
True -> Text -> Widget n
forall n. Text -> Widget n
txt Text
"This message has no reactions."
            Bool
False -> [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
vBox ([Widget n] -> Widget n) -> [Widget n] -> Widget n
forall a b. (a -> b) -> a -> b
$ (Text, Set UserId) -> Widget n
forall n. (Text, Set UserId) -> Widget n
mkEntry ((Text, Set UserId) -> Widget n)
-> [(Text, Set UserId)] -> [Widget n]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Set UserId)]
reacList
        reacList :: [(Text, Set UserId)]
reacList = Map Text (Set UserId) -> [(Text, Set UserId)]
forall k a. Map k a -> [(k, a)]
M.toList (Message
mMessage
-> Getting (Map Text (Set UserId)) Message (Map Text (Set UserId))
-> Map Text (Set UserId)
forall s a. s -> Getting a s a -> a
^.Getting (Map Text (Set UserId)) Message (Map Text (Set UserId))
Lens' Message (Map Text (Set UserId))
mReactions)
        mkEntry :: (Text, Set UserId) -> Widget n
mkEntry (Text
reactionName, Set UserId
userIdSet) =
            let count :: Widget n
count = [Char] -> Widget n
forall n. [Char] -> Widget n
str ([Char] -> Widget n) -> [Char] -> Widget n
forall a b. (a -> b) -> a -> b
$ [Char]
"(" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. Show a => a -> [Char]
show (Set UserId -> Int
forall a. Set a -> Int
S.size Set UserId
userIdSet) [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
")"
                name :: Widget n
name = AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
emojiAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Text -> Widget n
forall n. Text -> Widget n
txt (Text -> Widget n) -> Text -> Widget n
forall a b. (a -> b) -> a -> b
$ Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
reactionName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":"
                usernameList :: Widget a
usernameList = Set UserId -> Widget a
forall (t :: * -> *) a. Foldable t => t UserId -> Widget a
usernameText Set UserId
userIdSet
            in (Widget n
forall n. Widget n
name Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> (Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padLeft (Int -> Padding
Pad Int
1) Widget n
forall n. Widget n
count)) Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<=>
               (Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padLeft (Int -> Padding
Pad Int
2) Widget n
forall n. Widget n
usernameList)

        hs :: HighlightSet
hs = ChatState -> HighlightSet
getHighlightSet ChatState
st

        usernameText :: t UserId -> Widget a
usernameText t UserId
uids =
            Maybe TeamBaseURL -> Text -> HighlightSet -> Text -> Widget a
forall a.
Maybe TeamBaseURL -> Text -> HighlightSet -> Text -> Widget a
renderText' Maybe TeamBaseURL
forall a. Maybe a
Nothing (ChatState -> Text
myUsername ChatState
st) HighlightSet
hs (Text -> Widget a) -> Text -> Widget a
forall a b. (a -> b) -> a -> b
$
            Text -> [Text] -> Text
T.intercalate Text
", " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
            (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text
userSigil Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$
            [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes (UserId -> Maybe Text
lookupUsername (UserId -> Maybe Text) -> [UserId] -> [Maybe Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t UserId -> [UserId]
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

viewMessageBox :: ChatState -> Message -> Widget Name
viewMessageBox :: ChatState -> Message -> Widget Name
viewMessageBox ChatState
st Message
msg =
    let maybeWarn :: Widget n -> Widget n
maybeWarn = if Bool -> Bool
not (Message
msgMessage -> Getting Bool Message Bool -> Bool
forall s a. s -> Getting a s a -> a
^.Getting Bool Message Bool
Lens' Message Bool
mDeleted) then Widget n -> Widget n
forall a. a -> a
id else Widget n -> Widget n
forall n. Widget n -> Widget n
warn
        warn :: Widget n -> Widget n
warn Widget n
w = [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
vBox [Widget n
w, Widget n
forall n. Widget n
hBorder, Widget n
forall n. Widget n
deleteWarning]
        tId :: TeamId
tId = ChatState
stChatState -> Getting TeamId ChatState TeamId -> TeamId
forall s a. s -> Getting a s a -> a
^.Getting TeamId ChatState TeamId
SimpleGetter ChatState TeamId
csCurrentTeamId
        deleteWarning :: Widget n
deleteWarning = AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
errorMessageAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
                        Text -> Widget n
forall n. Text -> Widget n
txtWrap (Text -> Widget n) -> Text -> Widget n
forall a b. (a -> b) -> a -> b
$ Text
"Alert: this message has been deleted and " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                                  Text
"will no longer be accessible once this window " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                                  Text
"is closed."
        mkBody :: Int -> Widget Name
mkBody Int
vpWidth =
            let hs :: HighlightSet
hs = ChatState -> HighlightSet
getHighlightSet ChatState
st
                parent :: Maybe Message
parent = case Message
msgMessage -> Getting ReplyState Message ReplyState -> ReplyState
forall s a. s -> Getting a s a -> a
^.Getting ReplyState Message ReplyState
Lens' Message ReplyState
mInReplyToMsg of
                     ReplyState
NotAReply -> Maybe Message
forall a. Maybe a
Nothing
                     InReplyTo PostId
pId -> ChatState -> PostId -> Maybe Message
getMessageForPostId ChatState
st PostId
pId
                md :: MessageData
md = MessageData :: Maybe ServerTime
-> Bool
-> Bool
-> Message
-> Maybe Text
-> Maybe Message
-> Maybe Text
-> ThreadState
-> Bool
-> HighlightSet
-> Bool
-> Maybe Int
-> Text
-> Bool
-> MessageData
MessageData { mdEditThreshold :: Maybe ServerTime
mdEditThreshold     = Maybe ServerTime
forall a. Maybe a
Nothing
                                 , mdShowOlderEdits :: Bool
mdShowOlderEdits    = Bool
False
                                 , mdMessage :: Message
mdMessage           = Message
msg
                                 , mdUserName :: Maybe Text
mdUserName          = Message
msgMessage -> Getting (Maybe Text) Message (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^.(UserRef -> Const (Maybe Text) UserRef)
-> Message -> Const (Maybe Text) Message
Lens' Message UserRef
mUser((UserRef -> Const (Maybe Text) UserRef)
 -> Message -> Const (Maybe Text) Message)
-> ((Maybe Text -> Const (Maybe Text) (Maybe Text))
    -> UserRef -> Const (Maybe Text) UserRef)
-> Getting (Maybe Text) Message (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(UserRef -> Maybe Text) -> SimpleGetter UserRef (Maybe Text)
forall s a. (s -> a) -> SimpleGetter s a
to (ChatState -> UserRef -> Maybe Text
nameForUserRef ChatState
st)
                                 , mdParentMessage :: Maybe Message
mdParentMessage     = Maybe Message
parent
                                 , mdParentUserName :: Maybe Text
mdParentUserName    = Maybe Message
parent Maybe Message -> (Message -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Message -> Getting (Maybe Text) Message (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^.(UserRef -> Const (Maybe Text) UserRef)
-> Message -> Const (Maybe Text) Message
Lens' Message UserRef
mUser((UserRef -> Const (Maybe Text) UserRef)
 -> Message -> Const (Maybe Text) Message)
-> ((Maybe Text -> Const (Maybe Text) (Maybe Text))
    -> UserRef -> Const (Maybe Text) UserRef)
-> Getting (Maybe Text) Message (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(UserRef -> Maybe Text) -> SimpleGetter UserRef (Maybe Text)
forall s a. (s -> a) -> SimpleGetter s a
to (ChatState -> UserRef -> Maybe Text
nameForUserRef 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 = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
vpWidth
                                 , mdMyUsername :: Text
mdMyUsername        = ChatState -> Text
myUsername ChatState
st
                                 , mdWrapNonhighlightedCodeBlocks :: Bool
mdWrapNonhighlightedCodeBlocks = Bool
False
                                 }
            in MessageData -> Widget Name
renderMessage MessageData
md

    in Size -> Size -> RenderM Name (Result Name) -> Widget Name
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Greedy Size
Greedy (RenderM Name (Result Name) -> Widget Name)
-> RenderM Name (Result Name) -> Widget Name
forall a b. (a -> b) -> a -> b
$ do
        Context
ctx <- RenderM Name Context
forall n. RenderM n Context
getContext
        Widget Name -> RenderM Name (Result Name)
forall n. Widget n -> RenderM n (Result n)
render (Widget Name -> RenderM Name (Result Name))
-> Widget Name -> RenderM Name (Result Name)
forall a b. (a -> b) -> a -> b
$ Widget Name -> Widget Name
forall n. Widget n -> Widget n
maybeWarn (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ Name -> ViewportType -> Widget Name -> Widget Name
forall n.
(Ord n, Show n) =>
n -> ViewportType -> Widget n -> Widget n
viewport (TeamId -> Name
ViewMessageArea TeamId
tId) ViewportType
Both (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ Int -> Widget Name
mkBody (Context
ctxContext -> Getting Int Context Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Context Int
Lens' Context Int
availWidthL)

viewMessageKeybindings :: KeyConfig -> KeyHandlerMap
viewMessageKeybindings :: KeyConfig -> KeyHandlerMap
viewMessageKeybindings = [KeyEventHandler] -> KeyConfig -> KeyHandlerMap
mkKeybindings [KeyEventHandler]
viewMessageKeyHandlers

viewMessageKeyHandlers :: [KeyEventHandler]
viewMessageKeyHandlers :: [KeyEventHandler]
viewMessageKeyHandlers =
    let vs :: TeamId -> ViewportScroll Name
vs = Name -> ViewportScroll Name
forall n. n -> ViewportScroll n
viewportScroll (Name -> ViewportScroll Name)
-> (TeamId -> Name) -> TeamId -> ViewportScroll Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TeamId -> Name
ViewMessageArea
    in [ KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
PageUpEvent Text
"Page up" (MH () -> KeyEventHandler) -> MH () -> KeyEventHandler
forall a b. (a -> b) -> a -> b
$ do
           TeamId
tId <- Getting TeamId ChatState TeamId -> MH TeamId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting TeamId ChatState TeamId
SimpleGetter ChatState TeamId
csCurrentTeamId
           EventM Name () -> MH ()
forall a. EventM Name a -> MH a
mh (EventM Name () -> MH ()) -> EventM Name () -> MH ()
forall a b. (a -> b) -> a -> b
$ ViewportScroll Name -> Int -> EventM Name ()
forall n. ViewportScroll n -> Int -> EventM n ()
vScrollBy (TeamId -> ViewportScroll Name
vs TeamId
tId) (-Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
pageAmount)

       , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
PageDownEvent Text
"Page down" (MH () -> KeyEventHandler) -> MH () -> KeyEventHandler
forall a b. (a -> b) -> a -> b
$ do
           TeamId
tId <- Getting TeamId ChatState TeamId -> MH TeamId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting TeamId ChatState TeamId
SimpleGetter ChatState TeamId
csCurrentTeamId
           EventM Name () -> MH ()
forall a. EventM Name a -> MH a
mh (EventM Name () -> MH ()) -> EventM Name () -> MH ()
forall a b. (a -> b) -> a -> b
$ ViewportScroll Name -> Int -> EventM Name ()
forall n. ViewportScroll n -> Int -> EventM n ()
vScrollBy (TeamId -> ViewportScroll Name
vs TeamId
tId) Int
pageAmount

       , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
PageLeftEvent Text
"Page left" (MH () -> KeyEventHandler) -> MH () -> KeyEventHandler
forall a b. (a -> b) -> a -> b
$ do
           TeamId
tId <- Getting TeamId ChatState TeamId -> MH TeamId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting TeamId ChatState TeamId
SimpleGetter ChatState TeamId
csCurrentTeamId
           EventM Name () -> MH ()
forall a. EventM Name a -> MH a
mh (EventM Name () -> MH ()) -> EventM Name () -> MH ()
forall a b. (a -> b) -> a -> b
$ ViewportScroll Name -> Int -> EventM Name ()
forall n. ViewportScroll n -> Int -> EventM n ()
hScrollBy (TeamId -> ViewportScroll Name
vs TeamId
tId) (-Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
pageAmount)

       , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
PageRightEvent Text
"Page right" (MH () -> KeyEventHandler) -> MH () -> KeyEventHandler
forall a b. (a -> b) -> a -> b
$ do
           TeamId
tId <- Getting TeamId ChatState TeamId -> MH TeamId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting TeamId ChatState TeamId
SimpleGetter ChatState TeamId
csCurrentTeamId
           EventM Name () -> MH ()
forall a. EventM Name a -> MH a
mh (EventM Name () -> MH ()) -> EventM Name () -> MH ()
forall a b. (a -> b) -> a -> b
$ ViewportScroll Name -> Int -> EventM Name ()
forall n. ViewportScroll n -> Int -> EventM n ()
hScrollBy (TeamId -> ViewportScroll Name
vs TeamId
tId) (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
pageAmount)

       , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
ScrollUpEvent Text
"Scroll up" (MH () -> KeyEventHandler) -> MH () -> KeyEventHandler
forall a b. (a -> b) -> a -> b
$ do
           TeamId
tId <- Getting TeamId ChatState TeamId -> MH TeamId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting TeamId ChatState TeamId
SimpleGetter ChatState TeamId
csCurrentTeamId
           EventM Name () -> MH ()
forall a. EventM Name a -> MH a
mh (EventM Name () -> MH ()) -> EventM Name () -> MH ()
forall a b. (a -> b) -> a -> b
$ ViewportScroll Name -> Int -> EventM Name ()
forall n. ViewportScroll n -> Int -> EventM n ()
vScrollBy (TeamId -> ViewportScroll Name
vs TeamId
tId) (-Int
1)

       , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
ScrollDownEvent Text
"Scroll down" (MH () -> KeyEventHandler) -> MH () -> KeyEventHandler
forall a b. (a -> b) -> a -> b
$ do
           TeamId
tId <- Getting TeamId ChatState TeamId -> MH TeamId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting TeamId ChatState TeamId
SimpleGetter ChatState TeamId
csCurrentTeamId
           EventM Name () -> MH ()
forall a. EventM Name a -> MH a
mh (EventM Name () -> MH ()) -> EventM Name () -> MH ()
forall a b. (a -> b) -> a -> b
$ ViewportScroll Name -> Int -> EventM Name ()
forall n. ViewportScroll n -> Int -> EventM n ()
vScrollBy (TeamId -> ViewportScroll Name
vs TeamId
tId) Int
1

       , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
ScrollLeftEvent Text
"Scroll left" (MH () -> KeyEventHandler) -> MH () -> KeyEventHandler
forall a b. (a -> b) -> a -> b
$ do
           TeamId
tId <- Getting TeamId ChatState TeamId -> MH TeamId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting TeamId ChatState TeamId
SimpleGetter ChatState TeamId
csCurrentTeamId
           EventM Name () -> MH ()
forall a. EventM Name a -> MH a
mh (EventM Name () -> MH ()) -> EventM Name () -> MH ()
forall a b. (a -> b) -> a -> b
$ ViewportScroll Name -> Int -> EventM Name ()
forall n. ViewportScroll n -> Int -> EventM n ()
hScrollBy (TeamId -> ViewportScroll Name
vs TeamId
tId) (-Int
1)

       , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
ScrollRightEvent Text
"Scroll right" (MH () -> KeyEventHandler) -> MH () -> KeyEventHandler
forall a b. (a -> b) -> a -> b
$ do
           TeamId
tId <- Getting TeamId ChatState TeamId -> MH TeamId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting TeamId ChatState TeamId
SimpleGetter ChatState TeamId
csCurrentTeamId
           EventM Name () -> MH ()
forall a. EventM Name a -> MH a
mh (EventM Name () -> MH ()) -> EventM Name () -> MH ()
forall a b. (a -> b) -> a -> b
$ ViewportScroll Name -> Int -> EventM Name ()
forall n. ViewportScroll n -> Int -> EventM n ()
hScrollBy (TeamId -> ViewportScroll Name
vs TeamId
tId) Int
1

       , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
ScrollBottomEvent Text
"Scroll to the end of the message" (MH () -> KeyEventHandler) -> MH () -> KeyEventHandler
forall a b. (a -> b) -> a -> b
$ do
           TeamId
tId <- Getting TeamId ChatState TeamId -> MH TeamId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting TeamId ChatState TeamId
SimpleGetter ChatState TeamId
csCurrentTeamId
           EventM Name () -> MH ()
forall a. EventM Name a -> MH a
mh (EventM Name () -> MH ()) -> EventM Name () -> MH ()
forall a b. (a -> b) -> a -> b
$ ViewportScroll Name -> EventM Name ()
forall n. ViewportScroll n -> EventM n ()
vScrollToEnd (TeamId -> ViewportScroll Name
vs TeamId
tId)

       , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
ScrollTopEvent Text
"Scroll to the beginning of the message" (MH () -> KeyEventHandler) -> MH () -> KeyEventHandler
forall a b. (a -> b) -> a -> b
$ do
           TeamId
tId <- Getting TeamId ChatState TeamId -> MH TeamId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting TeamId ChatState TeamId
SimpleGetter ChatState TeamId
csCurrentTeamId
           EventM Name () -> MH ()
forall a. EventM Name a -> MH a
mh (EventM Name () -> MH ()) -> EventM Name () -> MH ()
forall a b. (a -> b) -> a -> b
$ ViewportScroll Name -> EventM Name ()
forall n. ViewportScroll n -> EventM n ()
vScrollToBeginning (TeamId -> ViewportScroll Name
vs TeamId
tId)
       ]

viewMessageReactionsKeybindings :: KeyConfig -> KeyHandlerMap
viewMessageReactionsKeybindings :: KeyConfig -> KeyHandlerMap
viewMessageReactionsKeybindings = [KeyEventHandler] -> KeyConfig -> KeyHandlerMap
mkKeybindings [KeyEventHandler]
viewMessageReactionsKeyHandlers

viewMessageReactionsKeyHandlers :: [KeyEventHandler]
viewMessageReactionsKeyHandlers :: [KeyEventHandler]
viewMessageReactionsKeyHandlers =
    let vs :: TeamId -> ViewportScroll Name
vs = Name -> ViewportScroll Name
forall n. n -> ViewportScroll n
viewportScroll (Name -> ViewportScroll Name)
-> (TeamId -> Name) -> TeamId -> ViewportScroll Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TeamId -> Name
ViewMessageReactionsArea
    in [ KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
PageUpEvent Text
"Page up" (MH () -> KeyEventHandler) -> MH () -> KeyEventHandler
forall a b. (a -> b) -> a -> b
$ do
           TeamId
tId <- Getting TeamId ChatState TeamId -> MH TeamId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting TeamId ChatState TeamId
SimpleGetter ChatState TeamId
csCurrentTeamId
           EventM Name () -> MH ()
forall a. EventM Name a -> MH a
mh (EventM Name () -> MH ()) -> EventM Name () -> MH ()
forall a b. (a -> b) -> a -> b
$ ViewportScroll Name -> Int -> EventM Name ()
forall n. ViewportScroll n -> Int -> EventM n ()
vScrollBy (TeamId -> ViewportScroll Name
vs TeamId
tId) (-Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
pageAmount)

       , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
PageDownEvent Text
"Page down" (MH () -> KeyEventHandler) -> MH () -> KeyEventHandler
forall a b. (a -> b) -> a -> b
$ do
           TeamId
tId <- Getting TeamId ChatState TeamId -> MH TeamId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting TeamId ChatState TeamId
SimpleGetter ChatState TeamId
csCurrentTeamId
           EventM Name () -> MH ()
forall a. EventM Name a -> MH a
mh (EventM Name () -> MH ()) -> EventM Name () -> MH ()
forall a b. (a -> b) -> a -> b
$ ViewportScroll Name -> Int -> EventM Name ()
forall n. ViewportScroll n -> Int -> EventM n ()
vScrollBy (TeamId -> ViewportScroll Name
vs TeamId
tId) Int
pageAmount

       , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
ScrollUpEvent Text
"Scroll up" (MH () -> KeyEventHandler) -> MH () -> KeyEventHandler
forall a b. (a -> b) -> a -> b
$ do
           TeamId
tId <- Getting TeamId ChatState TeamId -> MH TeamId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting TeamId ChatState TeamId
SimpleGetter ChatState TeamId
csCurrentTeamId
           EventM Name () -> MH ()
forall a. EventM Name a -> MH a
mh (EventM Name () -> MH ()) -> EventM Name () -> MH ()
forall a b. (a -> b) -> a -> b
$ ViewportScroll Name -> Int -> EventM Name ()
forall n. ViewportScroll n -> Int -> EventM n ()
vScrollBy (TeamId -> ViewportScroll Name
vs TeamId
tId) (-Int
1)

       , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
ScrollDownEvent Text
"Scroll down" (MH () -> KeyEventHandler) -> MH () -> KeyEventHandler
forall a b. (a -> b) -> a -> b
$ do
           TeamId
tId <- Getting TeamId ChatState TeamId -> MH TeamId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting TeamId ChatState TeamId
SimpleGetter ChatState TeamId
csCurrentTeamId
           EventM Name () -> MH ()
forall a. EventM Name a -> MH a
mh (EventM Name () -> MH ()) -> EventM Name () -> MH ()
forall a b. (a -> b) -> a -> b
$ ViewportScroll Name -> Int -> EventM Name ()
forall n. ViewportScroll n -> Int -> EventM n ()
vScrollBy (TeamId -> ViewportScroll Name
vs TeamId
tId) Int
1

       , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
ScrollBottomEvent Text
"Scroll to the end of the reactions list" (MH () -> KeyEventHandler) -> MH () -> KeyEventHandler
forall a b. (a -> b) -> a -> b
$ do
           TeamId
tId <- Getting TeamId ChatState TeamId -> MH TeamId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting TeamId ChatState TeamId
SimpleGetter ChatState TeamId
csCurrentTeamId
           EventM Name () -> MH ()
forall a. EventM Name a -> MH a
mh (EventM Name () -> MH ()) -> EventM Name () -> MH ()
forall a b. (a -> b) -> a -> b
$ ViewportScroll Name -> EventM Name ()
forall n. ViewportScroll n -> EventM n ()
vScrollToEnd (TeamId -> ViewportScroll Name
vs TeamId
tId)

       , KeyEvent -> Text -> MH () -> KeyEventHandler
mkKb KeyEvent
ScrollTopEvent Text
"Scroll to the beginning of the reactions list" (MH () -> KeyEventHandler) -> MH () -> KeyEventHandler
forall a b. (a -> b) -> a -> b
$ do
           TeamId
tId <- Getting TeamId ChatState TeamId -> MH TeamId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting TeamId ChatState TeamId
SimpleGetter ChatState TeamId
csCurrentTeamId
           EventM Name () -> MH ()
forall a. EventM Name a -> MH a
mh (EventM Name () -> MH ()) -> EventM Name () -> MH ()
forall a b. (a -> b) -> a -> b
$ ViewportScroll Name -> EventM Name ()
forall n. ViewportScroll n -> EventM n ()
vScrollToBeginning (TeamId -> ViewportScroll Name
vs TeamId
tId)
       ]