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

import           Prelude ()
import           Matterhorn.Prelude

import           Brick
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.Keybindings
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.KeyEvents
import           Matterhorn.Types.RichText


drawMessageInterface :: ChatState
                     -> HighlightSet
                     -> TeamId
                     -> Bool
                     -> Lens' ChatState (MessageInterface Name i)
                     -> Bool
                     -> Bool
                     -> Widget Name
drawMessageInterface :: 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
stChatState
-> Getting MessageInterfaceMode ChatState MessageInterfaceMode
-> MessageInterfaceMode
forall s a. s -> Getting a s a -> a
^.(MessageInterface Name i
 -> Const MessageInterfaceMode (MessageInterface Name i))
-> ChatState -> Const MessageInterfaceMode ChatState
Lens' ChatState (MessageInterface Name i)
which((MessageInterface Name i
  -> Const MessageInterfaceMode (MessageInterface Name i))
 -> ChatState -> Const MessageInterfaceMode ChatState)
-> ((MessageInterfaceMode
     -> Const MessageInterfaceMode MessageInterfaceMode)
    -> MessageInterface Name i
    -> Const MessageInterfaceMode (MessageInterface Name i))
-> Getting MessageInterfaceMode ChatState MessageInterfaceMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MessageInterfaceMode
 -> Const MessageInterfaceMode MessageInterfaceMode)
-> MessageInterface Name i
-> Const MessageInterfaceMode (MessageInterface Name i)
forall n i. Lens' (MessageInterface n i) MessageInterfaceMode
miMode MessageInterfaceMode -> MessageInterfaceMode -> Bool
forall a. Eq a => a -> a -> Bool
== MessageInterfaceMode
MessageSelect
    eName :: Name
eName = Editor Text Name -> Name
forall a n. Named a n => a -> n
getName (Editor Text Name -> Name) -> Editor Text Name -> Name
forall a b. (a -> b) -> a -> b
$ ChatState
stChatState
-> Getting (Editor Text Name) ChatState (Editor Text Name)
-> Editor Text Name
forall s a. s -> Getting a s a -> a
^.(MessageInterface Name i
 -> Const (Editor Text Name) (MessageInterface Name i))
-> ChatState -> Const (Editor Text Name) ChatState
Lens' ChatState (MessageInterface Name i)
which((MessageInterface Name i
  -> Const (Editor Text Name) (MessageInterface Name i))
 -> ChatState -> Const (Editor Text Name) ChatState)
-> ((Editor Text Name
     -> Const (Editor Text Name) (Editor Text Name))
    -> MessageInterface Name i
    -> Const (Editor Text Name) (MessageInterface Name i))
-> Getting (Editor Text Name) ChatState (Editor Text Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EditState Name -> Const (Editor Text Name) (EditState Name))
-> MessageInterface Name i
-> Const (Editor Text Name) (MessageInterface Name i)
forall n i. Lens' (MessageInterface n i) (EditState n)
miEditor((EditState Name -> Const (Editor Text Name) (EditState Name))
 -> MessageInterface Name i
 -> Const (Editor Text Name) (MessageInterface Name i))
-> ((Editor Text Name
     -> Const (Editor Text Name) (Editor Text Name))
    -> EditState Name -> Const (Editor Text Name) (EditState Name))
-> (Editor Text Name
    -> Const (Editor Text Name) (Editor Text Name))
-> MessageInterface Name i
-> Const (Editor Text Name) (MessageInterface Name i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Editor Text Name -> Const (Editor Text Name) (Editor Text Name))
-> EditState Name -> Const (Editor Text Name) (EditState Name)
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
stChatState
-> Getting MessageInterfaceMode ChatState MessageInterfaceMode
-> MessageInterfaceMode
forall s a. s -> Getting a s a -> a
^.(MessageInterface Name i
 -> Const MessageInterfaceMode (MessageInterface Name i))
-> ChatState -> Const MessageInterfaceMode ChatState
Lens' ChatState (MessageInterface Name i)
which((MessageInterface Name i
  -> Const MessageInterfaceMode (MessageInterface Name i))
 -> ChatState -> Const MessageInterfaceMode ChatState)
-> ((MessageInterfaceMode
     -> Const MessageInterfaceMode MessageInterfaceMode)
    -> MessageInterface Name i
    -> Const MessageInterfaceMode (MessageInterface Name i))
-> Getting MessageInterfaceMode ChatState MessageInterfaceMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MessageInterfaceMode
 -> Const MessageInterfaceMode MessageInterfaceMode)
-> MessageInterface Name i
-> Const MessageInterfaceMode (MessageInterface Name i)
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       -> ChatState
-> HighlightSet
-> Lens' ChatState (MessageInterface Name i)
-> Widget Name
forall i.
ChatState
-> HighlightSet
-> Lens' ChatState (MessageInterface Name i)
-> Widget Name
drawUrlSelectWindow ChatState
st HighlightSet
hs Lens' ChatState (MessageInterface Name i)
which
            SaveAttachment {} -> ChatState
-> Lens' ChatState (MessageInterface Name i) -> Widget Name
forall i.
ChatState
-> Lens' ChatState (MessageInterface Name i) -> Widget Name
drawSaveAttachmentWindow ChatState
st Lens' ChatState (MessageInterface Name i)
which
            MessageInterfaceMode
ManageAttachments -> ChatState
-> Lens' ChatState (MessageInterface Name i) -> Widget Name
forall i.
ChatState
-> Lens' ChatState (MessageInterface Name i) -> Widget Name
drawAttachmentList ChatState
st Lens' ChatState (MessageInterface Name i)
which
            MessageInterfaceMode
BrowseFiles       -> ChatState
-> Lens' ChatState (MessageInterface Name i) -> Widget Name
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 =
        [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
vBox [ Widget Name -> Widget Name
forall n. Widget n -> Widget n
freezeBorders (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
               ChatState
-> Bool
-> Bool
-> TeamId
-> HighlightSet
-> Lens' ChatState (MessageInterface Name i)
-> Bool
-> Name
-> Widget Name
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 ((MessageInterface Name i -> Const r (MessageInterface Name i))
-> ChatState -> Const r ChatState
Lens' ChatState (MessageInterface Name i)
which((MessageInterface Name i -> Const r (MessageInterface Name i))
 -> ChatState -> Const r ChatState)
-> ((EditState Name -> Const r (EditState Name))
    -> MessageInterface Name i -> Const r (MessageInterface Name i))
-> (EditState Name -> Const r (EditState Name))
-> ChatState
-> Const r ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EditState Name -> Const r (EditState Name))
-> MessageInterface Name i -> Const r (MessageInterface Name i)
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 ((MessageInterface Name i -> f (MessageInterface Name i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface Name i)
which((MessageInterface Name i -> f (MessageInterface Name i))
 -> ChatState -> f ChatState)
-> ((EditState Name -> f (EditState Name))
    -> MessageInterface Name i -> f (MessageInterface Name i))
-> (EditState Name -> f (EditState Name))
-> ChatState
-> f ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EditState Name -> f (EditState Name))
-> MessageInterface Name i -> f (MessageInterface Name i)
forall n i. Lens' (MessageInterface n i) (EditState n)
miEditor) Bool
focused HighlightSet
hs
             ]

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

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

    showTypingUsers :: Widget Name
showTypingUsers =
        let format :: Text -> Widget Name
format = 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 Maybe (Int -> Inline -> Maybe Name)
forall a. Maybe a
Nothing
        in case TypingUsers -> [UserId]
allTypingUsers (ChatState
stChatState
-> Getting TypingUsers ChatState TypingUsers -> TypingUsers
forall s a. s -> Getting a s a -> a
^.(MessageInterface Name i
 -> Const TypingUsers (MessageInterface Name i))
-> ChatState -> Const TypingUsers ChatState
Lens' ChatState (MessageInterface Name i)
which((MessageInterface Name i
  -> Const TypingUsers (MessageInterface Name i))
 -> ChatState -> Const TypingUsers ChatState)
-> ((TypingUsers -> Const TypingUsers TypingUsers)
    -> MessageInterface Name i
    -> Const TypingUsers (MessageInterface Name i))
-> Getting TypingUsers ChatState TypingUsers
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EditState Name -> Const TypingUsers (EditState Name))
-> MessageInterface Name i
-> Const TypingUsers (MessageInterface Name i)
forall n i. Lens' (MessageInterface n i) (EditState n)
miEditor((EditState Name -> Const TypingUsers (EditState Name))
 -> MessageInterface Name i
 -> Const TypingUsers (MessageInterface Name i))
-> ((TypingUsers -> Const TypingUsers TypingUsers)
    -> EditState Name -> Const TypingUsers (EditState Name))
-> (TypingUsers -> Const TypingUsers TypingUsers)
-> MessageInterface Name i
-> Const TypingUsers (MessageInterface Name i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EphemeralEditState -> Const TypingUsers EphemeralEditState)
-> EditState Name -> Const TypingUsers (EditState Name)
forall n. Lens' (EditState n) EphemeralEditState
esEphemeral((EphemeralEditState -> Const TypingUsers EphemeralEditState)
 -> EditState Name -> Const TypingUsers (EditState Name))
-> ((TypingUsers -> Const TypingUsers TypingUsers)
    -> EphemeralEditState -> Const TypingUsers EphemeralEditState)
-> (TypingUsers -> Const TypingUsers TypingUsers)
-> EditState Name
-> Const TypingUsers (EditState Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(TypingUsers -> Const TypingUsers TypingUsers)
-> EphemeralEditState -> Const TypingUsers EphemeralEditState
Lens' EphemeralEditState TypingUsers
eesTypingUsers) of
            [] -> Widget Name
forall n. Widget n
emptyWidget
            [UserId
uId] | Just Text
un <- UserId -> ChatState -> Maybe Text
usernameForUserId UserId
uId ChatState
st ->
               Text -> Widget Name
format (Text -> Widget Name) -> Text -> Widget Name
forall a b. (a -> b) -> a -> b
$ Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
addUserSigil Text
un Text -> Text -> Text
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 (Text -> Widget Name) -> Text -> Widget Name
forall a b. (a -> b) -> a -> b
$ Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
addUserSigil Text
un1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" and " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
addUserSigil Text
un2 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" are typing]"
            [UserId]
_ -> Text -> Widget Name
format Text
"[several people are typing]"

    kc :: KeyConfig
kc = ChatState
stChatState -> Getting KeyConfig ChatState KeyConfig -> KeyConfig
forall s a. s -> Getting a s a -> a
^.(ChatResources -> Const KeyConfig ChatResources)
-> ChatState -> Const KeyConfig ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Const KeyConfig ChatResources)
 -> ChatState -> Const KeyConfig ChatState)
