{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE RankNTypes #-}

-- | This module provides the Drawing functionality for the
-- ChannelList sidebar.  The sidebar is divided vertically into groups
-- and each group is rendered separately.
--
-- There are actually two UI modes handled by this code:
--
--   * Normal display of the channels, with various markers to
--     indicate the current channel, channels with unread messages,
--     user state (for Direct Message channels), etc.
--
--   * ChannelSelect display where the user is typing match characters
--     into a prompt at the ChannelList sidebar is showing only those
--     channels matching the entered text (and highlighting the
--     matching portion).

module Matterhorn.Draw.ChannelList (renderChannelList, renderChannelListHeader) where

import           Prelude ()
import           Matterhorn.Prelude

import           Brick
import           Brick.Widgets.Border
import           Brick.Widgets.Center (hCenter)
import qualified Data.Text as T
import           Lens.Micro.Platform (non)

import qualified Network.Mattermost.Types as MM

import           Matterhorn.Constants ( userSigil )
import           Matterhorn.Draw.Util
import           Matterhorn.State.Channels
import           Matterhorn.Themes
import           Matterhorn.Types
import           Matterhorn.Types.Common ( sanitizeUserText )
import qualified Matterhorn.Zipper as Z

-- | Internal record describing each channel entry and its associated
-- attributes.  This is the object passed to the rendering function so
-- that it can determine how to render each channel.
data ChannelListEntryData =
    ChannelListEntryData { ChannelListEntryData -> Text
entrySigil       :: Text
                         , ChannelListEntryData -> Text
entryLabel       :: Text
                         , ChannelListEntryData -> Bool
entryHasUnread   :: Bool
                         , ChannelListEntryData -> Int
entryMentions    :: Int
                         , ChannelListEntryData -> Bool
entryIsRecent    :: Bool
                         , ChannelListEntryData -> Bool
entryIsReturn    :: Bool
                         , ChannelListEntryData -> Bool
entryIsCurrent   :: Bool
                         , ChannelListEntryData -> Bool
entryIsMuted     :: Bool
                         , ChannelListEntryData -> Maybe UserStatus
entryUserStatus  :: Maybe UserStatus
                         }

renderChannelListHeader :: ChatState -> Widget Name
renderChannelListHeader :: ChatState -> Widget Name
renderChannelListHeader ChatState
st =
    [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
vBox [ Widget Name
forall n. Widget n
teamHeader
         , Widget Name
forall n. Widget n
selfHeader
         , Widget Name
forall n. Widget n
unreadCountHeader
         ]
    where
        myUsername_ :: Text
myUsername_ = ChatState -> Text
myUsername ChatState
st
        teamHeader :: Widget n
teamHeader = Widget n -> Widget n
forall n. Widget n -> Widget n
hCenter (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
"Team: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
teamNameStr
        selfHeader :: Widget n
selfHeader = Widget n -> Widget n
forall n. Widget n -> Widget n
hCenter (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
                     Text -> Text -> Text -> Widget n
forall a. Text -> Text -> Text -> Widget a
colorUsername Text
myUsername_ Text
myUsername_
                         (Char -> Text
T.singleton Char
statusSigil Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
userSigil Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
myUsername_)
        teamNameStr :: Text
teamNameStr = 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
MM.teamDisplayName (Team -> UserText) -> Team -> UserText
forall a b. (a -> b) -> a -> b
$ ChatState
stChatState -> Getting Team ChatState Team -> Team
forall s a. s -> Getting a s a -> a
^.(TeamState -> Const Team TeamState)
-> ChatState -> Const Team ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Const Team TeamState)
 -> ChatState -> Const Team ChatState)
-> ((Team -> Const Team Team) -> TeamState -> Const Team TeamState)
-> Getting Team ChatState Team
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Team -> Const Team Team) -> TeamState -> Const Team TeamState
Lens' TeamState Team
tsTeam
        statusSigil :: Char
statusSigil = Char -> (UserInfo -> Char) -> Maybe UserInfo -> Char
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Char
' ' UserInfo -> Char
userSigilFromInfo Maybe UserInfo
me
        me :: Maybe UserInfo
me = UserId -> ChatState -> Maybe UserInfo
userById (ChatState -> UserId
myUserId ChatState
st) ChatState
st
        unreadCountHeader :: Widget n
unreadCountHeader = Widget n -> Widget n
forall n. Widget n -> Widget n
hCenter (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
"Unread: " 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
unreadCount)
        unreadCount :: Int
unreadCount = [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 -> Int
channelListGroupUnread (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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Zipper ChannelListGroup ChannelListEntry
-> [(ChannelListGroup, [ChannelListEntry])]
forall a b. Zipper a b -> [(a, [b])]
Z.toList (ChatState
stChatState
-> Getting
     (Zipper ChannelListGroup ChannelListEntry)
     ChatState
     (Zipper ChannelListGroup ChannelListEntry)
-> Zipper ChannelListGroup ChannelListEntry
forall s a. s -> Getting a s a -> a
^.(TeamState
 -> Const (Zipper ChannelListGroup ChannelListEntry) TeamState)
-> ChatState
-> Const (Zipper ChannelListGroup ChannelListEntry) ChatState
Lens' ChatState TeamState
csCurrentTeam((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)

renderChannelList :: ChatState -> Widget Name
renderChannelList :: ChatState -> Widget Name
renderChannelList ChatState
st =
    Name -> ViewportType -> Widget Name -> Widget Name
forall n.
(Ord n, Show n) =>
n -> ViewportType -> Widget n -> Widget n
viewport (TeamId -> Name
ChannelList TeamId
tId) ViewportType
Vertical Widget Name
body
    where
        myUsername_ :: Text
myUsername_ = ChatState -> Text
myUsername ChatState
st
        channelName :: ChannelListEntry -> Name
channelName ChannelListEntry
e = ChannelId -> Name
ClickableChannelListEntry (ChannelId -> Name) -> ChannelId -> Name
forall a b. (a -> b) -> a -> b
$ ChannelListEntry -> ChannelId
channelListEntryChannelId  ChannelListEntry
e
        renderEntry :: ChatState -> ChannelListEntry -> Widget Name
renderEntry ChatState
s ChannelListEntry
e = Name -> Widget Name -> Widget Name
forall n. n -> Widget n -> Widget n
clickable (ChannelListEntry -> Name
channelName ChannelListEntry
e) (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ 
                          Text -> ChannelListEntryData -> Widget Name
renderChannelListEntry Text
myUsername_ (ChannelListEntryData -> Widget Name)
-> ChannelListEntryData -> Widget Name
forall a b. (a -> b) -> a -> b
$ ChatState -> ChannelListEntry -> ChannelListEntryData
mkChannelEntryData ChatState
s ChannelListEntry
e
        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
        body :: Widget Name
body = 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 ->
                let zipper :: Zipper ChannelListGroup ChannelSelectMatch
zipper = ChatState
stChatState
-> Getting
     (Zipper ChannelListGroup ChannelSelectMatch)
     ChatState
     (Zipper ChannelListGroup ChannelSelectMatch)
-> Zipper ChannelListGroup ChannelSelectMatch
forall s a. s -> Getting a s a -> a
^.(TeamState
 -> Const (Zipper ChannelListGroup ChannelSelectMatch) TeamState)
-> ChatState
-> Const (Zipper ChannelListGroup ChannelSelectMatch) ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState
  -> Const (Zipper ChannelListGroup ChannelSelectMatch) TeamState)
 -> ChatState
 -> Const (Zipper ChannelListGroup ChannelSelectMatch) ChatState)
-> ((Zipper ChannelListGroup ChannelSelectMatch
     -> Const
          (Zipper ChannelListGroup ChannelSelectMatch)
          (Zipper ChannelListGroup ChannelSelectMatch))
    -> TeamState
    -> Const (Zipper ChannelListGroup ChannelSelectMatch) TeamState)
-> Getting
     (Zipper ChannelListGroup ChannelSelectMatch)
     ChatState
     (Zipper ChannelListGroup ChannelSelectMatch)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChannelSelectState
 -> Const
      (Zipper ChannelListGroup ChannelSelectMatch) ChannelSelectState)
-> TeamState
-> Const (Zipper ChannelListGroup ChannelSelectMatch) TeamState
Lens' TeamState ChannelSelectState
tsChannelSelectState((ChannelSelectState
  -> Const
       (Zipper ChannelListGroup ChannelSelectMatch) ChannelSelectState)
 -> TeamState
 -> Const (Zipper ChannelListGroup ChannelSelectMatch) TeamState)
-> ((Zipper ChannelListGroup ChannelSelectMatch
     -> Const
          (Zipper ChannelListGroup ChannelSelectMatch)
          (Zipper ChannelListGroup ChannelSelectMatch))
    -> ChannelSelectState
    -> Const
         (Zipper ChannelListGroup ChannelSelectMatch) ChannelSelectState)
-> (Zipper ChannelListGroup ChannelSelectMatch
    -> Const
         (Zipper ChannelListGroup ChannelSelectMatch)
         (Zipper ChannelListGroup ChannelSelectMatch))
-> TeamState
-> Const (Zipper ChannelListGroup ChannelSelectMatch) TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Zipper ChannelListGroup ChannelSelectMatch
 -> Const
      (Zipper ChannelListGroup ChannelSelectMatch)
      (Zipper ChannelListGroup ChannelSelectMatch))
-> ChannelSelectState
-> Const
     (Zipper ChannelListGroup ChannelSelectMatch) ChannelSelectState
Lens'
  ChannelSelectState (Zipper ChannelListGroup ChannelSelectMatch)
channelSelectMatches
                    matches :: [Widget Name]
matches = if Zipper ChannelListGroup ChannelSelectMatch -> Bool
forall a b. Zipper a b -> Bool
Z.isEmpty Zipper ChannelListGroup ChannelSelectMatch
zipper
                              then [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
"No matches"]
                              else (ChatState
-> (ChatState -> ChannelSelectMatch -> Widget Name)
-> (ChannelListGroup, [ChannelSelectMatch])
-> Widget Name
forall e.
ChatState
-> (ChatState -> e -> Widget Name)
-> (ChannelListGroup, [e])
-> Widget Name
renderChannelListGroup ChatState
st
                                       (Maybe ChannelSelectMatch
-> ChatState -> ChannelSelectMatch -> Widget Name
renderChannelSelectListEntry (Zipper ChannelListGroup ChannelSelectMatch
-> Maybe ChannelSelectMatch
forall a b. Zipper a b -> Maybe b
Z.focus Zipper ChannelListGroup ChannelSelectMatch
zipper)) ((ChannelListGroup, [ChannelSelectMatch]) -> Widget Name)
-> [(ChannelListGroup, [ChannelSelectMatch])] -> [Widget Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                   Zipper ChannelListGroup ChannelSelectMatch
-> [(ChannelListGroup, [ChannelSelectMatch])]
forall a b. Zipper a b -> [(a, [b])]
Z.toList Zipper ChannelListGroup ChannelSelectMatch
zipper)
                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
$
                   ChatState -> Widget Name
renderChannelListHeader ChatState
st Widget Name -> [Widget Name] -> [Widget Name]
forall a. a -> [a] -> [a]
:
                   [Widget Name]
matches
            Mode
_ ->
                Name -> Widget Name -> Widget Name
forall n. Ord n => n -> Widget n -> Widget n
cached (TeamId -> Name
ChannelSidebar TeamId
tId) (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
                [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
vBox ([Widget Name] -> Widget Name) -> [Widget Name] -> Widget Name
forall a b. (a -> b) -> a -> b
$
                ChatState -> Widget Name
renderChannelListHeader ChatState
st Widget Name -> [Widget Name] -> [Widget Name]
forall a. a -> [a] -> [a]
:
                (ChatState
-> (ChatState -> ChannelListEntry -> Widget Name)
-> (ChannelListGroup, [ChannelListEntry])
-> Widget Name
forall e.
ChatState
-> (ChatState -> e -> Widget Name)
-> (ChannelListGroup, [e])
-> Widget Name
renderChannelListGroup ChatState
st ChatState -> ChannelListEntry -> Widget Name
renderEntry ((ChannelListGroup, [ChannelListEntry]) -> Widget Name)
-> [(ChannelListGroup, [ChannelListEntry])] -> [Widget Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Zipper ChannelListGroup ChannelListEntry
-> [(ChannelListGroup, [ChannelListEntry])]
forall a b. Zipper a b -> [(a, [b])]
Z.toList (ChatState
stChatState
-> Getting
     (Zipper ChannelListGroup ChannelListEntry)
     ChatState
     (Zipper ChannelListGroup ChannelListEntry)
-> Zipper ChannelListGroup ChannelListEntry
forall s a. s -> Getting a s a -> a
^.(TeamState
 -> Const (Zipper ChannelListGroup ChannelListEntry) TeamState)
-> ChatState
-> Const (Zipper ChannelListGroup ChannelListEntry) ChatState
Lens' ChatState TeamState
csCurrentTeam((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))

renderChannelListGroupHeading :: ChannelListGroup -> Widget Name
renderChannelListGroupHeading :: ChannelListGroup -> Widget Name
renderChannelListGroupHeading ChannelListGroup
g =
    let (Int
unread, Text
label) = case ChannelListGroup
g of
            ChannelGroupPublicChannels Int
u -> (Int
u, Text
"Public Channels")
            ChannelGroupPrivateChannels Int
u -> (Int
u, Text
"Private Channels")
            ChannelGroupFavoriteChannels Int
u -> (Int
u, Text
"Favorite Channels")
            ChannelGroupDirectMessages Int
u -> (Int
u, Text
"Direct Messages")
        addUnread :: Widget n -> Widget n
addUnread = if Int
unread Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
                    then (Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> (AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
unreadGroupMarkerAttr (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
"*"))
                    else Widget n -> Widget n
forall a. a -> a
id
        labelWidget :: Widget n
labelWidget = Widget n -> Widget n
forall n. Widget n -> Widget n
addUnread (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
channelListHeaderAttr (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
label
    in Widget Name -> Widget Name
forall n. Widget n -> Widget n
hBorderWithLabel Widget Name
forall n. Widget n
labelWidget

renderChannelListGroup :: ChatState
                       -> (ChatState -> e -> Widget Name)
                       -> (ChannelListGroup, [e])
                       -> Widget Name
renderChannelListGroup :: ChatState
-> (ChatState -> e -> Widget Name)
-> (ChannelListGroup, [e])
-> Widget Name
renderChannelListGroup ChatState
st ChatState -> e -> Widget Name
renderEntry (ChannelListGroup
group, [e]
es) =
    let heading :: Widget Name
heading = ChannelListGroup -> Widget Name
renderChannelListGroupHeading ChannelListGroup
group
        entryWidgets :: [Widget Name]
entryWidgets = ChatState -> e -> Widget Name
renderEntry ChatState
st (e -> Widget Name) -> [e] -> [Widget Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [e]
es
    in if [Widget Name] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Widget Name]
entryWidgets
       then Widget Name
forall n. Widget n
emptyWidget
       else [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
vBox (Widget Name
heading Widget Name -> [Widget Name] -> [Widget Name]
forall a. a -> [a] -> [a]
: [Widget Name]
entryWidgets)

mkChannelEntryData :: ChatState
                   -> ChannelListEntry
                   -> ChannelListEntryData
mkChannelEntryData :: ChatState -> ChannelListEntry -> ChannelListEntryData
mkChannelEntryData ChatState
st ChannelListEntry
e =
    ChannelListEntryData :: Text
-> Text
-> Bool
-> Int
-> Bool
-> Bool
-> Bool
-> Bool
-> Maybe UserStatus
-> ChannelListEntryData
ChannelListEntryData { entrySigil :: Text
entrySigil       = Text
sigilWithSpace
                         , entryLabel :: Text
entryLabel       = Text
name
                         , entryHasUnread :: Bool
entryHasUnread   = Bool
unread
                         , entryMentions :: Int
entryMentions    = Int
mentions
                         , entryIsRecent :: Bool
entryIsRecent    = Bool
recent
                         , entryIsReturn :: Bool
entryIsReturn    = Bool
ret
                         , entryIsCurrent :: Bool
entryIsCurrent   = Bool
current
                         , entryIsMuted :: Bool
entryIsMuted     = Bool
muted
                         , entryUserStatus :: Maybe UserStatus
entryUserStatus  = Maybe UserStatus
status
                         }
    where
        cId :: ChannelId
cId = ChannelListEntry -> ChannelId
channelListEntryChannelId ChannelListEntry
e
        unread :: Bool
unread = ChannelListEntry -> Bool
channelListEntryUnread ChannelListEntry
e
        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)
        recent :: Bool
recent = ChatState -> ChannelId -> Bool
isRecentChannel ChatState
st ChannelId
cId
        ret :: Bool
ret = ChatState -> ChannelId -> Bool
isReturnChannel ChatState
st ChannelId
cId
        current :: Bool
current = ChatState -> ChannelId -> Bool
isCurrentChannel ChatState
st ChannelId
cId
        muted :: Bool
muted = ClientChannel -> Bool
isMuted ClientChannel
chan
        (Text
name, Maybe Text
normalSigil, Bool
addSpace, Maybe UserStatus
status) = case ChannelListEntry -> ChannelListEntryType
channelListEntryType ChannelListEntry
e of
            ChannelListEntryType
CLChannel ->
                (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, Maybe Text
forall a. Maybe a
Nothing, Bool
False, Maybe UserStatus
forall a. Maybe a
Nothing)
            ChannelListEntryType
CLGroupDM ->
                (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, Text -> Maybe Text
forall a. a -> Maybe a
Just Text
" ", Bool
True, Maybe UserStatus
forall a. Maybe a
Nothing)
            CLUserDM UserId
uId ->
                let Just UserInfo
u = UserId -> ChatState -> Maybe UserInfo
userById UserId
uId ChatState
st
                    uname :: Text
uname = if ChatState -> Bool
useNickname ChatState
st
                            then UserInfo
uUserInfo -> Getting Text UserInfo Text -> Text
forall s a. s -> Getting a s a -> a
^.(Maybe Text -> Const Text (Maybe Text))
-> UserInfo -> Const Text UserInfo
Lens' UserInfo (Maybe Text)
uiNickName((Maybe Text -> Const Text (Maybe Text))
 -> UserInfo -> Const Text UserInfo)
-> ((Text -> Const Text Text)
    -> Maybe Text -> Const Text (Maybe Text))
-> Getting Text UserInfo Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Text -> Lens' (Maybe Text) Text
forall a. Eq a => a -> Lens' (Maybe a) a
non (UserInfo
uUserInfo -> Getting Text UserInfo Text -> Text
forall s a. s -> Getting a s a -> a
^.Getting Text UserInfo Text
Lens' UserInfo Text
uiName)
                            else UserInfo
uUserInfo -> Getting Text UserInfo Text -> Text
forall s a. s -> Getting a s a -> a
^.Getting Text UserInfo Text
Lens' UserInfo Text
uiName
                in (Text
uname, Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton (Char -> Text) -> Char -> Text
forall a b. (a -> b) -> a -> b
$ UserInfo -> Char
userSigilFromInfo UserInfo
u,
                    Bool
True, UserStatus -> Maybe UserStatus
forall a. a -> Maybe a
Just (UserStatus -> Maybe UserStatus) -> UserStatus -> Maybe UserStatus
forall a b. (a -> b) -> a -> b
$ UserInfo
uUserInfo -> Getting UserStatus UserInfo UserStatus -> UserStatus
forall s a. s -> Getting a s a -> a
^.Getting UserStatus UserInfo UserStatus
Lens' UserInfo UserStatus
uiStatus)
        sigilWithSpace :: Text
sigilWithSpace = Text
sigil Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> if Bool
addSpace then Text
" " else Text
""
        prevEditSigil :: Text
prevEditSigil = Text
"»"
        sigil :: Text
sigil = if Bool
current
                then Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" Maybe Text
normalSigil
                else case ClientChannel
chanClientChannel
-> Getting (Maybe Int) ClientChannel (Maybe Int) -> Maybe Int
forall s a. s -> Getting a s a -> a
^.(EphemeralEditState -> Const (Maybe Int) EphemeralEditState)
-> ClientChannel -> Const (Maybe Int) ClientChannel
Lens' ClientChannel EphemeralEditState
ccEditState((EphemeralEditState -> Const (Maybe Int) EphemeralEditState)
 -> ClientChannel -> Const (Maybe Int) ClientChannel)
-> ((Maybe Int -> Const (Maybe Int) (Maybe Int))
    -> EphemeralEditState -> Const (Maybe Int) EphemeralEditState)
-> Getting (Maybe Int) ClientChannel (Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe Int -> Const (Maybe Int) (Maybe Int))
-> EphemeralEditState -> Const (Maybe Int) EphemeralEditState
Lens' EphemeralEditState (Maybe Int)
eesInputHistoryPosition of
                    Just Int
_ -> Text
prevEditSigil
                    Maybe Int
Nothing ->
                        case ClientChannel
chanClientChannel
-> Getting (Text, EditMode) ClientChannel (Text, EditMode)
-> (Text, EditMode)
forall s a. s -> Getting a s a -> a
^.(EphemeralEditState -> Const (Text, EditMode) EphemeralEditState)
-> ClientChannel -> Const (Text, EditMode) ClientChannel
Lens' ClientChannel EphemeralEditState
ccEditState((EphemeralEditState -> Const (Text, EditMode) EphemeralEditState)
 -> ClientChannel -> Const (Text, EditMode) ClientChannel)
-> (((Text, EditMode) -> Const (Text, EditMode) (Text, EditMode))
    -> EphemeralEditState -> Const (Text, EditMode) EphemeralEditState)
-> Getting (Text, EditMode) ClientChannel (Text, EditMode)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((Text, EditMode) -> Const (Text, EditMode) (Text, EditMode))
-> EphemeralEditState -> Const (Text, EditMode) EphemeralEditState
Lens' EphemeralEditState (Text, EditMode)
eesLastInput of
                            (Text
"", EditMode
_) -> Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" Maybe Text
normalSigil
                            (Text, EditMode)
_       -> Text
prevEditSigil
        mentions :: Int
mentions = ClientChannel
chanClientChannel -> Getting Int ClientChannel Int -> Int
forall s a. s -> Getting a s a -> a
^.(ChannelInfo -> Const Int ChannelInfo)
-> ClientChannel -> Const Int ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Const Int ChannelInfo)
 -> ClientChannel -> Const Int ClientChannel)
-> ((Int -> Const Int Int) -> ChannelInfo -> Const Int ChannelInfo)
-> Getting Int ClientChannel Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> Const Int Int) -> ChannelInfo -> Const Int ChannelInfo
Lens' ChannelInfo Int
cdMentionCount

-- | Render an individual Channel List entry (in Normal mode) with
-- appropriate visual decorations.
renderChannelListEntry :: Text -> ChannelListEntryData -> Widget Name
renderChannelListEntry :: Text -> ChannelListEntryData -> Widget Name
renderChannelListEntry Text
myUName ChannelListEntryData
entry = Widget Name
forall n. Widget n
body
    where
    body :: Widget n
body = Widget n -> Widget n
forall n. Widget n -> Widget n
decorate (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ ChannelListEntryData -> Widget n -> Widget n
forall n. ChannelListEntryData -> Widget n -> Widget n
decorateEntry ChannelListEntryData
entry (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ ChannelListEntryData -> Widget n -> Widget n
forall n. ChannelListEntryData -> Widget n -> Widget n
decorateMentions ChannelListEntryData
entry (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padRight Padding
Max (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
           Text -> Widget n
forall n. Text -> Widget n
entryWidget (Text -> Widget n) -> Text -> Widget n
forall a b. (a -> b) -> a -> b
$ ChannelListEntryData -> Text
entrySigil ChannelListEntryData
entry Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ChannelListEntryData -> Text
entryLabel ChannelListEntryData
entry
    decorate :: Widget n -> Widget n
decorate = if | ChannelListEntryData -> Bool
entryIsCurrent ChannelListEntryData
entry ->
                      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
forceAttr AttrName
currentChannelNameAttr
                  | ChannelListEntryData -> Int
entryMentions ChannelListEntryData
entry Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Bool -> Bool
not (ChannelListEntryData -> Bool
entryIsMuted ChannelListEntryData
entry) ->
                      AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
forceAttr AttrName
mentionsChannelAttr
                  | ChannelListEntryData -> Bool
entryHasUnread ChannelListEntryData
entry ->
                      AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
forceAttr AttrName
unreadChannelAttr
                  | Bool
otherwise -> Widget n -> Widget n
forall a. a -> a
id
    entryWidget :: Text -> Widget n
entryWidget = case ChannelListEntryData -> Maybe UserStatus
entryUserStatus ChannelListEntryData
entry of
                    Just UserStatus
Offline -> AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
clientMessageAttr (Widget n -> Widget n) -> (Text -> Widget n) -> Text -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Widget n
forall n. Text -> Widget n
txt
                    Just UserStatus
_       -> Text -> Text -> Text -> Widget n
forall a. Text -> Text -> Text -> Widget a
colorUsername Text
myUName (ChannelListEntryData -> Text
entryLabel ChannelListEntryData
entry)
                    Maybe UserStatus
Nothing      -> Text -> Widget n
forall n. Text -> Widget n
txt

-- | Render an individual entry when in Channel Select mode,
-- highlighting the matching portion, or completely suppressing the
-- entry if it doesn't match.
renderChannelSelectListEntry :: Maybe ChannelSelectMatch
                             -> ChatState
                             -> ChannelSelectMatch
                             -> Widget Name
renderChannelSelectListEntry :: Maybe ChannelSelectMatch
-> ChatState -> ChannelSelectMatch -> Widget Name
renderChannelSelectListEntry Maybe ChannelSelectMatch
curMatch ChatState
st ChannelSelectMatch
match =
    let ChannelSelectMatch Text
preMatch Text
inMatch Text
postMatch Text
_ ChannelListEntry
entry = ChannelSelectMatch
match
        maybeSelect :: Widget n -> Widget n
maybeSelect = if (ChannelListEntry -> Maybe ChannelListEntry
forall a. a -> Maybe a
Just ChannelListEntry
entry) Maybe ChannelListEntry -> Maybe ChannelListEntry -> Bool
forall a. Eq a => a -> a -> Bool
== (ChannelSelectMatch -> ChannelListEntry
matchEntry (ChannelSelectMatch -> ChannelListEntry)
-> Maybe ChannelSelectMatch -> Maybe ChannelListEntry
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ChannelSelectMatch
curMatch)
                      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
currentChannelNameAttr
                      else Widget n -> Widget n
forall a. a -> a
id
        entryData :: ChannelListEntryData
entryData = ChatState -> ChannelListEntry -> ChannelListEntryData
mkChannelEntryData ChatState
st ChannelListEntry
entry
        decorate :: Widget n -> Widget n
decorate = if | ChannelListEntryData -> Int
entryMentions ChannelListEntryData
entryData Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Bool -> Bool
not (ChannelListEntryData -> Bool
entryIsMuted ChannelListEntryData
entryData) ->
                          AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
mentionsChannelAttr
                      | ChannelListEntryData -> Bool
entryHasUnread ChannelListEntryData
entryData ->
                          AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
unreadChannelAttr
                      | Bool
otherwise -> Widget n -> Widget n
forall a. a -> a
id
    in Name -> Widget Name -> Widget Name
forall n. n -> Widget n -> Widget n
clickable (ChannelSelectMatch -> Name
ChannelSelectEntry ChannelSelectMatch
match) (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
decorate (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
maybeSelect (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
       ChannelListEntryData -> Widget Name -> Widget Name
forall n. ChannelListEntryData -> Widget n -> Widget n
decorateEntry ChannelListEntryData
entryData (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ ChannelListEntryData -> Widget Name -> Widget Name
forall n. ChannelListEntryData -> Widget n -> Widget n
decorateMentions ChannelListEntryData
entryData (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
$
         [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
hBox [ Text -> Widget Name
forall n. Text -> Widget n
txt (Text -> Widget Name) -> Text -> Widget Name
forall a b. (a -> b) -> a -> b
$ ChannelListEntryData -> Text
entrySigil ChannelListEntryData
entryData Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
preMatch
              , AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
forceAttr AttrName
channelSelectMatchAttr (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
inMatch
              , Text -> Widget Name
forall n. Text -> Widget n
txt Text
postMatch
              ]

-- If this channel is the return channel, add a decoration to denote
-- that.
--
-- Otherwise, if this channel is the most recently viewed channel (prior
-- to the currently viewed channel), add a decoration to denote that.
decorateEntry :: ChannelListEntryData -> Widget n -> Widget n
decorateEntry :: ChannelListEntryData -> Widget n -> Widget n
decorateEntry ChannelListEntryData
entry =
    if ChannelListEntryData -> Bool
entryIsReturn ChannelListEntryData
entry
    then (Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> (AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
recentMarkerAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
str String
returnChannelSigil))
    else if ChannelListEntryData -> Bool
entryIsRecent ChannelListEntryData
entry
         then (Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> (AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
recentMarkerAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
str String
recentChannelSigil))
         else Widget n -> Widget n
forall a. a -> a
id

decorateMentions :: ChannelListEntryData -> Widget n -> Widget n
decorateMentions :: ChannelListEntryData -> Widget n -> Widget n
decorateMentions ChannelListEntryData
entry
  | ChannelListEntryData -> Int
entryMentions ChannelListEntryData
entry Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
9 =
      (Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> String -> Widget n
forall n. String -> Widget n
str String
"(9+)")
  | ChannelListEntryData -> Int
entryMentions ChannelListEntryData
entry Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 =
      (Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> String -> Widget n
forall n. String -> Widget n
str (String
"(" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (ChannelListEntryData -> Int
entryMentions ChannelListEntryData
entry) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
")"))
  | ChannelListEntryData -> Bool
entryIsMuted ChannelListEntryData
entry =
      (Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> String -> Widget n
forall n. String -> Widget n
str String
"(m)")
  | Bool
otherwise = Widget n -> Widget n
forall a. a -> a
id

recentChannelSigil :: String
recentChannelSigil :: String
recentChannelSigil = String
"<"

returnChannelSigil :: String
returnChannelSigil :: String
returnChannelSigil = String
"~"