{-# 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 =
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
, _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
}
data Token =
Ignore Text
| Check Text
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)
doHighlightMisspellings :: HighlightSet -> S.Set Text -> [Text] -> Widget Name
doHighlightMisspellings :: HighlightSet -> Set Text -> [Text] -> Widget Name
doHighlightMisspellings HighlightSet
hSet Set Text
misspellings [Text]
contents =
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 =
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 =
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
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 =
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 =
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 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
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
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))
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
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
'▸']