-> ((KeyConfig -> Const KeyConfig KeyConfig)
    -> ChatResources -> Const KeyConfig ChatResources)
-> Getting KeyConfig ChatState KeyConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Config -> Const KeyConfig Config)
-> ChatResources -> Const KeyConfig ChatResources
Lens' ChatResources Config
crConfiguration((Config -> Const KeyConfig Config)
 -> ChatResources -> Const KeyConfig ChatResources)
-> ((KeyConfig -> Const KeyConfig KeyConfig)
    -> Config -> Const KeyConfig Config)
-> (KeyConfig -> Const KeyConfig KeyConfig)
-> ChatResources
-> Const KeyConfig ChatResources
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(KeyConfig -> Const KeyConfig KeyConfig)
-> Config -> Const KeyConfig Config
Lens' Config KeyConfig
configUserKeysL
    showAttachmentCount :: Widget n
showAttachmentCount =
        let count :: Int
count = Vector AttachmentData -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Vector AttachmentData -> Int) -> Vector AttachmentData -> Int
forall a b. (a -> b) -> a -> b
$ GenericList Name Vector AttachmentData -> Vector AttachmentData
forall n (t :: * -> *) e. GenericList n t e -> t e
listElements (GenericList Name Vector AttachmentData -> Vector AttachmentData)
-> GenericList Name Vector AttachmentData -> Vector AttachmentData
forall a b. (a -> b) -> a -> b
$ ChatState
stChatState
-> Getting
     (GenericList Name Vector AttachmentData)
     ChatState
     (GenericList Name Vector AttachmentData)
-> GenericList Name Vector AttachmentData
forall s a. s -> Getting a s a -> a
^.(MessageInterface Name i
 -> Const
      (GenericList Name Vector AttachmentData) (MessageInterface Name i))
-> ChatState
-> Const (GenericList Name Vector AttachmentData) ChatState
Lens' ChatState (MessageInterface Name i)
which((MessageInterface Name i
  -> Const
       (GenericList Name Vector AttachmentData) (MessageInterface Name i))
 -> ChatState
 -> Const (GenericList Name Vector AttachmentData) ChatState)
-> ((GenericList Name Vector AttachmentData
     -> Const
          (GenericList Name Vector AttachmentData)
          (GenericList Name Vector AttachmentData))
    -> MessageInterface Name i
    -> Const
         (GenericList Name Vector AttachmentData) (MessageInterface Name i))
-> Getting
     (GenericList Name Vector AttachmentData)
     ChatState
     (GenericList Name Vector AttachmentData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EditState Name
 -> Const (GenericList Name Vector AttachmentData) (EditState Name))
-> MessageInterface Name i
-> Const
     (GenericList Name Vector AttachmentData) (MessageInterface Name i)
forall n i. Lens' (MessageInterface n i) (EditState n)
miEditor((EditState Name
  -> Const (GenericList Name Vector AttachmentData) (EditState Name))
 -> MessageInterface Name i
 -> Const
      (GenericList Name Vector AttachmentData) (MessageInterface Name i))
-> ((GenericList Name Vector AttachmentData
     -> Const
          (GenericList Name Vector AttachmentData)
          (GenericList Name Vector AttachmentData))
    -> EditState Name
    -> Const (GenericList Name Vector AttachmentData) (EditState Name))
-> (GenericList Name Vector AttachmentData
    -> Const
         (GenericList Name Vector AttachmentData)
         (GenericList Name Vector AttachmentData))
-> MessageInterface Name i
-> Const
     (GenericList Name Vector AttachmentData) (MessageInterface Name i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(GenericList Name Vector AttachmentData
 -> Const
      (GenericList Name Vector AttachmentData)
      (GenericList Name Vector AttachmentData))
-> EditState Name
-> Const (GenericList Name Vector AttachmentData) (EditState Name)
forall n. Lens' (EditState n) (List n AttachmentData)
esAttachmentList
        in if Int
count Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
           then Widget n
forall n. Widget n
emptyWidget
           else [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
hBox [ Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
hLimit Int
1 Widget n
forall n. Widget n
hBorder
                     , AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
clientMessageAttr (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
<> (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
count) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" attachment" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                             (if Int
count Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then Text
"" else Text
"s") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"; "
                     , AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
clientEmphAttr (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
$ Binding -> Text
ppBinding (KeyConfig -> KeyEvent -> Binding
firstActiveBinding KeyConfig
kc KeyEvent
ShowAttachmentListEvent)
                     , Text -> Widget n
forall n. Text -> Widget n
txt Text
" to manage)"
                     ]

messageSelectBottomBar :: ChatState
                       -> TeamId
                       -> Lens' ChatState (MessageInterface Name i)
                       -> Widget Name
messageSelectBottomBar :: ChatState
-> TeamId
-> Lens' ChatState (MessageInterface Name i)
-> Widget Name
messageSelectBottomBar ChatState
st TeamId
tId Lens' ChatState (MessageInterface Name i)
which =
    case Lens' ChatState (MessageInterface Name i)
-> ChatState -> Maybe Message
forall n i.
Lens' ChatState (MessageInterface n i)
-> ChatState -> Maybe Message
getSelectedMessage Lens' ChatState (MessageInterface Name i)
which ChatState
st of
        Maybe Message
Nothing -> Widget Name
forall n. Widget n
emptyWidget
        Just Message
postMsg ->
            let optionList :: Widget n
optionList = if [Widget Any] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Widget Any]
forall n. [Widget n]
usableOptions
                             then Text -> Widget n
forall n. Text -> Widget n
txt Text
"(no actions available for this message)"
                             else [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
hBox ([Widget n] -> Widget n) -> [Widget n] -> Widget n
forall a b. (a -> b) -> a -> b
$ Widget n -> [Widget n] -> [Widget n]
forall a. a -> [a] -> [a]
intersperse (Text -> Widget n
forall n. Text -> Widget n
txt Text
" ") [Widget n]
forall n. [Widget n]
usableOptions
                usableOptions :: [Widget n]
usableOptions = [Maybe (Widget n)] -> [Widget n]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Widget n)] -> [Widget n])
-> [Maybe (Widget n)] -> [Widget n]
forall a b. (a -> b) -> a -> b
$ (Message -> Bool, Text, Text) -> Maybe (Widget n)
forall n. (Message -> Bool, Text, Text) -> Maybe (Widget n)
mkOption ((Message -> Bool, Text, Text) -> Maybe (Widget n))
-> [(Message -> Bool, Text, Text)] -> [Maybe (Widget n)]
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 Widget n -> Maybe (Widget n)
forall a. a -> Maybe a
Just (Widget n -> Maybe (Widget n)) -> Widget n -> Maybe (Widget n)
forall a b. (a -> b) -> a -> b
$ AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
messageSelectStatusAttr (Text -> Widget n
forall n. Text -> Widget n
txt Text
k) Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+>
                                                    Text -> Widget n
forall n. Text -> Widget n
txt (Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
desc)
                                        else Maybe (Widget n)
forall a. Maybe a
Nothing
                numURLs :: Int
numURLs = Seq LinkChoice -> Int
forall a. Seq a -> Int
Seq.length (Seq LinkChoice -> Int) -> Seq LinkChoice -> Int
forall a b. (a -> b) -> a -> b
$ Message -> Seq LinkChoice
msgURLs Message
postMsg
                s :: Text
s = if Int
numURLs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then Text
"" else Text
"s"
                hasURLs :: Bool
hasURLs = Int
numURLs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
                openUrlsMsg :: Text
openUrlsMsg = Text
"open " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
numURLs) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" URL" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s
                hasVerb :: Bool
hasVerb = Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust (Blocks -> Maybe Text
findVerbatimChunk (Message
postMsgMessage -> Getting Blocks Message Blocks -> Blocks
forall s a. s -> Getting a s a -> a
^.Getting Blocks Message Blocks
Lens' Message Blocks
mText))
                ev :: KeyEvent -> Text
ev = ChatState -> (KeyConfig -> KeyHandlerMap) -> KeyEvent -> Text
keyEventBindings ChatState
st (TeamId
-> Lens' ChatState (MessageInterface Name i)
-> KeyConfig
-> KeyHandlerMap
forall n i.
TeamId
-> Lens' ChatState (MessageInterface n i)
-> KeyConfig
-> KeyHandlerMap
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 (Bool -> Bool) -> (Message -> Bool) -> Message -> Bool
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
mMessage -> Getting Bool Message Bool -> Bool
forall s a. s -> Getting a s a -> a
^.Getting Bool Message Bool
Lens' Message Bool
mFlagged)
                            , KeyEvent -> Text
ev KeyEvent
FlagMessageEvent
                            , Text
"flag"
                            )
                          , ( \Message
m -> Message -> Bool
isFlaggable Message
m Bool -> Bool -> Bool
&& Message
mMessage -> Getting Bool Message Bool -> Bool
forall s a. s -> Getting a s a -> a
^.Getting Bool Message Bool
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
mMessage -> Getting Bool Message Bool -> Bool
forall s a. s -> Getting a s a -> a
^.Getting Bool Message Bool
Lens' Message Bool
mPinned)
                            , KeyEvent -> Text
ev KeyEvent
PinMessageEvent
                            , Text
