{-# LANGUAGE MultiWayIf #-}
module Matterhorn.Draw.Main (drawMain) where

import           Prelude ()
import           Matterhorn.Prelude

import           Brick
import           Brick.Widgets.Border
import           Brick.Widgets.Border.Style
import           Brick.Widgets.Center ( hCenter )
import           Brick.Widgets.List ( listElements )
import           Brick.Widgets.Edit ( editContentsL, renderEditor, getEditContents )
import           Control.Arrow ( (>>>) )
import           Data.Char ( isSpace, isPunctuation )
import qualified Data.Foldable as F
import           Data.List ( intersperse )
import qualified Data.Map as M
import qualified Data.Sequence as Seq
import qualified Data.Set as S
import qualified Data.Text as T
import           Data.Text.Zipper ( cursorPosition, insertChar, getText, gotoEOL )
import           Data.Time.Calendar ( fromGregorian )
import           Data.Time.Clock ( UTCTime(..) )
import qualified Graphics.Vty as Vty
import           Lens.Micro.Platform ( (.~), (^?!), to, view, folding )

import           Network.Mattermost.Types ( ChannelId, Type(Direct, Private, Group)
                                          , ServerTime(..), UserId, TeamId, teamDisplayName
                                          , teamId
                                          )


import           Matterhorn.Constants
import           Matterhorn.Draw.ChannelList ( renderChannelList, renderChannelListHeader )
import           Matterhorn.Draw.Messages
import           Matterhorn.Draw.Autocomplete
import           Matterhorn.Draw.URLList
import           Matterhorn.Draw.Util
import           Matterhorn.Draw.RichText
import           Matterhorn.Events.Keybindings
import           Matterhorn.Events.MessageSelect
import           Matterhorn.State.MessageSelect
import           Matterhorn.Themes
import           Matterhorn.TimeUtils ( justAfter, justBefore )
import           Matterhorn.Types
import           Matterhorn.Types.Common ( sanitizeUserText )
import           Matterhorn.Types.DirectionalSeq ( emptyDirSeq )
import           Matterhorn.Types.RichText ( parseMarkdown, TeamBaseURL )
import           Matterhorn.Types.KeyEvents
import qualified Matterhorn.Zipper as Z


previewFromInput :: TeamBaseURL -> Maybe MessageType -> UserId -> Text -> Maybe Message
previewFromInput :: TeamBaseURL -> Maybe MessageType -> UserId -> Text -> Maybe Message
previewFromInput TeamBaseURL
_ Maybe MessageType
_ UserId
_ Text
s | Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Text
T.singleton Char
cursorSentinel = Maybe Message
forall a. Maybe a
Nothing
previewFromInput TeamBaseURL
baseUrl Maybe MessageType
overrideTy UserId
uId Text
s =
    -- If it starts with a slash but not /me, this has no preview
    -- representation
    let isCommand :: Bool
isCommand = Text
"/" Text -> Text -> Bool
`T.isPrefixOf` Text
s
        isEmoteCmd :: Bool
isEmoteCmd = Text
"/me " Text -> Text -> Bool
`T.isPrefixOf` Text
s
        content :: Text
content = if Bool
isEmoteCmd
                  then Text -> Text
T.stripStart (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop Int
3 Text
s
                  else Text
s
        msgTy :: MessageType
msgTy = MessageType -> Maybe MessageType -> MessageType
forall a. a -> Maybe a -> a
fromMaybe (if Bool
isEmoteCmd then ClientPostType -> MessageType
CP ClientPostType
Emote else ClientPostType -> MessageType
CP ClientPostType
NormalPost) Maybe MessageType
overrideTy
    in if Bool
isCommand Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isEmoteCmd
       then Maybe Message
forall a. Maybe a
Nothing
       else Message -> Maybe Message
forall a. a -> Maybe a
Just (Message -> Maybe Message) -> Message -> Maybe Message
forall a b. (a -> b) -> a -> b
$ Message :: Blocks
-> Text
-> UserRef
-> ServerTime
-> MessageType
-> Bool
-> Bool
-> Seq Attachment
-> ReplyState
-> Maybe MessageId
-> Map Text (Set UserId)
-> Maybe Post
-> Bool
-> Bool
-> Maybe ChannelId
-> Message
Message { _mText :: Blocks
_mText          = Maybe TeamBaseURL -> Text -> Blocks
parseMarkdown (TeamBaseURL -> Maybe TeamBaseURL
forall a. a -> Maybe a
Just TeamBaseURL
baseUrl) Text
content
                           , _mMarkdownSource :: Text
_mMarkdownSource = Text
content
                           , _mUser :: UserRef
_mUser          = Bool -> UserId -> UserRef
UserI Bool
False UserId
uId
                           , _mDate :: ServerTime
_mDate          = UTCTime -> ServerTime
ServerTime (UTCTime -> ServerTime) -> UTCTime -> ServerTime
forall a b. (a -> b) -> a -> b
$ Day -> DiffTime -> UTCTime
UTCTime (Integer -> Int -> Int -> Day
fromGregorian Integer
1970 Int
1 Int
1) DiffTime
0
                           -- The date is not used for preview
                           -- rendering, but we need to provide one.
                           -- Ideally we'd just use today's date, but
                           -- the rendering function is pure so we
                           -- can't.
                           , _mType :: MessageType
_mType          = MessageType
msgTy
                           , _mPending :: Bool
_mPending       = Bool
False
                           , _mDeleted :: Bool
_mDeleted       = Bool
False
                           , _mAttachments :: Seq Attachment
_mAttachments   = Seq Attachment
forall a. Monoid a => a
mempty
                           , _mInReplyToMsg :: ReplyState
_mInReplyToMsg  = ReplyState
NotAReply
                           , _mMessageId :: Maybe MessageId
_mMessageId     = Maybe MessageId
forall a. Maybe a
Nothing
                           , _mReactions :: Map Text (Set UserId)
_mReactions     = Map Text (Set UserId)
forall a. Monoid a => a
mempty
                           , _mOriginalPost :: Maybe Post
_mOriginalPost  = Maybe Post
forall a. Maybe a
Nothing
                           , _mFlagged :: Bool
_mFlagged       = Bool
False
                           , _mPinned :: Bool
_mPinned        = Bool
False
                           , _mChannelId :: Maybe ChannelId
_mChannelId     = Maybe ChannelId
forall a. Maybe a
Nothing
                           }

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

drawEditorContents :: ChatState -> HighlightSet -> [Text] -> Widget Name
drawEditorContents :: ChatState -> HighlightSet -> [Text] -> Widget Name
drawEditorContents ChatState
st 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
    in case ChatState
stChatState
-> Getting
     (Maybe (Aspell, IO ())) ChatState (Maybe (Aspell, IO ()))
-> Maybe (Aspell, IO ())
forall s a. s -> Getting a s a -> a
^.(TeamState -> Const (Maybe (Aspell, IO ())) TeamState)
-> ChatState -> Const (Maybe (Aspell, IO ())) ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Const (Maybe (Aspell, IO ())) TeamState)
 -> ChatState -> Const (Maybe (Aspell, IO ())) ChatState)
-> ((Maybe (Aspell, IO ())
     -> Const (Maybe (Aspell, IO ())) (Maybe (Aspell, IO ())))
    -> TeamState -> Const (Maybe (Aspell, IO ())) TeamState)
-> Getting
     (Maybe (Aspell, IO ())) ChatState (Maybe (Aspell, IO ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChatEditState -> Const (Maybe (Aspell, IO ())) ChatEditState)
-> TeamState -> Const (Maybe (Aspell, IO ())) TeamState
Lens' TeamState ChatEditState
tsEditState((ChatEditState -> Const (Maybe (Aspell, IO ())) ChatEditState)
 -> TeamState -> Const (Maybe (Aspell, IO ())) TeamState)
-> ((Maybe (Aspell, IO ())
     -> Const (Maybe (Aspell, IO ())) (Maybe (Aspell, IO ())))
    -> ChatEditState -> Const (Maybe (Aspell, IO ())) ChatEditState)
-> (Maybe (Aspell, IO ())
    -> Const (Maybe (Aspell, IO ())) (Maybe (Aspell, IO ())))
-> TeamState
-> Const (Maybe (Aspell, IO ())) TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe (Aspell, IO ())
 -> Const (Maybe (Aspell, IO ())) (Maybe (Aspell, IO ())))
-> ChatEditState -> Const (Maybe (Aspell, IO ())) ChatEditState
Lens' ChatEditState (Maybe (Aspell, IO ()))
cedSpellChecker of
        Maybe (Aspell, IO ())
Nothing -> [Text] -> Widget Name
forall n. [Text] -> Widget n
noHighlight
        Just (Aspell, IO ())
_ ->
            case Set Text -> Bool
forall a. Set a -> Bool
S.null (ChatState
stChatState -> Getting (Set Text) ChatState (Set Text) -> Set Text
forall s a. s -> Getting a s a -> a
^.(TeamState -> Const (Set Text) TeamState)
-> ChatState -> Const (Set Text) ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Const (Set Text) TeamState)
 -> ChatState -> Const (Set Text) ChatState)
-> ((Set Text -> Const (Set Text) (Set Text))
    -> TeamState -> Const (Set Text) TeamState)
-> Getting (Set Text) ChatState (Set Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChatEditState -> Const (Set Text) ChatEditState)
-> TeamState -> Const (Set Text) TeamState
Lens' TeamState ChatEditState
tsEditState((ChatEditState -> Const (Set Text) ChatEditState)
 -> TeamState -> Const (Set Text) TeamState)
-> ((Set Text -> Const (Set Text) (Set Text))
    -> ChatEditState -> Const (Set Text) ChatEditState)
-> (Set Text -> Const (Set Text) (Set Text))
-> TeamState
-> Const (Set Text) TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Set Text -> Const (Set Text) (Set Text))
-> ChatEditState -> Const (Set Text) ChatEditState
Lens' ChatEditState (Set Text)
cedMisspellings) of
                Bool
True -> [Text] -> Widget Name
forall n. [Text] -> Widget n
noHighlight
                Bool
False -> HighlightSet -> Set Text -> [Text] -> Widget Name
doHighlightMisspellings
                           HighlightSet
