{-# LANGUAGE RankNTypes #-}
module Matterhorn.Draw.MessageInterface
  ( drawMessageInterface
  )
where

import           Prelude ()
import           Matterhorn.Prelude

import           Brick
import           Brick.Keybindings
import           Brick.Focus ( withFocusRing )
import           Brick.Widgets.Border
import           Brick.Widgets.Border.Style
import           Brick.Widgets.Center
import           Brick.Widgets.List ( listElements, listSelectedElement, renderList )
import           Brick.Widgets.Edit ( editContentsL, renderEditor, getEditContents )
import           Data.Char ( isSpace, isPunctuation )
import qualified Data.Foldable as F
import           Data.List ( intersperse )
import           Data.Maybe ( fromJust )
import qualified Data.Sequence as Seq
import qualified Data.Set as S
import qualified Data.Text as T
import           Data.Text.Zipper ( cursorPosition )
import           Data.Time.Clock ( UTCTime(..) )
import           Lens.Micro.Platform ( (.~), (^?!), to, view, Lens', Traversal', SimpleGetter )

import           Network.Mattermost.Types ( ChannelId, Type(Direct, Group)
                                          , ServerTime(..), TeamId, idString
                                          )

import           Matterhorn.Constants
import           Matterhorn.Draw.Buttons
import           Matterhorn.Draw.Messages
import           Matterhorn.Draw.ManageAttachments
import           Matterhorn.Draw.InputPreview
import           Matterhorn.Draw.Util
import           Matterhorn.Draw.RichText
import           Matterhorn.Events.MessageSelect
import           Matterhorn.Events.UrlSelect
import           Matterhorn.State.MessageSelect
import           Matterhorn.Themes
import           Matterhorn.TimeUtils ( justAfter, justBefore )
import           Matterhorn.Types
import           Matterhorn.Types.DirectionalSeq ( emptyDirSeq )
import           Matterhorn.Types.RichText


drawMessageInterface :: ChatState
                     -> HighlightSet
                     -> TeamId
                     -> Bool
                     -> Lens' ChatState (MessageInterface Name i)
                     -> Bool
                     -> Bool
                     -> Widget Name
drawMessageInterface :: forall i.
ChatState
-> HighlightSet
-> TeamId
-> Bool
-> Lens' ChatState (MessageInterface Name i)
-> Bool
-> Bool
-> Widget Name
drawMessageInterface ChatState
st HighlightSet
hs TeamId
tId Bool
showNewMsgLine Lens' ChatState (MessageInterface Name i)
which Bool
renderReplyIndent Bool
focused =
    Widget Name
interfaceContents
    where
    inMsgSelect :: Bool
inMsgSelect = ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState (MessageInterface Name i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) MessageInterfaceMode
miMode forall a. Eq a => a -> a -> Bool
== MessageInterfaceMode
MessageSelect
    eName :: Name
eName = forall a n. Named a n => a -> n
getName forall a b. (a -> b) -> a -> b
$ ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState (MessageInterface Name i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) (EditState n)
miEditorforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (Editor Text n)
esEditor
    region :: Name
region = Name -> Name
MessageInterfaceMessages Name
eName
    previewVpName :: Name
previewVpName = Name -> Name
MessagePreviewViewport Name
eName

    interfaceContents :: Widget Name
interfaceContents =
        case ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState (MessageInterface Name i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) MessageInterfaceMode
miMode of
            MessageInterfaceMode
Compose           -> Bool -> Widget Name
renderMessages Bool
False
            MessageInterfaceMode
MessageSelect     -> Bool -> Widget Name
renderMessages Bool
True
            MessageInterfaceMode
ShowUrlList       -> forall i.
ChatState
-> HighlightSet
-> Lens' ChatState (MessageInterface Name i)
-> Widget Name
drawUrlSelectWindow ChatState
st HighlightSet
hs Lens' ChatState (MessageInterface Name i)
which
            SaveAttachment {} -> forall i.
ChatState
-> Lens' ChatState (MessageInterface Name i) -> Widget Name
drawSaveAttachmentWindow ChatState
st Lens' ChatState (MessageInterface Name i)
which
            MessageInterfaceMode
ManageAttachments -> forall i.
ChatState
-> Lens' ChatState (MessageInterface Name i) -> Widget Name
drawAttachmentList ChatState
st Lens' ChatState (MessageInterface Name i)
which
            MessageInterfaceMode
BrowseFiles       -> forall i.
ChatState
-> Lens' ChatState (MessageInterface Name i) -> Widget Name
drawFileBrowser ChatState
st Lens' ChatState (MessageInterface Name i)
which

    renderMessages :: Bool -> Widget Name
renderMessages Bool
inMsgSel =
        forall n. [Widget n] -> Widget n
vBox [ forall n. Widget n -> Widget n
freezeBorders forall a b. (a -> b) -> a -> b
$
               forall i.
ChatState
-> Bool
-> Bool
-> TeamId
-> HighlightSet
-> Lens' ChatState (MessageInterface Name i)
-> Bool
-> Name
-> Widget Name
renderMessageListing ChatState
st Bool
inMsgSel Bool
showNewMsgLine TeamId
tId HighlightSet
hs Lens' ChatState (MessageInterface Name i)
which Bool
renderReplyIndent Name
region
             , Widget Name
bottomBorder
             , ChatState
-> SimpleGetter ChatState (EditState Name)
-> TeamId
-> Name
-> HighlightSet
-> Widget Name
inputPreview ChatState
st (Lens' ChatState (MessageInterface Name i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) (EditState n)
miEditor) TeamId
tId Name
previewVpName HighlightSet
hs
             , ChatState
-> Lens' ChatState (EditState Name)
-> Bool
-> HighlightSet
-> Widget Name
inputArea ChatState
st (Lens' ChatState (MessageInterface Name i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) (EditState n)
miEditor) Bool
focused HighlightSet
hs
             ]

    bottomBorder :: Widget Name
bottomBorder =
        if Bool
inMsgSelect
        then forall i.
ChatState
-> TeamId
-> Lens' ChatState (MessageInterface Name i)
-> Widget Name
messageSelectBottomBar ChatState
st TeamId
tId Lens' ChatState (MessageInterface Name i)
which
        else forall n. [Widget n] -> Widget n
hBox [ forall {n}. Widget n
showAttachmentCount
                  , forall {n}. Widget n
hBorder
                  , Widget Name
showTypingUsers
                  , forall {n}. Widget n
showBusy
                  ]

    showBusy :: Widget n
showBusy = case ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState (Maybe (Maybe Int))
csWorkerIsBusy of
                 Just (Just Int
n) -> forall n. Int -> Widget n -> Widget n
hLimit Int
2 forall {n}. Widget n
hBorder forall n. Widget n -> Widget n -> Widget n
<+> forall n. Text -> Widget n
txt (String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ String
"*" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
n)
                 Just Maybe Int
Nothing -> forall n. Int -> Widget n -> Widget n
hLimit Int
2 forall {n}. Widget n
hBorder forall n. Widget n -> Widget n -> Widget n
<+> forall n. Text -> Widget n
txt Text
"*"
                 Maybe (Maybe Int)
Nothing -> forall {n}. Widget n
emptyWidget

    showTypingUsers :: Widget Name
showTypingUsers =
        let format :: Text -> Widget Name
format = forall a.
SemEq a =>
Maybe TeamBaseURL
-> Text
-> HighlightSet
-> Maybe (Int -> Inline -> Maybe a)
-> Text
-> Widget a
renderText' forall a. Maybe a
Nothing (ChatState -> Text
myUsername ChatState
st) HighlightSet
hs forall a. Maybe a
Nothing
        in case TypingUsers -> [UserId]
allTypingUsers (ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState (MessageInterface Name i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) (EditState n)
miEditorforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) EphemeralEditState
esEphemeralforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' EphemeralEditState TypingUsers
eesTypingUsers) of
            [] -> forall {n}. Widget n
emptyWidget
            [UserId
uId] | Just Text
un <- UserId -> ChatState -> Maybe Text
usernameForUserId UserId
uId ChatState
st ->
               Text -> Widget Name
format forall a b. (a -> b) -> a -> b
$ Text
"[" forall a. Semigroup a => a -> a -> a
<> Text -> Text
addUserSigil Text
un forall a. Semigroup a => a -> a -> a
<> Text
" is typing]"
            [UserId
uId1, UserId
uId2] | Just Text
un1 <- UserId -> ChatState -> Maybe Text
usernameForUserId UserId
uId1 ChatState
st
                         , Just Text
