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 = 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"

-- 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 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)
       ]