hs
                           (ChatState
stChatState -> Getting (Set Text) ChatState (Set Text) -> Set Text
forall s a. s -> Getting a s a -> a
^.(TeamState -> Const (Set Text) TeamState)
-> ChatState -> Const (Set Text) ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Const (Set Text) TeamState)
 -> ChatState -> Const (Set Text) ChatState)
-> ((Set Text -> Const (Set Text) (Set Text))
    -> TeamState -> Const (Set Text) TeamState)
-> Getting (Set Text) ChatState (Set Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChatEditState -> Const (Set Text) ChatEditState)
-> TeamState -> Const (Set Text) TeamState
Lens' TeamState ChatEditState
tsEditState((ChatEditState -> Const (Set Text) ChatEditState)
 -> TeamState -> Const (Set Text) TeamState)
-> ((Set Text -> Const (Set Text) (Set Text))
    -> ChatEditState -> Const (Set Text) ChatEditState)
-> (Set Text -> Const (Set Text) (Set Text))
-> TeamState
-> Const (Set Text) TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Set Text -> Const (Set Text) (Set Text))
-> ChatEditState -> Const (Set Text) ChatEditState
Lens' ChatEditState (Set Text)
cedMisspellings)

-- | 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
hSet 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
hSet) (HighlightSet -> Set Text
hChannelSet HighlightSet
hSet)

        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

renderUserCommandBox :: ChatState -> HighlightSet -> Widget Name
renderUserCommandBox :: ChatState -> HighlightSet -> Widget Name
renderUserCommandBox ChatState
st HighlightSet
hs =
    let prompt :: Widget n
prompt = Text -> Widget n
forall n. Text -> Widget n
txt (Text -> Widget n) -> Text -> Widget n
forall a b. (a -> b) -> a -> b
$ case ChatState
stChatState -> Getting EditMode ChatState EditMode -> EditMode
forall s a. s -> Getting a s a -> a
^.(TeamState -> Const EditMode TeamState)
-> ChatState -> Const EditMode ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Const EditMode TeamState)
 -> ChatState -> Const EditMode ChatState)
-> ((EditMode -> Const EditMode EditMode)
    -> TeamState -> Const EditMode TeamState)
-> Getting EditMode ChatState EditMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChatEditState -> Const EditMode ChatEditState)
-> TeamState -> Const EditMode TeamState
Lens' TeamState ChatEditState
tsEditState((ChatEditState -> Const EditMode ChatEditState)
 -> TeamState -> Const EditMode TeamState)
-> ((EditMode -> Const EditMode EditMode)
    -> ChatEditState -> Const EditMode ChatEditState)
-> (EditMode -> Const EditMode EditMode)
-> TeamState
-> Const EditMode TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EditMode -> Const EditMode EditMode)
-> ChatEditState -> Const EditMode ChatEditState
Lens' ChatEditState EditMode
cedEditMode of
            Replying Message
_ Post
_ -> Text
"reply> "
            Editing Post
_ MessageType
_  ->  Text
"edit> "
            EditMode
NewPost      ->      Text
"> "
        tId :: TeamId
tId = ChatState
stChatState -> Getting TeamId ChatState TeamId -> TeamId
forall s a. s -> Getting a s a -> a
^.Getting TeamId ChatState TeamId
SimpleGetter ChatState TeamId
csCurrentTeamId
        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 -> HighlightSet -> [Text] -> Widget Name
drawEditorContents ChatState
st HighlightSet
hs) Bool
True (ChatState
stChatState
-> Getting (Editor Text Name) ChatState (Editor Text Name)
-> Editor Text Name
forall s a. s -> Getting a s a -> a
^.(TeamState -> Const (Editor Text Name) TeamState)
-> ChatState -> Const (Editor Text Name) ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Const (Editor Text Name) TeamState)
 -> ChatState -> Const (Editor Text Name) ChatState)
-> ((Editor Text Name
     -> Const (Editor Text Name) (Editor Text Name))
    -> TeamState -> Const (Editor Text Name) TeamState)
-> Getting (Editor Text Name) ChatState (Editor Text Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChatEditState -> Const (Editor Text Name) ChatEditState)
-> TeamState -> Const (Editor Text Name) TeamState
Lens' TeamState ChatEditState
tsEditState((ChatEditState -> Const (Editor Text Name) ChatEditState)
 -> TeamState -> Const (Editor Text Name) TeamState)
-> ((Editor Text Name
     -> Const (Editor Text Name) (Editor Text Name))
    -> ChatEditState -> Const (Editor Text Name) ChatEditState)
-> (Editor Text Name
    -> Const (Editor Text Name) (Editor Text Name))
-> TeamState
-> Const (Editor Text Name) TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Editor Text Name -> Const (Editor Text Name) (Editor Text Name))
-> ChatEditState -> Const (Editor Text Name) ChatEditState
Lens' ChatEditState (Editor Text Name)
cedEditor)
        curContents :: [Text]
curContents = Editor Text Name -> [Text]
forall t n. Monoid t => Editor t n -> [t]
getEditContents (Editor Text Name -> [Text]) -> Editor Text Name -> [Text]
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
^.(TeamState -> Const (Editor Text Name) TeamState)
-> ChatState -> Const (Editor Text Name) ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Const (Editor Text Name) TeamState)
 -> ChatState -> Const (Editor Text Name) ChatState)
-> ((Editor Text Name
     -> Const (Editor Text Name) (Editor Text Name))
    -> TeamState -> Const (Editor Text Name) TeamState)
-> Getting (Editor Text Name) ChatState (Editor Text Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChatEditState -> Const (Editor Text Name) ChatEditState)
-> TeamState -> Const (Editor Text Name) TeamState
Lens' TeamState ChatEditState
tsEditState((ChatEditState -> Const (Editor Text Name) ChatEditState)
 -> TeamState -> Const (Editor Text Name) TeamState)
-> ((Editor Text Name
     -> Const (Editor Text Name) (Editor Text Name))
    -> ChatEditState -> Const (Editor Text Name) ChatEditState)
-> (Editor Text Name
    -> Const (Editor Text Name) (Editor Text Name))
-> TeamState
-> Const (Editor Text Name) TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Editor Text Name -> Const (Editor Text Name) (Editor Text Name))
-> ChatEditState -> Const (Editor Text Name) ChatEditState
Lens' ChatEditState (Editor Text Name)
cedEditor
        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 [ (BorderStyle -> Char) -> Widget n
forall n. (BorderStyle -> Char) -> Widget n
borderElem BorderStyle -> Char
bsHorizontal
                 , String -> Widget n
forall n. String -> Widget n
str (String -> Widget n) -> String -> Widget n
forall a b. (a -> b) -> a -> b
$ String
"[" String -> ShowS
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
$
                                        ChatState
stChatState
-> Getting (TextZipper Text) ChatState (TextZipper Text)
-> TextZipper Text
forall s a. s -> Getting a s a -> a
^.(TeamState -> Const (TextZipper Text) TeamState)
-> ChatState -> Const (TextZipper Text) ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Const (TextZipper Text) TeamState)
 -> ChatState -> Const (TextZipper Text) ChatState)
-> ((TextZipper Text -> Const (TextZipper Text) (TextZipper Text))
    -> TeamState -> Const (TextZipper Text) TeamState)
-> Getting (TextZipper Text) ChatState (TextZipper Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChatEditState -> Const (TextZipper Text) ChatEditState)
-> TeamState -> Const (TextZipper Text) TeamState
Lens' TeamState ChatEditState
tsEditState((ChatEditState -> Const (TextZipper Text) ChatEditState)
 -> TeamState -> Const (TextZipper Text) TeamState)
-> ((TextZipper Text -> Const (TextZipper Text) (TextZipper Text))
    -> ChatEditState -> Const (TextZipper Text) ChatEditState)
-> (TextZipper Text -> Const (TextZipper Text) (TextZipper Text))
-> TeamState
-> Const (TextZipper Text) TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Editor Text Name -> Const (TextZipper Text) (Editor Text Name))
-> ChatEditState -> Const (TextZipper Text) ChatEditState
Lens' ChatEditState (Editor Text Name)
cedEditor((Editor Text Name -> Const (TextZipper Text) (Editor Text Name))
 -> ChatEditState -> Const (TextZipper Text) ChatEditState)
-> ((TextZipper Text -> Const (TextZipper Text) (TextZipper Text))
    -> Editor Text Name -> Const (TextZipper Text) (Editor Text Name))
-> (TextZipper Text -> Const (TextZipper Text) (TextZipper Text))
-> ChatEditState
-> Const (TextZipper Text) ChatEditState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(TextZipper Text -> Const (TextZipper Text) (TextZipper Text))
-> Editor Text Name -> Const (TextZipper Text) (Editor Text Name)
forall t1 n t2.
Lens (Editor t1 n) (Editor t2 n) (TextZipper t1) (TextZipper t2)
editContentsL) String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
                         String
"/" String -> ShowS
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 -> ShowS
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
^.(TeamState -> Const EditMode TeamState)
-> ChatState -> Const EditMode ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Const EditMode TeamState)
 -> ChatState -> Const EditMode ChatState)
-> ((EditMode -> Const EditMode EditMode)
    -> TeamState -> Const EditMode TeamState)
-> Getting EditMode ChatState EditMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChatEditState -> Const EditMode ChatEditState)
-> TeamState -> Const EditMode TeamState
Lens' TeamState ChatEditState
tsEditState((ChatEditState -> Const EditMode ChatEditState)
 -> TeamState -> Const EditMode TeamState)
-> ((EditMode -> Const EditMode EditMode)
    -> ChatEditState -> Const EditMode ChatEditState)
-> (EditMode -> Const EditMode EditMode)
-> TeamState
-> Const EditMode TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EditMode -> Const EditMode EditMode)
-> ChatEditState -> Const EditMode ChatEditState
Lens' ChatEditState EditMode
cedEditMode of
            Replying Message
msg Post
_ ->
                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
-> HighlightSet
-> Bool
-> Maybe Int
-> Text
-> Bool
-> 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
nameForUserRef 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
                          , 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
                          , mdWrapNonhighlightedCodeBlocks :: Bool
mdWrapNonhighlightedCodeBlocks = Bool
True
                          }
                        ]
            EditMode
_ -> Widget Name
forall n. Widget n
emptyWidget

        multiLineToggleKey :: Text
