{-# 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 { entrySigil :: Text , entryLabel :: Text , entryHasUnread :: Bool , entryMentions :: Int , entryIsRecent :: Bool , entryIsReturn :: Bool , entryIsCurrent :: Bool , entryIsMuted :: Bool , entryUserStatus :: Maybe UserStatus } renderChannelListHeader :: ChatState -> Widget Name renderChannelListHeader st = vBox [ teamHeader , selfHeader , unreadCountHeader ] where myUsername_ = myUsername st teamHeader = hCenter $ withDefAttr clientEmphAttr $ txt $ "Team: " <> teamNameStr selfHeader = hCenter $ colorUsername myUsername_ myUsername_ (T.singleton statusSigil <> " " <> userSigil <> myUsername_) teamNameStr = sanitizeUserText $ MM.teamDisplayName $ st^.csMyTeam statusSigil = maybe ' ' userSigilFromInfo me me = userById (myUserId st) st unreadCountHeader = hCenter $ txt $ "Unread: " <> (T.pack $ show unreadCount) unreadCount = sum $ (channelListGroupUnread . fst) <$> Z.toList (st^.csFocus) renderChannelList :: ChatState -> Widget Name renderChannelList st = viewport ChannelList Vertical body where myUsername_ = myUsername st renderEntry s e = renderChannelListEntry myUsername_ $ mkChannelEntryData s e body = case appMode st of ChannelSelect -> let zipper = st^.csChannelSelectState.channelSelectMatches matches = if Z.isEmpty zipper then [hCenter $ txt "No matches"] else (renderChannelListGroup st (renderChannelSelectListEntry (Z.focus zipper)) <$> Z.toList zipper) in vBox $ renderChannelListHeader st : matches _ -> cached ChannelSidebar $ vBox $ renderChannelListHeader st : (renderChannelListGroup st renderEntry <$> Z.toList (st^.csFocus)) renderChannelListGroupHeading :: ChannelListGroup -> Widget Name renderChannelListGroupHeading g = let (unread, label) = case g of ChannelGroupPublicChannels u -> (u, "Public Channels") ChannelGroupPrivateChannels u -> (u, "Private Channels") ChannelGroupDirectMessages u -> (u, "Direct Messages") addUnread = if unread > 0 then (<+> (withDefAttr unreadGroupMarkerAttr $ txt "*")) else id labelWidget = addUnread $ withDefAttr channelListHeaderAttr $ txt label in hBorderWithLabel labelWidget renderChannelListGroup :: ChatState -> (ChatState -> e -> Widget Name) -> (ChannelListGroup, [e]) -> Widget Name renderChannelListGroup st renderEntry (group, es) = let heading = renderChannelListGroupHeading group entryWidgets = renderEntry st <$> es in if null entryWidgets then emptyWidget else vBox (heading : entryWidgets) mkChannelEntryData :: ChatState -> ChannelListEntry -> ChannelListEntryData mkChannelEntryData st e = ChannelListEntryData { entrySigil = sigilWithSpace , entryLabel = name , entryHasUnread = unread , entryMentions = mentions , entryIsRecent = recent , entryIsReturn = ret , entryIsCurrent = current , entryIsMuted = muted , entryUserStatus = status } where cId = channelListEntryChannelId e Just chan = findChannelById cId (st^.csChannels) unread = hasUnread' chan recent = isRecentChannel st cId ret = isReturnChannel st cId current = isCurrentChannel st cId muted = isMuted chan (name, normalSigil, addSpace, status) = case e of CLChannel _ -> (chan^.ccInfo.cdDisplayName, Nothing, False, Nothing) CLGroupDM _ -> (chan^.ccInfo.cdDisplayName, Just " ", True, Nothing) CLUserDM _ uId -> let Just u = userById uId st uname = if useNickname st then u^.uiNickName.non (u^.uiName) else u^.uiName in (uname, Just $ T.singleton $ userSigilFromInfo u, True, Just $ u^.uiStatus) sigilWithSpace = sigil <> if addSpace then " " else "" prevEditSigil = "ยป" sigil = if current then fromMaybe "" normalSigil else case chan^.ccEditState.eesInputHistoryPosition of Just _ -> prevEditSigil Nothing -> case chan^.ccEditState.eesLastInput of ("", _) -> fromMaybe "" normalSigil _ -> prevEditSigil mentions = chan^.ccInfo.cdMentionCount -- | Render an individual Channel List entry (in Normal mode) with -- appropriate visual decorations. renderChannelListEntry :: Text -> ChannelListEntryData -> Widget Name renderChannelListEntry myUName entry = body where body = decorate $ decorateEntry entry $ decorateMentions entry $ padRight Max $ entryWidget $ entrySigil entry <> entryLabel entry decorate = if | entryIsCurrent entry -> visible . forceAttr currentChannelNameAttr | entryMentions entry > 0 && not (entryIsMuted entry) -> forceAttr mentionsChannelAttr | entryHasUnread entry -> forceAttr unreadChannelAttr | otherwise -> id entryWidget = case entryUserStatus entry of Just Offline -> withDefAttr clientMessageAttr . txt Just _ -> colorUsername myUName (entryLabel entry) Nothing -> 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 curMatch st match = let ChannelSelectMatch preMatch inMatch postMatch _ entry = match maybeSelect = if (Just entry) == (matchEntry <$> curMatch) then visible . withDefAttr currentChannelNameAttr else id entryData = mkChannelEntryData st entry decorate = if | entryMentions entryData > 0 && not (entryIsMuted entryData) -> withDefAttr mentionsChannelAttr | entryHasUnread entryData -> withDefAttr unreadChannelAttr | otherwise -> id in decorate $ maybeSelect $ decorateEntry entryData $ decorateMentions entryData $ padRight Max $ hBox [ txt $ entrySigil entryData <> preMatch , forceAttr channelSelectMatchAttr $ txt inMatch , txt 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 entry = if entryIsReturn entry then (<+> (withDefAttr recentMarkerAttr $ str returnChannelSigil)) else if entryIsRecent entry then (<+> (withDefAttr recentMarkerAttr $ str recentChannelSigil)) else id decorateMentions :: ChannelListEntryData -> Widget n -> Widget n decorateMentions entry | entryMentions entry > 9 = (<+> str "(9+)") | entryMentions entry > 0 = (<+> str ("(" <> show (entryMentions entry) <> ")")) | entryIsMuted entry = (<+> str "(m)") | otherwise = id recentChannelSigil :: String recentChannelSigil = "<" returnChannelSigil :: String returnChannelSigil = "~"