"pin"
                            )
                          , ( \Message
m -> Message -> Bool
isPinnable Message
m Bool -> Bool -> Bool
&& Message
mMessage -> Getting Bool Message Bool -> Bool
forall s a. s -> Getting a s a -> a
^.Getting Bool Message Bool
Lens' Message Bool
mPinned
                            , KeyEvent -> Text
ev KeyEvent
PinMessageEvent
                            , Text
"unpin"
                            )
                          , ( Message -> Bool
isReplyable
                            , KeyEvent -> Text
ev KeyEvent
ReplyMessageEvent
                            , Text
"reply"
                            )
                          , ( Bool -> Bool
not (Bool -> Bool) -> (Message -> Bool) -> Message -> Bool
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"
                            )
                          , ( Bool -> Message -> Bool
forall a b. a -> b -> a
const Bool
hasURLs
                            , KeyEvent -> Text
ev KeyEvent
OpenMessageURLEvent
                            , Text
openUrlsMsg
                            )
                          , ( Bool -> Message -> Bool
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 [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
hBox [ Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
hLimit Int
1 Widget Name
forall n. Widget n
hBorder
                    , Text -> Widget Name
forall n. Text -> Widget n
txt Text
"["
                    , Widget Name
forall n. Widget n
optionList
                    , Text -> Widget Name
forall n. Text -> Widget n
txt Text
"]"
                    , Widget Name
forall n. Widget n
hBorder
                    ]

renderMessageListing :: ChatState
                     -> Bool
                     -> Bool
                     -> TeamId
                     -> HighlightSet
                     -> Lens' ChatState (MessageInterface Name i)
                     -> Bool
                     -> Name
                     -> Widget Name
renderMessageListing :: 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
stChatState
-> 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)

    messages :: Widget Name
messages = Padding -> Widget Name -> Widget Name
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 -> Char -> Widget Name
forall n. Char -> Widget n
fill Char
' '
            Just ChannelId
cId ->
                if Bool
inMsgSelect
                then Widget Name -> Widget Name
forall n. Widget n -> Widget n
freezeBorders (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
                     ChannelId
-> MessageSelectState
-> DirectionalSeq Chronological Message
-> Widget Name
renderMessagesWithSelect ChannelId
cId (ChatState
stChatState
-> Getting MessageSelectState ChatState MessageSelectState
-> MessageSelectState
forall s a. s -> Getting a s a -> a
^.(MessageInterface Name i
 -> Const MessageSelectState (MessageInterface Name i))
-> ChatState -> Const MessageSelectState ChatState
Lens' ChatState (MessageInterface Name i)
which((MessageInterface Name i
  -> Const MessageSelectState (MessageInterface Name i))
 -> ChatState -> Const MessageSelectState ChatState)
-> ((MessageSelectState
     -> Const MessageSelectState MessageSelectState)
    -> MessageInterface Name i
    -> Const MessageSelectState (MessageInterface Name i))
-> Getting MessageSelectState ChatState MessageSelectState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MessageSelectState -> Const MessageSelectState MessageSelectState)
-> MessageInterface Name i
-> Const MessageSelectState (MessageInterface Name i)
forall n i. Lens' (MessageInterface n i) MessageSelectState
miMessageSelect) (ChannelId -> DirectionalSeq Chronological Message
buildMessages ChannelId
cId)
                else Name -> Widget Name -> Widget Name
forall n. Ord n => n -> Widget n -> Widget n
cached Name
region (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
                     Widget Name -> Widget Name
forall n. Widget n -> Widget n
freezeBorders (Widget Name -> Widget Name) -> Widget Name -> Widget Name
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 (DirectionalSeq Retrograde (Message, ThreadState) -> Widget Name)
-> DirectionalSeq Retrograde (Message, ThreadState) -> Widget Name
forall a b. (a -> b) -> a -> b
$
                     RetrogradeMessages
-> DirectionalSeq Retrograde (Message, ThreadState)
retrogradeMsgsWithThreadStates (RetrogradeMessages
 -> DirectionalSeq Retrograde (Message, ThreadState))
-> RetrogradeMessages
-> DirectionalSeq Retrograde (Message, ThreadState)
forall a b. (a -> b) -> a -> b
$
                     DirectionalSeq Chronological Message -> RetrogradeMessages
reverseMessages (DirectionalSeq Chronological Message -> RetrogradeMessages)
-> DirectionalSeq Chronological Message -> RetrogradeMessages
forall a b. (a -> b) -> a -> b
$
                     ChannelId -> DirectionalSeq Chronological Message
buildMessages ChannelId
cId

    renderMessagesWithSelect :: ChannelId
-> MessageSelectState
-> DirectionalSeq Chronological Message
-> Widget Name
renderMessagesWithSelect ChannelId
cId (MessageSelectState Maybe MessageId
selMsgId) DirectionalSeq Chronological Message
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 Retrograde (Message, ThreadState)
before, DirectionalSeq Chronological (Message, ThreadState)
after)) = ((Message, ThreadState) -> Bool)
-> DirectionalSeq Chronological (Message, ThreadState)
-> (Maybe (Message, ThreadState),
    (DirectionalSeq
       (ReverseDirection Chronological) (Message, ThreadState),
     DirectionalSeq Chronological (Message, ThreadState)))
forall d a.
SeqDirection d =>
(a -> Bool)
-> DirectionalSeq d a
-> (Maybe a,
    (DirectionalSeq (ReverseDirection d) a, DirectionalSeq d a))
splitDirSeqOn (\(Message
m, ThreadState
_) -> 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 Maybe MessageId -> Maybe MessageId -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe MessageId
selMsgId) DirectionalSeq Chronological (Message, ThreadState)
msgsWithStates
            msgsWithStates :: DirectionalSeq Chronological (Message, ThreadState)
msgsWithStates = DirectionalSeq Chronological Message
-> DirectionalSeq Chronological (Message, ThreadState)
chronologicalMsgsWithThreadStates DirectionalSeq Chronological Message
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 ->
                 ((Message, ThreadState),
 (DirectionalSeq Retrograde (Message, ThreadState),
  DirectionalSeq Chronological (Message, ThreadState)))
-> (Message -> ThreadState -> Name -> Widget Name)
-> Name
-> Widget Name
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 Maybe ServerTime
forall a. Maybe a
Nothing) Name
region

    buildMessages :: ChannelId -> DirectionalSeq Chronological Message
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 Maybe NewMessageIndicator
forall a. Maybe a
Nothing
            ms :: DirectionalSeq Chronological Message
ms = ChatState
-> Traversal' ChatState (DirectionalSeq Chronological Message)
-> DirectionalSeq Chronological Message
filterMessageListing ChatState
st ((MessageInterface Name i -> f (MessageInterface Name i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface Name i)
which((MessageInterface Name i -> f (MessageInterface Name i))
 -> ChatState -> f ChatState)
-> ((DirectionalSeq Chronological Message
     -> f (DirectionalSeq Chronological Message))
    -> MessageInterface Name i -> f (MessageInterface Name i))
-> (DirectionalSeq Chronological Message
    -> f (DirectionalSeq Chronological Message))
-> ChatState
-> f ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(DirectionalSeq Chronological Message
 -> f (DirectionalSeq Chronological Message))
-> MessageInterface Name i -> f (MessageInterface Name i)
forall n i.
Lens' (MessageInterface n i) (DirectionalSeq Chronological Message)
miMessages)
        in if DirectionalSeq Chronological Message -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
F.null DirectionalSeq Chronological Message
ms
           then Message
-> DirectionalSeq Chronological Message
-> DirectionalSeq Chronological Message
forall a. MessageOps a => Message -> a -> a
addMessage (ChatState -> ChannelId -> Message
emptyChannelFillerMessage ChatState
st ChannelId
cId) DirectionalSeq Chronological Message
forall dir a. DirectionalSeq dir a
emptyDirSeq
           else DirectionalSeq Chronological Message
-> Maybe NewMessageIndicator
-> Text
-> TimeZoneSeries
-> DirectionalSeq Chronological Message
insertTransitions DirectionalSeq Chronological Message
ms
                                  Maybe NewMessageIndicator
cutoff
                                  (ChatState -> Text
getDateFormat ChatState
st)
                                  (ChatState
st ChatState
-> Getting TimeZoneSeries ChatState TimeZoneSeries
-> TimeZoneSeries
forall s a. s -> Getting a s a -> a
^. Getting TimeZoneSeries ChatState TimeZoneSeries
Lens' ChatState TimeZoneSeries
timeZone)

insertTransitions :: Messages -> Maybe NewMessageIndicator -> Text -> TimeZoneSeries -> Messages
insertTransitions :: DirectionalSeq Chronological Message
-> Maybe NewMessageIndicator
-> Text
-> TimeZoneSeries
-> DirectionalSeq Chronological Message
insertTransitions DirectionalSeq Chronological Message
ms Maybe NewMessageIndicator
cutoff = DirectionalSeq Chronological Message
-> Text -> TimeZoneSeries -> DirectionalSeq Chronological Message
insertDateMarkers (DirectionalSeq Chronological Message
 -> Text -> TimeZoneSeries -> DirectionalSeq Chronological Message)
-> DirectionalSeq Chronological Message
-> Text
-> TimeZoneSeries
-> DirectionalSeq Chronological Message
forall a b. (a -> b) -> a -> b
$ (Message
 -> DirectionalSeq Chronological Message
 -> DirectionalSeq Chronological Message)
-> DirectionalSeq Chronological Message
-> [Message]
-> DirectionalSeq Chronological Message
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Message
-> DirectionalSeq Chronological Message
-> DirectionalSeq Chronological Message
forall a. MessageOps a => Message -> a -> a
addMessage DirectionalSeq Chronological Message
ms [Message]
newMessagesT
    where anyNondeletedNewMessages :: ServerTime -> Bool
anyNondeletedNewMessages ServerTime
t =
              Maybe Message -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Message -> Bool) -> Maybe Message -> Bool