multiLineToggleKey = Binding -> Text
ppBinding (Binding -> Text) -> Binding -> Text
forall a b. (a -> b) -> a -> b
$ KeyEvent -> Binding
getFirstDefaultBinding KeyEvent
ToggleMultiLineEvent

        commandBox :: Widget Name
commandBox = case ChatState
stChatState -> Getting Bool ChatState Bool -> Bool
forall s a. s -> Getting a s a -> a
^.(TeamState -> Const Bool TeamState)
-> ChatState -> Const Bool ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Const Bool TeamState)
 -> ChatState -> Const Bool ChatState)
-> ((Bool -> Const Bool Bool) -> TeamState -> Const Bool TeamState)
-> Getting Bool ChatState Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChatEditState -> Const Bool ChatEditState)
-> TeamState -> Const Bool TeamState
Lens' TeamState ChatEditState
tsEditState((ChatEditState -> Const Bool ChatEditState)
 -> TeamState -> Const Bool TeamState)
-> ((Bool -> Const Bool Bool)
    -> ChatEditState -> Const Bool ChatEditState)
-> (Bool -> Const Bool Bool)
-> TeamState
-> Const Bool TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EphemeralEditState -> Const Bool EphemeralEditState)
-> ChatEditState -> Const Bool ChatEditState
Lens' ChatEditState EphemeralEditState
cedEphemeral((EphemeralEditState -> Const Bool EphemeralEditState)
 -> ChatEditState -> Const Bool ChatEditState)
-> ((Bool -> Const Bool Bool)
    -> EphemeralEditState -> Const Bool EphemeralEditState)
-> (Bool -> Const Bool Bool)
-> ChatEditState
-> Const Bool ChatEditState
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 -> ShowS
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
forall n. Widget n
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 -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
numLines String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
linesStr String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
                                         String
"; Enter: send, " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
multiLineToggleKey String -> ShowS
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 (TeamId -> Name
MessageInput TeamId
tId) ((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

renderChannelHeader :: ChatState -> HighlightSet -> ClientChannel -> Widget Name
renderChannelHeader :: ChatState -> HighlightSet -> ClientChannel -> Widget Name
renderChannelHeader ChatState
st HighlightSet
hs ClientChannel
chan =
    let chnType :: Type
chnType = 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
        topicStr :: Text
topicStr = 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
cdHeader
        userHeader :: UserInfo -> Text
userHeader UserInfo
u = let s :: Text
s = Text -> [Text] -> Text
T.intercalate Text
" " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) [Text]
parts
                           parts :: [Text]
parts = [ Text
chanName
                                   , if ((Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Text -> Bool
T.null [Text]
names)
                                     then Text
forall a. Monoid a => a
mempty
                                     else Text
"is"
                                   ] [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
names [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [
                                     if Text -> Bool
T.null (UserInfo
uUserInfo -> Getting Text UserInfo Text -> Text
forall s a. s -> Getting a s a -> a
^.Getting Text UserInfo Text
Lens' UserInfo Text
uiEmail)
                                     then Text
forall a. Monoid a => a
mempty
                                     else Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> UserInfo
uUserInfo -> Getting Text UserInfo Text -> Text
forall s a. s -> Getting a s a -> a
^.Getting Text UserInfo Text
Lens' UserInfo Text
uiEmail Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
                                   ]
                           names :: [Text]
names = [ UserInfo
uUserInfo -> Getting Text UserInfo Text -> Text
forall s a. s -> Getting a s a -> a
^.Getting Text UserInfo Text
Lens' UserInfo Text
uiFirstName
                                   , Text
nick
                                   , UserInfo
uUserInfo -> Getting Text UserInfo Text -> Text
forall s a. s -> Getting a s a -> a
^.Getting Text UserInfo Text
Lens' UserInfo Text
uiLastName
                                   ]
                           quote :: a -> a
quote a
n = a
"\"" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
n a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"\""
                           nick :: Text
nick = Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" Text -> Text
forall a. (Semigroup a, IsString a) => a -> a
quote (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ UserInfo
uUserInfo
-> Getting (Maybe Text) UserInfo (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^.Getting (Maybe Text) UserInfo (Maybe Text)
Lens' UserInfo (Maybe Text)
uiNickName
                       in Text
s
        firstTopicLine :: Text
firstTopicLine = case Text -> [Text]
T.lines Text
topicStr of
            [Text
h] -> Text
h
            (Text
h:Text
_:[Text]
_) -> Text
h
            [Text]
_ -> Text
""
        maybeTopic :: Text
maybeTopic = if Text -> Bool
T.null Text
topicStr
                     then Text
""
                     else Text
" - " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> if 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
.(Config -> Const Bool Config)
-> ChatResources -> Const Bool ChatResources
Lens' ChatResources Config
crConfiguration((Config -> Const Bool Config)
 -> ChatResources -> Const Bool ChatResources)
-> ((Bool -> Const Bool Bool) -> Config -> Const Bool Config)
-> (Bool -> Const Bool Bool)
-> ChatResources
-> Const Bool ChatResources
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Const Bool Bool) -> Config -> Const Bool Config
Lens' Config Bool
configShowExpandedChannelTopicsL
                                   then Text
topicStr
                                   else Text
firstTopicLine
        channelNameString :: Text
channelNameString = case Type
chnType of
            Type
Direct ->
                case 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 of
                    Maybe UserInfo
Nothing -> Text
chanName
                    Just UserInfo
u -> UserInfo -> Text
userHeader UserInfo
u
            Type
Private ->
                Text
channelNamePair Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (Private)"
            Type
Group ->
                Text
channelNamePair Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (Private group)"
            Type
_ ->
                Text
channelNamePair
        channelNamePair :: Text
channelNamePair = Text
chanName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" - " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (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)
        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)
        tId :: TeamId
tId = ChatState
stChatState -> Getting TeamId ChatState TeamId -> TeamId
forall s a. s -> Getting a s a -> a
^.Getting TeamId ChatState TeamId
SimpleGetter ChatState TeamId
csCurrentTeamId
        baseUrl :: TeamBaseURL
baseUrl = ChatState -> TeamId -> TeamBaseURL
serverBaseUrl ChatState
st TeamId
tId

    in Maybe TeamBaseURL -> Text -> HighlightSet -> Text -> Widget Name
forall a.
Maybe TeamBaseURL -> Text -> HighlightSet -> Text -> Widget a
renderText' (TeamBaseURL -> Maybe TeamBaseURL
forall a. a -> Maybe a
Just TeamBaseURL
baseUrl) (ChatState -> Text
myUsername ChatState
st)
         HighlightSet
hs
         (Text
channelNameString Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
maybeTopic)

renderCurrentChannelDisplay :: ChatState -> HighlightSet -> Widget Name
renderCurrentChannelDisplay :: ChatState -> HighlightSet -> Widget Name
renderCurrentChannelDisplay ChatState
st HighlightSet
hs = Widget Name
header Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=> Widget Name
forall n. Widget n
hBorder Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=> Widget Name
messages
    where
    header :: Widget Name
header =
        if 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
.(Config -> Const Bool Config)
-> ChatResources -> Const Bool ChatResources
Lens' ChatResources Config
crConfiguration((Config -> Const Bool Config)
 -> ChatResources -> Const Bool ChatResources)
-> ((Bool -> Const Bool Bool) -> Config -> Const Bool Config)
-> (Bool -> Const Bool Bool)
-> ChatResources
-> Const Bool ChatResources
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Const Bool Bool) -> Config -> Const Bool Config
Lens' Config Bool
configShowChannelListL
        then Widget Name
channelHeader
        else Widget Name
headerWithStatus

    headerWithStatus :: Widget Name
headerWithStatus =
        -- Render the channel list header next to the channel header
        -- itself. We want them to be separated by a vertical border,
        -- but we want the border to be as high as the tallest of the
        -- two. To make that work we need to render the two and then
        -- render a border between them that is the same height as the
        -- taller of the two. We can't do that without making a custom
        -- widget which is why we take this approach here rather than
        -- just putting them all in an hBox.
        Size -> Size -> RenderM Name (Result Name) -> Widget Name
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed (RenderM Name (Result Name) -> Widget Name)
-> RenderM Name (Result Name) -> Widget Name
forall a b. (a -> b) -> a -> b
$ do
            Context
ctx <- RenderM Name Context
forall n. RenderM n Context
getContext
            Result Name
statusBox <- Widget Name -> RenderM Name (Result Name)
forall n. Widget n -> RenderM n (Result n)
render (Widget Name -> RenderM Name (Result Name))
-> Widget Name -> RenderM Name (Result Name)
forall a b. (a -> b) -> a -> b
$
                Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
hLimit (Config -> Int
configChannelListWidth (Config -> Int) -> Config -> Int
forall a b. (a -> b) -> a -> b
$ ChatState
stChatState -> Getting Config ChatState Config -> Config
forall s a. s -> Getting a s a -> a
^.(ChatResources -> Const Config ChatResources)
-> ChatState -> Const Config ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Const Config ChatResources)
 -> ChatState -> Const Config ChatState)
-> ((Config -> Const Config Config)
    -> ChatResources -> Const Config ChatResources)
-> Getting Config ChatState Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Config -> Const Config Config)
-> ChatResources -> Const Config ChatResources
Lens' ChatResources Config
crConfiguration) (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
                       (ChatState -> Widget Name
renderChannelListHeader ChatState
st)

            let channelHeaderWidth :: Int
channelHeaderWidth = Context
ctxContext -> Getting Int Context Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Context Int
Lens' Context Int
availWidthL Int -> Int -> Int
forall a. Num a => a -> a -> a
-
                                     (Image -> Int
Vty.imageWidth (Image -> Int) -> Image -> Int
forall a b. (a -> b) -> a -> b
$ Result Name
statusBoxResult Name -> Getting Image (Result Name) Image -> Image
forall s a. s -> Getting a s a -> a
^.Getting Image (Result Name) Image
forall n. Lens' (Result n) Image
imageL) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

            Result Name
channelHeaderResult <- Widget Name -> RenderM Name (Result Name)
forall n. Widget n -> RenderM n (Result n)
render (Widget Name -> RenderM Name (Result Name))
-> Widget Name -> RenderM Name (Result Name)
forall a b. (a -> b) -> a -> b
$ Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
hLimit Int
channelHeaderWidth Widget Name
channelHeader

            let maxHeight :: Int
maxHeight = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Image -> Int
Vty.imageHeight (Image -> Int) -> Image -> Int
forall a b. (a -> b) -> a -> b
$ Result Name
statusBoxResult Name -> Getting Image (Result Name) Image -> Image
forall s a. s -> Getting a s a -> a
^.Getting Image (Result Name) Image
forall n. Lens' (Result n) Image
imageL)
                                (Image -> Int
Vty.imageHeight (Image -> Int) -> Image -> Int
forall a b. (a -> b) -> a -> b
$ Result Name
channelHeaderResultResult Name -> Getting Image (Result Name) Image -> Image
forall s a. s -> Getting a s a -> a
^.Getting Image (Result Name) Image
forall n. Lens' (Result n) Image
imageL)
                statusBoxWidget :: Widget Name