un2 <- UserId -> ChatState -> Maybe Text
usernameForUserId UserId
uId2 ChatState
st ->
               Text -> Widget Name
format forall a b. (a -> b) -> a -> b
$ Text
"[" forall a. Semigroup a => a -> a -> a
<> Text -> Text
addUserSigil Text
un1 forall a. Semigroup a => a -> a -> a
<> Text
" and " forall a. Semigroup a => a -> a -> a
<> Text -> Text
addUserSigil Text
un2 forall a. Semigroup a => a -> a -> a
<> Text
" are typing]"
            [UserId]
_ -> Text -> Widget Name
format Text
"[several people are typing]"

    kc :: KeyConfig KeyEvent
kc = ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources Config
crConfigurationforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' Config (KeyConfig KeyEvent)
configUserKeysL
    showAttachmentCount :: Widget n
showAttachmentCount =
        let count :: Int
count = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall n (t :: * -> *) e. GenericList n t e -> t e
listElements forall a b. (a -> b) -> a -> b
$ ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState (MessageInterface Name i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) (EditState n)
miEditorforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (List n AttachmentData)
esAttachmentList
        in if Int
count forall a. Eq a => a -> a -> Bool
== Int
0
           then forall {n}. Widget n
emptyWidget
           else forall n. [Widget n] -> Widget n
hBox [ forall n. Int -> Widget n -> Widget n
hLimit Int
1 forall {n}. Widget n
hBorder
                     , forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
clientMessageAttr forall a b. (a -> b) -> a -> b
$
                       forall n. Text -> Widget n
txt forall a b. (a -> b) -> a -> b
$ Text
"(" forall a. Semigroup a => a -> a -> a
<> (String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
count) forall a. Semigroup a => a -> a -> a
<> Text
" attachment" forall a. Semigroup a => a -> a -> a
<>
                             (if Int
count forall a. Eq a => a -> a -> Bool
== Int
1 then Text
"" else Text
"s") forall a. Semigroup a => a -> a -> a
<> Text
"; "
                     , forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
clientEmphAttr forall a b. (a -> b) -> a -> b
$
                       forall n. Text -> Widget n
txt forall a b. (a -> b) -> a -> b
$ Maybe Binding -> Text
ppMaybeBinding (forall k. (Show k, Ord k) => KeyConfig k -> k -> Maybe Binding
firstActiveBinding KeyConfig KeyEvent
kc KeyEvent
ShowAttachmentListEvent)
                     , forall n. Text -> Widget n
txt Text
" to manage)"
                     ]

messageSelectBottomBar :: ChatState
                       -> TeamId
                       -> Lens' ChatState (MessageInterface Name i)
                       -> Widget Name
messageSelectBottomBar :: forall i.
ChatState
-> TeamId
-> Lens' ChatState (MessageInterface Name i)
-> Widget Name
messageSelectBottomBar ChatState
st TeamId
tId Lens' ChatState (MessageInterface Name i)
which =
    case forall n i.
Lens' ChatState (MessageInterface n i)
-> ChatState -> Maybe Message
getSelectedMessage Lens' ChatState (MessageInterface Name i)
which ChatState
st of
        Maybe Message
Nothing -> forall {n}. Widget n
emptyWidget
        Just Message
postMsg ->
            let optionList :: Widget n
optionList = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall {n}. [Widget n]
usableOptions
                             then forall n. Text -> Widget n
txt Text
"(no actions available for this message)"
                             else forall n. [Widget n] -> Widget n
hBox forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a]
intersperse (forall n. Text -> Widget n
txt Text
" ") forall {n}. [Widget n]
usableOptions
                usableOptions :: [Widget n]
usableOptions = forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$ forall {n}. (Message -> Bool, Text, Text) -> Maybe (Widget n)
mkOption forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Message -> Bool, Text, Text)]
options
                mkOption :: (Message -> Bool, Text, Text) -> Maybe (Widget n)
mkOption (Message -> Bool
f, Text
k, Text
desc) = if Message -> Bool
f Message
postMsg
                                        then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
messageSelectStatusAttr (forall n. Text -> Widget n
txt Text
k) forall n. Widget n -> Widget n -> Widget n
<+>
                                                    forall n. Text -> Widget n
txt (Text
":" forall a. Semigroup a => a -> a -> a
<> Text
desc)
                                        else forall a. Maybe a
Nothing
                numURLs :: Int
numURLs = forall a. Seq a -> Int
Seq.length forall a b. (a -> b) -> a -> b
$ Message -> Seq LinkChoice
msgURLs Message
postMsg
                s :: Text
s = if Int
numURLs forall a. Eq a => a -> a -> Bool
== Int
1 then Text
"" else Text
"s"
                hasURLs :: Bool
hasURLs = Int
numURLs forall a. Ord a => a -> a -> Bool
> Int
0
                openUrlsMsg :: Text
openUrlsMsg = Text
"open " forall a. Semigroup a => a -> a -> a
<> (String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
numURLs) forall a. Semigroup a => a -> a -> a
<> Text
" URL" forall a. Semigroup a => a -> a -> a
<> Text
s
                hasVerb :: Bool
hasVerb = forall a. Maybe a -> Bool
isJust (Blocks -> Maybe Text
findVerbatimChunk (Message
postMsgforall s a. s -> Getting a s a -> a
^.Lens' Message Blocks
mText))
                ev :: KeyEvent -> Text
ev = ChatState
-> (KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH)
-> KeyEvent
-> Text
keyEventBindings ChatState
st (forall n i.
TeamId
-> Lens' ChatState (MessageInterface n i)
-> KeyConfig KeyEvent
-> KeyDispatcher KeyEvent MH
messageSelectKeybindings TeamId
tId Lens' ChatState (MessageInterface Name i)
which)
                -- make sure these keybinding pieces are up-to-date!
                options :: [(Message -> Bool, Text, Text)]
options = [ ( Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message -> Bool
isGap
                            , KeyEvent -> Text
ev KeyEvent
YankWholeMessageEvent
                            , Text
"yank-all"
                            )
                          , ( \Message
m -> Message -> Bool
isFlaggable Message
m Bool -> Bool -> Bool
&& Bool -> Bool
not (Message
mforall s a. s -> Getting a s a -> a
^.Lens' Message Bool
mFlagged)
                            , KeyEvent -> Text
ev KeyEvent
FlagMessageEvent
                            , Text
"flag"
                            )
                          , ( \Message
m -> Message -> Bool
isFlaggable Message
m Bool -> Bool -> Bool
&& Message
mforall s a. s -> Getting a s a -> a
^.Lens' Message Bool
mFlagged
                            , KeyEvent -> Text
ev KeyEvent
FlagMessageEvent
                            , Text
"unflag"
                            )
                          , ( Message -> Bool
isReplyable
                            , KeyEvent -> Text
ev KeyEvent
OpenThreadEvent
                            , Text
"thread"
                            )
                          , ( Message -> Bool
isPostMessage
                            , KeyEvent -> Text
ev KeyEvent
CopyPostLinkEvent
                            , Text
"copy-link"
                            )
                          , ( \Message
m -> Message -> Bool
isPinnable Message
m Bool -> Bool -> Bool
&& Bool -> Bool
not (Message
mforall s a. s -> Getting a s a -> a
^.Lens' Message Bool
mPinned)
                            , KeyEvent -> Text
ev KeyEvent
PinMessageEvent
                            , Text
"pin"
                            )
                          , ( \Message
m -> Message -> Bool
isPinnable Message
m Bool -> Bool -> Bool
&& Message
mforall s a. s -> Getting a s a -> a
^.Lens' Message Bool
mPinned
                            , KeyEvent -> Text
ev KeyEvent
PinMessageEvent
                            , Text
"unpin"
                            )
                          , ( Message -> Bool
isReplyable
                            , KeyEvent -> Text
ev KeyEvent
ReplyMessageEvent
                            , Text
"reply"
                            )
                          , ( Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message -> Bool
isGap
                            , KeyEvent -> Text
ev KeyEvent
ViewMessageEvent
                            , Text
"view"
                            )
                          , ( Message -> Bool
isGap
                            , KeyEvent -> Text
ev KeyEvent
FillGapEvent
                            , Text
"load messages"
                            )
                          , ( \Message
m -> ChatState -> Message -> Bool
isMine ChatState
st Message
m Bool -> Bool -> Bool
&& Message -> Bool
isEditable Message
m
                            , KeyEvent -> Text
ev KeyEvent
EditMessageEvent
                            , Text
"edit"
                            )
                          , ( \Message
m -> ChatState -> Message -> Bool
isMine ChatState
st Message
m Bool -> Bool -> Bool
&& Message -> Bool
isDeletable Message
m
                            , KeyEvent -> Text
ev KeyEvent
DeleteMessageEvent
                            , Text
"delete"
                            )
                          , ( forall a b. a -> b -> a
const Bool
hasURLs
                            , KeyEvent -> Text
ev KeyEvent
OpenMessageURLEvent
                            , Text
openUrlsMsg
                            )
                          , ( forall a b. a -> b -> a
const Bool
hasVerb
                            , KeyEvent -> Text
ev KeyEvent
YankMessageEvent
                            , Text
"yank-code"
                            )
                          , ( Message -> Bool
isReactable
                            , KeyEvent -> Text
ev KeyEvent
ReactToMessageEvent
                            , Text
"react"
                            )
                          ]

            in forall n. [Widget n] -> Widget n