forall a b. (a -> b) -> a -> b
$ (Message -> Bool)
-> DirectionalSeq Chronological Message -> Maybe Message
findLatestUserMessage (Bool -> Bool
not (Bool -> Bool) -> (Message -> Bool) -> Message -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Bool Message Bool -> Message -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool Message Bool
Lens' Message Bool
mDeleted) (ServerTime
-> DirectionalSeq Chronological Message
-> DirectionalSeq Chronological Message
messagesAfter ServerTime
t DirectionalSeq Chronological Message
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 (ServerTime -> Message) -> ServerTime -> Message
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 (ServerTime -> Message) -> ServerTime -> Message
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 (UTCTime -> ServerTime) -> UTCTime -> ServerTime
forall a b. (a -> b) -> a -> b
$ Day -> DiffTime -> UTCTime
UTCTime (Int -> Day
forall a. Enum a => Int -> a
toEnum Int
0) DiffTime
0
        chan :: ClientChannel
chan = Maybe ClientChannel -> ClientChannel
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe ClientChannel -> ClientChannel)
-> Maybe ClientChannel -> ClientChannel
forall a b. (a -> b) -> a -> b
$ ChannelId -> ClientChannels -> Maybe ClientChannel
findChannelById ChannelId
cId (ChatState
stChatState
-> Getting ClientChannels ChatState ClientChannels
-> ClientChannels
forall s a. s -> Getting a s a -> a
^.Getting ClientChannels ChatState ClientChannels
Lens' ChatState ClientChannels
csChannels)
        chanName :: Text
chanName = ChatState -> ChannelInfo -> Text
mkChannelName ChatState
st (ClientChannel
chanClientChannel
-> Getting ChannelInfo ClientChannel ChannelInfo -> ChannelInfo
forall s a. s -> Getting a s a -> a
^.Getting ChannelInfo ClientChannel ChannelInfo
Lens' ClientChannel ChannelInfo
ccInfo)
        msg :: Text
msg = case ClientChannel
chanClientChannel -> Getting Type ClientChannel Type -> Type
forall s a. s -> Getting a s a -> a
^.(ChannelInfo -> Const Type ChannelInfo)
-> ClientChannel -> Const Type ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Const Type ChannelInfo)
 -> ClientChannel -> Const Type ClientChannel)
-> ((Type -> Const Type Type)
    -> ChannelInfo -> Const Type ChannelInfo)
-> Getting Type ClientChannel Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Type -> Const Type Type) -> ChannelInfo -> Const Type ChannelInfo
Lens' ChannelInfo Type
cdType of
            Type
Direct ->
                let u :: Maybe UserInfo
u = ClientChannel
chanClientChannel
-> Getting (Maybe UserId) ClientChannel (Maybe UserId)
-> Maybe UserId
forall s a. s -> Getting a s a -> a
^.(ChannelInfo -> Const (Maybe UserId) ChannelInfo)
-> ClientChannel -> Const (Maybe UserId) ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Const (Maybe UserId) ChannelInfo)
 -> ClientChannel -> Const (Maybe UserId) ClientChannel)
-> ((Maybe UserId -> Const (Maybe UserId) (Maybe UserId))
    -> ChannelInfo -> Const (Maybe UserId) ChannelInfo)
-> Getting (Maybe UserId) ClientChannel (Maybe UserId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe UserId -> Const (Maybe UserId) (Maybe UserId))
-> ChannelInfo -> Const (Maybe UserId) ChannelInfo
Lens' ChannelInfo (Maybe UserId)
cdDMUserId Maybe UserId -> (UserId -> Maybe UserInfo) -> Maybe UserInfo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (UserId -> ChatState -> Maybe UserInfo)
-> ChatState -> UserId -> Maybe UserInfo
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 -> Maybe Text -> Text
forall p. (Semigroup p, IsString p) => Maybe p -> p
userMsg Maybe Text
forall a. Maybe a
Nothing
                    Just UserInfo
_ -> Maybe Text -> Text
forall p. (Semigroup p, IsString p) => Maybe p -> p
userMsg (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
chanName)
            Type
Group ->
                Text -> Text
forall a. (Semigroup a, IsString a) => a -> a
groupMsg (ClientChannel
chanClientChannel -> Getting Text ClientChannel Text -> Text
forall s a. s -> Getting a s a -> a
^.(ChannelInfo -> Const Text ChannelInfo)
-> ClientChannel -> Const Text ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Const Text ChannelInfo)
 -> ClientChannel -> Const Text ClientChannel)
-> ((Text -> Const Text Text)
    -> ChannelInfo -> Const Text ChannelInfo)
-> Getting Text ClientChannel Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Text -> Const Text Text) -> ChannelInfo -> Const Text ChannelInfo
Lens' ChannelInfo Text
cdDisplayName)
            Type
_ ->
                Text -> Text
forall a. (Semigroup a, IsString a) => a -> a
chanMsg Text
chanName
        userMsg :: Maybe p -> p
userMsg (Just p
cn) = p
"You have not yet sent any direct messages to " p -> p -> p
forall a. Semigroup a => a -> a -> a
<> p
cn p -> p -> p
forall a. Semigroup a => a -> a -> a
<> p
"."
        userMsg Maybe p
Nothing   = p
"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 " a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
us a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"."
        chanMsg :: a -> a
chanMsg a
cn = a
"There are not yet any messages in the " a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
cn a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
" channel."

filterMessageListing :: ChatState -> Traversal' ChatState Messages -> Messages
filterMessageListing :: ChatState
-> Traversal' ChatState (DirectionalSeq Chronological Message)
-> DirectionalSeq Chronological Message
filterMessageListing ChatState
st Traversal' ChatState (DirectionalSeq Chronological Message)
msgsWhich =
    ChatState
st ChatState
-> Getting
     (Endo (DirectionalSeq Chronological Message))
     ChatState
     (DirectionalSeq Chronological Message)
-> DirectionalSeq Chronological Message
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Getting
  (Endo (DirectionalSeq Chronological Message))
  ChatState
  (DirectionalSeq Chronological Message)
Traversal' ChatState (DirectionalSeq Chronological Message)
msgsWhich Getting
  (Endo (DirectionalSeq Chronological Message))
  ChatState
  (DirectionalSeq Chronological Message)
-> ((DirectionalSeq Chronological Message
     -> Const
          (Endo (DirectionalSeq Chronological Message))
          (DirectionalSeq Chronological Message))
    -> DirectionalSeq Chronological Message
    -> Const
         (Endo (DirectionalSeq Chronological Message))
         (DirectionalSeq Chronological Message))
-> Getting
     (Endo (DirectionalSeq Chronological Message))
     ChatState
     (DirectionalSeq Chronological Message)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DirectionalSeq Chronological Message
 -> DirectionalSeq Chronological Message)
-> SimpleGetter
     (DirectionalSeq Chronological Message)
     (DirectionalSeq Chronological Message)
forall s a. (s -> a) -> SimpleGetter s a
to ((Message -> Bool)
-> DirectionalSeq Chronological Message
-> DirectionalSeq Chronological Message
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
stChatState -> Getting Bool ChatState Bool -> Bool
forall s a. s -> Getting a s a -> a
^.(ChatResources -> Const Bool ChatResources)
-> ChatState -> Const Bool ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Const Bool ChatResources)
 -> ChatState -> Const Bool ChatState)
-> ((Bool -> Const Bool Bool)
    -> ChatResources -> Const Bool ChatResources)
-> Getting Bool ChatState Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(UserPreferences -> Const Bool UserPreferences)
-> ChatResources -> Const Bool ChatResources
Lens' ChatResources UserPreferences
crUserPreferences((UserPreferences -> Const Bool UserPreferences)
 -> ChatResources -> Const Bool ChatResources)
-> ((Bool -> Const Bool Bool)
    -> UserPreferences -> Const Bool UserPreferences)
-> (Bool -> Const Bool Bool)
-> ChatResources
-> Const Bool ChatResources
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Const Bool Bool)
-> UserPreferences -> Const Bool UserPreferences
Lens' UserPreferences Bool
userPrefShowJoinLeave = Bool
True
            | Bool
otherwise = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
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
stChatState -> Getting Bool ChatState Bool -> Bool
forall s a. s -> Getting a s a -> a
^.(EditState Name -> Const Bool (EditState Name))
-> ChatState -> Const Bool ChatState
Lens' ChatState (EditState Name)
which((EditState Name -> Const Bool (EditState Name))
 -> ChatState -> Const Bool ChatState)
-> ((Bool -> Const Bool Bool)
    -> EditState Name -> Const Bool (EditState Name))
-> Getting Bool ChatState Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Const Bool Bool)
-> EditState Name -> Const Bool (EditState Name)
forall n. Lens' (EditState n) Bool
esShowReplyPrompt
        maybeHighlight :: Widget n -> Widget n
maybeHighlight = if Bool
focused
                         then AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
focusedEditorPromptAttr
                         else Widget n -> Widget n
forall a. a -> a
id
        prompt :: Widget Name