statusBoxWidget = Size -> Size -> RenderM Name (Result Name) -> Widget Name
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed (RenderM Name (Result Name) -> Widget Name)
-> RenderM Name (Result Name) -> Widget Name
forall a b. (a -> b) -> a -> b
$ Result Name -> RenderM Name (Result Name)
forall (m :: * -> *) a. Monad m => a -> m a
return Result Name
statusBox
                headerWidget :: Widget Name
headerWidget = Size -> Size -> RenderM Name (Result Name) -> Widget Name
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed (RenderM Name (Result Name) -> Widget Name)
-> RenderM Name (Result Name) -> Widget Name
forall a b. (a -> b) -> a -> b
$ Result Name -> RenderM Name (Result Name)
forall (m :: * -> *) a. Monad m => a -> m a
return Result Name
channelHeaderResult
                borderWidget :: Widget n
borderWidget = Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
vLimit Int
maxHeight Widget n
forall n. Widget n
vBorder

            Widget Name -> RenderM Name (Result Name)
forall n. Widget n -> RenderM n (Result n)
render (Widget Name -> RenderM Name (Result Name))
-> Widget Name -> RenderM Name (Result Name)
forall a b. (a -> b) -> a -> b
$ if ChatState
stChatState -> Getting Mode ChatState Mode -> Mode
forall s a. s -> Getting a s a -> a
^.(TeamState -> Const Mode TeamState)
-> ChatState -> Const Mode ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Const Mode TeamState)
 -> ChatState -> Const Mode ChatState)
-> ((Mode -> Const Mode Mode) -> TeamState -> Const Mode TeamState)
-> Getting Mode ChatState Mode
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Mode -> Const Mode Mode) -> TeamState -> Const Mode TeamState
Lens' TeamState Mode
tsMode Mode -> Mode -> Bool
forall a. Eq a => a -> a -> Bool
== Mode
ChannelSelect
                        then Widget Name
headerWidget
                        else [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
$ case ChatState
stChatState
-> Getting ChannelListOrientation ChatState ChannelListOrientation
-> ChannelListOrientation
forall s a. s -> Getting a s a -> a
^.Getting ChannelListOrientation ChatState ChannelListOrientation
Lens' ChatState ChannelListOrientation
csChannelListOrientation of
                            ChannelListOrientation
ChannelListLeft ->
                                [ Widget Name
statusBoxWidget
                                , Widget Name
forall n. Widget n
borderWidget
                                , Widget Name
headerWidget
                                ]
                            ChannelListOrientation
ChannelListRight ->
                                [ Widget Name
headerWidget
                                , Widget Name
forall n. Widget n
borderWidget
                                , Widget Name
statusBoxWidget
                                ]

    channelHeader :: Widget Name
channelHeader =
        AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
channelHeaderAttr (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
padRight Padding
Max (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
        ChatState -> HighlightSet -> ClientChannel -> Widget Name
renderChannelHeader ChatState
st HighlightSet
hs ClientChannel
chan

    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 ChatState
stChatState -> Getting Mode ChatState Mode -> Mode
forall s a. s -> Getting a s a -> a
^.(TeamState -> Const Mode TeamState)
-> ChatState -> Const Mode ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Const Mode TeamState)
 -> ChatState -> Const Mode ChatState)
-> ((Mode -> Const Mode Mode) -> TeamState -> Const Mode TeamState)
-> Getting Mode ChatState Mode
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Mode -> Const Mode Mode) -> TeamState -> Const Mode TeamState
Lens' TeamState Mode
tsMode of
        Mode
MessageSelect ->
            MessageSelectState
-> DirectionalSeq Chronological Message -> Widget Name
renderMessagesWithSelect (ChatState
stChatState
-> Getting MessageSelectState ChatState MessageSelectState
-> MessageSelectState
forall s a. s -> Getting a s a -> a
^.(TeamState -> Const MessageSelectState TeamState)
-> ChatState -> Const MessageSelectState ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Const MessageSelectState TeamState)
 -> ChatState -> Const MessageSelectState ChatState)
-> ((MessageSelectState
     -> Const MessageSelectState MessageSelectState)
    -> TeamState -> Const MessageSelectState TeamState)
-> Getting MessageSelectState ChatState MessageSelectState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MessageSelectState -> Const MessageSelectState MessageSelectState)
-> TeamState -> Const MessageSelectState TeamState
Lens' TeamState MessageSelectState
tsMessageSelect) DirectionalSeq Chronological Message
channelMessages
        Mode
MessageSelectDeleteConfirm ->
            MessageSelectState
-> DirectionalSeq Chronological Message -> Widget Name
renderMessagesWithSelect (ChatState
stChatState
-> Getting MessageSelectState ChatState MessageSelectState
-> MessageSelectState
forall s a. s -> Getting a s a -> a
^.(TeamState -> Const MessageSelectState TeamState)
-> ChatState -> Const MessageSelectState ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Const MessageSelectState TeamState)
 -> ChatState -> Const MessageSelectState ChatState)
-> ((MessageSelectState
     -> Const MessageSelectState MessageSelectState)
    -> TeamState -> Const MessageSelectState TeamState)
-> Getting MessageSelectState ChatState MessageSelectState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MessageSelectState -> Const MessageSelectState MessageSelectState)
-> TeamState -> Const MessageSelectState TeamState
Lens' TeamState MessageSelectState
tsMessageSelect) DirectionalSeq Chronological Message
channelMessages
        Mode
_ ->
            Name -> Widget Name -> Widget Name
forall n. Ord n => n -> Widget n -> Widget n
cached (ChannelId -> Name
ChannelMessages ChannelId
cId) (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
            ChatState
-> HighlightSet
-> Maybe ServerTime
-> DirectionalSeq Retrograde (Message, ThreadState)
-> Widget Name
renderLastMessages ChatState
st HighlightSet
hs Maybe ServerTime
editCutoff (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
channelMessages

    renderMessagesWithSelect :: MessageSelectState
-> DirectionalSeq Chronological Message -> Widget Name
renderMessagesWithSelect (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
-> DirectionalSeq Retrograde (Message, ThreadState)
-> Widget Name
renderLastMessages ChatState
st HighlightSet
hs Maybe ServerTime
editCutoff DirectionalSeq Retrograde (Message, ThreadState)
before
             Just (Message, ThreadState)
m ->
                 ((Message, ThreadState),
 (DirectionalSeq Retrograde (Message, ThreadState),
  DirectionalSeq Chronological (Message, ThreadState)))
-> (Message -> ThreadState -> Widget Name) -> Widget Name
forall (f :: * -> *) (g :: * -> *).
(Foldable f, Foldable g) =>
((Message, ThreadState),
 (f (Message, ThreadState), g (Message, ThreadState)))
-> (Message -> ThreadState -> Widget Name) -> Widget Name
unsafeRenderMessageSelection ((Message, ThreadState)
m, (DirectionalSeq Retrograde (Message, ThreadState)
before, DirectionalSeq Chronological (Message, ThreadState)
after)) (ChatState
-> HighlightSet
-> Maybe ServerTime
-> Message
-> ThreadState
-> Widget Name
renderSingleMessage ChatState
st HighlightSet
hs Maybe ServerTime
forall a. Maybe a
Nothing)

    cutoff :: Maybe NewMessageIndicator
cutoff = ChannelId -> ChatState -> Maybe NewMessageIndicator
getNewMessageCutoff ChannelId
cId ChatState
st
    editCutoff :: Maybe ServerTime
editCutoff = ChannelId -> ChatState -> Maybe ServerTime
getEditedMessageCutoff ChannelId
cId ChatState
st
    messageListing :: DirectionalSeq Chronological Message
messageListing = ChannelId -> ChatState -> DirectionalSeq Chronological Message
getMessageListing ChannelId
cId ChatState
st
    channelMessages :: DirectionalSeq Chronological Message
channelMessages =
        -- If the channel is empty, add an informative message to the
        -- message listing to make it explicit that this channel does
        -- not yet have any messages.
        if DirectionalSeq Chronological Message -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
F.null DirectionalSeq Chronological Message
messageListing
        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
messageListing
                               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)

    tId :: TeamId
tId = ChatState
stChatState -> Getting TeamId ChatState TeamId -> TeamId
forall s a. s -> Getting a s a -> a
^.Getting TeamId ChatState TeamId
SimpleGetter ChatState TeamId
csCurrentTeamId
    cId :: ChannelId
cId = ChatState
stChatState -> Getting ChannelId ChatState ChannelId -> ChannelId
forall s a. s -> Getting a s a -> a
^.(TeamId -> SimpleGetter ChatState ChannelId
csCurrentChannelId TeamId
tId)
    chan :: ClientChannel
chan = ChatState
stChatState
-> Getting ClientChannel ChatState ClientChannel -> ClientChannel
forall s a. s -> Getting a s a -> a
^.Getting ClientChannel ChatState ClientChannel
Lens' ChatState ClientChannel
csCurrentChannel

-- | 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
        Just ClientChannel
chan = 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."

getMessageListing :: ChannelId -> ChatState -> Messages
getMessageListing :: ChannelId -> ChatState -> DirectionalSeq Chronological Message
getMessageListing ChannelId
cId ChatState
st =
    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
^?! (ClientChannels
 -> Const
      (Endo (DirectionalSeq Chronological Message)) ClientChannels)
-> ChatState
-> Const (Endo (DirectionalSeq Chronological Message)) ChatState
Lens' ChatState ClientChannels
csChannels((ClientChannels
  -> Const
       (Endo (DirectionalSeq Chronological Message)) ClientChannels)
 -> ChatState
 -> Const (Endo (DirectionalSeq Chronological Message)) ChatState)
-> ((DirectionalSeq Chronological Message
     -> Const
          (Endo (DirectionalSeq Chronological Message))
          (DirectionalSeq Chronological Message))
    -> ClientChannels
    -> Const
         (Endo (DirectionalSeq Chronological Message)) ClientChannels)
-> Getting
     (Endo (DirectionalSeq Chronological Message))
     ChatState
     (DirectionalSeq Chronological Message)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ClientChannels -> Maybe ClientChannel)
-> SimpleFold ClientChannels ClientChannel
forall (f :: * -> *) s a.
Foldable f =>
(s -> f a) -> SimpleFold s a
folding (ChannelId -> ClientChannels -> Maybe ClientChannel
findChannelById ChannelId
cId) Getting
  (Endo (DirectionalSeq Chronological Message))
  ClientChannels
  ClientChannel
-> ((DirectionalSeq Chronological Message
     -> Const
          (Endo (DirectionalSeq Chronological Message))
          (DirectionalSeq Chronological Message))
    -> ClientChannel
    -> Const
         (Endo (DirectionalSeq Chronological Message)) ClientChannel)
-> (DirectionalSeq Chronological Message
    -> Const
         (Endo (DirectionalSeq Chronological Message))
         (DirectionalSeq Chronological Message))
-> ClientChannels
-> Const
     (Endo (DirectionalSeq Chronological Message)) ClientChannels
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChannelContents
 -> Const
      (Endo (DirectionalSeq Chronological Message)) ChannelContents)