hBox [ forall n. Int -> Widget n -> Widget n
hLimit Int
1 forall {n}. Widget n
hBorder
                    , forall n. Text -> Widget n
txt Text
"["
                    , forall {n}. Widget n
optionList
                    , forall n. Text -> Widget n
txt Text
"]"
                    , forall {n}. Widget n
hBorder
                    ]

renderMessageListing :: ChatState
                     -> Bool
                     -> Bool
                     -> TeamId
                     -> HighlightSet
                     -> Lens' ChatState (MessageInterface Name i)
                     -> Bool
                     -> Name
                     -> Widget Name
renderMessageListing :: forall i.
ChatState
-> Bool
-> Bool
-> TeamId
-> HighlightSet
-> Lens' ChatState (MessageInterface Name i)
-> Bool
-> Name
-> Widget Name
renderMessageListing ChatState
st Bool
inMsgSelect Bool
showNewMsgLine TeamId
tId HighlightSet
hs Lens' ChatState (MessageInterface Name i)
which Bool
renderReplyIndent Name
region =
    Widget Name
messages
    where
    mcId :: Maybe ChannelId
mcId = ChatState
stforall s a. s -> Getting a s a -> a
^.(TeamId -> SimpleGetter ChatState (Maybe ChannelId)
csCurrentChannelId TeamId
tId)

    messages :: Widget Name
messages = forall n. Padding -> Widget n -> Widget n
padTop Padding
Max Widget Name
chatText

    chatText :: Widget Name
chatText =
        case Maybe ChannelId
mcId of
            Maybe ChannelId
Nothing -> forall n. Char -> Widget n
fill Char
' '
            Just ChannelId
cId ->
                if Bool
inMsgSelect
                then forall n. Widget n -> Widget n
freezeBorders forall a b. (a -> b) -> a -> b
$
                     ChannelId -> MessageSelectState -> Messages -> Widget Name
renderMessagesWithSelect ChannelId
cId (ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState (MessageInterface Name i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) MessageSelectState
miMessageSelect) (ChannelId -> Messages
buildMessages ChannelId
cId)
                else forall n. Ord n => n -> Widget n -> Widget n
cached Name
region forall a b. (a -> b) -> a -> b
$
                     forall n. Widget n -> Widget n
freezeBorders forall a b. (a -> b) -> a -> b
$
                     ChatState
-> HighlightSet
-> Maybe ServerTime
-> Bool
-> Name
-> DirectionalSeq Retrograde (Message, ThreadState)
-> Widget Name
renderLastMessages ChatState
st HighlightSet
hs (ChannelId -> ChatState -> Maybe ServerTime
getEditedMessageCutoff ChannelId
cId ChatState
st) Bool
renderReplyIndent Name
region forall a b. (a -> b) -> a -> b
$
                     RetrogradeMessages
-> DirectionalSeq Retrograde (Message, ThreadState)
retrogradeMsgsWithThreadStates forall a b. (a -> b) -> a -> b
$
                     Messages -> RetrogradeMessages
reverseMessages forall a b. (a -> b) -> a -> b
$
                     ChannelId -> Messages
buildMessages ChannelId
cId

    renderMessagesWithSelect :: ChannelId -> MessageSelectState -> Messages -> Widget Name
renderMessagesWithSelect ChannelId
cId (MessageSelectState Maybe MessageId
selMsgId) Messages
msgs =
        -- In this case, we want to fill the message list with messages
        -- but use the post ID as a cursor. To do this efficiently we
        -- only want to render enough messages to fill the screen.
        --
        -- If the message area is H rows high, this actually renders at
        -- most 2H rows' worth of messages and then does the appropriate
        -- cropping. This way we can simplify the math needed to figure
        -- out how to crop while bounding the number of messages we
        -- render around the cursor.
        --
        -- First, we sanity-check the application state because under
        -- some conditions, the selected message might be gone (e.g.
        -- deleted).
        let (Maybe (Message, ThreadState)
s, (DirectionalSeq
  (ReverseDirection Chronological) (Message, ThreadState)
before, DirectionalSeq Chronological (Message, ThreadState)
after)) = forall d a.
SeqDirection d =>
(a -> Bool)
-> DirectionalSeq d a
-> (Maybe a,
    (DirectionalSeq (ReverseDirection d) a, DirectionalSeq d a))
splitDirSeqOn (\(Message
m, ThreadState
_) -> Message
mforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe MessageId)
mMessageId forall a. Eq a => a -> a -> Bool
== Maybe MessageId
selMsgId) DirectionalSeq Chronological (Message, ThreadState)
msgsWithStates
            msgsWithStates :: DirectionalSeq Chronological (Message, ThreadState)
msgsWithStates = Messages -> DirectionalSeq Chronological (Message, ThreadState)
chronologicalMsgsWithThreadStates Messages
msgs
        in case Maybe (Message, ThreadState)
s of
             Maybe (Message, ThreadState)
Nothing ->
                 ChatState
-> HighlightSet
-> Maybe ServerTime
-> Bool
-> Name
-> DirectionalSeq Retrograde (Message, ThreadState)
-> Widget Name
renderLastMessages ChatState
st HighlightSet
hs (ChannelId -> ChatState -> Maybe ServerTime
getEditedMessageCutoff ChannelId
cId ChatState
st) Bool
renderReplyIndent Name
region DirectionalSeq Retrograde (Message, ThreadState)
before
             Just (Message, ThreadState)
m ->
                 forall dir1 dir2.
(SeqDirection dir1, SeqDirection dir2) =>
((Message, ThreadState),
 (DirectionalSeq dir1 (Message, ThreadState),
  DirectionalSeq dir2 (Message, ThreadState)))
-> (Message -> ThreadState -> Name -> Widget Name)
-> Name
-> Widget Name
unsafeRenderMessageSelection ((Message, ThreadState)
m, (DirectionalSeq Retrograde (Message, ThreadState)
before, DirectionalSeq Chronological (Message, ThreadState)
after))
                     (ChatState
-> HighlightSet
-> Bool
-> Maybe ServerTime
-> Message
-> ThreadState
-> Name
-> Widget Name
renderSingleMessage ChatState
st HighlightSet
hs Bool
renderReplyIndent forall a. Maybe a
Nothing) Name
region

    buildMessages :: ChannelId -> Messages
buildMessages ChannelId
cId =
        -- If the message list is empty, add an informative message to
        -- the message listing to make it explicit that this listing is
        -- empty.
        let cutoff :: Maybe NewMessageIndicator
cutoff = if Bool
showNewMsgLine
                     then ChannelId -> ChatState -> Maybe NewMessageIndicator
getNewMessageCutoff ChannelId
cId ChatState
st
                     else forall a. Maybe a
Nothing
            ms :: Messages
ms = ChatState -> Traversal' ChatState Messages -> Messages
filterMessageListing ChatState
st (Lens' ChatState (MessageInterface Name i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) Messages
miMessages)
        in if forall (t :: * -> *) a. Foldable t => t a -> Bool
F.null Messages
ms
           then forall a. MessageOps a => Message -> a -> a
addMessage (ChatState -> ChannelId -> Message
emptyChannelFillerMessage ChatState
st ChannelId
cId) forall dir a. DirectionalSeq dir a
emptyDirSeq
           else Messages
-> Maybe NewMessageIndicator -> Text -> TimeZoneSeries -> Messages
insertTransitions Messages
ms
                                  Maybe NewMessageIndicator
cutoff
                                  (ChatState -> Text
getDateFormat ChatState
st)
                                  (ChatState
st forall s a. s -> Getting a s a -> a
^. Lens' ChatState TimeZoneSeries
timeZone)