prompt = Widget Name -> Widget Name
forall n. Widget n -> Widget n
maybeHighlight (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
                 Name -> Widget Name -> Widget Name
forall n. Ord n => n -> Widget n -> Widget n
reportExtent (Name -> Name
MessageInputPrompt (Name -> Name) -> Name -> Name
forall a b. (a -> b) -> a -> b
$ Editor Text Name -> Name
forall a n. Named a n => a -> n
getName Editor Text Name
editor) (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
                 Text -> Widget Name
forall n. Text -> Widget n
txt (Text -> Widget Name) -> Text -> Widget Name
forall a b. (a -> b) -> a -> b
$ case ChatState
stChatState -> Getting EditMode ChatState EditMode -> EditMode
forall s a. s -> Getting a s a -> a
^.(EditState Name -> Const EditMode (EditState Name))
-> ChatState -> Const EditMode ChatState
Lens' ChatState (EditState Name)
which((EditState Name -> Const EditMode (EditState Name))
 -> ChatState -> Const EditMode ChatState)
-> ((EditMode -> Const EditMode EditMode)
    -> EditState Name -> Const EditMode (EditState Name))
-> Getting EditMode ChatState EditMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EditMode -> Const EditMode EditMode)
-> EditState Name -> Const EditMode (EditState Name)
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
stChatState
-> Getting (Editor Text Name) ChatState (Editor Text Name)
-> Editor Text Name
forall s a. s -> Getting a s a -> a
^.(EditState Name -> Const (Editor Text Name) (EditState Name))
-> ChatState -> Const (Editor Text Name) ChatState
Lens' ChatState (EditState Name)
which((EditState Name -> Const (Editor Text Name) (EditState Name))
 -> ChatState -> Const (Editor Text Name) ChatState)
-> ((Editor Text Name
     -> Const (Editor Text Name) (Editor Text Name))
    -> EditState Name -> Const (Editor Text Name) (EditState Name))
-> Getting (Editor Text Name) ChatState (Editor Text Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Editor Text Name -> Const (Editor Text Name) (Editor Text Name))
-> EditState Name -> Const (Editor Text Name) (EditState Name)
forall n. Lens' (EditState n) (Editor Text n)
esEditor
        inputBox :: Widget Name
inputBox = ([Text] -> Widget Name) -> Bool -> Editor Text Name -> Widget Name
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 SimpleGetter ChatState (EditState Name)
Lens' ChatState (EditState Name)
which HighlightSet
hs) Bool
True Editor Text Name
editor
        curContents :: [Text]
curContents = Editor Text Name -> [Text]
forall t n. Monoid t => Editor t n -> [t]
getEditContents Editor Text Name
editor
        multilineContent :: Bool
multilineContent = [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
curContents Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
        multilineHints :: Widget n
multilineHints =
            [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
hBox [ Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
hLimit Int
1 Widget n
forall n. Widget n
hBorder
                 , String -> Widget n
forall n. String -> Widget n
str (String -> Widget n) -> String -> Widget n
forall a b. (a -> b) -> a -> b
$ String
"[" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> Int
forall a b. (a, b) -> a
fst ((Int, Int) -> Int) -> (Int, Int) -> Int
forall a b. (a -> b) -> a -> b
$ TextZipper Text -> (Int, Int)
forall a. TextZipper a -> (Int, Int)
cursorPosition (TextZipper Text -> (Int, Int)) -> TextZipper Text -> (Int, Int)
forall a b. (a -> b) -> a -> b
$
                                        Editor Text Name
editorEditor Text Name
-> Getting (TextZipper Text) (Editor Text Name) (TextZipper Text)
-> TextZipper Text
forall s a. s -> Getting a s a -> a
^.Getting (TextZipper Text) (Editor Text Name) (TextZipper Text)
forall t1 n t2.
Lens (Editor t1 n) (Editor t2 n) (TextZipper t1) (TextZipper t2)
editContentsL) String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
                         String
"/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
curContents) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"]"
                 , Widget n -> Widget n
forall n. Widget n -> Widget n
hBorderWithLabel (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
clientEmphAttr (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
"In multi-line mode. Press " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
multiLineToggleKey Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                         Text
" to finish."
                 ]

        replyDisplay :: Widget Name
replyDisplay = case ChatState
stChatState -> Getting EditMode ChatState EditMode -> EditMode
forall s a. s -> Getting a s a -> a
^.(EditState Name -> Const EditMode (EditState Name))
-> ChatState -> Const EditMode ChatState
Lens' ChatState (EditState Name)
which((EditState Name -> Const EditMode (EditState Name))
 -> ChatState -> Const EditMode ChatState)
-> ((EditMode -> Const EditMode EditMode)
    -> EditState Name -> Const EditMode (EditState Name))
-> Getting EditMode ChatState EditMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EditMode -> Const EditMode EditMode)
-> EditState Name -> Const EditMode (EditState Name)
forall n. Lens' (EditState n) EditMode
esEditMode of
            Replying Message
msg Post
_ | Bool
showReplyPrompt ->
                let msgWithoutParent :: Message
msgWithoutParent = Message
msg Message -> (Message -> Message) -> Message
forall a b. a -> (a -> b) -> b
& (ReplyState -> Identity ReplyState) -> Message -> Identity Message
Lens' Message ReplyState
mInReplyToMsg ((ReplyState -> Identity ReplyState)
 -> Message -> Identity Message)
-> ReplyState -> Message -> Message
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ReplyState
NotAReply
                in [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
hBox [ Widget Name
forall n. Widget n
replyArrow
                        , Widget Name -> Widget Name
forall n. Widget n -> Widget n
addEllipsis (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ MessageData -> Widget Name
renderMessage MessageData :: Maybe ServerTime
-> Bool
-> Bool
-> Message
-> Maybe Text
-> Maybe Message
-> Maybe Text
-> ThreadState
-> Bool
-> Bool
-> HighlightSet
-> Bool
-> Maybe Int
-> Maybe Int
-> Text
-> UserId
-> Bool
-> Name
-> MessageData
MessageData
                          { mdMessage :: Message
mdMessage           = Message
msgWithoutParent
                          , mdUserName :: Maybe Text
mdUserName          = Message
msgWithoutParentMessage -> 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
forall a. Maybe a
Nothing
                          , mdParentUserName :: Maybe Text
mdParentUserName    = Maybe Text
forall a. Maybe a
Nothing
                          , mdHighlightSet :: HighlightSet
mdHighlightSet      = HighlightSet
hs
                          , mdEditThreshold :: Maybe ServerTime
mdEditThreshold     = Maybe ServerTime
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 = Maybe Int
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 = Maybe Int
forall a. Maybe a
Nothing
                          , mdClickableNameTag :: Name
mdClickableNameTag  = Editor Text Name -> Name
forall a n. Named a n => a -> n
getName Editor Text Name
editor
                          }
                        ]
            EditMode
_ -> Widget Name
forall n. Widget n
emptyWidget

        kc :: KeyConfig
kc = ChatState
stChatState -> Getting KeyConfig ChatState KeyConfig -> KeyConfig
forall s a. s -> Getting a s a -> a
^.(ChatResources -> Const KeyConfig ChatResources)
-> ChatState -> Const KeyConfig ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Const KeyConfig ChatResources)
 -> ChatState -> Const KeyConfig ChatState)
-> ((KeyConfig -> Const KeyConfig KeyConfig)
    -> ChatResources -> Const KeyConfig ChatResources)
-> Getting KeyConfig ChatState KeyConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Config -> Const KeyConfig Config)
-> ChatResources -> Const KeyConfig ChatResources
Lens' ChatResources Config
crConfiguration((Config -> Const KeyConfig Config)
 -> ChatResources -> Const KeyConfig ChatResources)
-> ((KeyConfig -> Const KeyConfig KeyConfig)
    -> Config -> Const KeyConfig Config)
-> (KeyConfig -> Const KeyConfig KeyConfig)
-> ChatResources
-> Const KeyConfig ChatResources
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(KeyConfig -> Const KeyConfig KeyConfig)
-> Config -> Const KeyConfig Config
Lens' Config KeyConfig
configUserKeysL
        multiLineToggleKey :: Text
multiLineToggleKey = Binding -> Text
ppBinding (Binding -> Text) -> Binding -> Text
forall a b. (a -> b) -> a -> b
$ KeyConfig -> KeyEvent -> Binding
firstActiveBinding KeyConfig
kc KeyEvent
ToggleMultiLineEvent

        commandBox :: Widget Name
commandBox = case ChatState
stChatState -> Getting Bool ChatState Bool -> Bool
forall s a. s -> Getting a s a -> a
^.(EditState Name -> Const Bool (EditState Name))
-> ChatState -> Const Bool ChatState
Lens' ChatState (EditState Name)
which((EditState Name -> Const Bool (EditState Name))
 -> ChatState -> Const Bool ChatState)
-> ((Bool -> Const Bool Bool)
    -> EditState Name -> Const Bool (EditState Name))
-> Getting Bool ChatState Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EphemeralEditState -> Const Bool EphemeralEditState)
-> EditState Name -> Const Bool (EditState Name)
forall n. Lens' (EditState n) EphemeralEditState
esEphemeral((EphemeralEditState -> Const Bool EphemeralEditState)
 -> EditState Name -> Const Bool (EditState Name))
-> ((Bool -> Const Bool Bool)
    -> EphemeralEditState -> Const Bool EphemeralEditState)
-> (Bool -> Const Bool Bool)
-> EditState Name
-> Const Bool (EditState Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Const Bool Bool)
-> EphemeralEditState -> Const Bool EphemeralEditState
Lens' EphemeralEditState Bool
eesMultiline of
            Bool
False ->
                let linesStr :: String
linesStr = String
"line" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> if Int
numLines Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then String
"" else String
"s"
                    numLines :: Int
