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 = 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 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 (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 ChatState () -> MH ()
forall a. EventM Name ChatState a -> MH a
mh (EventM Name ChatState () -> MH ())
-> EventM Name ChatState () -> MH ()
forall a b. (a -> b) -> a -> b
$ do
ViewportScroll Name -> forall s. EventM Name s ()
forall n. ViewportScroll n -> forall s. EventM n s ()
vScrollToBeginning ViewportScroll Name
vs
ViewportScroll Name -> forall s. EventM Name s ()
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
csChatState
-> Getting
(Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab))
ChatState
(Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab))
-> Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)
forall s a. s -> Getting a s a -> a
^.TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)((TeamState
-> Const
(Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab))
TeamState)
-> ChatState
-> Const
(Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab))
ChatState)
-> ((Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)
-> Const
(Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab))
(Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)))
-> TeamState
-> Const
(Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab))
TeamState)
-> Getting
(Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab))
ChatState
(Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)
-> Const
(Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab))
(Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)))
-> TeamState
-> Const
(Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab))
TeamState
Lens'
TeamState
(Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab))
tsViewedMessage of
Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)
Nothing -> [Char] -> Maybe Message
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 -> Widget Name
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
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 -> Maybe Message
forall a. a -> Maybe a
Just Message
m
Just MessageId
mId -> do
ChannelId
cId <- ChatState
csChatState
-> Getting (Maybe ChannelId) ChatState (Maybe ChannelId)
-> Maybe ChannelId
forall s a. s -> Getting a s a -> a
^.TeamId -> SimpleGetter ChatState (Maybe ChannelId)
csCurrentChannelId(TeamId
tId)
ClientChannel
chan <- ChatState
csChatState
-> Getting (First ClientChannel) ChatState ClientChannel
-> Maybe ClientChannel
forall s a. s -> Getting (First a) s a -> Maybe a
^?ChannelId -> Traversal' ChatState ClientChannel
csChannel(ChannelId
cId)
MessageId -> Messages -> Maybe Message
findMessage MessageId
mId (Messages -> Maybe Message) -> Messages -> Maybe Message
forall a b. (a -> b) -> a -> b
$ ClientChannel
chanClientChannel
-> Getting Messages ClientChannel Messages -> Messages
forall s a. s -> Getting a s a -> a
^.(MessageInterface Name ()
-> Const Messages (MessageInterface Name ()))
-> ClientChannel -> Const Messages ClientChannel
Lens' ClientChannel (MessageInterface Name ())
ccMessageInterface((MessageInterface Name ()
-> Const Messages (MessageInterface Name ()))
-> ClientChannel -> Const Messages ClientChannel)
-> ((Messages -> Const Messages Messages)
-> MessageInterface Name ()
-> Const Messages (MessageInterface Name ()))
-> Getting Messages ClientChannel Messages
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Const Messages Messages)
-> MessageInterface Name ()
-> Const Messages (MessageInterface Name ())
forall n i (f :: * -> *).
Functor f =>
(Messages -> f Messages)
-> MessageInterface n i -> f (MessageInterface n i)
miMessages
handleEvent :: TeamId -> ViewMessageWindowTab -> Vty.Event -> MH ()
handleEvent :: TeamId -> ViewMessageWindowTab -> Event -> MH ()
handleEvent TeamId
tId 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 KeyEvent -> KeyDispatcher KeyEvent MH)
-> Event -> MH Bool
mhHandleKeyboardEvent (TeamId -> KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH
viewMessageKeybindings TeamId
tId)
handleEvent TeamId
tId 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 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 = Name -> ViewportType -> Widget Name -> Widget Name
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 [(Text, Set UserId)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Text, Set UserId)]
reacList of
Bool
True -> Text -> Widget Name
forall n. Text -> Widget n
txt Text
"This message has no reactions."
Bool
False -> [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
vBox ([Widget Name] -> Widget Name) -> [Widget Name] -> Widget Name
forall a b. (a -> b) -> a -> b
$ (Text, Set UserId) -> Widget Name
mkEntry ((Text, Set UserId) -> Widget Name)
-> [(Text, Set UserId)] -> [Widget Name]
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 Name
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
":"
clickableName :: Widget Name
clickableName = Widget Name -> Text -> Set UserId -> Widget Name
makeClickableName Widget Name
forall n. Widget n
name Text
reactionName Set UserId
userIdSet
usernameList :: Widget Name
usernameList = Set UserId -> Widget Name
forall {t :: * -> *}. Foldable t => t UserId -> Widget Name
usernameText Set UserId
userIdSet
in (Widget Name
clickableName Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> (Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padLeft (Int -> Padding
Pad Int
1) Widget Name
forall n. Widget n
count)) Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=>
(Padding -> Widget Name -> Widget Name
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) =
Name -> Maybe Name
forall a. a -> Maybe a
Just (Name -> Maybe Name) -> Name -> Maybe Name
forall a b. (a -> b) -> a -> b
$ Maybe MessageId -> Name -> Int -> Text -> Name
ClickableUsername Maybe MessageId
forall a. Maybe a
Nothing Name
vpName Int
i Text
un
clickableUsernames Int
_ Inline
_ =
Maybe Name
forall a. Maybe a
Nothing
usernameText :: t UserId -> Widget Name
usernameText t UserId
uids =
Maybe TeamBaseURL
-> Text
-> HighlightSet
-> Maybe (Int -> Inline -> Maybe Name)
-> Text
-> Widget Name
forall a.
SemEq a =>
Maybe TeamBaseURL
-> Text
-> HighlightSet
-> Maybe (Int -> Inline -> Maybe a)
-> Text
-> Widget a
renderText' Maybe TeamBaseURL
forall a. Maybe a
Nothing (ChatState -> Text
myUsername ChatState
st) HighlightSet
hs ((Int -> Inline -> Maybe Name)
-> Maybe (Int -> Inline -> Maybe Name)
forall a. a -> Maybe a
Just Int -> Inline -> Maybe Name
clickableUsernames) (Text -> Widget Name) -> Text -> Widget Name
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 a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
addUserSigil ([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 a. t a -> [a]
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 (Post -> PostId) -> Maybe Post -> Maybe PostId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message
mMessage -> Getting (Maybe Post) Message (Maybe Post) -> Maybe Post
forall s a. s -> Getting a s a -> a
^.Getting (Maybe Post) Message (Maybe Post)
Lens' Message (Maybe Post)
mOriginalPost
Name -> Maybe Name
forall a. a -> Maybe a
Just (Name -> Maybe Name) -> Name -> Maybe Name
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 -> Name -> Widget Name -> Widget Name
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
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]
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 -> TeamId -> HighlightSet
getHighlightSet ChatState
st TeamId
tId
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 { 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
printableNameForUserRef ChatState
st)
, mdParentMessage :: Maybe Message
mdParentMessage = Maybe Message
parent
, mdParentUserName :: Maybe Text
mdParentUserName = Maybe Message
parent Maybe Message -> (Message -> Maybe Text) -> Maybe Text
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
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
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 = Int -> Maybe Int
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 = Maybe Int
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 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 Name
ctx <- RenderM Name (Context Name)
forall n. RenderM n (Context n)
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 Name
ctxContext Name -> Getting Int (Context Name) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (Context Name) Int
forall n (f :: * -> *).
Functor f =>
(Int -> f Int) -> Context n -> f (Context n)
availWidthL)
viewMessageKeybindings :: TeamId -> KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH
viewMessageKeybindings :: TeamId -> KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH
viewMessageKeybindings TeamId
tId KeyConfig KeyEvent
kc = KeyConfig KeyEvent
-> [KeyEventHandler KeyEvent MH] -> KeyDispatcher KeyEvent MH
forall k (m :: * -> *).
Ord k =>
KeyConfig k -> [KeyEventHandler k m] -> KeyDispatcher k m
unsafeKeyDispatcher KeyConfig KeyEvent
kc (TeamId -> [KeyEventHandler KeyEvent MH]
viewMessageKeyHandlers TeamId
tId)
viewMessageKeyHandlers :: TeamId -> [MHKeyEventHandler]
viewMessageKeyHandlers :: TeamId -> [KeyEventHandler KeyEvent MH]
viewMessageKeyHandlers TeamId
tId =
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 KeyEvent MH
forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
PageUpEvent Text
"Page up" (MH () -> KeyEventHandler KeyEvent MH)
-> MH () -> KeyEventHandler KeyEvent MH
forall a b. (a -> b) -> a -> b
$ do
EventM Name ChatState () -> MH ()
forall a. EventM Name ChatState a -> MH a
mh (EventM Name ChatState () -> MH ())
-> EventM Name ChatState () -> MH ()
forall a b. (a -> b) -> a -> b
$ ViewportScroll Name -> forall s. Int -> EventM Name s ()
forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
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 KeyEvent MH
forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
PageDownEvent Text
"Page down" (MH () -> KeyEventHandler KeyEvent MH)
-> MH () -> KeyEventHandler KeyEvent MH
forall a b. (a -> b) -> a -> b
$ do
EventM Name ChatState () -> MH ()
forall a. EventM Name ChatState a -> MH a
mh (EventM Name ChatState () -> MH ())
-> EventM Name ChatState () -> MH ()
forall a b. (a -> b) -> a -> b
$ ViewportScroll Name -> forall s. Int -> EventM Name s ()
forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy (TeamId -> ViewportScroll Name
vs TeamId
tId) Int
pageAmount
, KeyEvent -> Text -> MH () -> KeyEventHandler KeyEvent MH
forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
PageLeftEvent Text
"Page left" (MH () -> KeyEventHandler KeyEvent MH)
-> MH () -> KeyEventHandler KeyEvent MH
forall a b. (a -> b) -> a -> b
$ do
EventM Name ChatState () -> MH ()
forall a. EventM Name ChatState a -> MH a
mh (EventM Name ChatState () -> MH ())
-> EventM Name ChatState () -> MH ()
forall a b. (a -> b) -> a -> b
$ ViewportScroll Name -> forall s. Int -> EventM Name s ()
forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
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 KeyEvent MH
forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
PageRightEvent Text
"Page right" (MH () -> KeyEventHandler KeyEvent MH)
-> MH () -> KeyEventHandler KeyEvent MH
forall a b. (a -> b) -> a -> b
$ do
EventM Name ChatState () -> MH ()
forall a. EventM Name ChatState a -> MH a
mh (EventM Name ChatState () -> MH ())
-> EventM Name ChatState () -> MH ()
forall a b. (a -> b) -> a -> b
$ ViewportScroll Name -> forall s. Int -> EventM Name s ()
forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
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 KeyEvent MH
forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
ScrollUpEvent Text
"Scroll up" (MH () -> KeyEventHandler KeyEvent MH)
-> MH () -> KeyEventHandler KeyEvent MH
forall a b. (a -> b) -> a -> b
$ do
EventM Name ChatState () -> MH ()
forall a. EventM Name ChatState a -> MH a
mh (EventM Name ChatState () -> MH ())
-> EventM Name ChatState () -> MH ()
forall a b. (a -> b) -> a -> b
$ ViewportScroll Name -> forall s. Int -> EventM Name s ()
forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy (TeamId -> ViewportScroll Name
vs TeamId
tId) (-Int
1)
, KeyEvent -> Text -> MH () -> KeyEventHandler KeyEvent MH
forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
ScrollDownEvent Text
"Scroll down" (MH () -> KeyEventHandler KeyEvent MH)
-> MH () -> KeyEventHandler KeyEvent MH
forall a b. (a -> b) -> a -> b
$ do
EventM Name ChatState () -> MH ()
forall a. EventM Name ChatState a -> MH a
mh (EventM Name ChatState () -> MH ())
-> EventM Name ChatState () -> MH ()
forall a b. (a -> b) -> a -> b
$ ViewportScroll Name -> forall s. Int -> EventM Name s ()
forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy (TeamId -> ViewportScroll Name
vs TeamId
tId) Int
1
, KeyEvent -> Text -> MH () -> KeyEventHandler KeyEvent MH
forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
ScrollLeftEvent Text
"Scroll left" (MH () -> KeyEventHandler KeyEvent MH)
-> MH () -> KeyEventHandler KeyEvent MH
forall a b. (a -> b) -> a -> b
$ do
EventM Name ChatState () -> MH ()
forall a. EventM Name ChatState a -> MH a
mh (EventM Name ChatState () -> MH ())
-> EventM Name ChatState () -> MH ()
forall a b. (a -> b) -> a -> b
$ ViewportScroll Name -> forall s. Int -> EventM Name s ()
forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
hScrollBy (TeamId -> ViewportScroll Name
vs TeamId
tId) (-Int
1)
, KeyEvent -> Text -> MH () -> KeyEventHandler KeyEvent MH
forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
ScrollRightEvent Text
"Scroll right" (MH () -> KeyEventHandler KeyEvent MH)
-> MH () -> KeyEventHandler KeyEvent MH
forall a b. (a -> b) -> a -> b
$ do
EventM Name ChatState () -> MH ()
forall a. EventM Name ChatState a -> MH a
mh (EventM Name ChatState () -> MH ())
-> EventM Name ChatState () -> MH ()
forall a b. (a -> b) -> a -> b
$ ViewportScroll Name -> forall s. Int -> EventM Name s ()
forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
hScrollBy (TeamId -> ViewportScroll Name
vs TeamId
tId) Int
1
, KeyEvent -> Text -> MH () -> KeyEventHandler KeyEvent MH
forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
ScrollBottomEvent Text
"Scroll to the end of the message" (MH () -> KeyEventHandler KeyEvent MH)
-> MH () -> KeyEventHandler KeyEvent MH
forall a b. (a -> b) -> a -> b
$ do
EventM Name ChatState () -> MH ()
forall a. EventM Name ChatState a -> MH a
mh (EventM Name ChatState () -> MH ())
-> EventM Name ChatState () -> MH ()
forall a b. (a -> b) -> a -> b
$ ViewportScroll Name -> forall s. EventM Name s ()
forall n. ViewportScroll n -> forall s. EventM n s ()
vScrollToEnd (TeamId -> ViewportScroll Name
vs TeamId
tId)
, KeyEvent -> Text -> MH () -> KeyEventHandler KeyEvent MH
forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
ScrollTopEvent Text
"Scroll to the beginning of the message" (MH () -> KeyEventHandler KeyEvent MH)
-> MH () -> KeyEventHandler KeyEvent MH
forall a b. (a -> b) -> a -> b
$ do
EventM Name ChatState () -> MH ()
forall a. EventM Name ChatState a -> MH a
mh (EventM Name ChatState () -> MH ())
-> EventM Name ChatState () -> MH ()
forall a b. (a -> b) -> a -> b
$ ViewportScroll Name -> forall s. EventM Name s ()
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 = KeyConfig KeyEvent
-> [KeyEventHandler KeyEvent MH] -> KeyDispatcher KeyEvent MH
forall k (m :: * -> *).
Ord k =>
KeyConfig k -> [KeyEventHandler k m] -> KeyDispatcher k m
unsafeKeyDispatcher KeyConfig KeyEvent
kc (TeamId -> [KeyEventHandler KeyEvent MH]
viewMessageReactionsKeyHandlers TeamId
tId)
viewMessageReactionsKeyHandlers :: TeamId -> [MHKeyEventHandler]
viewMessageReactionsKeyHandlers :: TeamId -> [KeyEventHandler KeyEvent MH]
viewMessageReactionsKeyHandlers TeamId
tId =
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 KeyEvent MH
forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
PageUpEvent Text
"Page up" (MH () -> KeyEventHandler KeyEvent MH)
-> MH () -> KeyEventHandler KeyEvent MH
forall a b. (a -> b) -> a -> b
$ do
EventM Name ChatState () -> MH ()
forall a. EventM Name ChatState a -> MH a
mh (EventM Name ChatState () -> MH ())
-> EventM Name ChatState () -> MH ()
forall a b. (a -> b) -> a -> b
$ ViewportScroll Name -> forall s. Int -> EventM Name s ()
forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
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 KeyEvent MH
forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
PageDownEvent Text
"Page down" (MH () -> KeyEventHandler KeyEvent MH)
-> MH () -> KeyEventHandler KeyEvent MH
forall a b. (a -> b) -> a -> b
$ do
EventM Name ChatState () -> MH ()
forall a. EventM Name ChatState a -> MH a
mh (EventM Name ChatState () -> MH ())
-> EventM Name ChatState () -> MH ()
forall a b. (a -> b) -> a -> b
$ ViewportScroll Name -> forall s. Int -> EventM Name s ()
forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy (TeamId -> ViewportScroll Name
vs TeamId
tId) Int
pageAmount
, KeyEvent -> Text -> MH () -> KeyEventHandler KeyEvent MH
forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
ScrollUpEvent Text
"Scroll up" (MH () -> KeyEventHandler KeyEvent MH)
-> MH () -> KeyEventHandler KeyEvent MH
forall a b. (a -> b) -> a -> b
$ do
EventM Name ChatState () -> MH ()
forall a. EventM Name ChatState a -> MH a
mh (EventM Name ChatState () -> MH ())
-> EventM Name ChatState () -> MH ()
forall a b. (a -> b) -> a -> b
$ ViewportScroll Name -> forall s. Int -> EventM Name s ()
forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy (TeamId -> ViewportScroll Name
vs TeamId
tId) (-Int
1)
, KeyEvent -> Text -> MH () -> KeyEventHandler KeyEvent MH
forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
ScrollDownEvent Text
"Scroll down" (MH () -> KeyEventHandler KeyEvent MH)
-> MH () -> KeyEventHandler KeyEvent MH
forall a b. (a -> b) -> a -> b
$ do
EventM Name ChatState () -> MH ()
forall a. EventM Name ChatState a -> MH a
mh (EventM Name ChatState () -> MH ())
-> EventM Name ChatState () -> MH ()
forall a b. (a -> b) -> a -> b
$ ViewportScroll Name -> forall s. Int -> EventM Name s ()
forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy (TeamId -> ViewportScroll Name
vs TeamId
tId) Int
1
, KeyEvent -> Text -> MH () -> KeyEventHandler KeyEvent MH
forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
ScrollBottomEvent Text
"Scroll to the end of the reactions list" (MH () -> KeyEventHandler KeyEvent MH)
-> MH () -> KeyEventHandler KeyEvent MH
forall a b. (a -> b) -> a -> b
$ do
EventM Name ChatState () -> MH ()
forall a. EventM Name ChatState a -> MH a
mh (EventM Name ChatState () -> MH ())
-> EventM Name ChatState () -> MH ()
forall a b. (a -> b) -> a -> b
$ ViewportScroll Name -> forall s. EventM Name s ()
forall n. ViewportScroll n -> forall s. EventM n s ()
vScrollToEnd (TeamId -> ViewportScroll Name
vs TeamId
tId)
, KeyEvent -> Text -> MH () -> KeyEventHandler KeyEvent MH
forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
ScrollTopEvent Text
"Scroll to the beginning of the reactions list" (MH () -> KeyEventHandler KeyEvent MH)
-> MH () -> KeyEventHandler KeyEvent MH
forall a b. (a -> b) -> a -> b
$ do
EventM Name ChatState () -> MH ()
forall a. EventM Name ChatState a -> MH a
mh (EventM Name ChatState () -> MH ())
-> EventM Name ChatState () -> MH ()
forall a b. (a -> b) -> a -> b
$ ViewportScroll Name -> forall s. EventM Name s ()
forall n. ViewportScroll n -> forall s. EventM n s ()
vScrollToBeginning (TeamId -> ViewportScroll Name
vs TeamId
tId)
]