insertTransitions :: Messages -> Maybe NewMessageIndicator -> Text -> TimeZoneSeries -> Messages
insertTransitions :: Messages
-> Maybe NewMessageIndicator -> Text -> TimeZoneSeries -> Messages
insertTransitions Messages
ms Maybe NewMessageIndicator
cutoff = Messages -> Text -> TimeZoneSeries -> Messages
insertDateMarkers forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a. MessageOps a => Message -> a -> a
addMessage Messages
ms [Message]
newMessagesT
    where anyNondeletedNewMessages :: ServerTime -> Bool
anyNondeletedNewMessages ServerTime
t =
              forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ (Message -> Bool) -> Messages -> Maybe Message
findLatestUserMessage (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Message Bool
mDeleted) (ServerTime -> Messages -> Messages
messagesAfter ServerTime
t Messages
ms)
          newMessagesT :: [Message]
newMessagesT = case Maybe NewMessageIndicator
cutoff of
              Maybe NewMessageIndicator
Nothing -> []
              Just NewMessageIndicator
Hide -> []
              Just (NewPostsAfterServerTime ServerTime
t)
                  | ServerTime -> Bool
anyNondeletedNewMessages ServerTime
t -> [ServerTime -> Message
newMessagesMsg forall a b. (a -> b) -> a -> b
$ ServerTime -> ServerTime
justAfter ServerTime
t]
                  | Bool
otherwise -> []
              Just (NewPostsStartingAt ServerTime
t)
                  | ServerTime -> Bool
anyNondeletedNewMessages (ServerTime -> ServerTime
justBefore ServerTime
t) -> [ServerTime -> Message
newMessagesMsg forall a b. (a -> b) -> a -> b
$ ServerTime -> ServerTime
justBefore ServerTime
t]
                  | Bool
otherwise -> []
          newMessagesMsg :: ServerTime -> Message
newMessagesMsg ServerTime
d = Text -> MessageType -> ServerTime -> Message
newMessageOfType (String -> Text
T.pack String
"New Messages")
                             (ClientMessageType -> MessageType
C ClientMessageType
NewMessagesTransition) ServerTime
d

-- | Construct a single message to be displayed in the specified channel
-- when it does not yet have any user messages posted to it.
emptyChannelFillerMessage :: ChatState -> ChannelId -> Message
emptyChannelFillerMessage :: ChatState -> ChannelId -> Message
emptyChannelFillerMessage ChatState
st ChannelId
cId =
    Text -> MessageType -> ServerTime -> Message
newMessageOfType Text
msg (ClientMessageType -> MessageType
C ClientMessageType
Informative) ServerTime
ts
    where
        -- This is a bogus timestamp, but its value does not matter
        -- because it is only used to create a message that will be
        -- shown in a channel with no date transitions (which would
        -- otherwise include this bogus date) or other messages (which
        -- would make for a broken message sorting).
        ts :: ServerTime
ts = UTCTime -> ServerTime
ServerTime forall a b. (a -> b) -> a -> b
$ Day -> DiffTime -> UTCTime
UTCTime (forall a. Enum a => Int -> a
toEnum Int
0) DiffTime
0
        chan :: ClientChannel
chan = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ ChannelId -> ClientChannels -> Maybe ClientChannel
findChannelById ChannelId
cId (ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState ClientChannels
csChannels)
        chanName :: Text
chanName = ChatState -> ChannelInfo -> Text
mkChannelName ChatState
st (ClientChannel
chanforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfo)
        msg :: Text
msg = case ClientChannel
chanforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo Type
cdType of
            Type
Direct ->
                let u :: Maybe UserInfo
u = ClientChannel
chanforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo (Maybe UserId)
cdDMUserId forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b c. (a -> b -> c) -> b -> a -> c
flip UserId -> ChatState -> Maybe UserInfo
userById ChatState
st
                in case Maybe UserInfo
u of
                    Maybe UserInfo
Nothing -> forall {a}. (Semigroup a, IsString a) => Maybe a -> a
userMsg forall a. Maybe a
Nothing
                    Just UserInfo
_ -> forall {a}. (Semigroup a, IsString a) => Maybe a -> a
userMsg (forall a. a -> Maybe a
Just Text
chanName)
            Type
Group ->
                forall {a}. (Semigroup a, IsString a) => a -> a
groupMsg (ClientChannel
chanforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo Text
cdDisplayName)
            Type
_ ->
                forall {a}. (Semigroup a, IsString a) => a -> a
chanMsg Text
chanName
        userMsg :: Maybe a -> a
userMsg (Just a
cn) = a
"You have not yet sent any direct messages to " forall a. Semigroup a => a -> a -> a
<> a
cn forall a. Semigroup a => a -> a -> a
<> a
"."
        userMsg Maybe a
Nothing   = a
"You have not yet sent any direct messages to this user."
        groupMsg :: a -> a
groupMsg a
us = a
"There are not yet any direct messages in the group " forall a. Semigroup a => a -> a -> a
<> a
us forall a. Semigroup a => a -> a -> a
<> a
"."
        chanMsg :: a -> a
chanMsg a
cn = a
"There are not yet any messages in the " forall a. Semigroup a => a -> a -> a
<> a
cn forall a. Semigroup a => a -> a -> a
<> a
" channel."

filterMessageListing :: ChatState -> Traversal' ChatState Messages -> Messages
filterMessageListing :: ChatState -> Traversal' ChatState Messages -> Messages
filterMessageListing ChatState
st Traversal' ChatState Messages
msgsWhich =
    ChatState
st forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Traversal' ChatState Messages
msgsWhich forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. (s -> a) -> SimpleGetter s a
to (forall seq a.
SeqDirection seq =>
(a -> Bool) -> DirectionalSeq seq a -> DirectionalSeq seq a
filterMessages Message -> Bool
isShown)
    where isShown :: Message -> Bool
isShown Message
m
            | ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources UserPreferences
crUserPreferencesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' UserPreferences Bool
userPrefShowJoinLeave = Bool
True
            | Bool
otherwise = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Message -> Bool
isJoinLeave Message
m

inputArea :: ChatState
          -> Lens' ChatState (EditState Name)
          -> Bool
          -> HighlightSet
          -> Widget Name
inputArea :: ChatState
-> Lens' ChatState (EditState Name)
-> Bool
-> HighlightSet
-> Widget Name
inputArea ChatState
st Lens' ChatState (EditState Name)
which Bool
focused HighlightSet
hs =
    let replyPrompt :: Text
replyPrompt = Text
"reply> "
        normalPrompt :: Text
normalPrompt = Text
"> "
        editPrompt :: Text
editPrompt = Text
"edit> "
        showReplyPrompt :: Bool
showReplyPrompt = ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) Bool
esShowReplyPrompt
        maybeHighlight :: Widget n -> Widget n
maybeHighlight = if Bool
focused
                         then forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
focusedEditorPromptAttr
                         else forall a. a -> a
id
        prompt :: Widget Name
prompt = forall n. Widget n -> Widget n
maybeHighlight forall a b. (a -> b) -> a -> b
$
                 forall n. Ord n => n -> Widget n -> Widget n
reportExtent (Name -> Name
MessageInputPrompt forall a b. (a -> b) -> a -> b
$ forall a n. Named a n => a -> n
getName Editor Text Name
editor) forall a b. (a -> b) -> a -> b
$
                 forall n. Text -> Widget n
txt forall a b. (a -> b) -> a -> b
$ case ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) EditMode
esEditMode of
            Replying {} ->
                if Bool
showReplyPrompt then Text
replyPrompt else Text
normalPrompt
            Editing {}  ->
                Text
editPrompt
            EditMode
NewPost ->
                Text
normalPrompt
        editor :: Editor Text Name
editor = ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (Editor Text n)
esEditor
        inputBox :: Widget Name
inputBox = forall n t.
(Ord n, Show n, Monoid t, TextWidth t, GenericTextZipper t) =>
([t] -> Widget n) -> Bool -> Editor t n -> Widget n
renderEditor (ChatState
-> SimpleGetter ChatState (EditState Name)
-> HighlightSet
-> [Text]
-> Widget Name
drawEditorContents ChatState
st Lens' ChatState (EditState Name)
which HighlightSet
hs) Bool
True Editor Text Name
editor
        curContents :: [Text]
curContents = forall t n. Monoid t => Editor t n -> [t]
getEditContents Editor Text Name
editor
        multilineContent :: Bool
multilineContent = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
curContents forall a. Ord a => a -> a -> Bool
> Int
1
        multilineHints :: Widget n