-> ClientChannel
-> Const
     (Endo (DirectionalSeq Chronological Message)) ClientChannel
Lens' ClientChannel ChannelContents
ccContents ((ChannelContents
  -> Const
       (Endo (DirectionalSeq Chronological Message)) ChannelContents)
 -> ClientChannel
 -> Const
      (Endo (DirectionalSeq Chronological Message)) ClientChannel)
-> ((DirectionalSeq Chronological Message
     -> Const
          (Endo (DirectionalSeq Chronological Message))
          (DirectionalSeq Chronological Message))
    -> ChannelContents
    -> Const
         (Endo (DirectionalSeq Chronological Message)) ChannelContents)
-> (DirectionalSeq Chronological Message
    -> Const
         (Endo (DirectionalSeq Chronological Message))
         (DirectionalSeq Chronological Message))
-> ClientChannel
-> Const
     (Endo (DirectionalSeq Chronological Message)) ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DirectionalSeq Chronological Message
 -> Const
      (Endo (DirectionalSeq Chronological Message))
      (DirectionalSeq Chronological Message))
-> ChannelContents
-> Const
     (Endo (DirectionalSeq Chronological Message)) ChannelContents
Lens' ChannelContents (DirectionalSeq Chronological Message)
cdMessages ((DirectionalSeq Chronological Message
  -> Const
       (Endo (DirectionalSeq Chronological Message))
       (DirectionalSeq Chronological Message))
 -> ChannelContents
 -> Const
      (Endo (DirectionalSeq Chronological Message)) ChannelContents)
-> ((DirectionalSeq Chronological Message
     -> Const
          (Endo (DirectionalSeq Chronological Message))
          (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))
-> ChannelContents
-> Const
     (Endo (DirectionalSeq Chronological Message)) ChannelContents
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

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

renderChannelSelectPrompt :: ChatState -> Widget Name
renderChannelSelectPrompt :: ChatState -> Widget Name
renderChannelSelectPrompt ChatState
st =
    let e :: Editor Text Name
e = ChatState
stChatState
-> Getting (Editor Text Name) ChatState (Editor Text Name)
-> Editor Text Name
forall s a. s -> Getting a s a -> a
^.(TeamState -> Const (Editor Text Name) TeamState)
-> ChatState -> Const (Editor Text Name) ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Const (Editor Text Name) TeamState)
 -> ChatState -> Const (Editor Text Name) ChatState)
-> ((Editor Text Name
     -> Const (Editor Text Name) (Editor Text Name))
    -> TeamState -> Const (Editor Text Name) TeamState)
-> Getting (Editor Text Name) ChatState (Editor Text Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChannelSelectState -> Const (Editor Text Name) ChannelSelectState)
-> TeamState -> Const (Editor Text Name) TeamState
Lens' TeamState ChannelSelectState
tsChannelSelectState((ChannelSelectState
  -> Const (Editor Text Name) ChannelSelectState)
 -> TeamState -> Const (Editor Text Name) TeamState)
-> ((Editor Text Name
     -> Const (Editor Text Name) (Editor Text Name))
    -> ChannelSelectState
    -> Const (Editor Text Name) ChannelSelectState)
-> (Editor Text Name
    -> Const (Editor Text Name) (Editor Text Name))
-> TeamState
-> Const (Editor Text Name) TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Editor Text Name -> Const (Editor Text Name) (Editor Text Name))
-> ChannelSelectState
-> Const (Editor Text Name) ChannelSelectState
Lens' ChannelSelectState (Editor Text Name)
channelSelectInput
    in AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
channelSelectPromptAttr (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
"Switch to channel [use ^ and $ to anchor]: ") Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+>
       (([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
txt (Text -> Widget Name) -> ([Text] -> Text) -> [Text] -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.concat) Bool
True Editor Text Name
e)

drawMain :: Bool -> ChatState -> [Widget Name]
drawMain :: Bool -> ChatState -> [Widget Name]
drawMain Bool
useColor ChatState
st =
    let maybeColor :: Widget n -> Widget n
maybeColor = if Bool
useColor then Widget n -> Widget n
forall a. a -> a
id else AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
forceAttr AttrName
"invalid"
    in Widget Name -> Widget Name
forall n. Widget n -> Widget n
maybeColor (Widget Name -> Widget Name) -> [Widget Name] -> [Widget Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
           [ ChatState -> Widget Name
connectionLayer ChatState
st
           , ChatState -> Widget Name
autocompleteLayer ChatState
st
           , Widget Name -> Widget Name
forall n. Widget n -> Widget n
joinBorders (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ ChatState -> Widget Name
mainInterface ChatState
st
           ]

teamList :: ChatState -> Widget Name
teamList :: ChatState -> Widget Name
teamList ChatState
st =
    let curTid :: TeamId
curTid = ChatState
stChatState -> Getting TeamId ChatState TeamId -> TeamId
forall s a. s -> Getting a s a -> a
^.Getting TeamId ChatState TeamId
SimpleGetter ChatState TeamId
csCurrentTeamId
        z :: Zipper () TeamId
z = ChatState
stChatState
-> Getting (Zipper () TeamId) ChatState (Zipper () TeamId)
-> Zipper () TeamId
forall s a. s -> Getting a s a -> a
^.Getting (Zipper () TeamId) ChatState (Zipper () TeamId)
Lens' ChatState (Zipper () TeamId)
csTeamZipper
        teams :: [TeamState]
teams = (\TeamId
tId -> ChatState
stChatState -> Getting TeamState ChatState TeamState -> TeamState
forall s a. s -> Getting a s a -> a
^.TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)) (TeamId -> TeamState) -> [TeamId] -> [TeamState]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([[TeamId]] -> [TeamId]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[TeamId]] -> [TeamId]) -> [[TeamId]] -> [TeamId]
forall a b. (a -> b) -> a -> b
$ ((), [TeamId]) -> [TeamId]
forall a b. (a, b) -> b
snd (((), [TeamId]) -> [TeamId]) -> [((), [TeamId])] -> [[TeamId]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Zipper () TeamId -> [((), [TeamId])]
forall a b. Zipper a b -> [(a, [b])]
Z.toList Zipper () TeamId
z)
        entries :: [Widget n]
entries = TeamState -> Widget n
forall n. TeamState -> Widget n
mkEntry (TeamState -> Widget n) -> [TeamState] -> [Widget n]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TeamState]
teams
        mkEntry :: TeamState -> Widget n
mkEntry TeamState
ts =
            let tId :: TeamId
tId = Team -> TeamId
teamId (Team -> TeamId) -> Team -> TeamId
forall a b. (a -> b) -> a -> b
$ TeamState -> Team
_tsTeam TeamState
ts
                unread :: Bool
unread = Int
uCount Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
                uCount :: Int
uCount = TeamId -> Int
unreadCount TeamId
tId
            in (if TeamId
tId TeamId -> TeamId -> Bool
forall a. Eq a => a -> a -> Bool
== TeamId
curTid
                   then Widget n -> Widget n
forall n. Widget n -> Widget n
visible (Widget n -> Widget n)
-> (Widget n -> Widget n) -> Widget n -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
currentTeamAttr
                   else if Bool
unread
                        then AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
unreadChannelAttr
                        else Widget n -> Widget n
forall a. a -> a
id) (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
T.strip (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ UserText -> Text
sanitizeUserText (UserText -> Text) -> UserText -> Text
forall a b. (a -> b) -> a -> b
$ Team -> UserText
teamDisplayName (Team -> UserText) -> Team -> UserText
forall a b. (a -> b) -> a -> b
$ TeamState -> Team
_tsTeam TeamState
ts)
        unreadCount :: TeamId -> Int
unreadCount TeamId
tId = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ((ChannelListGroup, [ChannelListEntry]) -> Int)
-> [(ChannelListGroup, [ChannelListEntry])] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ChannelListGroup -> Int
nonDMChannelListGroupUnread (ChannelListGroup -> Int)
-> ((ChannelListGroup, [ChannelListEntry]) -> ChannelListGroup)
-> (ChannelListGroup, [ChannelListEntry])
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChannelListGroup, [ChannelListEntry]) -> ChannelListGroup
forall a b. (a, b) -> a
fst) ([(ChannelListGroup, [ChannelListEntry])] -> [Int])
-> [(ChannelListGroup, [ChannelListEntry])] -> [Int]
forall a b. (a -> b) -> a -> b
$
                          Zipper ChannelListGroup ChannelListEntry
-> [(ChannelListGroup, [ChannelListEntry])]
forall a b. Zipper a b -> [(a, [b])]
Z.toList (Zipper ChannelListGroup ChannelListEntry
 -> [(ChannelListGroup, [ChannelListEntry])])
-> Zipper ChannelListGroup ChannelListEntry
-> [(ChannelListGroup, [ChannelListEntry])]
forall a b. (a -> b) -> a -> b
$ ChatState
stChatState
-> Getting
     (Zipper ChannelListGroup ChannelListEntry)
     ChatState
     (Zipper ChannelListGroup ChannelListEntry)