numLines = [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
curContents
                in Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
vLimit Int
1 (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
hBox ([Widget Name] -> Widget Name) -> [Widget Name] -> Widget Name
forall a b. (a -> b) -> a -> b
$
                   Widget Name
prompt Widget Name -> [Widget Name] -> [Widget Name]
forall a. a -> [a] -> [a]
: if Bool
multilineContent
                            then [ AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
clientEmphAttr (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
                                   String -> Widget Name
forall n. String -> Widget n
str (String -> Widget Name) -> String -> Widget Name
forall a b. (a -> b) -> a -> b
$ String
"[" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
numLines String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
linesStr String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
                                         String
"; Enter: send, " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
multiLineToggleKey String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
                                         String
": edit, Backspace: cancel] "
                                 , Text -> Widget Name
forall n. Text -> Widget n
txt (Text -> Widget Name) -> Text -> Widget Name
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. [a] -> a
head [Text]
curContents
                                 , Name -> Location -> Widget Name -> Widget Name
forall n. n -> Location -> Widget n -> Widget n
showCursor (Editor Text Name -> Name
forall a n. Named a n => a -> n
getName Editor Text Name
editor) ((Int, Int) -> Location
Location (Int
0,Int
0)) (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ String -> Widget Name
forall n. String -> Widget n
str String
" "
                                 ]
                            else [Widget Name
inputBox]
            Bool
True -> Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
vLimit Int
multilineHeightLimit Widget Name
inputBox Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=> Widget Name
forall n. Widget n
multilineHints
    in Widget Name
replyDisplay Widget Name -> Widget Name -> Widget Name
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 = Text -> Widget n
forall n. Text -> Widget n
txt (Text -> Widget n) -> ([Text] -> Text) -> [Text] -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines
        ms :: Set Text
ms = ChatState
stChatState -> Getting (Set Text) ChatState (Set Text) -> Set Text
forall s a. s -> Getting a s a -> a
^.Getting (Set Text) ChatState (EditState Name)
SimpleGetter ChatState (EditState Name)
editWhichGetting (Set Text) ChatState (EditState Name)
-> ((Set Text -> Const (Set Text) (Set Text))
    -> EditState Name -> Const (Set Text) (EditState Name))
-> Getting (Set Text) ChatState (Set Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Set Text -> Const (Set Text) (Set Text))
-> EditState Name -> Const (Set Text) (EditState Name)
forall n. Lens' (EditState n) (Set Text)
esMisspellings
    in case Set Text -> Bool
forall a. Set a -> Bool
S.null Set Text
ms of
        Bool
True -> [Text] -> Widget Name
forall n. [Text] -> Widget n
noHighlight
        Bool
False -> HighlightSet -> Set Text -> [Text] -> Widget Name
doHighlightMisspellings HighlightSet
hs Set Text
ms

replyArrow :: Widget a
replyArrow :: Widget a
replyArrow =
    Size -> Size -> RenderM a (Result a) -> Widget a
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed (RenderM a (Result a) -> Widget a)
-> RenderM a (Result a) -> Widget a
forall a b. (a -> b) -> a -> b
$ do
        Context a
ctx <- RenderM a (Context a)
forall n. RenderM n (Context n)
getContext
        let bs :: BorderStyle
bs = Context a
ctxContext a
-> Getting BorderStyle (Context a) BorderStyle -> BorderStyle
forall s a. s -> Getting a s a -> a
^.Getting BorderStyle (Context a) BorderStyle
forall n. Lens' (Context n) BorderStyle
ctxBorderStyleL
        Widget a -> RenderM a (Result a)
forall n. Widget n -> RenderM n (Result n)
render (Widget a -> RenderM a (Result a))
-> Widget a -> RenderM a (Result a)
forall a b. (a -> b) -> a -> b
$ String -> Widget a
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 -> String -> String
[Token] -> String -> String
Token -> String
(Int -> Token -> String -> String)
-> (Token -> String) -> ([Token] -> String -> String) -> Show Token
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Token] -> String -> String
$cshowList :: [Token] -> String -> String
show :: Token -> String
$cshow :: Token -> String
showsPrec :: Int -> Token -> String -> String
$cshowsPrec :: Int -> Token -> String -> String
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 = Set Text -> Set Text -> Set Text
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 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"" = Text -> Widget n
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 Widget n
forall n. Widget n
emptyWidget
                       else AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
misspellingAttr (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
$ 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 Widget n
forall n. Widget n
emptyWidget
                       else Text -> Widget n
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 (Token -> Either Token Token
forall a b. a -> Either a b
Left (Token -> Either Token Token) -> Token -> Either Token Token
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 (Token -> Either Token Token
forall a b. b -> Either a b
Right (Token -> Either Token Token) -> Token -> Either Token Token
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 Either Token Token -> [Either Token Token] -> [Either Token Token]
forall a. a -> [a] -> [a]
: Either Token Token -> [Either Token Token] -> [Either Token Token]
go Either Token Token
tok [Either Token Token]
toks

            in [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
hBox ([Widget n] -> Widget n) -> [Widget n] -> Widget n
forall a b. (a -> b) -> a -> b
$ Either Token Token -> Widget n
forall n. Either Token Token -> Widget n
mkW (Either Token Token -> Widget n)
-> [Either Token Token] -> [Widget n]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Either Token Token -> [Either Token Token] -> [Either Token Token]
go (Token -> Either Token Token
forall a b. b -> Either a b
Right (Token -> Either Token Token) -> Token -> Either Token Token
forall a b. (a -> b) -> a -> b
$ Text -> Token
Ignore Text
"") ([Either Token Token] -> [Either Token Token])
-> [Either Token Token] -> [Either Token Token]
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 (Text -> Token) -> Text -> Token
forall a b. (a -> b) -> a -> b
$ Text
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
b
        combineTokens (Check Text
a) (Check Text
b) = Text -> Token
Check (Text -> Token) -> Text -> Token
forall a b. (a -> b) -> a -> b
$ Text
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
b
        combineTokens (Ignore Text
a) (Check Text
b) = Text -> Token
Check (Text -> Token) -> Text -> Token
forall a b. (a -> b) -> a -> b
$ Text
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
b
        combineTokens (Check Text
a) (Ignore Text
b) = Text -> Token
Check (Text -> Token) -> Text -> Token
forall a b. (a -> b) -> a -> b
$ Text
a Text -> Text -> Text
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 (Token -> Either Token Token) -> [Token] -> [Either Token Token]
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
_) = Token -> Either Token Token
forall a b. b -> Either a b
Right Token
t
        checkMisspelling t :: Token
t@(Check Text
s) =
            if Text
s Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set Text
whitelist
            then Token -> Either Token Token
forall a b. b -> Either a b
Right Token
t
            else if Text
s Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set Text
misspellings
                 then Token -> Either Token Token
forall a b. a -> Either a b
Left Token
t
                 else Token -> Either Token Token
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 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'`' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/' Bool -> Bool -> Bool
||
                       Char -> Text
T.singleton Char
c Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
userSigil Bool -> Bool -> Bool
|| Char -> Text
T.singleton Char
c Text -> Text -> Bool
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 (Char -> Bool) -> Char -> Bool
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 (Text -> Token) -> Text -> Token
forall a b. (a -> b) -> a -> b
$ Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Char -> Text
T.singleton (Char -> Text) -> Char -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Char
T.head Text
t))
                    Check Text
s -> Text -> Token
Check Text
s Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: Text -> Token -> [Token]
tokenize (Text -> Text
T.tail Text
t) (Text -> Token
Ignore (Text -> Token) -> Text -> Token
forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton (Char -> Text) -> Char -> Text
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 Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: Text -> Token -> [Token]
tokenize (Text -> Text
T.tail Text
t) (Text -> Token
Check (Text -> Token) -> Text -> Token
forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton (Char -> Text) -> Char -> Text
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 (Text -> Token) -> Text -> Token
forall a b. (a -> b) -> a -> b
$ Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Char -> Text
T.singleton (Char -> Text) -> Char -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Char
T.head Text
t))

    in [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 -> Widget Name
forall n. Text -> Widget n
handleLine (Text -> Widget Name) -> [Text] -> [Widget Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
contents

drawSaveAttachmentWindow :: ChatState
                         -> Lens' ChatState (MessageInterface Name i)
                         -> Widget Name
drawSaveAttachmentWindow :: ChatState
-> Lens' ChatState (MessageInterface Name i) -> Widget Name
drawSaveAttachmentWindow ChatState
st Lens' ChatState (MessageInterface Name i)
which =
    Widget Name -> Widget Name
forall n. Widget n -> Widget n
center (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
    Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
padAll Int
2 (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
    Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
borderWithLabel (AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
clientEmphAttr (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ Text -> Widget Name
forall n. Text -> Widget n
txt Text
"Save Attachment") (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
    [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
vBox [ Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
padAll Int
1 (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
           Text -> Widget Name
forall n. Text -> Widget n
txt Text
"Path: " Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+>
           (Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
vLimit Int
editorHeight (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
            FocusRing Name
-> (Bool -> Editor Text Name -> Widget Name)
-> Editor Text Name
-> Widget Name
forall n a b.
(Eq n, Named a n) =>
FocusRing n -> (Bool -> a -> b) -> a -> b
withFocusRing FocusRing Name
foc (([Text] -> Widget Name) -> Bool -> Editor Text Name -> Widget Name
forall n t.
(Ord n, Show n, Monoid t, TextWidth t, GenericTextZipper t) =>
([t] -> Widget n) -> Bool -> Editor t n -> Widget n
renderEditor [Text] -> Widget Name
forall n. [Text] -> Widget n
drawEditorTxt) Editor Text Name
ed)
         , [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
hBox [ Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padRight Padding
Max (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
                  Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padLeft (Int -> Padding
Pad Int
1) (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
                  FocusRing Name -> Name -> Text -> Widget Name
forall n. Eq n => FocusRing n -> n -> Text -> Widget n
drawButton FocusRing Name
foc (Name -> Name
AttachmentPathSaveButton Name
listName) Text
"Save"
                , Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padRight (Int -> Padding
Pad Int
1) (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
                  FocusRing Name -> Name -> Text -> Widget Name
forall n. Eq 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 = List Name (Int, LinkChoice) -> Name
forall a n. Named a n => a -> n
getName (List Name (Int, LinkChoice) -> Name)
-> List Name (Int, LinkChoice) -> Name
forall a b. (a -> b) -> a -> b
$ ChatState
stChatState
-> Getting
     (List Name (Int, LinkChoice))
     ChatState
     (List Name (Int, LinkChoice))
-> List Name (Int, LinkChoice)
forall s a. s -> Getting a s a -> a
^.(MessageInterface Name i
 -> Const (List Name (Int, LinkChoice)) (MessageInterface Name i))
-> ChatState -> Const (List Name (Int, LinkChoice)) ChatState
Lens' ChatState (MessageInterface Name i)
which((MessageInterface Name i
  -> Const (List Name (Int, LinkChoice)) (MessageInterface Name i))
 -> ChatState -> Const (List Name (Int, LinkChoice)) ChatState)
-> ((List Name (Int, LinkChoice)
     -> Const
          (List Name (Int, LinkChoice)) (List Name (Int, LinkChoice)))
    -> MessageInterface Name i
    -> Const (List Name (Int, LinkChoice)) (MessageInterface Name i))
-> Getting
     (List Name (Int, LinkChoice))
     ChatState
     (List Name (Int, LinkChoice))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(URLList Name
 -> Const (List Name (Int, LinkChoice)) (URLList Name))
-> MessageInterface Name i
-> Const (List Name (Int, LinkChoice)) (MessageInterface Name i)
forall n i. Lens' (MessageInterface n i) (URLList n)
miUrlList((URLList Name
  -> Const (List Name (Int, LinkChoice)) (URLList Name))
 -> MessageInterface Name i
 -> Const (List Name (Int, LinkChoice)) (MessageInterface Name i))
-> ((List Name (Int, LinkChoice)
     -> Const
          (List Name (Int, LinkChoice)) (List Name (Int, LinkChoice)))
    -> URLList Name
    -> Const (List Name (Int, LinkChoice)) (URLList Name))
-> (List Name (Int, LinkChoice)
    -> Const
         (List Name (Int, LinkChoice)) (List Name (Int, LinkChoice)))
-> MessageInterface Name i
-> Const (List Name (Int, LinkChoice)) (MessageInterface Name i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(List Name (Int, LinkChoice)
 -> Const
      (List Name (Int, LinkChoice)) (List Name (Int, LinkChoice)))
-> URLList Name
-> Const (List Name (Int, LinkChoice)) (URLList Name)
forall n1 n2.
Lens
  (URLList n1)
  (URLList n2)
  (List n1 (Int, LinkChoice))
  (List n2 (Int, LinkChoice))
ulList
        foc :: FocusRing Name
foc = ChatState
stChatState
-> Getting (FocusRing Name) ChatState (FocusRing Name)
-> FocusRing Name
forall s a. s -> Getting a s a -> a
^.(MessageInterface Name i
 -> Const (FocusRing Name) (MessageInterface Name i))
-> ChatState -> Const (FocusRing Name) ChatState
Lens' ChatState (MessageInterface Name i)
which((MessageInterface Name i
  -> Const (FocusRing Name) (MessageInterface Name i))
 -> ChatState -> Const (FocusRing Name) ChatState)
-> ((FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
    -> MessageInterface Name i
    -> Const (FocusRing Name) (MessageInterface Name i))
-> Getting (FocusRing Name) ChatState (FocusRing Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(SaveAttachmentDialogState Name
 -> Const (FocusRing Name) (SaveAttachmentDialogState Name))
-> MessageInterface Name i
-> Const (FocusRing Name) (MessageInterface Name i)
forall n i.
Lens' (MessageInterface n i) (SaveAttachmentDialogState n)
miSaveAttachmentDialog((SaveAttachmentDialogState Name
  -> Const (FocusRing Name) (SaveAttachmentDialogState Name))
 -> MessageInterface Name i
 -> Const (FocusRing Name) (MessageInterface Name i))
-> ((FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
    -> SaveAttachmentDialogState Name
    -> Const (FocusRing Name) (SaveAttachmentDialogState Name))
-> (FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
-> MessageInterface Name i
-> Const (FocusRing Name) (MessageInterface Name i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
-> SaveAttachmentDialogState Name
-> Const (FocusRing Name) (SaveAttachmentDialogState Name)
forall n. Lens' (SaveAttachmentDialogState n) (FocusRing n)
attachmentPathDialogFocus
        ed :: Editor Text Name
ed = ChatState
stChatState
-> Getting (Editor Text Name) ChatState (Editor Text Name)
-> Editor Text Name
forall s a. s -> Getting a s a -> a
^.(MessageInterface Name i
 -> Const (Editor Text Name) (MessageInterface Name i))
-> ChatState -> Const (Editor Text Name) ChatState
Lens' ChatState (MessageInterface Name i)
which((MessageInterface Name i
  -> Const (Editor Text Name) (MessageInterface Name i))
 -> ChatState -> Const (Editor Text Name) ChatState)
-> ((Editor Text Name
     -> Const (Editor Text Name) (Editor Text Name))
    -> MessageInterface Name i
    -> Const (Editor Text Name) (MessageInterface Name i))
-> Getting (Editor Text Name) ChatState (Editor Text Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(SaveAttachmentDialogState Name
 -> Const (Editor Text Name) (SaveAttachmentDialogState Name))
-> MessageInterface Name i
-> Const (Editor Text Name) (MessageInterface Name i)
forall n i.
Lens' (MessageInterface n i) (SaveAttachmentDialogState n)
miSaveAttachmentDialog((SaveAttachmentDialogState Name
  -> Const (Editor Text Name) (SaveAttachmentDialogState Name))
 -> MessageInterface Name i
 -> Const (Editor Text Name) (MessageInterface Name i))
-> ((Editor Text Name
     -> Const (Editor Text Name) (Editor Text Name))
    -> SaveAttachmentDialogState Name
    -> Const (Editor Text Name) (SaveAttachmentDialogState Name))
-> (Editor Text Name
    -> Const (Editor Text Name) (Editor Text Name))
-> MessageInterface Name i
-> Const (Editor Text Name) (MessageInterface Name i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Editor Text Name -> Const (Editor Text Name) (Editor Text Name))
-> SaveAttachmentDialogState Name
-> Const (Editor Text Name) (SaveAttachmentDialogState Name)
forall n. Lens' (SaveAttachmentDialogState n) (Editor Text n)
attachmentPathEditor
        drawEditorTxt :: [Text] -> Widget n
drawEditorTxt = Text -> Widget n
forall n. Text -> Widget n
txt (Text -> Widget n) -> ([Text] -> Text) -> [Text] -> Widget n
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 :: ChatState
-> HighlightSet
-> Lens' ChatState (MessageInterface Name i)
-> Widget Name
drawUrlSelectWindow ChatState
st HighlightSet
hs Lens' ChatState (MessageInterface Name i)
which =
    [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
vBox [ ChatState
-> HighlightSet
-> Lens' ChatState (MessageInterface Name i)
-> Widget Name
forall i.
ChatState
-> HighlightSet
-> Lens' ChatState (MessageInterface Name i)
-> Widget Name
renderUrlList ChatState
st HighlightSet
hs Lens' ChatState (MessageInterface Name i)
which
         , ChatState
-> Lens' ChatState (MessageInterface Name i) -> Widget Name
forall i.
ChatState
-> Lens' ChatState (MessageInterface Name i) -> Widget Name
urlSelectBottomBar ChatState
st Lens' ChatState (MessageInterface Name i)
which
         , ChatState
-> Lens' ChatState (MessageInterface Name i) -> Widget Name
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 :: 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 List Name (Int, LinkChoice) -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
F.length List Name (Int, LinkChoice)
urls Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
                     then String -> Widget Name
forall n. String -> Widget n
str String
"No links found." Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=> Char -> Widget Name
forall n. Char -> Widget n
fill Char
' '
                     else (Bool -> (Int, LinkChoice) -> Widget Name)
-> Bool -> List Name (Int, LinkChoice) -> Widget Name
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
stChatState
-> Getting
     (List Name (Int, LinkChoice))
     ChatState
     (List Name (Int, LinkChoice))
-> List Name (Int, LinkChoice)
forall s a. s -> Getting a s a -> a
^.(MessageInterface Name i
 -> Const (List Name (Int, LinkChoice)) (MessageInterface Name i))
-> ChatState -> Const (List Name (Int, LinkChoice)) ChatState
Lens' ChatState (MessageInterface Name i)
which((MessageInterface Name i
  -> Const (List Name (Int, LinkChoice)) (MessageInterface Name i))
 -> ChatState -> Const (List Name (Int, LinkChoice)) ChatState)
-> ((List Name (Int, LinkChoice)
     -> Const
          (List Name (Int, LinkChoice)) (List Name (Int, LinkChoice)))
    -> MessageInterface Name i
    -> Const (List Name (Int, LinkChoice)) (MessageInterface Name i))
-> Getting
     (List Name (Int, LinkChoice))
     ChatState
     (List Name (Int, LinkChoice))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(URLList Name
 -> Const (List Name (Int, LinkChoice)) (URLList Name))
-> MessageInterface Name i
-> Const (List Name (Int, LinkChoice)) (MessageInterface Name i)
forall n i. Lens' (MessageInterface n i) (URLList n)
miUrlList((URLList Name
  -> Const (List Name (Int, LinkChoice)) (URLList Name))
 -> MessageInterface Name i
 -> Const (List Name (Int, LinkChoice)) (MessageInterface Name i))
-> ((List Name (Int, LinkChoice)
     -> Const
          (List Name (Int, LinkChoice)) (List Name (Int, LinkChoice)))
    -> URLList Name
    -> Const (List Name (Int, LinkChoice)) (URLList Name))
-> (List Name (Int, LinkChoice)
    -> Const
         (List Name (Int, LinkChoice)) (List Name (Int, LinkChoice)))
-> MessageInterface Name i
-> Const (List Name (Int, LinkChoice)) (MessageInterface Name i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(List Name (Int, LinkChoice)
 -> Const
      (List Name (Int, LinkChoice)) (List Name (Int, LinkChoice)))
-> URLList Name
-> Const (List Name (Int, LinkChoice)) (URLList Name)
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
linkLinkChoice
-> Getting ServerTime LinkChoice ServerTime -> ServerTime
forall s a. s -> Getting a s a -> a
^.Getting ServerTime LinkChoice ServerTime
Lens' LinkChoice ServerTime
linkTime
          in Bool -> Widget Name -> Widget Name
forall n. Bool -> Widget n -> Widget n
attr Bool
sel (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
vLimit Int
2 (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
            (Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
vLimit Int
1 (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
             [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
hBox [ let u :: Text
u = Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"<server>" Text -> Text
forall a. a -> a
id (LinkChoice
linkLinkChoice
-> Getting (Maybe Text) LinkChoice (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^.(UserRef -> Const (Maybe Text) UserRef)
-> LinkChoice -> Const (Maybe Text) LinkChoice
Lens' LinkChoice UserRef
linkUser((UserRef -> Const (Maybe Text) UserRef)
 -> LinkChoice -> Const (Maybe Text) LinkChoice)
-> ((Maybe Text -> Const (Maybe Text) (Maybe Text))
    -> UserRef -> Const (Maybe Text) UserRef)
-> Getting (Maybe Text) LinkChoice (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))
                    in Text -> Text -> Text -> Widget Name
forall a. Text -> Text -> Text -> Widget a
colorUsername Text
me Text
u Text
u
                  , case LinkChoice
linkLinkChoice
-> Getting (Maybe Inlines) LinkChoice (Maybe Inlines)
-> Maybe Inlines
forall s a. s -> Getting a s a -> a
^.Getting (Maybe Inlines) LinkChoice (Maybe Inlines)
Lens' LinkChoice (Maybe Inlines)
linkLabel of
                      Maybe Inlines
Nothing -> Widget Name
forall n. Widget n
emptyWidget
                      Just Inlines
label ->
                          case Seq Inline -> Bool
forall a. Seq a -> Bool
Seq.null (Inlines -> Seq Inline
unInlines Inlines
label) of
                              Bool
True -> Widget Name
forall n. Widget n
emptyWidget
                              Bool
False -> Text -> Widget Name
forall n. Text -> Widget n
txt Text
": " Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> Text
-> HighlightSet
-> Maybe Int
-> Bool
-> Maybe Int
-> Maybe (Int -> Inline -> Maybe Name)
-> Blocks
-> Widget Name
forall a.
SemEq a =>
Text
-> HighlightSet
-> Maybe Int
-> Bool
-> Maybe Int
-> Maybe (Int -> Inline -> Maybe a)
-> Blocks
-> Widget a
renderRichText Text
me HighlightSet
hs Maybe Int
forall a. Maybe a
Nothing Bool
False Maybe Int
forall a. Maybe a
Nothing Maybe (Int -> Inline -> Maybe Name)
forall a. Maybe a
Nothing
                                                    (Seq Block -> Blocks
Blocks (Seq Block -> Blocks) -> Seq Block -> Blocks
forall a b. (a -> b) -> a -> b
$ Block -> Seq Block
forall a. a -> Seq a
Seq.singleton (Block -> Seq Block) -> Block -> Seq Block
forall a b. (a -> b) -> a -> b
$ Inlines -> Block
Para Inlines
label)
                  , Char -> Widget Name
forall n. Char -> Widget n
fill Char
' '
                  , ChatState -> UTCTime -> Widget Name
renderDate ChatState
st (UTCTime -> Widget Name) -> UTCTime -> Widget Name
forall a b. (a -> b) -> a -> b
$ ServerTime -> UTCTime
withServerTime ServerTime
time
                  , String -> Widget Name
forall n. String -> Widget n
str String
" "
                  , ChatState -> UTCTime -> Widget Name
renderTime ChatState
st (UTCTime -> Widget Name) -> UTCTime -> Widget Name
forall a b. (a -> b) -> a -> b
$ ServerTime -> UTCTime
withServerTime ServerTime
time
                  ] ) Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=>
            (Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
vLimit Int
1 (Name -> Widget Name -> Widget Name
forall n. Ord n => n -> Widget n -> Widget n
clickable (Int -> LinkTarget -> Name
ClickableURLListEntry Int
i (LinkChoice
linkLinkChoice
-> Getting LinkTarget LinkChoice LinkTarget -> LinkTarget
forall s a. s -> Getting a s a -> a
^.Getting LinkTarget LinkChoice LinkTarget
Lens' LinkChoice LinkTarget
linkTarget)) (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ LinkTarget -> Widget Name
forall a. SemEq a => LinkTarget -> Widget a
renderLinkTarget (LinkChoice
linkLinkChoice
-> Getting LinkTarget LinkChoice LinkTarget -> LinkTarget
forall s a. s -> Getting a s a -> a
^.Getting LinkTarget LinkChoice LinkTarget
Lens' LinkChoice LinkTarget
linkTarget)))

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

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

urlSelectBottomBar :: ChatState -> Lens' ChatState (MessageInterface Name i) -> Widget Name
urlSelectBottomBar :: ChatState
-> Lens' ChatState (MessageInterface Name i) -> Widget Name
urlSelectBottomBar ChatState
st Lens' ChatState (MessageInterface Name i)
which =
    case List Name (Int, LinkChoice) -> Maybe (Int, (Int, LinkChoice))
forall (t :: * -> *) n e.
(Splittable t, Foldable t) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (List Name (Int, LinkChoice) -> Maybe (Int, (Int, LinkChoice)))
-> List Name (Int, LinkChoice) -> Maybe (Int, (Int, LinkChoice))
forall a b. (a -> b) -> a -> b
$ ChatState
stChatState
-> Getting
     (List Name (Int, LinkChoice))
     ChatState
     (List Name (Int, LinkChoice))
-> List Name (Int, LinkChoice)
forall s a. s -> Getting a s a -> a
^.(MessageInterface Name i
 -> Const (List Name (Int, LinkChoice)) (MessageInterface Name i))
-> ChatState -> Const (List Name (Int, LinkChoice)) ChatState
Lens' ChatState (MessageInterface Name i)
which((MessageInterface Name i
  -> Const (List Name (Int, LinkChoice)) (MessageInterface Name i))
 -> ChatState -> Const (List Name (Int, LinkChoice)) ChatState)
-> ((List Name (Int, LinkChoice)
     -> Const
          (List Name (Int, LinkChoice)) (List Name (Int, LinkChoice)))
    -> MessageInterface Name i
    -> Const (List Name (Int, LinkChoice)) (MessageInterface Name i))
-> Getting
     (List Name (Int, LinkChoice))
     ChatState
     (List Name (Int, LinkChoice))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(URLList Name
 -> Const (List Name (Int, LinkChoice)) (URLList Name))
-> MessageInterface Name i
-> Const (List Name (Int, LinkChoice)) (MessageInterface Name i)
forall n i. Lens' (MessageInterface n i) (URLList n)
miUrlList((URLList Name
  -> Const (List Name (Int, LinkChoice)) (URLList Name))
 -> MessageInterface Name i
 -> Const (List Name (Int, LinkChoice)) (MessageInterface Name i))
-> ((List Name (Int, LinkChoice)
     -> Const
          (List Name (Int, LinkChoice)) (List Name (Int, LinkChoice)))
    -> URLList Name
    -> Const (List Name (Int, LinkChoice)) (URLList Name))
-> (List Name (Int, LinkChoice)
    -> Const
         (List Name (Int, LinkChoice)) (List Name (Int, LinkChoice)))
-> MessageInterface Name i
-> Const (List Name (Int, LinkChoice)) (MessageInterface Name i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(List Name (Int, LinkChoice)
 -> Const
      (List Name (Int, LinkChoice)) (List Name (Int, LinkChoice)))
-> URLList Name
-> Const (List Name (Int, LinkChoice)) (URLList Name)
forall n1 n2.
Lens
  (URLList n1)
  (URLList n2)
  (List n1 (Int, LinkChoice))
  (List n2 (Int, LinkChoice))
ulList of
        Maybe (Int, (Int, LinkChoice))
Nothing -> Widget Name
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 -> KeyHandlerMap) -> KeyEvent -> Text
keyEventBindings ChatState
st (Lens' ChatState (MessageInterface Name i)
-> KeyConfig -> KeyHandlerMap
forall i.
Lens' ChatState (MessageInterface Name i)
-> KeyConfig -> KeyHandlerMap
urlSelectKeybindings Lens' ChatState (MessageInterface Name i)
which)
                isFile :: LinkChoice -> Bool
isFile LinkChoice
entry = case LinkChoice
entryLinkChoice
-> Getting LinkTarget LinkChoice LinkTarget -> LinkTarget
forall s a. s -> Getting a s a -> a
^.Getting LinkTarget LinkChoice LinkTarget
Lens' LinkChoice LinkTarget
linkTarget of
                    LinkFileId {} -> Bool
True
                    LinkTarget
_ -> Bool
False
                optionList :: Widget n
optionList = [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
hBox ([Widget n] -> Widget n) -> [Widget n] -> Widget n
forall a b. (a -> b) -> a -> b
$ Widget n -> [Widget n] -> [Widget n]
forall a. a -> [a] -> [a]
intersperse (Text -> Widget n
forall n. Text -> Widget n
txt Text
" ") [Widget n]
forall n. [Widget n]
usableOptions
                usableOptions :: [Widget n]
usableOptions = [Maybe (Widget n)] -> [Widget n]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Widget n)] -> [Widget n])
-> [Maybe (Widget n)] -> [Widget n]
forall a b. (a -> b) -> a -> b
$ (LinkChoice -> Bool, Text, Text) -> Maybe (Widget n)
forall n. (LinkChoice -> Bool, Text, Text) -> Maybe (Widget n)
mkOption ((LinkChoice -> Bool, Text, Text) -> Maybe (Widget n))
-> [(LinkChoice -> Bool, Text, Text)] -> [Maybe (Widget n)]
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 Widget n -> Maybe (Widget n)
forall a. a -> Maybe a
Just (Widget n -> Maybe (Widget n)) -> Widget n -> Maybe (Widget n)
forall a b. (a -> b) -> a -> b
$ AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
urlSelectStatusAttr (Text -> Widget n
forall n. Text -> Widget n
txt Text
k) Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+>
                                                    Text -> Widget n
forall n. Text -> Widget n
txt (Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
desc)
                                        else Maybe (Widget n)
forall a. Maybe a
Nothing
            in if [Widget Any] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Widget Any]
forall n. [Widget n]
usableOptions
               then Widget Name
forall n. Widget n
hBorder
               else [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
hBox [ Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
hLimit Int
1 Widget Name
forall n. Widget n
hBorder
                         , Text -> Widget Name
forall n. Text -> Widget n
txt Text
"["
                         , Text -> Widget Name
forall n. Text -> Widget n
txt Text
"Options: "
                         , Widget Name
forall n. Widget n
optionList
                         , Text -> Widget Name
forall n. Text -> Widget n
txt Text
"]"
                         , Widget Name
forall n. Widget n
hBorder
                         ]

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