multilineHints =
            forall n. [Widget n] -> Widget n
hBox [ forall n. Int -> Widget n -> Widget n
hLimit Int
1 forall {n}. Widget n
hBorder
                 , forall n. String -> Widget n
str forall a b. (a -> b) -> a -> b
$ String
"[" forall a. Semigroup a => a -> a -> a
<> (forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ (forall a. Num a => a -> a -> a
+Int
1) forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. TextZipper a -> (Int, Int)
cursorPosition forall a b. (a -> b) -> a -> b
$
                                        Editor Text Name
editorforall s a. s -> Getting a s a -> a
^.forall t1 n t2.
Lens (Editor t1 n) (Editor t2 n) (TextZipper t1) (TextZipper t2)
editContentsL) forall a. Semigroup a => a -> a -> a
<>
                         String
"/" forall a. Semigroup a => a -> a -> a
<> (forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
curContents) forall a. Semigroup a => a -> a -> a
<> String
"]"
                 , forall n. Widget n -> Widget n
hBorderWithLabel forall a b. (a -> b) -> a -> b
$ forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
clientEmphAttr forall a b. (a -> b) -> a -> b
$
                   forall n. Text -> Widget n
txt forall a b. (a -> b) -> a -> b
$ Text
"In multi-line mode. Press " forall a. Semigroup a => a -> a -> a
<> Text
multiLineToggleKey forall a. Semigroup a => a -> a -> a
<>
                         Text
" to finish."
                 ]

        replyDisplay :: Widget Name
replyDisplay = case ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) EditMode
esEditMode of
            Replying Message
msg Post
_ | Bool
showReplyPrompt ->
                let msgWithoutParent :: Message
msgWithoutParent = Message
msg forall a b. a -> (a -> b) -> b
& Lens' Message ReplyState
mInReplyToMsg forall s t a b. ASetter s t a b -> b -> s -> t
.~ ReplyState
NotAReply
                in forall n. [Widget n] -> Widget n
hBox [ forall {n}. Widget n
replyArrow
                        , forall n. Widget n -> Widget n
addEllipsis forall a b. (a -> b) -> a -> b
$ MessageData -> Widget Name
renderMessage MessageData
                          { mdMessage :: Message
mdMessage           = Message
msgWithoutParent
                          , mdUserName :: Maybe Text
mdUserName          = Message
msgWithoutParentforall s a. s -> Getting a s a -> a
^.Lens' Message UserRef
mUserforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to (ChatState -> UserRef -> Maybe Text
printableNameForUserRef ChatState
st)
                          , mdParentMessage :: Maybe Message
mdParentMessage     = forall a. Maybe a
Nothing
                          , mdParentUserName :: Maybe Text
mdParentUserName    = forall a. Maybe a
Nothing
                          , mdHighlightSet :: HighlightSet
mdHighlightSet      = HighlightSet
hs
                          , mdEditThreshold :: Maybe ServerTime
mdEditThreshold     = forall a. Maybe a
Nothing
                          , mdShowOlderEdits :: Bool
mdShowOlderEdits    = Bool
False
                          , mdRenderReplyParent :: Bool
mdRenderReplyParent = Bool
True
                          , mdRenderReplyIndent :: Bool
mdRenderReplyIndent = Bool
True
                          , mdIndentBlocks :: Bool
mdIndentBlocks      = Bool
False
                          , mdThreadState :: ThreadState
mdThreadState       = ThreadState
NoThread
                          , mdShowReactions :: Bool
mdShowReactions     = Bool
True
                          , mdMessageWidthLimit :: Maybe Int
mdMessageWidthLimit = forall a. Maybe a
Nothing
                          , mdMyUsername :: Text
mdMyUsername        = ChatState -> Text
myUsername ChatState
st
                          , mdMyUserId :: UserId
mdMyUserId          = ChatState -> UserId
myUserId ChatState
st
                          , mdWrapNonhighlightedCodeBlocks :: Bool
mdWrapNonhighlightedCodeBlocks = Bool
True
                          , mdTruncateVerbatimBlocks :: Maybe Int
mdTruncateVerbatimBlocks = forall a. Maybe a
Nothing
                          , mdClickableNameTag :: Name
mdClickableNameTag  = forall a n. Named a n => a -> n
getName Editor Text Name
editor
                          }
                        ]
            EditMode
_ -> forall {n}. Widget n
emptyWidget

        kc :: KeyConfig KeyEvent
kc = ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources Config
crConfigurationforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' Config (KeyConfig KeyEvent)
configUserKeysL
        multiLineToggleKey :: Text
multiLineToggleKey = Maybe Binding -> Text
ppMaybeBinding forall a b. (a -> b) -> a -> b
$ forall k. (Show k, Ord k) => KeyConfig k -> k -> Maybe Binding
firstActiveBinding KeyConfig KeyEvent
kc KeyEvent
ToggleMultiLineEvent

        commandBox :: Widget Name
commandBox = case ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState (EditState Name)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) EphemeralEditState
esEphemeralforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' EphemeralEditState Bool
eesMultiline of
            Bool
False ->
                let linesStr :: String
linesStr = String
"line" forall a. Semigroup a => a -> a -> a
<> if Int
numLines forall a. Eq a => a -> a -> Bool
== Int
1 then String
"" else String
"s"
                    numLines :: Int
numLines = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
curContents
                in forall n. Int -> Widget n -> Widget n
vLimit Int
1 forall a b. (a -> b) -> a -> b
$ forall n. [Widget n] -> Widget n
hBox forall a b. (a -> b) -> a -> b
$
                   Widget Name
prompt forall a. a -> [a] -> [a]
: if Bool
multilineContent
                            then [ forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
clientEmphAttr forall a b. (a -> b) -> a -> b
$
                                   forall n. String -> Widget n
str forall a b. (a -> b) -> a -> b
$ String
"[" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
numLines forall a. Semigroup a => a -> a -> a
<> String
" " forall a. Semigroup a => a -> a -> a
<> String
linesStr forall a. Semigroup a => a -> a -> a
<>
                                         String
"; Enter: send, " forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
multiLineToggleKey forall a. Semigroup a => a -> a -> a
<>
                                         String
": edit, Backspace: cancel] "
                                 , forall n. Text -> Widget n
txt forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [Text]
curContents
                                 , forall n. n -> Location -> Widget n -> Widget n
showCursor (forall a n. Named a n => a -> n
getName Editor Text Name
editor) ((Int, Int) -> Location
Location (Int
0,Int
0)) forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str String
" "
                                 ]
                            else [Widget Name
inputBox]
            Bool
True -> forall n. Int -> Widget n -> Widget n
vLimit Int
multilineHeightLimit Widget Name
inputBox forall n. Widget n -> Widget n -> Widget n
<=> forall {n}. Widget n
multilineHints
    in Widget Name
replyDisplay forall n. Widget n -> Widget n -> Widget n
<=> Widget Name
commandBox

drawEditorContents :: ChatState
                   -> SimpleGetter ChatState (EditState Name)
                   -> HighlightSet
                   -> [Text]
                   -> Widget Name
drawEditorContents :: ChatState
-> SimpleGetter ChatState (EditState Name)
-> HighlightSet
-> [Text]
-> Widget Name
drawEditorContents ChatState
st SimpleGetter ChatState (EditState Name)
editWhich HighlightSet
hs =
    let noHighlight :: [Text] -> Widget n
noHighlight = forall n. Text -> Widget n
txt forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines
        ms :: Set Text
ms = ChatState
stforall s a. s -> Getting a s a -> a
^.SimpleGetter ChatState (EditState Name)
editWhichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (Set Text)
esMisspellings
    in case forall a. Set a -> Bool
S.null Set Text
ms of
        Bool
True -> forall {n}. [Text] -> Widget n
noHighlight
        Bool
False -> HighlightSet -> Set Text -> [Text] -> Widget Name
doHighlightMisspellings HighlightSet
hs Set Text
ms

replyArrow :: Widget a
replyArrow :: forall {n}. Widget n
replyArrow =
    forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed forall a b. (a -> b) -> a -> b
$ do
        Context a
ctx <- forall n. RenderM n (Context n)
getContext
        let bs :: BorderStyle
bs = Context a
ctxforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Context n) BorderStyle
ctxBorderStyleL
        forall n. Widget n -> RenderM n (Result n)
render forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str [Char
' ', BorderStyle -> Char
bsCornerTL BorderStyle
bs, Char
'▸']