-> Zipper ChannelListGroup ChannelListEntry
forall s a. s -> Getting a s a -> a
^.TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)((TeamState
  -> Const (Zipper ChannelListGroup ChannelListEntry) TeamState)
 -> ChatState
 -> Const (Zipper ChannelListGroup ChannelListEntry) ChatState)
-> ((Zipper ChannelListGroup ChannelListEntry
     -> Const
          (Zipper ChannelListGroup ChannelListEntry)
          (Zipper ChannelListGroup ChannelListEntry))
    -> TeamState
    -> Const (Zipper ChannelListGroup ChannelListEntry) TeamState)
-> Getting
     (Zipper ChannelListGroup ChannelListEntry)
     ChatState
     (Zipper ChannelListGroup ChannelListEntry)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Zipper ChannelListGroup ChannelListEntry
 -> Const
      (Zipper ChannelListGroup ChannelListEntry)
      (Zipper ChannelListGroup ChannelListEntry))
-> TeamState
-> Const (Zipper ChannelListGroup ChannelListEntry) TeamState
Lens' TeamState (Zipper ChannelListGroup ChannelListEntry)
tsFocus
    in if [TeamState] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TeamState]
teams Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
       then Widget Name
forall n. Widget n
emptyWidget
       else [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
vBox [ [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
hBox [ 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
$ Text -> Widget Name
forall n. Text -> Widget n
txt Text
"Teams:"
                        , 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
$ Name -> ViewportType -> Widget Name -> Widget Name
forall n.
(Ord n, Show n) =>
n -> ViewportType -> Widget n -> Widget n
viewport Name
TeamList ViewportType
Horizontal (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 -> [Widget Name] -> [Widget Name]
forall a. a -> [a] -> [a]
intersperse (Text -> Widget Name
forall n. Text -> Widget n
txt Text
" ") [Widget Name]
forall n. [Widget n]
entries
                        ]
                 , Widget Name
forall n. Widget n
hBorder
                 ]

connectionLayer :: ChatState -> Widget Name
connectionLayer :: ChatState -> Widget Name
connectionLayer ChatState
st =
    case ChatState
stChatState
-> Getting ConnectionStatus ChatState ConnectionStatus
-> ConnectionStatus
forall s a. s -> Getting a s a -> a
^.Getting ConnectionStatus ChatState ConnectionStatus
Lens' ChatState ConnectionStatus
csConnectionStatus of
        ConnectionStatus
Connected -> Widget Name
forall n. Widget n
emptyWidget
        ConnectionStatus
Disconnected ->
            Size -> Size -> RenderM Name (Result Name) -> Widget Name
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed (RenderM Name (Result Name) -> Widget Name)
-> RenderM Name (Result Name) -> Widget Name
forall a b. (a -> b) -> a -> b
$ do
                Context
ctx <- RenderM Name Context
forall n. RenderM n Context
getContext
                let aw :: Int
aw = Context
ctxContext -> Getting Int Context Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Context Int
Lens' Context Int
availWidthL
                    w :: Int
w = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
msg Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2
                    msg :: String
msg = String
"NOT CONNECTED"
                Widget Name -> RenderM Name (Result Name)
forall n. Widget n -> RenderM n (Result n)
render (Widget Name -> RenderM Name (Result Name))
-> Widget Name -> RenderM Name (Result Name)
forall a b. (a -> b) -> a -> b
$ Location -> Widget Name -> Widget Name
forall n. Location -> Widget n -> Widget n
translateBy ((Int, Int) -> Location
Location (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
aw Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
w), Int
0)) (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
                         AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
errorMessageAttr (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
border (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
msg

messageSelectBottomBar :: ChatState -> Widget Name
messageSelectBottomBar :: ChatState -> Widget Name
messageSelectBottomBar ChatState
st =
    case ChatState -> Maybe Message
getSelectedMessage 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))
                -- make sure these keybinding pieces are up-to-date!
                ev :: KeyEvent -> Text
ev KeyEvent
e =
                  let keyconf :: KeyConfig
keyconf = 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
                      KeyHandlerMap Map Event KeyHandler
keymap = KeyConfig -> KeyHandlerMap
messageSelectKeybindings KeyConfig
keyconf
                  in Text -> [Text] -> Text
T.intercalate Text
","
                       [ Binding -> Text
ppBinding (Event -> Binding
eventToBinding Event
k)
                       | KH { khKey :: KeyHandler -> Event
khKey     = Event
k
                            , khHandler :: KeyHandler -> KeyEventHandler
khHandler = KeyEventHandler
h
                            } <- Map Event KeyHandler -> [KeyHandler]
forall k a. Map k a -> [a]
M.elems Map Event KeyHandler
keymap
                       , KeyEventHandler -> KeyEventTrigger
kehEventTrigger KeyEventHandler
h KeyEventTrigger -> KeyEventTrigger -> Bool
forall a. Eq a => a -> a -> Bool
== KeyEvent -> KeyEventTrigger
ByEvent KeyEvent
e
                       ]
                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
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 [ (BorderStyle -> Char) -> Widget Name
forall n. (BorderStyle -> Char) -> Widget n
borderElem BorderStyle -> Char
bsHorizontal
                    , Text -> Widget Name
forall n. Text -> Widget n
txt Text
"["
                    , Text -> Widget Name
forall n. Text -> Widget n
txt Text
"Message select: "
                    , Widget Name
forall n. Widget n
optionList
                    , Text -> Widget Name
forall n. Text -> Widget n
txt Text
"]"
                    , Widget Name
forall n. Widget n
hBorder
                    ]

maybePreviewViewport :: TeamId -> Widget Name -> Widget Name
maybePreviewViewport :: TeamId -> Widget Name -> Widget Name
maybePreviewViewport TeamId
tId Widget Name
w =
    Size -> Size -> RenderM Name (Result Name) -> Widget Name
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Greedy Size
Fixed (RenderM Name (Result Name) -> Widget Name)
-> RenderM Name (Result Name) -> Widget Name
forall a b. (a -> b) -> a -> b
$ do
        Result Name
result <- Widget Name -> RenderM Name (Result Name)
forall n. Widget n -> RenderM n (Result n)
render Widget Name
w
        case (Image -> Int
Vty.imageHeight (Image -> Int) -> Image -> Int
forall a b. (a -> b) -> a -> b
$ Result Name
resultResult Name -> Getting Image (Result Name) Image -> Image
forall s a. s -> Getting a s a -> a
^.Getting Image (Result Name) Image
forall n. Lens' (Result n) Image
imageL) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
previewMaxHeight of
            Bool
False -> Result Name -> RenderM Name (Result Name)
forall (m :: * -> *) a. Monad m => a -> m a
return Result Name
result
            Bool
True ->
                Widget Name -> RenderM Name (Result Name)
forall n. Widget n -> RenderM n (Result n)
render (Widget Name -> RenderM Name (Result Name))
-> Widget Name -> RenderM Name (Result Name)
forall a b. (a -> b) -> a -> b
$ Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
vLimit Int
previewMaxHeight (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ Name -> ViewportType -> Widget Name -> Widget Name
forall n.
(Ord n, Show n) =>
n -> ViewportType -> Widget n -> Widget n
viewport (TeamId -> Name
MessagePreviewViewport TeamId
tId) ViewportType
Vertical (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
                         (Size -> Size -> RenderM Name (Result Name) -> Widget Name
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed (RenderM Name (Result Name) -> Widget Name)
-> RenderM Name (Result Name) -> Widget Name
forall a b. (a -> b) -> a -> b
$ Result Name -> RenderM Name (Result Name)
forall (m :: * -> *) a. Monad m => a -> m a
return Result Name
result)

inputPreview :: ChatState -> HighlightSet -> Widget Name
inputPreview :: ChatState -> HighlightSet -> Widget Name
inputPreview ChatState
st HighlightSet
hs | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ 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
.(Config -> Const Bool Config)
-> ChatResources -> Const Bool ChatResources
Lens' ChatResources Config
crConfiguration((Config -> Const Bool Config)
 -> ChatResources -> Const Bool ChatResources)
-> ((Bool -> Const Bool Bool) -> Config -> Const Bool Config)
-> (Bool -> Const Bool Bool)
-> ChatResources
-> Const Bool ChatResources
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Const Bool Bool) -> Config -> Const Bool Config
Lens' Config Bool
configShowMessagePreviewL = Widget Name
forall n. Widget n
emptyWidget
                   | Bool
otherwise = Widget Name
thePreview
    where
    uId :: UserId
uId = ChatState -> UserId
myUserId ChatState
st
    tId :: TeamId
tId = ChatState
stChatState -> Getting TeamId ChatState TeamId -> TeamId
forall s a. s -> Getting a s a -> a
^.Getting TeamId ChatState TeamId
SimpleGetter ChatState TeamId
csCurrentTeamId
    -- Insert a cursor sentinel into the input text just before
    -- rendering the preview. We use the inserted sentinel (which is
    -- not rendered) to get brick to ensure that the line the cursor is
    -- on is visible in the preview viewport. We put the sentinel at
    -- the *end* of the line because it will still influence markdown
    -- parsing and can create undesirable/confusing churn in the
    -- rendering while the cursor moves around. If the cursor is at the
    -- end of whatever line the user is editing, that is very unlikely
    -- to be a problem.
    curContents :: [Text]
curContents = TextZipper Text -> [Text]
forall a. Monoid a => TextZipper a -> [a]
getText (TextZipper Text -> [Text]) -> TextZipper Text -> [Text]
forall a b. (a -> b) -> a -> b
$ (TextZipper Text -> TextZipper Text
forall a. Monoid a => TextZipper a -> TextZipper a
gotoEOL (TextZipper Text -> TextZipper Text)
-> (TextZipper Text -> TextZipper Text)
-> TextZipper Text
-> TextZipper Text
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Char -> TextZipper Text -> TextZipper Text
forall a. Monoid a => Char -> TextZipper a -> TextZipper a
insertChar Char
cursorSentinel) (TextZipper Text -> TextZipper Text)
-> TextZipper Text -> TextZipper Text
forall a b. (a -> b) -> a -> b
$
                  ChatState
stChatState
-> Getting (TextZipper Text) ChatState (TextZipper Text)
-> TextZipper Text
forall s a. s -> Getting a s a -> a
^.(TeamState -> Const (TextZipper Text) TeamState)
-> ChatState -> Const (TextZipper Text) ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Const (TextZipper Text) TeamState)
 -> ChatState -> Const (TextZipper Text) ChatState)
-> ((TextZipper Text -> Const (TextZipper Text) (TextZipper Text))
    -> TeamState -> Const (TextZipper Text) TeamState)
-> Getting (TextZipper Text) ChatState (TextZipper Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChatEditState -> Const (TextZipper Text) ChatEditState)
-> TeamState -> Const (TextZipper Text) TeamState
Lens' TeamState ChatEditState
tsEditState((ChatEditState -> Const (TextZipper Text) ChatEditState)
 -> TeamState -> Const (TextZipper Text) TeamState)
-> ((TextZipper Text -> Const (TextZipper Text) (TextZipper Text))
    -> ChatEditState -> Const (TextZipper Text) ChatEditState)
-> (TextZipper Text -> Const (TextZipper Text) (TextZipper Text))
-> TeamState
-> Const (TextZipper Text) TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Editor Text Name -> Const (TextZipper Text) (Editor Text Name))
-> ChatEditState -> Const (TextZipper Text) ChatEditState
Lens' ChatEditState (Editor Text Name)
cedEditor((Editor Text Name -> Const (TextZipper Text) (Editor Text Name))
 -> ChatEditState -> Const (TextZipper Text) ChatEditState)
-> ((TextZipper Text -> Const (TextZipper Text) (TextZipper Text))
    -> Editor Text Name -> Const (TextZipper Text) (Editor Text Name))
-> (TextZipper Text -> Const (TextZipper Text) (TextZipper Text))
-> ChatEditState
-> Const (TextZipper Text) ChatEditState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(TextZipper Text -> Const (TextZipper Text) (TextZipper Text))
-> Editor Text Name -> Const (TextZipper Text) (Editor Text Name)
forall t1 n t2.
Lens (Editor t1 n) (Editor t2 n) (TextZipper t1) (TextZipper t2)
editContentsL
    curStr :: Text
curStr = Text -> [Text] -> Text
T.intercalate Text
"\n" [Text]
curContents
    overrideTy :: Maybe MessageType
overrideTy = case ChatState
stChatState -> Getting EditMode ChatState EditMode -> EditMode
forall s a. s -> Getting a s a -> a
^.(TeamState -> Const EditMode TeamState)
-> ChatState -> Const EditMode ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Const EditMode TeamState)
 -> ChatState -> Const EditMode ChatState)
