{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE RankNTypes #-}
module Matterhorn.Draw.Main
( drawMain
)
where
import Prelude ()
import Matterhorn.Prelude
import Brick
import Brick.Widgets.Border
import Data.List ( intersperse )
import Data.Maybe ( fromJust )
import qualified Data.Text as T
import Lens.Micro.Platform ( Lens' )
import Network.Mattermost.Types ( Type(Direct, Private, Group)
, TeamId, teamDisplayName, teamId
)
import Matterhorn.Draw.ChannelList ( renderChannelList, channelListWidth )
import Matterhorn.Draw.Messages
import Matterhorn.Draw.MessageInterface
import Matterhorn.Draw.Autocomplete
import Matterhorn.Draw.Util
import Matterhorn.Draw.RichText
import Matterhorn.Themes
import Matterhorn.Types
import Matterhorn.Types.Common ( sanitizeUserText )
import qualified Matterhorn.Zipper as Z
drawMain :: ChatState -> Mode -> [Widget Name]
drawMain :: ChatState -> Mode -> [Widget Name]
drawMain ChatState
st Mode
mode =
(ChatState -> Widget Name
connectionLayer ChatState
st Widget Name -> [Widget Name] -> [Widget Name]
forall a. a -> [a] -> [a]
: ChatState -> [Widget Name]
drawAutocompleteLayers ChatState
st) [Widget Name] -> [Widget Name] -> [Widget Name]
forall a. Semigroup a => a -> a -> a
<>
[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 -> Mode -> Maybe TeamId -> Widget Name
mainInterface ChatState
st Mode
mode (ChatState
stChatState
-> Getting (Maybe TeamId) ChatState (Maybe TeamId) -> Maybe TeamId
forall s a. s -> Getting a s a -> a
^.Getting (Maybe TeamId) ChatState (Maybe TeamId)
SimpleGetter ChatState (Maybe TeamId)
csCurrentTeamId)]
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 Name
ctx <- RenderM Name (Context Name)
forall n. RenderM n (Context n)
getContext
let aw :: Int
aw = Context Name
ctxContext Name -> Getting Int (Context Name) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (Context Name) Int
forall n (f :: * -> *).
Functor f =>
(Int -> f Int) -> Context n -> f (Context n)
availWidthL
w :: Int
w = String -> Int
forall a. [a] -> 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
mainInterface :: ChatState -> Mode -> Maybe TeamId -> Widget Name
mainInterface :: ChatState -> Mode -> Maybe TeamId -> Widget Name
mainInterface ChatState
st Mode
mode Maybe TeamId
mtId =
[Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
vBox [ ChatState -> Widget Name
teamList ChatState
st
, Widget Name
body
]
where
config :: Config
config = 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
showChannelList :: Bool
showChannelList =
Config
configConfig -> Getting Bool Config Bool -> Bool
forall s a. s -> Getting a s a -> a
^.Getting Bool Config Bool
Lens' Config Bool
configShowChannelListL Bool -> Bool -> Bool
||
case Maybe TeamId
mtId of
Maybe TeamId
Nothing -> Bool
True
Just {} -> Mode
mode 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
mainDisplay :: Widget Name
mainDisplay = Widget Name -> Widget Name
forall n. Widget n -> Widget n
maybeSubdue Widget Name
messageInterface
channelList :: Widget Name
channelList = Mode -> Widget Name -> Widget Name
forall {n}. Mode -> Widget n -> Widget n
channelListMaybeVlimit Mode
mode (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
hLimit (ChatState -> Int
channelListWidth ChatState
st) (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ case Maybe TeamId
mtId of
Maybe TeamId
Nothing -> Char -> Widget Name
forall n. Char -> Widget n
fill Char
' '
Just TeamId
tId -> ChatState -> TeamId -> Widget Name
renderChannelList ChatState
st TeamId
tId
channelListMaybeVlimit :: Mode -> Widget n -> Widget n
channelListMaybeVlimit Mode
ChannelSelect Widget n
w =
Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget (Widget n -> Size
forall n. Widget n -> Size
hSize Widget n
w) (Widget n -> Size
forall n. Widget n -> Size
vSize Widget n
w) (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ do
Context n
ctx <- RenderM n (Context n)
forall n. RenderM n (Context n)
getContext
Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render (Widget n -> RenderM n (Result n))
-> Widget n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
vLimit (Context n
ctxContext n -> Getting Int (Context n) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (Context n) Int
forall n (f :: * -> *).
Functor f =>
(Int -> f Int) -> Context n -> f (Context n)
availHeightL Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Widget n
w
channelListMaybeVlimit Mode
_ Widget n
w = Widget n
w
noMessageInterface :: Widget n
noMessageInterface = Char -> Widget n
forall n. Char -> Widget n
fill Char
' '
messageInterface :: Widget Name
messageInterface = Widget Name -> Maybe (Widget Name) -> Widget Name
forall a. a -> Maybe a -> a
fromMaybe Widget Name
forall n. Widget n
noMessageInterface (Maybe (Widget Name) -> Widget Name)
-> Maybe (Widget Name) -> Widget Name
forall a b. (a -> b) -> a -> b
$ do
TeamId
tId <- Maybe TeamId
mtId
let hs :: HighlightSet
hs = ChatState -> TeamId -> HighlightSet
getHighlightSet ChatState
st TeamId
tId
channelHeader :: ClientChannel -> Widget Name
channelHeader ClientChannel
chan =
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 -> TeamId -> HighlightSet -> ClientChannel -> Widget Name
renderChannelHeader ChatState
st TeamId
tId HighlightSet
hs ClientChannel
chan
focused :: Bool
focused = ChatState
stChatState
-> Getting MessageInterfaceFocus ChatState MessageInterfaceFocus
-> MessageInterfaceFocus
forall s a. s -> Getting a s a -> a
^.TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)((TeamState -> Const MessageInterfaceFocus TeamState)
-> ChatState -> Const MessageInterfaceFocus ChatState)
-> ((MessageInterfaceFocus
-> Const MessageInterfaceFocus MessageInterfaceFocus)
-> TeamState -> Const MessageInterfaceFocus TeamState)
-> Getting MessageInterfaceFocus ChatState MessageInterfaceFocus
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MessageInterfaceFocus
-> Const MessageInterfaceFocus MessageInterfaceFocus)
-> TeamState -> Const MessageInterfaceFocus TeamState
Lens' TeamState MessageInterfaceFocus
tsMessageInterfaceFocus MessageInterfaceFocus -> MessageInterfaceFocus -> Bool
forall a. Eq a => a -> a -> Bool
== MessageInterfaceFocus
FocusCurrentChannel Bool -> Bool -> Bool
&&
Bool
threadShowing
threadShowing :: Bool
threadShowing = Maybe ThreadInterface -> Bool
forall a. Maybe a -> Bool
isJust (Maybe ThreadInterface -> Bool) -> Maybe ThreadInterface -> Bool
forall a b. (a -> b) -> a -> b
$ ChatState
stChatState
-> Getting
(Maybe ThreadInterface) ChatState (Maybe ThreadInterface)
-> Maybe ThreadInterface
forall s a. s -> Getting a s a -> a
^.TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)((TeamState -> Const (Maybe ThreadInterface) TeamState)
-> ChatState -> Const (Maybe ThreadInterface) ChatState)
-> ((Maybe ThreadInterface
-> Const (Maybe ThreadInterface) (Maybe ThreadInterface))
-> TeamState -> Const (Maybe ThreadInterface) TeamState)
-> Getting
(Maybe ThreadInterface) ChatState (Maybe ThreadInterface)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe ThreadInterface
-> Const (Maybe ThreadInterface) (Maybe ThreadInterface))
-> TeamState -> Const (Maybe ThreadInterface) TeamState
Lens' TeamState (Maybe ThreadInterface)
tsThreadInterface
channelMessageIface :: ChannelId -> Widget Name
channelMessageIface ChannelId
cId =
ChatState
-> HighlightSet
-> TeamId
-> Bool
-> Lens' ChatState (MessageInterface Name ())
-> Bool
-> Bool
-> Widget Name
forall i.
ChatState
-> HighlightSet
-> TeamId
-> Bool
-> Lens' ChatState (MessageInterface Name i)
-> Bool
-> Bool
-> Widget Name
drawMessageInterface ChatState
st HighlightSet
hs TeamId
tId Bool
True
(ChannelId -> Lens' ChatState (MessageInterface Name ())
csChannelMessageInterface(ChannelId
cId))
Bool
True
Bool
focused
maybeThreadIface :: Maybe (Widget Name)
maybeThreadIface = do
ThreadInterface
_ <- ChatState
stChatState
-> Getting
(Maybe ThreadInterface) ChatState (Maybe ThreadInterface)
-> Maybe ThreadInterface
forall s a. s -> Getting a s a -> a
^.TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)((TeamState -> Const (Maybe ThreadInterface) TeamState)
-> ChatState -> Const (Maybe ThreadInterface) ChatState)
-> ((Maybe ThreadInterface
-> Const (Maybe ThreadInterface) (Maybe ThreadInterface))
-> TeamState -> Const (Maybe ThreadInterface) TeamState)
-> Getting
(Maybe ThreadInterface) ChatState (Maybe ThreadInterface)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe ThreadInterface
-> Const (Maybe ThreadInterface) (Maybe ThreadInterface))
-> TeamState -> Const (Maybe ThreadInterface) TeamState
Lens' TeamState (Maybe ThreadInterface)
tsThreadInterface
Widget Name -> Maybe (Widget Name)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Widget Name -> Maybe (Widget Name))
-> Widget Name -> Maybe (Widget Name)
forall a b. (a -> b) -> a -> b
$ ChatState -> TeamId -> Widget Name
drawThreadWindow ChatState
st TeamId
tId
ChannelId
cId <- ChatState
stChatState
-> Getting (Maybe ChannelId) ChatState (Maybe ChannelId)
-> Maybe ChannelId
forall s a. s -> Getting a s a -> a
^.TeamId -> SimpleGetter ChatState (Maybe ChannelId)
csCurrentChannelId(TeamId
tId)
ClientChannel
ch <- ChatState
stChatState
-> Getting (First ClientChannel) ChatState ClientChannel
-> Maybe ClientChannel
forall s a. s -> Getting (First a) s a -> Maybe a
^?ChannelId -> Traversal' ChatState ClientChannel
csChannel(ChannelId
cId)
let channelUI :: Widget Name
channelUI = ClientChannel -> Widget Name
channelHeader ClientChannel
ch 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
<=> ChannelId -> Widget Name
channelMessageIface ChannelId
cId
Widget Name -> Maybe (Widget Name)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Widget Name -> Maybe (Widget Name))
-> Widget Name -> Maybe (Widget Name)
forall a b. (a -> b) -> a -> b
$ Widget Name -> Maybe (Widget Name) -> Widget Name
forall a. a -> Maybe a -> a
fromMaybe Widget Name
channelUI (Maybe (Widget Name) -> Widget Name)
-> Maybe (Widget Name) -> Widget Name
forall a b. (a -> b) -> a -> b
$ do
Widget Name
tui <- Maybe (Widget Name)
maybeThreadIface
Widget Name -> Maybe (Widget Name)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Widget Name -> Maybe (Widget Name))
-> Widget Name -> Maybe (Widget Name)
forall a b. (a -> b) -> a -> b
$ case Config
configConfig
-> Getting ThreadOrientation Config ThreadOrientation
-> ThreadOrientation
forall s a. s -> Getting a s a -> a
^.Getting ThreadOrientation Config ThreadOrientation
Lens' Config ThreadOrientation
configThreadOrientationL of
ThreadOrientation
ThreadAbove -> Widget Name
tui 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
channelUI
ThreadOrientation
ThreadBelow -> Widget Name
channelUI 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
tui
ThreadOrientation
ThreadLeft -> Widget Name
tui Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> Widget Name
forall n. Widget n
vBorder Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> Widget Name
channelUI
ThreadOrientation
ThreadRight -> Widget Name
channelUI Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> Widget Name
forall n. Widget n
vBorder Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> Widget Name
tui
maybeSubdue :: Widget n -> Widget n
maybeSubdue = if Mode
mode 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 -> Widget n -> Widget n)
-> AttrName -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> AttrName
attrName String
""
else Widget n -> Widget n
forall a. a -> a
id
teamList :: ChatState -> Widget Name
teamList :: ChatState -> Widget Name
teamList ChatState
st =
let curTid :: Maybe TeamId
curTid = ChatState
stChatState
-> Getting (Maybe TeamId) ChatState (Maybe TeamId) -> Maybe TeamId
forall s a. s -> Getting a s a -> a
^.Getting (Maybe TeamId) ChatState (Maybe TeamId)
SimpleGetter ChatState (Maybe 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
pos :: Int
pos = Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ Zipper () TeamId -> Maybe Int
forall b a. Eq b => Zipper a b -> Maybe Int
Z.position Zipper () TeamId
z
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)
numTeams :: Int
numTeams = [TeamState] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TeamState]
teams
entries :: [Widget Name]
entries = TeamState -> Widget Name
mkEntry (TeamState -> Widget Name) -> [TeamState] -> [Widget Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TeamState]
teams
mkEntry :: TeamState -> Widget Name
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 -> ChatState -> Int
teamUnreadCount TeamId
tId ChatState
st
tName :: Name
tName = TeamId -> Name
ClickableTeamListEntry TeamId
tId
in (if TeamId -> Maybe TeamId
forall a. a -> Maybe a
Just TeamId
tId Maybe TeamId -> Maybe TeamId -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe TeamId
curTid
then Widget Name -> Widget Name
forall n. Widget n -> Widget n
visible (Widget Name -> Widget Name)
-> (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
currentTeamAttr
else if Bool
unread
then AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
unreadChannelAttr
else Widget Name -> Widget Name
forall a. a -> a
id) (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
Name -> Widget Name -> Widget Name
forall n. Ord n => n -> Widget n -> Widget n
clickable Name
tName (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ Text -> Widget Name
forall n. Text -> Widget n
txt (Text -> Widget Name) -> Text -> Widget Name
forall a b. (a -> b) -> a -> b
$
(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)
in if Int
numTeams 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 -> Widget Name) -> Text -> Widget Name
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"Teams (" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
numTeams String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"):"
, 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]
entries
]
, Widget Name
forall n. Widget n
hBorder
]
renderChannelHeader :: ChatState -> TeamId -> HighlightSet -> ClientChannel -> Widget Name
ChatState
st TeamId
tId 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)
-> Getting Bool Config Bool
-> (Bool -> Const Bool Bool)
-> ChatResources
-> Const Bool ChatResources
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Getting Bool Config Bool
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 a b. Maybe a -> (a -> Maybe b) -> Maybe b
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)
baseUrl :: TeamBaseURL
baseUrl = ChatState -> TeamId -> TeamBaseURL
serverBaseUrl ChatState
st TeamId
tId
in Maybe TeamBaseURL
-> Text
-> HighlightSet
-> Maybe (Int -> Inline -> Maybe Name)
-> Text
-> Widget Name
forall a.
SemEq a =>
Maybe TeamBaseURL
-> Text
-> HighlightSet
-> Maybe (Int -> Inline -> Maybe a)
-> Text
-> Widget a
renderText' (TeamBaseURL -> Maybe TeamBaseURL
forall a. a -> Maybe a
Just TeamBaseURL
baseUrl) (ChatState -> Text
myUsername ChatState
st)
HighlightSet
hs ((Int -> Inline -> Maybe Name)
-> Maybe (Int -> Inline -> Maybe Name)
forall a. a -> Maybe a
Just (Maybe MessageId -> Name -> Int -> Inline -> Maybe Name
mkClickableInline Maybe MessageId
forall a. Maybe a
Nothing (ChannelId -> Name
ChannelTopic (ChannelId -> Name) -> ChannelId -> Name
forall a b. (a -> b) -> a -> b
$ ClientChannel
chanClientChannel
-> Getting ChannelId ClientChannel ChannelId -> ChannelId
forall s a. s -> Getting a s a -> a
^.(ChannelInfo -> Const ChannelId ChannelInfo)
-> ClientChannel -> Const ChannelId ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Const ChannelId ChannelInfo)
-> ClientChannel -> Const ChannelId ClientChannel)
-> ((ChannelId -> Const ChannelId ChannelId)
-> ChannelInfo -> Const ChannelId ChannelInfo)
-> Getting ChannelId ClientChannel ChannelId
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChannelId -> Const ChannelId ChannelId)
-> ChannelInfo -> Const ChannelId ChannelInfo
Lens' ChannelInfo ChannelId
cdChannelId)))
(Text
channelNameString Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
maybeTopic)
drawThreadWindow :: ChatState -> TeamId -> Widget Name
drawThreadWindow :: ChatState -> TeamId -> Widget Name
drawThreadWindow ChatState
st TeamId
tId = AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
threadAttr Widget Name
body
where
ti :: Lens' ChatState ThreadInterface
ti :: Lens' ChatState ThreadInterface
ti = HasCallStack => TeamId -> Lens' ChatState ThreadInterface
TeamId -> Lens' ChatState ThreadInterface
unsafeThreadInterface(TeamId
tId)
hs :: HighlightSet
hs = ChatState -> TeamId -> HighlightSet
getHighlightSet ChatState
st TeamId
tId
cId :: ChannelId
cId = ChatState
stChatState -> Getting ChannelId ChatState ChannelId -> ChannelId
forall s a. s -> Getting a s a -> a
^.(ThreadInterface -> Const ChannelId ThreadInterface)
-> ChatState -> Const ChannelId ChatState
Lens' ChatState ThreadInterface
ti((ThreadInterface -> Const ChannelId ThreadInterface)
-> ChatState -> Const ChannelId ChatState)
-> ((ChannelId -> Const ChannelId ChannelId)
-> ThreadInterface -> Const ChannelId ThreadInterface)
-> Getting ChannelId ChatState ChannelId
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChannelId -> Const ChannelId ChannelId)
-> ThreadInterface -> Const ChannelId ThreadInterface
forall n i (f :: * -> *).
Functor f =>
(ChannelId -> f ChannelId)
-> MessageInterface n i -> f (MessageInterface n i)
miChannelId
titleText :: Text
titleText = case ChatState
stChatState
-> Getting (First ClientChannel) ChatState ClientChannel
-> Maybe ClientChannel
forall s a. s -> Getting (First a) s a -> Maybe a
^?ChannelId -> Traversal' ChatState ClientChannel
csChannel(ChannelId
cId) of
Maybe ClientChannel
Nothing -> Text
"Thread"
Just ClientChannel
chan ->
let prefix :: Text
prefix = 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
Group -> Text
"Thread with "
Type
Direct -> Text
"Thread with "
Type
_ -> Text
"Thread in "
in Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> 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)
title :: Widget Name
title = Maybe TeamBaseURL
-> Text
-> HighlightSet
-> Maybe (Int -> Inline -> Maybe Name)
-> Text
-> Widget Name
forall a.
SemEq a =>
Maybe TeamBaseURL
-> Text
-> HighlightSet
-> Maybe (Int -> Inline -> Maybe a)
-> Text
-> Widget a
renderText' Maybe TeamBaseURL
forall a. Maybe a
Nothing Text
"" HighlightSet
hs Maybe (Int -> Inline -> Maybe Name)
forall a. Maybe a
Nothing Text
titleText
focused :: Bool
focused = ChatState
stChatState
-> Getting MessageInterfaceFocus ChatState MessageInterfaceFocus
-> MessageInterfaceFocus
forall s a. s -> Getting a s a -> a
^.TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)((TeamState -> Const MessageInterfaceFocus TeamState)
-> ChatState -> Const MessageInterfaceFocus ChatState)
-> ((MessageInterfaceFocus
-> Const MessageInterfaceFocus MessageInterfaceFocus)
-> TeamState -> Const MessageInterfaceFocus TeamState)
-> Getting MessageInterfaceFocus ChatState MessageInterfaceFocus
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MessageInterfaceFocus
-> Const MessageInterfaceFocus MessageInterfaceFocus)
-> TeamState -> Const MessageInterfaceFocus TeamState
Lens' TeamState MessageInterfaceFocus
tsMessageInterfaceFocus MessageInterfaceFocus -> MessageInterfaceFocus -> Bool
forall a. Eq a => a -> a -> Bool
== MessageInterfaceFocus
FocusThread
body :: Widget Name
body = Widget Name
title 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
messageUI
messageUI :: Widget Name
messageUI = ChatState
-> HighlightSet
-> TeamId
-> Bool
-> Lens' ChatState ThreadInterface
-> Bool
-> Bool
-> Widget Name
forall i.
ChatState
-> HighlightSet
-> TeamId
-> Bool
-> Lens' ChatState (MessageInterface Name i)
-> Bool
-> Bool
-> Widget Name
drawMessageInterface ChatState
st HighlightSet
hs TeamId
tId Bool
False (ThreadInterface -> f ThreadInterface) -> ChatState -> f ChatState
Lens' ChatState ThreadInterface
ti Bool
False Bool
focused