-- | Tokens in spell check highlighting.
data Token =
    Ignore Text
    -- ^ This bit of text is to be ignored for the purposes of
    -- spell-checking.
    | Check Text
    -- ^ This bit of text should be checked against the spell checker's
    -- misspelling list.
    deriving (Int -> Token -> ShowS
[Token] -> ShowS
Token -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Token] -> ShowS
$cshowList :: [Token] -> ShowS
show :: Token -> String
$cshow :: Token -> String
showsPrec :: Int -> Token -> ShowS
$cshowsPrec :: Int -> Token -> ShowS
Show)

-- | This function takes a set of misspellings from the spell
-- checker, the editor lines, and builds a rendering of the text with
-- misspellings highlighted.
--
-- This function processes each line of text from the editor as follows:
--
-- * Tokenize the line based on our rules for what constitutes
--   whitespace. We do this because we need to check "words" in the
--   user's input against the list of misspellings returned by the spell
--   checker. But to do this we need to ignore the same things that
--   Aspell ignores, and it ignores whitespace and lots of puncutation.
--   We also do this because once we have identified the misspellings
--   present in the input, we need to reconstruct the user's input and
--   that means preserving whitespace so that the input looks as it was
--   originally typed.
--
-- * Once we have a list of tokens -- the whitespace tokens to be
--   preserved but ignored and the tokens to be checked -- we check
--   each non-whitespace token for presence in the list of misspellings
--   reported by the checker.
--
-- * Having indicated which tokens correspond to misspelled words, we
--   then need to coallesce adjacent tokens that are of the same
--   "misspelling status", i.e., two neighboring tokens (of whitespace
--   or check type) need to be coallesced if they both correspond to
--   text that is a misspelling or if they both are NOT a misspelling.
--   We do this so that the final Brick widget is optimal in that it
--   uses a minimal number of box cells to display substrings that have
--   the same attribute.
--
-- * Finally we build a widget out of these coallesced tokens and apply
--   the misspellingAttr attribute to the misspelled tokens.
--
-- Note that since we have to come to our own conclusion about which
-- words are worth checking in the checker's output, sometimes our
-- algorithm will differ from aspell in what is considered "part of a
-- word" and what isn't. In particular, Aspell is smart about sometimes
-- noticing that "'" is an apostrophe and at other times that it is
-- a single quote as part of a quoted string. As a result there will
-- be cases where Markdown formatting characters interact poorly
-- with Aspell's checking to result in misspellings that are *not*
-- highlighted.
--
-- One way to deal with this would be to *not* parse the user's input
-- as done here, complete with all its Markdown metacharacters, but to
-- instead 1) parse the input as Markdown, 2) traverse the Markdown AST
-- and extract the words from the relevant subtrees, and 3) spell-check
-- those words. The reason we don't do it that way in the first place is
-- because 1) the user's input might not be valid markdown and 2) even
-- if we did that, we'd still have to do this tokenization operation to
-- annotate misspellings and reconstruct the user's raw input.
doHighlightMisspellings :: HighlightSet -> S.Set Text -> [Text] -> Widget Name
doHighlightMisspellings :: HighlightSet -> Set Text -> [Text] -> Widget Name
doHighlightMisspellings HighlightSet
hs Set Text
misspellings [Text]
contents =
    -- Traverse the input, gathering non-whitespace into tokens and
    -- checking if they appear in the misspelling collection
    let whitelist :: Set Text
whitelist = forall a. Ord a => Set a -> Set a -> Set a
S.union (HighlightSet -> Set Text
hUserSet HighlightSet
hs) (HighlightSet -> Set Text
hChannelSet HighlightSet
hs)

        handleLine :: Text -> Widget n
handleLine Text
t | Text
t forall a. Eq a => a -> a -> Bool
== Text
"" = forall n. Text -> Widget n
txt Text
" "
        handleLine Text
t =
            -- For annotated tokens, coallesce tokens of the same type
            -- and add attributes for misspellings.
            let mkW :: Either Token Token -> Widget n
mkW (Left Token
tok) =
                    let s :: Text
s = Token -> Text
getTokenText Token
tok
                    in if Text -> Bool
T.null Text
s
                       then forall {n}. Widget n
emptyWidget
                       else forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
misspellingAttr forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt forall a b. (a -> b) -> a -> b
$ Token -> Text
getTokenText Token
tok
                mkW (Right Token
tok) =
                    let s :: Text
s = Token -> Text
getTokenText Token
tok
                    in if Text -> Bool
T.null Text
s
                       then forall {n}. Widget n
emptyWidget
                       else forall n. Text -> Widget n
txt Text
s

                go :: Either Token Token -> [Either Token Token] -> [Either Token Token]
                go :: Either Token Token -> [Either Token Token] -> [Either Token Token]
go Either Token Token
lst [] = [Either Token Token
lst]
                go Either Token Token
lst (Either Token Token
tok:[Either Token Token]
toks) =
                    case (Either Token Token
lst, Either Token Token
tok) of
                        (Left Token
a, Left Token
b)   -> Either Token Token -> [Either Token Token] -> [Either Token Token]
go (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Token -> Token -> Token
combineTokens Token
a Token
b) [Either Token Token]
toks
                        (Right Token
a, Right Token
b) -> Either Token Token -> [Either Token Token] -> [Either Token Token]
go (forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Token -> Token -> Token
combineTokens Token
a Token
b) [Either Token Token]
toks
                        (Either Token Token, Either Token Token)
_                  -> Either Token Token
lst forall a. a -> [a] -> [a]
: Either Token Token -> [Either Token Token] -> [Either Token Token]
go Either Token Token
tok [Either Token Token]
toks

            in forall n. [Widget n] -> Widget n
hBox forall a b. (a -> b) -> a -> b
$ forall {n}. Either Token Token -> Widget n
mkW forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Either Token Token -> [Either Token Token] -> [Either Token Token]
go (forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Text -> Token
Ignore Text
"") forall a b. (a -> b) -> a -> b
$ Text -> [Either Token Token]
annotatedTokens Text
t)

        combineTokens :: Token -> Token -> Token
combineTokens (Ignore Text
a) (Ignore Text
b) = Text -> Token
Ignore forall a b. (a -> b) -> a -> b
$ Text
a forall a. Semigroup a => a -> a -> a
<> Text
b
        combineTokens (Check Text
a) (Check Text
b) = Text -> Token
Check forall a b. (a -> b) -> a -> b
$ Text
a forall a. Semigroup a => a -> a -> a
<> Text
b
        combineTokens (Ignore Text
a) (Check Text
b) = Text -> Token
Check forall a b. (a -> b) -> a -> b
$ Text
a forall a. Semigroup a => a -> a -> a
<> Text
b
        combineTokens (Check Text
a) (Ignore Text
b) = Text -> Token
Check forall a b. (a -> b) -> a -> b
$ Text
a forall a. Semigroup a => a -> a -> a
<> Text
b

        getTokenText :: Token -> Text
getTokenText (Ignore Text
a) = Text
a
        getTokenText (Check Text
a) = Text
a

        annotatedTokens :: Text -> [Either Token Token]
annotatedTokens Text
t =
            -- For every token, check on whether it is a misspelling.
            -- The result is Either Token Token where the Left is a
            -- misspelling and the Right is not.
            Token -> Either Token Token
checkMisspelling forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Token -> [Token]
tokenize Text
t (Text -> Token
Ignore Text
"")

        checkMisspelling :: Token -> Either Token Token
checkMisspelling t :: Token
t@(Ignore Text
_) = forall a b. b -> Either a b
Right Token
t
        checkMisspelling t :: Token
t@(Check Text
s) =
            if Text
s forall a. Ord a => a -> Set a -> Bool
`S.member` Set Text
whitelist
            then forall a b. b -> Either a b
Right Token
t
            else if Text
s forall a. Ord a => a -> Set a -> Bool
`S.member` Set Text
misspellings
                 then forall a b. a -> Either a b
Left Token
t
                 else forall a b. b -> Either a b
Right Token
t

        ignoreChar :: Char -> Bool
ignoreChar Char
c = Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| Char -> Bool
isPunctuation Char
c Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'`' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'/' Bool -> Bool -> Bool
||
                       Char -> Text
T.singleton Char
c forall a. Eq a => a -> a -> Bool
== Text
userSigil Bool -> Bool -> Bool
|| Char -> Text
T.singleton Char
c forall a. Eq a => a -> a -> Bool
== Text
normalChannelSigil

        tokenize :: Text -> Token -> [Token]
tokenize Text
t Token
curTok
            | Text -> Bool