-> ((EditMode -> Const EditMode EditMode)
    -> TeamState -> Const EditMode TeamState)
-> Getting EditMode ChatState EditMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChatEditState -> Const EditMode ChatEditState)
-> TeamState -> Const EditMode TeamState
Lens' TeamState ChatEditState
tsEditState((ChatEditState -> Const EditMode ChatEditState)
 -> TeamState -> Const EditMode TeamState)
-> ((EditMode -> Const EditMode EditMode)
    -> ChatEditState -> Const EditMode ChatEditState)
-> (EditMode -> Const EditMode EditMode)
-> TeamState
-> Const EditMode TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EditMode -> Const EditMode EditMode)
-> ChatEditState -> Const EditMode ChatEditState
Lens' ChatEditState EditMode
cedEditMode of
        Editing Post
_ MessageType
ty -> MessageType -> Maybe MessageType
forall a. a -> Maybe a
Just MessageType
ty
        EditMode
_ -> Maybe MessageType
forall a. Maybe a
Nothing
    baseUrl :: TeamBaseURL
baseUrl = ChatState -> TeamId -> TeamBaseURL
serverBaseUrl ChatState
st TeamId
tId
    previewMsg :: Maybe Message
previewMsg = TeamBaseURL -> Maybe MessageType -> UserId -> Text -> Maybe Message
previewFromInput TeamBaseURL
baseUrl Maybe MessageType
overrideTy UserId
uId Text
curStr
    thePreview :: Widget Name
thePreview = let noPreview :: Widget n
noPreview = String -> Widget n
forall n. String -> Widget n
str String
"(No preview)"
                     msgPreview :: Widget Name
msgPreview = case Maybe Message
previewMsg of
                       Maybe Message
Nothing -> Widget Name
forall n. Widget n
noPreview
                       Just Message
pm -> if Text -> Bool
T.null Text
curStr
                                  then Widget Name
forall n. Widget n
noPreview
                                  else Message -> Maybe Message -> Widget Name
prview Message
pm (Maybe Message -> Widget Name) -> Maybe Message -> Widget Name
forall a b. (a -> b) -> a -> b
$ ChatState -> Message -> Maybe Message
getParentMessage ChatState
st Message
pm
                     prview :: Message -> Maybe Message -> Widget Name
prview Message
m Maybe Message
p = MessageData -> Widget Name
renderMessage MessageData :: Maybe ServerTime
-> Bool
-> Bool
-> Message
-> Maybe Text
-> Maybe Message
-> Maybe Text
-> ThreadState
-> Bool
-> HighlightSet
-> Bool
-> Maybe Int
-> Text
-> Bool
-> MessageData
MessageData
                                  { mdMessage :: Message
mdMessage           = Message
m
                                  , mdUserName :: Maybe Text
mdUserName          = Message
mMessage -> Getting (Maybe Text) Message (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^.(UserRef -> Const (Maybe Text) UserRef)
-> Message -> Const (Maybe Text) Message
Lens' Message UserRef
mUser((UserRef -> Const (Maybe Text) UserRef)
 -> Message -> Const (Maybe Text) Message)
-> ((Maybe Text -> Const (Maybe Text) (Maybe Text))
    -> UserRef -> Const (Maybe Text) UserRef)
-> Getting (Maybe Text) Message (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(UserRef -> Maybe Text) -> SimpleGetter UserRef (Maybe Text)
forall s a. (s -> a) -> SimpleGetter s a
to (ChatState -> UserRef -> Maybe Text
nameForUserRef ChatState
st)
                                  , mdParentMessage :: Maybe Message
mdParentMessage     = Maybe Message
p
                                  , mdParentUserName :: Maybe Text
mdParentUserName    = Maybe Message
p Maybe Message -> (Message -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Message -> Getting (Maybe Text) Message (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^.(UserRef -> Const (Maybe Text) UserRef)
-> Message -> Const (Maybe Text) Message
Lens' Message UserRef
mUser((UserRef -> Const (Maybe Text) UserRef)
 -> Message -> Const (Maybe Text) Message)
-> ((Maybe Text -> Const (Maybe Text) (Maybe Text))
    -> UserRef -> Const (Maybe Text) UserRef)
-> Getting (Maybe Text) Message (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(UserRef -> Maybe Text) -> SimpleGetter UserRef (Maybe Text)
forall s a. (s -> a) -> SimpleGetter s a
to (ChatState -> UserRef -> Maybe Text
nameForUserRef ChatState
st))
                                  , 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
                                  , mdIndentBlocks :: Bool
mdIndentBlocks      = Bool
True
                                  , 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
                                  , mdWrapNonhighlightedCodeBlocks :: Bool
mdWrapNonhighlightedCodeBlocks = Bool
True
                                  }
                 in (TeamId -> Widget Name -> Widget Name
maybePreviewViewport TeamId
tId Widget Name
msgPreview) Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=>
                    Widget Name -> Widget Name
forall n. Widget n -> Widget n
hBorderWithLabel (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
"[Preview ↑]")

userInputArea :: ChatState -> HighlightSet -> Widget Name
userInputArea :: ChatState -> HighlightSet -> Widget Name
userInputArea ChatState
st HighlightSet
hs =
    case ChatState
stChatState -> Getting Mode ChatState Mode -> Mode
forall s a. s -> Getting a s a -> a
^.(TeamState -> Const Mode TeamState)
-> ChatState -> Const Mode ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Const Mode TeamState)
 -> ChatState -> Const Mode ChatState)
-> ((Mode -> Const Mode Mode) -> TeamState -> Const Mode TeamState)
-> Getting Mode ChatState Mode
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Mode -> Const Mode Mode) -> TeamState -> Const Mode TeamState
Lens' TeamState Mode
tsMode of
        Mode
ChannelSelect -> ChatState -> Widget Name
renderChannelSelectPrompt ChatState
st
        Mode
UrlSelect     -> 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 [ Text -> Widget Name
forall n. Text -> Widget n
txt Text
"Press "
                                        , 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
" to open the selected URL or "
                                        , 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
"Escape"
                                        , Text -> Widget Name
forall n. Text -> Widget n
txt Text
" to cancel."
                                        ]
        Mode
MessageSelectDeleteConfirm -> Widget Name
renderDeleteConfirm
        Mode
_             -> ChatState -> HighlightSet -> Widget Name
renderUserCommandBox ChatState
st HighlightSet
hs

renderDeleteConfirm :: Widget Name
renderDeleteConfirm :: Widget Name
renderDeleteConfirm =
    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
$ Text -> Widget Name
forall n. Text -> Widget n
txt Text
"Are you sure you want to delete the selected message? (y/n)"

mainInterface :: ChatState -> Widget Name
mainInterface :: ChatState -> Widget Name
mainInterface ChatState
st =
    [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
vBox [ ChatState -> Widget Name
teamList ChatState
st
         , Widget Name
body
         ]
    where
    showChannelList :: Bool
showChannelList = 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
.(Config -> Const Bool Config)
-> ChatResources -> Const Bool ChatResources
Lens' ChatResources Config
crConfiguration((Config -> Const Bool Config)
 -> ChatResources -> Const Bool ChatResources)
-> ((Bool -> Const Bool Bool) -> Config -> Const Bool Config)
-> (Bool -> Const Bool Bool)
-> ChatResources
-> Const Bool ChatResources
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Const Bool Bool) -> Config -> Const Bool Config
Lens' Config Bool
configShowChannelListL Bool -> Bool -> Bool
||
                      ChatState
stChatState -> Getting Mode ChatState Mode -> Mode
forall s a. s -> Getting a s a -> a
^.(TeamState -> Const Mode TeamState)
-> ChatState -> Const Mode ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Const Mode TeamState)
 -> ChatState -> Const Mode ChatState)