T.null Text
t = [Token
curTok]
            | Char -> Bool
ignoreChar forall a b. (a -> b) -> a -> b
$ Text -> Char
T.head Text
t =
                case Token
curTok of
                    Ignore Text
s -> Text -> Token -> [Token]
tokenize (Text -> Text
T.tail Text
t) (Text -> Token
Ignore forall a b. (a -> b) -> a -> b
$ Text
s forall a. Semigroup a => a -> a -> a
<> (Char -> Text
T.singleton forall a b. (a -> b) -> a -> b
$ Text -> Char
T.head Text
t))
                    Check Text
s -> Text -> Token
Check Text
s forall a. a -> [a] -> [a]
: Text -> Token -> [Token]
tokenize (Text -> Text
T.tail Text
t) (Text -> Token
Ignore forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton forall a b. (a -> b) -> a -> b
$ Text -> Char
T.head Text
t)
            | Bool
otherwise =
                case Token
curTok of
                    Ignore Text
s -> Text -> Token
Ignore Text
s forall a. a -> [a] -> [a]
: Text -> Token -> [Token]
tokenize (Text -> Text
T.tail Text
t) (Text -> Token
Check forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton forall a b. (a -> b) -> a -> b
$ Text -> Char
T.head Text
t)
                    Check Text
s -> Text -> Token -> [Token]
tokenize (Text -> Text
T.tail Text
t) (Text -> Token
Check forall a b. (a -> b) -> a -> b
$ Text
s forall a. Semigroup a => a -> a -> a
<> (Char -> Text
T.singleton forall a b. (a -> b) -> a -> b
$ Text -> Char
T.head Text
t))

    in forall n. [Widget n] -> Widget n
vBox forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
handleLine forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
contents

drawSaveAttachmentWindow :: ChatState
                         -> Lens' ChatState (MessageInterface Name i)
                         -> Widget Name
drawSaveAttachmentWindow :: forall i.
ChatState
-> Lens' ChatState (MessageInterface Name i) -> Widget Name
drawSaveAttachmentWindow ChatState
st Lens' ChatState (MessageInterface Name i)
which =
    forall n. Widget n -> Widget n
center forall a b. (a -> b) -> a -> b
$
    forall n. Int -> Widget n -> Widget n
padAll Int
2 forall a b. (a -> b) -> a -> b
$
    forall n. Widget n -> Widget n -> Widget n
borderWithLabel (forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
clientEmphAttr forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt Text
"Save Attachment") forall a b. (a -> b) -> a -> b
$
    forall n. [Widget n] -> Widget n
vBox [ forall n. Int -> Widget n -> Widget n
padAll Int
1 forall a b. (a -> b) -> a -> b
$
           forall n. Text -> Widget n
txt Text
"Path: " forall n. Widget n -> Widget n -> Widget n
<+>
           (forall n. Int -> Widget n -> Widget n
vLimit Int
editorHeight forall a b. (a -> b) -> a -> b
$
            forall n a b.
(Eq n, Named a n) =>
FocusRing n -> (Bool -> a -> b) -> a -> b
withFocusRing FocusRing Name
foc (forall n t.
(Ord n, Show n, Monoid t, TextWidth t, GenericTextZipper t) =>
([t] -> Widget n) -> Bool -> Editor t n -> Widget n
renderEditor forall {n}. [Text] -> Widget n
drawEditorTxt) Editor Text Name
ed)
         , forall n. [Widget n] -> Widget n
hBox [ forall n. Padding -> Widget n -> Widget n
padRight Padding
Max forall a b. (a -> b) -> a -> b
$
                  forall n. Padding -> Widget n -> Widget n
padLeft (Int -> Padding
Pad Int
1) forall a b. (a -> b) -> a -> b
$
                  forall n. (Eq n, Ord n) => FocusRing n -> n -> Text -> Widget n
drawButton FocusRing Name
foc (Name -> Name
AttachmentPathSaveButton Name
listName) Text
"Save"
                , forall n. Padding -> Widget n -> Widget n
padRight (Int -> Padding
Pad Int
1) forall a b. (a -> b) -> a -> b
$
                  forall n. (Eq n, Ord n) => FocusRing n -> n -> Text -> Widget n
drawButton FocusRing Name
foc (Name -> Name
AttachmentPathCancelButton Name
listName) Text
"Cancel"
                ]
         ]
    where
        editorHeight :: Int
editorHeight = Int
1
        listName :: Name
listName = forall a n. Named a n => a -> n
getName forall a b. (a -> b) -> a -> b
$ ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState (MessageInterface Name i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) (URLList n)
miUrlListforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n1 n2.
Lens
  (URLList n1)
  (URLList n2)
  (List n1 (Int, LinkChoice))
  (List n2 (Int, LinkChoice))
ulList
        foc :: FocusRing Name
foc = ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState (MessageInterface Name i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i.
Lens' (MessageInterface n i) (SaveAttachmentDialogState n)
miSaveAttachmentDialogforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (SaveAttachmentDialogState n) (FocusRing n)
attachmentPathDialogFocus
        ed :: Editor Text Name
ed = ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState (MessageInterface Name i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i.
Lens' (MessageInterface n i) (SaveAttachmentDialogState n)
miSaveAttachmentDialogforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (SaveAttachmentDialogState n) (Editor Text n)
attachmentPathEditor
        drawEditorTxt :: [Text] -> Widget n
drawEditorTxt = forall n. Text -> Widget n
txt forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines

drawUrlSelectWindow :: ChatState -> HighlightSet -> Lens' ChatState (MessageInterface Name i) -> Widget Name
drawUrlSelectWindow :: forall i.
ChatState
-> HighlightSet
-> Lens' ChatState (MessageInterface Name i)
-> Widget Name
drawUrlSelectWindow ChatState
st HighlightSet
hs Lens' ChatState (MessageInterface Name i)
which =
    forall n. [Widget n] -> Widget n
vBox [ forall i.
ChatState
-> HighlightSet
-> Lens' ChatState (MessageInterface Name i)
-> Widget Name
renderUrlList ChatState
st HighlightSet
hs Lens' ChatState (MessageInterface Name i)
which
         , forall i.
ChatState
-> Lens' ChatState (MessageInterface Name i) -> Widget Name
urlSelectBottomBar ChatState
st Lens' ChatState (MessageInterface Name i)
which
         , forall i.
ChatState
-> Lens' ChatState (MessageInterface Name i) -> Widget Name
urlSelectInputArea ChatState
st Lens' ChatState (MessageInterface Name i)
which
         ]

renderUrlList :: ChatState -> HighlightSet -> Lens' ChatState (MessageInterface Name i) -> Widget Name
renderUrlList :: forall i.
ChatState
-> HighlightSet
-> Lens' ChatState (MessageInterface Name i)
-> Widget Name
renderUrlList ChatState
st HighlightSet
hs Lens' ChatState (MessageInterface Name i)
which =
    Widget Name
urlDisplay
    where
        urlDisplay :: Widget Name
urlDisplay = if forall (t :: * -> *) a. Foldable t => t a -> Int
F.length List Name (Int, LinkChoice)
urls forall a. Eq a => a -> a -> Bool
== Int
0
                     then forall n. String -> Widget n
str String
"No links found." forall n. Widget n -> Widget n -> Widget n
<=> forall n. Char -> Widget n
fill Char
' '
                     else forall (t :: * -> *) n e.
(Traversable t, Splittable t, Ord n, Show n) =>
(Bool -> e -> Widget n) -> Bool -> GenericList n t e -> Widget n
renderList Bool -> (Int, LinkChoice) -> Widget Name
renderItem Bool
True List Name (Int, LinkChoice)
urls

        urls :: List Name (Int, LinkChoice)
urls = ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState (MessageInterface Name i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) (URLList n)
miUrlListforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n1 n2.
Lens
  (URLList n1)
  (URLList n2)
  (List n1 (Int, LinkChoice))
  (List n2 (Int, LinkChoice))
ulList

        me :: Text
me = ChatState -> Text
myUsername ChatState
st

        renderItem :: Bool -> (Int, LinkChoice) -> Widget Name
renderItem Bool
sel (Int
i, LinkChoice
link) =
          let time :: ServerTime
time = LinkChoice
linkforall s a. s -> Getting a s a -> a
^.Lens' LinkChoice ServerTime
linkTime
          in forall {n}. Bool -> Widget n -> Widget n
attr Bool
sel forall a b. (a -> b) -> a -> b
$ forall n. Int -> Widget n -> Widget n
vLimit Int
2 forall a b. (a -> b) -> a -> b
$
            (forall n. Int -> Widget n -> Widget n
vLimit Int
1 forall a b. (a -> b) -> a -> b
$
             forall n. [Widget n] -> Widget n
hBox [ let u :: Text
u = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"<server>" forall a. a -> a
id (LinkChoice
linkforall s a. s -> Getting a s a -> a
^.Lens' LinkChoice UserRef
linkUserforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to (ChatState -> UserRef -> Maybe Text
printableNameForUserRef ChatState
st))
                    in forall a. Text -> Text -> Text -> Widget a
colorUsername Text
me Text
u Text
u
                  , case LinkChoice
linkforall s a. s -> Getting a s a -> a
^.Lens' LinkChoice (Maybe Inlines)
linkLabel of
                      Maybe Inlines
Nothing -> forall {n}. Widget n
emptyWidget
                      Just Inlines
label ->
                          case forall a. Seq a -> Bool
Seq.null (Inlines -> Seq Inline
unInlines Inlines
label) of
                              Bool
True -> forall {n}. Widget n
emptyWidget
                              Bool
False -> forall n. Text -> Widget n
txt Text
": " forall n. Widget n -> Widget n -> Widget n
<+> forall a.
SemEq a =>
Text
-> HighlightSet
-> Maybe Int
-> Bool
-> Maybe Int
-> Maybe (Int -> Inline -> Maybe a)
-> Blocks
-> Widget a
renderRichText Text
me HighlightSet
hs forall a. Maybe a
Nothing Bool
False forall a. Maybe a
Nothing forall a. Maybe a
Nothing
                                                    (Seq Block -> Blocks
Blocks forall a b. (a -> b) -> a -> b
$ forall a. a -> Seq a
Seq.singleton forall a b. (a -> b) -> a -> b
$ Inlines -> Block
Para Inlines
label)
                  , forall n. Char -> Widget n
fill Char
' '
                  , ChatState -> UTCTime -> Widget Name
renderDate ChatState
st forall a b. (a -> b) -> a -> b
$ ServerTime -> UTCTime
withServerTime ServerTime
time
                  , forall n. String -> Widget n
str String
" "
                  , ChatState -> UTCTime -> Widget Name
renderTime ChatState
st forall a b. (a -> b) -> a -> b
$ ServerTime -> UTCTime
withServerTime ServerTime
time
                  ] ) forall n. Widget n -> Widget n -> Widget n
<=>
            (forall n. Int -> Widget n -> Widget n
vLimit Int
1 (forall n. Ord n => n -> Widget n -> Widget n
clickable (Int -> LinkTarget -> Name
ClickableURLListEntry Int
i (LinkChoice
linkforall s a. s -> Getting a s a -> a
^.Lens' LinkChoice LinkTarget
linkTarget)) forall a b. (a -> b) -> a -> b
$ forall {a}. SemEq a => LinkTarget -> Widget a
renderLinkTarget (LinkChoice
linkforall s a. s -> Getting a s a -> a
^.Lens' LinkChoice LinkTarget
linkTarget)))

        renderLinkTarget :: LinkTarget -> Widget a
renderLinkTarget (LinkPermalink (TeamURLName Text
tName) PostId
pId) =
            forall a. SemEq a => Text -> Widget a
renderText forall a b. (a -> b) -> a -> b
$ Text
"Team: " forall a. Semigroup a => a -> a -> a
<> Text
tName forall a. Semigroup a => a -> a -> a
<> Text
", post " forall a. Semigroup a => a -> a -> a
<> forall x. IsId x => x -> Text
idString PostId
pId
        renderLinkTarget (LinkURL URL
url) = forall a. SemEq a => Text -> Widget a
renderText forall a b. (a -> b) -> a -> b
$ URL -> Text
unURL URL
url
        renderLinkTarget (LinkFileId FileId
_) = forall n. Text -> Widget n
txt Text
" "

        attr :: Bool -> Widget n -> Widget n
attr Bool
True = forall n. AttrName -> Widget n -> Widget n
forceAttr AttrName
urlListSelectedAttr
        attr Bool
False = forall a. a -> a
id

urlSelectBottomBar :: ChatState -> Lens' ChatState (MessageInterface Name i) -> Widget Name
urlSelectBottomBar :: forall i.
ChatState
-> Lens' ChatState (MessageInterface Name i) -> Widget Name
urlSelectBottomBar ChatState
st Lens' ChatState (MessageInterface Name i)
which =
    case forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement forall a b. (a -> b) -> a -> b
$ ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState (MessageInterface Name i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) (URLList n)
miUrlListforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n1 n2.
Lens
  (URLList n1)
  (URLList n2)
  (List n1 (Int, LinkChoice))
  (List n2 (Int, LinkChoice))
ulList of
        Maybe (Int, (Int, LinkChoice))
Nothing -> forall {n}. Widget n
hBorder
        Just (Int
_, (Int
_, LinkChoice
link)) ->
            let options :: [(LinkChoice -> Bool, Text, Text)]
options = [ ( LinkChoice -> Bool
isFile
                            , KeyEvent -> Text
ev KeyEvent
SaveAttachmentEvent
                            , Text
"save attachment"
                            )
                          ]
                ev :: KeyEvent -> Text
ev = ChatState
-> (KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH)
-> KeyEvent
-> Text
keyEventBindings ChatState
st (forall i.
Lens' ChatState (MessageInterface Name i)
-> KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH
urlSelectKeybindings Lens' ChatState (MessageInterface Name i)
which)
                isFile :: LinkChoice -> Bool
isFile LinkChoice
entry = case LinkChoice
entryforall s a. s -> Getting a s a -> a
^.Lens' LinkChoice LinkTarget
linkTarget of
                    LinkFileId {} -> Bool
True
                    LinkTarget
_ -> Bool
False
                optionList :: Widget n
optionList = forall n. [Widget n] -> Widget n
hBox forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a]
intersperse (forall n. Text -> Widget n
txt Text
" ") forall {n}. [Widget n]
usableOptions
                usableOptions :: [Widget n]
usableOptions = forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$ forall {n}. (LinkChoice -> Bool, Text, Text) -> Maybe (Widget n)
mkOption forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(LinkChoice -> Bool, Text, Text)]
options
                mkOption :: (LinkChoice -> Bool, Text, Text) -> Maybe (Widget n)
mkOption (LinkChoice -> Bool
f, Text
k, Text
desc) = if LinkChoice -> Bool
f LinkChoice
link
                                        then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
urlSelectStatusAttr (forall n. Text -> Widget n
txt Text
k) forall n. Widget n -> Widget n -> Widget n
<+>
                                                    forall n. Text -> Widget n
txt (Text
":" forall a. Semigroup a => a -> a -> a
<> Text
desc)
                                        else forall a. Maybe a
Nothing
            in if forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall {n}. [Widget n]
usableOptions
               then forall {n}. Widget n
hBorder
               else forall n. [Widget n] -> Widget n
hBox [ forall n. Int -> Widget n -> Widget n
hLimit Int
1 forall {n}. Widget n
hBorder
                         , forall n. Text -> Widget n
txt Text
"["
                         , forall n. Text -> Widget n
txt Text
"Options: "
                         , forall {n}. Widget n
optionList
                         , forall n. Text -> Widget n
txt Text
"]"
                         , forall {n}. Widget n
hBorder
                         ]

urlSelectInputArea :: ChatState -> Lens' ChatState (MessageInterface Name i) -> Widget Name
urlSelectInputArea :: forall i.
ChatState
-> Lens' ChatState (MessageInterface Name i) -> Widget Name
urlSelectInputArea ChatState
st Lens' ChatState (MessageInterface Name i)
which =
    let getBinding :: KeyEvent -> Text
getBinding = ChatState
-> (KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH)
-> KeyEvent
-> Text
keyEventBindings ChatState
st (forall i.
Lens' ChatState (MessageInterface Name i)
-> KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH
urlSelectKeybindings Lens' ChatState (MessageInterface Name i)
which)
    in forall n. Widget n -> Widget n
hCenter forall a b. (a -> b) -> a -> b
$ forall n. [Widget n] -> Widget n
hBox [ forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
clientEmphAttr forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt Text
"Enter"
                      , forall n. Text -> Widget n
txt Text
":open  "
                      , forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
clientEmphAttr forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt forall a b. (a -> b) -> a -> b
$ KeyEvent -> Text
getBinding KeyEvent
CancelEvent
                      , forall n. Text -> Widget n
txt Text
":close"
                      ]