-> ((Mode -> Const Mode Mode) -> TeamState -> Const Mode TeamState)
-> Getting Mode ChatState Mode
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Mode -> Const Mode Mode) -> TeamState -> Const Mode TeamState
Lens' TeamState Mode
tsMode Mode -> Mode -> Bool
forall a. Eq a => a -> a -> Bool
== Mode
ChannelSelect
    body :: Widget Name
body = if Bool
showChannelList
           then case ChatState
stChatState
-> Getting ChannelListOrientation ChatState ChannelListOrientation
-> ChannelListOrientation
forall s a. s -> Getting a s a -> a
^.Getting ChannelListOrientation ChatState ChannelListOrientation
Lens' ChatState ChannelListOrientation
csChannelListOrientation of
               ChannelListOrientation
ChannelListLeft ->
                   [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
hBox [Widget Name
channelList, Widget Name
forall n. Widget n
vBorder, Widget Name
mainDisplay]
               ChannelListOrientation
ChannelListRight ->
                   [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
hBox [Widget Name
mainDisplay, Widget Name
forall n. Widget n
vBorder, Widget Name
channelList]
           else Widget Name
mainDisplay
    channelList :: Widget Name
channelList = Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
hLimit Int
channelListWidth (ChatState -> Widget Name
renderChannelList ChatState
st)
    hs :: HighlightSet
hs = ChatState -> HighlightSet
getHighlightSet ChatState
st
    channelListWidth :: Int
channelListWidth = Config -> Int
configChannelListWidth (Config -> Int) -> Config -> Int
forall a b. (a -> b) -> a -> b
$ ChatState
stChatState -> Getting Config ChatState Config -> Config
forall s a. s -> Getting a s a -> a
^.(ChatResources -> Const Config ChatResources)
-> ChatState -> Const Config ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Const Config ChatResources)
 -> ChatState -> Const Config ChatState)
-> ((Config -> Const Config Config)
    -> ChatResources -> Const Config ChatResources)
-> Getting Config ChatState Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Config -> Const Config Config)
-> ChatResources -> Const Config ChatResources
Lens' ChatResources Config
crConfiguration
    mainDisplay :: Widget Name
mainDisplay =
        [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
vBox [ Widget Name
channelContents
             , Widget Name
bottomBorder
             , ChatState -> HighlightSet -> Widget Name
inputPreview ChatState
st HighlightSet
hs
             , ChatState -> HighlightSet -> Widget Name
userInputArea ChatState
st HighlightSet
hs
             ]
    channelContents :: Widget Name
channelContents = case ChatState
stChatState -> Getting Mode ChatState Mode -> Mode
forall s a. s -> Getting a s a -> a
^.(TeamState -> Const Mode TeamState)
-> ChatState -> Const Mode ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Const Mode TeamState)
 -> ChatState -> Const Mode ChatState)
-> ((Mode -> Const Mode Mode) -> TeamState -> Const Mode TeamState)
-> Getting Mode ChatState Mode
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Mode -> Const Mode Mode) -> TeamState -> Const Mode TeamState
Lens' TeamState Mode
tsMode of
        Mode
UrlSelect -> ChatState -> Widget Name
renderUrlList ChatState
st
        Mode
_         -> Widget Name -> Widget Name
forall n. Widget n -> Widget n
maybeSubdue (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ ChatState -> HighlightSet -> Widget Name
renderCurrentChannelDisplay ChatState
st HighlightSet
hs

    bottomBorder :: Widget Name
bottomBorder = case ChatState
stChatState -> Getting Mode ChatState Mode -> Mode
forall s a. s -> Getting a s a -> a
^.(TeamState -> Const Mode TeamState)
-> ChatState -> Const Mode ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Const Mode TeamState)
 -> ChatState -> Const Mode ChatState)
-> ((Mode -> Const Mode Mode) -> TeamState -> Const Mode TeamState)
-> Getting Mode ChatState Mode
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Mode -> Const Mode Mode) -> TeamState -> Const Mode TeamState
Lens' TeamState Mode
tsMode of
        Mode
MessageSelect -> ChatState -> Widget Name
messageSelectBottomBar ChatState
st
        Mode
_ -> Widget Name -> Widget Name
forall n. Widget n -> Widget n
maybeSubdue (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
forall n. Widget n
showAttachmentCount
             , Widget Name
forall n. Widget n
hBorder
             , Widget Name
forall n. Widget n
showTypingUsers
             , Widget Name
forall n. Widget n
showBusy
             ]

    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
^.(TeamState
 -> Const (GenericList Name Vector AttachmentData) TeamState)
-> ChatState
-> Const (GenericList Name Vector AttachmentData) ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState
  -> Const (GenericList Name Vector AttachmentData) TeamState)
 -> ChatState
 -> Const (GenericList Name Vector AttachmentData) ChatState)
-> ((GenericList Name Vector AttachmentData
     -> Const
          (GenericList Name Vector AttachmentData)
          (GenericList Name Vector AttachmentData))
    -> TeamState
    -> Const (GenericList Name Vector AttachmentData) TeamState)
-> Getting
     (GenericList Name Vector AttachmentData)
     ChatState
     (GenericList Name Vector AttachmentData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChatEditState
 -> Const (GenericList Name Vector AttachmentData) ChatEditState)
-> TeamState
-> Const (GenericList Name Vector AttachmentData) TeamState
Lens' TeamState ChatEditState
tsEditState((ChatEditState
  -> Const (GenericList Name Vector AttachmentData) ChatEditState)
 -> TeamState
 -> Const (GenericList Name Vector AttachmentData) TeamState)
-> ((GenericList Name Vector AttachmentData
     -> Const
          (GenericList Name Vector AttachmentData)
          (GenericList Name Vector AttachmentData))
    -> ChatEditState
    -> Const (GenericList Name Vector AttachmentData) ChatEditState)
-> (GenericList Name Vector AttachmentData
    -> Const
         (GenericList Name Vector AttachmentData)
         (GenericList Name Vector AttachmentData))
-> TeamState
-> Const (GenericList Name Vector AttachmentData) TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(GenericList Name Vector AttachmentData
 -> Const
      (GenericList Name Vector AttachmentData)
      (GenericList Name Vector AttachmentData))
-> ChatEditState
-> Const (GenericList Name Vector AttachmentData) ChatEditState
Lens' ChatEditState (GenericList Name Vector AttachmentData)
cedAttachmentList
        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 [ (BorderStyle -> Char) -> Widget n
forall n. (BorderStyle -> Char) -> Widget n
borderElem BorderStyle -> Char
bsHorizontal
                     , 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 (KeyEvent -> Binding
getFirstDefaultBinding KeyEvent
ShowAttachmentListEvent)
                     , Text -> Widget n
forall n. Text -> Widget n
txt Text
" to manage)"
                     ]

    showTypingUsers :: Widget n
showTypingUsers =
        let format :: Text -> Widget a
format = Maybe TeamBaseURL -> Text -> HighlightSet -> Text -> Widget a
forall a.
Maybe TeamBaseURL -> Text -> HighlightSet -> Text -> Widget a
renderText' Maybe TeamBaseURL
forall a. Maybe a
Nothing (ChatState -> Text
myUsername ChatState
st) HighlightSet
hs
        in case TypingUsers -> [UserId]
allTypingUsers (ChatState
stChatState
-> Getting TypingUsers ChatState TypingUsers -> TypingUsers
forall s a. s -> Getting a s a -> a
^.(ClientChannel -> Const TypingUsers ClientChannel)
-> ChatState -> Const TypingUsers ChatState
Lens' ChatState ClientChannel
csCurrentChannel((ClientChannel -> Const TypingUsers ClientChannel)
 -> ChatState -> Const TypingUsers ChatState)
-> ((TypingUsers -> Const TypingUsers TypingUsers)
    -> ClientChannel -> Const TypingUsers ClientChannel)
-> Getting TypingUsers ChatState TypingUsers
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChannelInfo -> Const TypingUsers ChannelInfo)
-> ClientChannel -> Const TypingUsers ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Const TypingUsers ChannelInfo)
 -> ClientChannel -> Const TypingUsers ClientChannel)
-> ((TypingUsers -> Const TypingUsers TypingUsers)
    -> ChannelInfo -> Const TypingUsers ChannelInfo)
-> (TypingUsers -> Const TypingUsers TypingUsers)
-> ClientChannel
-> Const TypingUsers ClientChannel
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(TypingUsers -> Const TypingUsers TypingUsers)
-> ChannelInfo -> Const TypingUsers ChannelInfo
Lens' ChannelInfo TypingUsers
cdTypingUsers) of
            [] -> Widget n
forall n. Widget n
emptyWidget
            [UserId
uId] | Just Text
un <- UserId -> ChatState -> Maybe Text
usernameForUserId UserId
uId ChatState
st ->
               Text -> Widget n
forall n. Text -> Widget n
format (Text -> Widget n) -> Text -> Widget n
forall a b. (a -> b) -> a -> b
$ Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
userSigil Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> 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 n
forall n. Text -> Widget n
format (Text -> Widget n) -> Text -> Widget n
forall a b. (a -> b) -> a -> b
$ Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
userSigil Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> 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
userSigil Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
un2 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" are typing]"
            [UserId]
_ -> Text -> Widget n
forall n. Text -> Widget n
format Text
"[several people are typing]"

    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 -> ShowS
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

    maybeSubdue :: Widget n -> Widget n
maybeSubdue = if ChatState
stChatState -> Getting Mode ChatState Mode -> Mode
forall s a. s -> Getting a s a -> a
^.(TeamState -> Const Mode TeamState)
-> ChatState -> Const Mode ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Const Mode TeamState)
 -> ChatState -> Const Mode ChatState)
-> ((Mode -> Const Mode Mode) -> TeamState -> Const Mode TeamState)
-> Getting Mode ChatState Mode
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Mode -> Const Mode Mode) -> TeamState -> Const Mode TeamState
Lens' TeamState Mode
tsMode Mode -> Mode -> Bool
forall a. Eq a => a -> a -> Bool
== Mode
ChannelSelect
                  then AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
forceAttr AttrName
""
                  else Widget n -> Widget n
forall a. a -> a
id

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
ctx <- RenderM a Context
forall n. RenderM n Context
getContext
        let bs :: BorderStyle
bs = Context
ctxContext -> Getting BorderStyle Context BorderStyle -> BorderStyle
forall s a. s -> Getting a s a -> a
^.Getting BorderStyle Context BorderStyle
Lens' Context 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
'▸']