{-# LANGUAGE OverloadedStrings #-}
module Matterhorn.Themes
  ( InternalTheme(..)

  , defaultTheme
  , internalThemes
  , lookupTheme
  , themeDocs

  -- * Attribute names
  , currentUserAttr
  , timeAttr
  , verbatimTruncateMessageAttr
  , channelHeaderAttr
  , channelListHeaderAttr
  , currentChannelNameAttr
  , unreadChannelAttr
  , unreadGroupMarkerAttr
  , mentionsChannelAttr
  , currentTeamAttr
  , urlAttr
  , codeAttr
  , emailAttr
  , emojiAttr
  , reactionAttr
  , myReactionAttr
  , channelNameAttr
  , clientMessageAttr
  , clientHeaderAttr
  , strikeThroughAttr
  , clientEmphAttr
  , clientStrongAttr
  , dateTransitionAttr
  , pinnedMessageIndicatorAttr
  , newMessageTransitionAttr
  , gapMessageAttr
  , errorMessageAttr
  , helpAttr
  , helpEmphAttr
  , helpKeyEventAttr
  , channelSelectPromptAttr
  , channelSelectMatchAttr
  , completionAlternativeListAttr
  , completionAlternativeCurrentAttr
  , permalinkAttr
  , dialogAttr
  , dialogEmphAttr
  , recentMarkerAttr
  , replyParentAttr
  , loadMoreAttr
  , urlListSelectedAttr
  , messageSelectAttr
  , messageSelectStatusAttr
  , urlSelectStatusAttr
  , misspellingAttr
  , editedMarkingAttr
  , editedRecentlyMarkingAttr
  , tabSelectedAttr
  , tabUnselectedAttr
  , buttonAttr
  , buttonFocusedAttr
  , threadAttr
  , focusedEditorPromptAttr

  -- * Username formatting
  , colorUsername
  , attrForUsername
  , usernameColorHashBuckets
  )
where

import           Prelude ()
import           Matterhorn.Prelude

import           Brick
import           Brick.Themes
import           Brick.Widgets.List
import qualified Brick.Widgets.FileBrowser as FB
import           Brick.Widgets.Skylighting ( attrNameForTokenType
                                           , attrMappingsForStyle
                                           , highlightedCodeBlockAttr
                                           )
import           Brick.Forms ( focusedFormInputAttr )
import           Data.Hashable ( hash )
import qualified Data.Map as M
import qualified Data.Text as T
import           Graphics.Vty
import qualified Skylighting.Styles as Sky
import           Skylighting.Types ( TokenType(..) )

import           Matterhorn.Types ( InternalTheme(..), specialUserMentions )


helpAttr :: AttrName
helpAttr :: AttrName
helpAttr = AttrName
"help"

helpEmphAttr :: AttrName
helpEmphAttr :: AttrName
helpEmphAttr = AttrName
"helpEmphasis"

helpKeyEventAttr :: AttrName
helpKeyEventAttr :: AttrName
helpKeyEventAttr = AttrName
"helpKeyEvent"

recentMarkerAttr :: AttrName
recentMarkerAttr :: AttrName
recentMarkerAttr = AttrName
"recentChannelMarker"

replyParentAttr :: AttrName
replyParentAttr :: AttrName
replyParentAttr = AttrName
"replyParentPreview"

pinnedMessageIndicatorAttr :: AttrName
pinnedMessageIndicatorAttr :: AttrName
pinnedMessageIndicatorAttr = AttrName
"pinnedMessageIndicator"

loadMoreAttr :: AttrName
loadMoreAttr :: AttrName
loadMoreAttr = AttrName
"loadMoreMessages"

urlListSelectedAttr :: AttrName
urlListSelectedAttr :: AttrName
urlListSelectedAttr = AttrName
"urlListCursor"

messageSelectAttr :: AttrName
messageSelectAttr :: AttrName
messageSelectAttr = AttrName
"messageSelectCursor"

editedMarkingAttr :: AttrName
editedMarkingAttr :: AttrName
editedMarkingAttr = AttrName
"editedMarking"

editedRecentlyMarkingAttr :: AttrName
editedRecentlyMarkingAttr :: AttrName
editedRecentlyMarkingAttr = AttrName
"editedRecentlyMarking"

permalinkAttr :: AttrName
permalinkAttr :: AttrName
permalinkAttr = AttrName
"permalink"

dialogAttr :: AttrName
dialogAttr :: AttrName
dialogAttr = AttrName
"dialog"

dialogEmphAttr :: AttrName
dialogEmphAttr :: AttrName
dialogEmphAttr = AttrName
"dialogEmphasis"

channelSelectMatchAttr :: AttrName
channelSelectMatchAttr :: AttrName
channelSelectMatchAttr = AttrName
"channelSelectMatch"

channelSelectPromptAttr :: AttrName
channelSelectPromptAttr :: AttrName
channelSelectPromptAttr = AttrName
"channelSelectPrompt"

completionAlternativeListAttr :: AttrName
completionAlternativeListAttr :: AttrName
completionAlternativeListAttr = AttrName
"tabCompletionAlternative"

completionAlternativeCurrentAttr :: AttrName
completionAlternativeCurrentAttr :: AttrName
completionAlternativeCurrentAttr = AttrName
"tabCompletionCursor"

timeAttr :: AttrName
timeAttr :: AttrName
timeAttr = AttrName
"time"

currentUserAttr :: AttrName
currentUserAttr :: AttrName
currentUserAttr = AttrName
"currentUser"

channelHeaderAttr :: AttrName
channelHeaderAttr :: AttrName
channelHeaderAttr = AttrName
"channelHeader"

verbatimTruncateMessageAttr :: AttrName
verbatimTruncateMessageAttr :: AttrName
verbatimTruncateMessageAttr = AttrName
"verbatimTruncateMessage"

channelListHeaderAttr :: AttrName
channelListHeaderAttr :: AttrName
channelListHeaderAttr = AttrName
"channelListSectionHeader"

currentChannelNameAttr :: AttrName
currentChannelNameAttr :: AttrName
currentChannelNameAttr = AttrName
"currentChannelName"

channelNameAttr :: AttrName
channelNameAttr :: AttrName
channelNameAttr = AttrName
"channelName"

unreadChannelAttr :: AttrName
unreadChannelAttr :: AttrName
unreadChannelAttr = AttrName
"unreadChannel"

unreadGroupMarkerAttr :: AttrName
unreadGroupMarkerAttr :: AttrName
unreadGroupMarkerAttr = AttrName
"unreadChannelGroupMarker"

mentionsChannelAttr :: AttrName
mentionsChannelAttr :: AttrName
mentionsChannelAttr = AttrName
"channelWithMentions"

currentTeamAttr :: AttrName
currentTeamAttr :: AttrName
currentTeamAttr = AttrName
"currentTeam"

tabSelectedAttr :: AttrName
tabSelectedAttr :: AttrName
tabSelectedAttr = AttrName
"tabSelected"

tabUnselectedAttr :: AttrName
tabUnselectedAttr :: AttrName
tabUnselectedAttr = AttrName
"tabUnselected"

dateTransitionAttr :: AttrName
dateTransitionAttr :: AttrName
dateTransitionAttr = AttrName
"dateTransition"

newMessageTransitionAttr :: AttrName
newMessageTransitionAttr :: AttrName
newMessageTransitionAttr = AttrName
"newMessageTransition"

urlAttr :: AttrName
urlAttr :: AttrName
urlAttr = AttrName
"url"

codeAttr :: AttrName
codeAttr :: AttrName
codeAttr = AttrName
"codeBlock"

emailAttr :: AttrName
emailAttr :: AttrName
emailAttr = AttrName
"email"

emojiAttr :: AttrName
emojiAttr :: AttrName
emojiAttr = AttrName
"emoji"

reactionAttr :: AttrName
reactionAttr :: AttrName
reactionAttr = AttrName
"reaction"

myReactionAttr :: AttrName
myReactionAttr :: AttrName
myReactionAttr = AttrName
reactionAttr AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> AttrName
"mine"

clientMessageAttr :: AttrName
clientMessageAttr :: AttrName
clientMessageAttr = AttrName
"clientMessage"

clientHeaderAttr :: AttrName
clientHeaderAttr :: AttrName
clientHeaderAttr = AttrName
"markdownHeader"

strikeThroughAttr :: AttrName
strikeThroughAttr :: AttrName
strikeThroughAttr = AttrName
"markdownStrikethrough"

clientEmphAttr :: AttrName
clientEmphAttr :: AttrName
clientEmphAttr = AttrName
"markdownEmph"

clientStrongAttr :: AttrName
clientStrongAttr :: AttrName
clientStrongAttr = AttrName
"markdownStrong"

errorMessageAttr :: AttrName
errorMessageAttr :: AttrName
errorMessageAttr = AttrName
"errorMessage"

gapMessageAttr :: AttrName
gapMessageAttr :: AttrName
gapMessageAttr = AttrName
"gapMessage"

misspellingAttr :: AttrName
misspellingAttr :: AttrName
misspellingAttr = AttrName
"misspelling"

messageSelectStatusAttr :: AttrName
messageSelectStatusAttr :: AttrName
messageSelectStatusAttr = AttrName
"messageSelectStatus"

urlSelectStatusAttr :: AttrName
urlSelectStatusAttr :: AttrName
urlSelectStatusAttr = AttrName
"urlSelectStatus"

buttonAttr :: AttrName
buttonAttr :: AttrName
buttonAttr = AttrName
"button"

buttonFocusedAttr :: AttrName
buttonFocusedAttr :: AttrName
buttonFocusedAttr = AttrName
buttonAttr AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> AttrName
"focused"

threadAttr :: AttrName
threadAttr :: AttrName
threadAttr = AttrName
"thread"

focusedEditorPromptAttr :: AttrName
focusedEditorPromptAttr :: AttrName
focusedEditorPromptAttr = AttrName
"focusedEditorPrompt"

lookupTheme :: Text -> Maybe InternalTheme
lookupTheme :: Text -> Maybe InternalTheme
lookupTheme Text
n = (InternalTheme -> Bool) -> [InternalTheme] -> Maybe InternalTheme
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
n) (Text -> Bool) -> (InternalTheme -> Text) -> InternalTheme -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InternalTheme -> Text
internalThemeName) [InternalTheme]
internalThemes

internalThemes :: [InternalTheme]
internalThemes :: [InternalTheme]
internalThemes = InternalTheme -> InternalTheme
validateInternalTheme (InternalTheme -> InternalTheme)
-> [InternalTheme] -> [InternalTheme]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    [ InternalTheme
darkColorTheme
    , InternalTheme
darkColor256Theme
    , InternalTheme
lightColorTheme
    , InternalTheme
lightColor256Theme
    ]

validateInternalTheme :: InternalTheme -> InternalTheme
validateInternalTheme :: InternalTheme -> InternalTheme
validateInternalTheme InternalTheme
it =
    let un :: [AttrName]
un = Theme -> [AttrName]
undocumentedAttrNames (InternalTheme -> Theme
internalTheme InternalTheme
it)
    in if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [AttrName] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [AttrName]
un
       then [Char] -> InternalTheme
forall a. HasCallStack => [Char] -> a
error ([Char] -> InternalTheme) -> [Char] -> InternalTheme
forall a b. (a -> b) -> a -> b
$ [Char]
"Internal theme " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> [Char]
forall a. Show a => a -> [Char]
show (Text -> [Char]
T.unpack (InternalTheme -> Text
internalThemeName InternalTheme
it)) [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<>
                    [Char]
" references undocumented attribute names: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [AttrName] -> [Char]
forall a. Show a => a -> [Char]
show [AttrName]
un
       else InternalTheme
it

undocumentedAttrNames :: Theme -> [AttrName]
undocumentedAttrNames :: Theme -> [AttrName]
undocumentedAttrNames Theme
t =
    let noDocs :: AttrName -> Bool
noDocs AttrName
k = Maybe Text -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe Text -> Bool) -> Maybe Text -> Bool
forall a b. (a -> b) -> a -> b
$ ThemeDocumentation -> AttrName -> Maybe Text
attrNameDescription ThemeDocumentation
themeDocs AttrName
k
    in (AttrName -> Bool) -> [AttrName] -> [AttrName]
forall a. (a -> Bool) -> [a] -> [a]
filter AttrName -> Bool
noDocs (Map AttrName Attr -> [AttrName]
forall k a. Map k a -> [k]
M.keys (Map AttrName Attr -> [AttrName])
-> Map AttrName Attr -> [AttrName]
forall a b. (a -> b) -> a -> b
$ Theme -> Map AttrName Attr
themeDefaultMapping Theme
t)

defaultTheme :: InternalTheme
defaultTheme :: InternalTheme
defaultTheme = InternalTheme
darkColorTheme

lightColorTheme :: InternalTheme
lightColorTheme :: InternalTheme
lightColorTheme = Text -> Theme -> Text -> InternalTheme
InternalTheme Text
name Theme
theme Text
desc
    where
        theme :: Theme
theme = Attr -> [(AttrName, Attr)] -> Theme
newTheme Attr
def ([(AttrName, Attr)] -> Theme) -> [(AttrName, Attr)] -> Theme
forall a b. (a -> b) -> a -> b
$ [Attr] -> [(AttrName, Attr)]
lightAttrs [Attr]
usernameColors16
        name :: Text
name = Text
"builtin:light"
        def :: Attr
def = Color
black Color -> Color -> Attr
`on` Color
white
        desc :: Text
desc = Text
"A 16-color theme for terminal windows with light background colors"

lightColor256Theme :: InternalTheme
lightColor256Theme :: InternalTheme
lightColor256Theme = Text -> Theme -> Text -> InternalTheme
InternalTheme Text
name Theme
theme Text
desc
    where
        theme :: Theme
theme = Attr -> [(AttrName, Attr)] -> Theme
newTheme Attr
def ([(AttrName, Attr)] -> Theme) -> [(AttrName, Attr)] -> Theme
forall a b. (a -> b) -> a -> b
$ [Attr] -> [(AttrName, Attr)]
lightAttrs [Attr]
usernameColors256
        name :: Text
name = Text
"builtin:light256"
        def :: Attr
def = Color
black Color -> Color -> Attr
`on` Color
white
        desc :: Text
desc = Text
"Like builtin:light, but with 256-color username colors"

lightAttrs :: [Attr] -> [(AttrName, Attr)]
lightAttrs :: [Attr] -> [(AttrName, Attr)]
lightAttrs [Attr]
usernameColors =
    let sty :: Style
sty = Style
Sky.kate
    in [ (AttrName
timeAttr,                         Color -> Attr
fg Color
black)
       , (AttrName
buttonAttr,                       Color
black Color -> Color -> Attr
`on` Color
cyan)
       , (AttrName
buttonFocusedAttr,                Color
black Color -> Color -> Attr
`on` Color
yellow)
       , (AttrName
threadAttr,                       Attr
defAttr)
       , (AttrName
focusedEditorPromptAttr,          Color -> Attr
fg Color
yellow Attr -> Style -> Attr
`withStyle` Style
bold)
       , (AttrName
currentUserAttr,                  Attr
defAttr Attr -> Style -> Attr
`withStyle` Style
bold)
       , (AttrName
channelHeaderAttr,                Color -> Attr
fg Color
black)
       , (AttrName
verbatimTruncateMessageAttr,      Color -> Attr
fg Color
blue)
       , (AttrName
scrollbarAttr,                    Attr
defAttr)
       , (AttrName
scrollbarHandleAttr,              Attr
defAttr Attr -> Style -> Attr
`withStyle` Style
reverseVideo)
       , (AttrName
scrollbarTroughAttr,              Attr
defAttr)
       , (AttrName
channelListHeaderAttr,            Color -> Attr
fg Color
cyan)
       , (AttrName
currentChannelNameAttr,           Color
black Color -> Color -> Attr
`on` Color
yellow Attr -> Style -> Attr
`withStyle` Style
bold)
       , (AttrName
unreadChannelAttr,                Color
black Color -> Color -> Attr
`on` Color
cyan   Attr -> Style -> Attr
`withStyle` Style
bold)
       , (AttrName
unreadGroupMarkerAttr,            Color -> Attr
fg Color
black Attr -> Style -> Attr
`withStyle` Style
bold)
       , (AttrName
mentionsChannelAttr,              Color
black Color -> Color -> Attr
`on` Color
red    Attr -> Style -> Attr
`withStyle` Style
bold)
       , (AttrName
urlAttr,                          Color -> Attr
fg Color
brightYellow)
       , (AttrName
emailAttr,                        Color -> Attr
fg Color
yellow)
       , (AttrName
codeAttr,                         Color -> Attr
fg Color
magenta)
       , (AttrName
emojiAttr,                        Color -> Attr
fg Color
yellow)
       , (AttrName
reactionAttr,                     Color -> Attr
fg Color
yellow)
       , (AttrName
myReactionAttr,                   Color -> Attr
fg Color
yellow Attr -> Style -> Attr
`withStyle` Style
underline)
       , (AttrName
channelNameAttr,                  Color -> Attr
fg Color
blue)
       , (AttrName
clientMessageAttr,                Color -> Attr
fg Color
black)
       , (AttrName
clientEmphAttr,                   Color -> Attr
fg Color
black Attr -> Style -> Attr
`withStyle` Style
bold)
       , (AttrName
clientStrongAttr,                 Color -> Attr
fg Color
black Attr -> Style -> Attr
`withStyle` Style
bold Attr -> Style -> Attr
`withStyle` Style
underline)
       , (AttrName
clientHeaderAttr,                 Color -> Attr
fg Color
red Attr -> Style -> Attr
`withStyle` Style
bold)
       , (AttrName
strikeThroughAttr,                Attr
defAttr Attr -> Style -> Attr
`withStyle` Style
strikethrough)
       , (AttrName
dateTransitionAttr,               Color -> Attr
fg Color
green)
       , (AttrName
newMessageTransitionAttr,         Color
black Color -> Color -> Attr
`on` Color
yellow)
       , (AttrName
errorMessageAttr,                 Color -> Attr
fg Color
red)
       , (AttrName
gapMessageAttr,                   Color -> Attr
fg Color
red)
       , (AttrName
helpAttr,                         Color -> Attr
fg Color
black)
       , (AttrName
pinnedMessageIndicatorAttr,       Color
black Color -> Color -> Attr
`on` Color
cyan)
       , (AttrName
helpEmphAttr,                     Color -> Attr
fg Color
blue Attr -> Style -> Attr
`withStyle` Style
bold)
       , (AttrName
helpKeyEventAttr,                 Color -> Attr
fg Color
magenta)
       , (AttrName
channelSelectMatchAttr,           Color
black Color -> Color -> Attr
`on` Color
magenta Attr -> Style -> Attr
`withStyle` Style
underline)
       , (AttrName
channelSelectPromptAttr,          Color -> Attr
fg Color
black)
       , (AttrName
completionAlternativeListAttr,    Color
white Color -> Color -> Attr
`on` Color
blue)
       , (AttrName
completionAlternativeCurrentAttr, Color
black Color -> Color -> Attr
`on` Color
yellow)
       , (AttrName
dialogAttr,                       Color
black Color -> Color -> Attr
`on` Color
cyan)
       , (AttrName
dialogEmphAttr,                   Color -> Attr
fg Color
white)
       , (AttrName
permalinkAttr,                    Color -> Attr
fg Color
green)
       , (AttrName
listSelectedFocusedAttr,          Color
black Color -> Color -> Attr
`on` Color
yellow)
       , (AttrName
recentMarkerAttr,                 Color -> Attr
fg Color
black Attr -> Style -> Attr
`withStyle` Style
bold)
       , (AttrName
loadMoreAttr,                     Color
black Color -> Color -> Attr
`on` Color
cyan)
       , (AttrName
urlListSelectedAttr,              Color
black Color -> Color -> Attr
`on` Color
yellow)
       , (AttrName
messageSelectAttr,                Color
black Color -> Color -> Attr
`on` Color
yellow)
       , (AttrName
messageSelectStatusAttr,          Color -> Attr
fg Color
black)
       , (AttrName
urlSelectStatusAttr,              Color -> Attr
fg Color
black)
       , (AttrName
misspellingAttr,                  Color -> Attr
fg Color
red Attr -> Style -> Attr
`withStyle` Style
underline)
       , (AttrName
editedMarkingAttr,                Color -> Attr
fg Color
yellow)
       , (AttrName
editedRecentlyMarkingAttr,        Color
black Color -> Color -> Attr
`on` Color
yellow)
       , (AttrName
tabSelectedAttr,                  Color
black Color -> Color -> Attr
`on` Color
yellow)
       , (AttrName
focusedFormInputAttr,             Color
black Color -> Color -> Attr
`on` Color
yellow)
       , (AttrName
currentTeamAttr,                  Color
black Color -> Color -> Attr
`on` Color
yellow)
       , (AttrName
FB.fileBrowserCurrentDirectoryAttr, Color
white Color -> Color -> Attr
`on` Color
blue)
       , (AttrName
FB.fileBrowserSelectionInfoAttr,  Color
white Color -> Color -> Attr
`on` Color
blue)
       , (AttrName
FB.fileBrowserDirectoryAttr,      Color -> Attr
fg Color
blue)
       , (AttrName
FB.fileBrowserBlockDeviceAttr,    Color -> Attr
fg Color
magenta)
       , (AttrName
FB.fileBrowserCharacterDeviceAttr, Color -> Attr
fg Color
green)
       , (AttrName
FB.fileBrowserNamedPipeAttr,      Color -> Attr
fg Color
yellow)
       , (AttrName
FB.fileBrowserSymbolicLinkAttr,   Color -> Attr
fg Color
cyan)
       , (AttrName
FB.fileBrowserUnixSocketAttr,     Color -> Attr
fg Color
red)
       ] [(AttrName, Attr)] -> [(AttrName, Attr)] -> [(AttrName, Attr)]
forall a. Semigroup a => a -> a -> a
<>
       ((\(Int
i, Attr
a) -> (Int -> AttrName
usernameAttr Int
i, Attr
a)) ((Int, Attr) -> (AttrName, Attr))
-> [(Int, Attr)] -> [(AttrName, Attr)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int] -> [Attr] -> [(Int, Attr)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..Int
usernameColorHashBucketsInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] ([Attr] -> [Attr]
forall a. [a] -> [a]
cycle [Attr]
usernameColors)) [(AttrName, Attr)] -> [(AttrName, Attr)] -> [(AttrName, Attr)]
forall a. Semigroup a => a -> a -> a
<>
       (((AttrName, Attr) -> Bool)
-> [(AttrName, Attr)] -> [(AttrName, Attr)]
forall a. (a -> Bool) -> [a] -> [a]
filter (AttrName, Attr) -> Bool
skipBaseCodeblockAttr ([(AttrName, Attr)] -> [(AttrName, Attr)])
-> [(AttrName, Attr)] -> [(AttrName, Attr)]
forall a b. (a -> b) -> a -> b
$ Style -> [(AttrName, Attr)]
attrMappingsForStyle Style
sty)

darkAttrs :: [Attr] -> [(AttrName, Attr)]
darkAttrs :: [Attr] -> [(AttrName, Attr)]
darkAttrs [Attr]
usernameColors =
  let sty :: Style
sty = Style
Sky.espresso
  in [ (AttrName
timeAttr,                         Color -> Attr
fg Color
white)
     , (AttrName
buttonAttr,                       Color
black Color -> Color -> Attr
`on` Color
cyan)
     , (AttrName
buttonFocusedAttr,                Color
black Color -> Color -> Attr
`on` Color
yellow)
     , (AttrName
threadAttr,                       Attr
defAttr)
     , (AttrName
focusedEditorPromptAttr,          Color -> Attr
fg Color
yellow Attr -> Style -> Attr
`withStyle` Style
bold)
     , (AttrName
currentUserAttr,                  Attr
defAttr Attr -> Style -> Attr
`withStyle` Style
bold)
     , (AttrName
channelHeaderAttr,                Color -> Attr
fg Color
white)
     , (AttrName
verbatimTruncateMessageAttr,      Color -> Attr
fg Color
cyan)
     , (AttrName
channelListHeaderAttr,            Color -> Attr
fg Color
cyan)
     , (AttrName
currentChannelNameAttr,           Color
black Color -> Color -> Attr
`on` Color
yellow Attr -> Style -> Attr
`withStyle` Style
bold)
     , (AttrName
unreadChannelAttr,                Color
black Color -> Color -> Attr
`on` Color
cyan   Attr -> Style -> Attr
`withStyle` Style
bold)
     , (AttrName
unreadGroupMarkerAttr,            Color -> Attr
fg Color
white Attr -> Style -> Attr
`withStyle` Style
bold)
     , (AttrName
mentionsChannelAttr,              Color
black Color -> Color -> Attr
`on` Color
brightMagenta Attr -> Style -> Attr
`withStyle` Style
bold)
     , (AttrName
scrollbarAttr,                    Attr
defAttr)
     , (AttrName
scrollbarHandleAttr,              Attr
defAttr Attr -> Style -> Attr
`withStyle` Style
reverseVideo)
     , (AttrName
scrollbarTroughAttr,              Attr
defAttr)
     , (AttrName
urlAttr,                          Color -> Attr
fg Color
yellow)
     , (AttrName
emailAttr,                        Color -> Attr
fg Color
yellow)
     , (AttrName
codeAttr,                         Color -> Attr
fg Color
magenta)
     , (AttrName
emojiAttr,                        Color -> Attr
fg Color
yellow)
     , (AttrName
reactionAttr,                     Color -> Attr
fg Color
yellow)
     , (AttrName
myReactionAttr,                   Color -> Attr
fg Color
yellow Attr -> Style -> Attr
`withStyle` Style
underline)
     , (AttrName
channelNameAttr,                  Color -> Attr
fg Color
cyan)
     , (AttrName
pinnedMessageIndicatorAttr,       Color -> Attr
fg Color
cyan Attr -> Style -> Attr
`withStyle` Style
bold)
     , (AttrName
clientMessageAttr,                Color -> Attr
fg Color
white)
     , (AttrName
clientEmphAttr,                   Color -> Attr
fg Color
white Attr -> Style -> Attr
`withStyle` Style
bold)
     , (AttrName
clientStrongAttr,                 Color -> Attr
fg Color
white Attr -> Style -> Attr
`withStyle` Style
bold Attr -> Style -> Attr
`withStyle` Style
underline)
     , (AttrName
clientHeaderAttr,                 Color -> Attr
fg Color
red Attr -> Style -> Attr
`withStyle` Style
bold)
     , (AttrName
strikeThroughAttr,                Attr
defAttr Attr -> Style -> Attr
`withStyle` Style
strikethrough)
     , (AttrName
dateTransitionAttr,               Color -> Attr
fg Color
green)
     , (AttrName
newMessageTransitionAttr,         Color -> Attr
fg Color
yellow Attr -> Style -> Attr
`withStyle` Style
bold)
     , (AttrName
errorMessageAttr,                 Color -> Attr
fg Color
red)
     , (AttrName
gapMessageAttr,                   Color
black Color -> Color -> Attr
`on` Color
yellow)
     , (AttrName
helpAttr,                         Color -> Attr
fg Color
white)
     , (AttrName
helpEmphAttr,                     Color -> Attr
fg Color
cyan Attr -> Style -> Attr
`withStyle` Style
bold)
     , (AttrName
helpKeyEventAttr,                 Color -> Attr
fg Color
yellow)
     , (AttrName
channelSelectMatchAttr,           Color
black Color -> Color -> Attr
`on` Color
magenta Attr -> Style -> Attr
`withStyle` Style
underline)
     , (AttrName
channelSelectPromptAttr,          Color -> Attr
fg Color
white)
     , (AttrName
completionAlternativeListAttr,    Color
white Color -> Color -> Attr
`on` Color
blue)
     , (AttrName
completionAlternativeCurrentAttr, Color
black Color -> Color -> Attr
`on` Color
yellow)
     , (AttrName
dialogAttr,                       Color
black Color -> Color -> Attr
`on` Color
cyan)
     , (AttrName
dialogEmphAttr,                   Color -> Attr
fg Color
white)
     , (AttrName
permalinkAttr,                    Color -> Attr
fg Color
brightCyan)
     , (AttrName
listSelectedFocusedAttr,          Color
black Color -> Color -> Attr
`on` Color
yellow)
     , (AttrName
recentMarkerAttr,                 Color -> Attr
fg Color
yellow Attr -> Style -> Attr
`withStyle` Style
bold)
     , (AttrName
loadMoreAttr,                     Color
black Color -> Color -> Attr
`on` Color
cyan)
     , (AttrName
urlListSelectedAttr,              Color
black Color -> Color -> Attr
`on` Color
yellow)
     , (AttrName
messageSelectAttr,                Color
black Color -> Color -> Attr
`on` Color
yellow)
     , (AttrName
messageSelectStatusAttr,          Color -> Attr
fg Color
white)
     , (AttrName
urlSelectStatusAttr,              Color -> Attr
fg Color
white)
     , (AttrName
misspellingAttr,                  Color -> Attr
fg Color
red Attr -> Style -> Attr
`withStyle` Style
underline)
     , (AttrName
editedMarkingAttr,                Color -> Attr
fg Color
yellow)
     , (AttrName
editedRecentlyMarkingAttr,        Color
black Color -> Color -> Attr
`on` Color
yellow)
     , (AttrName
tabSelectedAttr,                  Color
black Color -> Color -> Attr
`on` Color
yellow)
     , (AttrName
focusedFormInputAttr,             Color
black Color -> Color -> Attr
`on` Color
yellow)
     , (AttrName
currentTeamAttr,                  Color
black Color -> Color -> Attr
`on` Color
yellow)
     , (AttrName
FB.fileBrowserCurrentDirectoryAttr, Color
white Color -> Color -> Attr
`on` Color
blue)
     , (AttrName
FB.fileBrowserSelectionInfoAttr,  Color
white Color -> Color -> Attr
`on` Color
blue)
     , (AttrName
FB.fileBrowserDirectoryAttr,      Color -> Attr
fg Color
blue)
     , (AttrName
FB.fileBrowserBlockDeviceAttr,    Color -> Attr
fg Color
magenta)
     , (AttrName
FB.fileBrowserCharacterDeviceAttr, Color -> Attr
fg Color
green)
     , (AttrName
FB.fileBrowserNamedPipeAttr,      Color -> Attr
fg Color
yellow)
     , (AttrName
FB.fileBrowserSymbolicLinkAttr,   Color -> Attr
fg Color
cyan)
     , (AttrName
FB.fileBrowserUnixSocketAttr,     Color -> Attr
fg Color
red)
     ] [(AttrName, Attr)] -> [(AttrName, Attr)] -> [(AttrName, Attr)]
forall a. Semigroup a => a -> a -> a
<>
     ((\(Int
i, Attr
a) -> (Int -> AttrName
usernameAttr Int
i, Attr
a)) ((Int, Attr) -> (AttrName, Attr))
-> [(Int, Attr)] -> [(AttrName, Attr)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int] -> [Attr] -> [(Int, Attr)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..Int
usernameColorHashBucketsInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] ([Attr] -> [Attr]
forall a. [a] -> [a]
cycle [Attr]
usernameColors)) [(AttrName, Attr)] -> [(AttrName, Attr)] -> [(AttrName, Attr)]
forall a. Semigroup a => a -> a -> a
<>
     (((AttrName, Attr) -> Bool)
-> [(AttrName, Attr)] -> [(AttrName, Attr)]
forall a. (a -> Bool) -> [a] -> [a]
filter (AttrName, Attr) -> Bool
skipBaseCodeblockAttr ([(AttrName, Attr)] -> [(AttrName, Attr)])
-> [(AttrName, Attr)] -> [(AttrName, Attr)]
forall a b. (a -> b) -> a -> b
$ Style -> [(AttrName, Attr)]
attrMappingsForStyle Style
sty)

skipBaseCodeblockAttr :: (AttrName, Attr) -> Bool
skipBaseCodeblockAttr :: (AttrName, Attr) -> Bool
skipBaseCodeblockAttr = ((AttrName -> AttrName -> Bool
forall a. Eq a => a -> a -> Bool
/= AttrName
highlightedCodeBlockAttr) (AttrName -> Bool)
-> ((AttrName, Attr) -> AttrName) -> (AttrName, Attr) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AttrName, Attr) -> AttrName
forall a b. (a, b) -> a
fst)

darkColorTheme :: InternalTheme
darkColorTheme :: InternalTheme
darkColorTheme = Text -> Theme -> Text -> InternalTheme
InternalTheme Text
name Theme
theme Text
desc
    where
        theme :: Theme
theme = Attr -> [(AttrName, Attr)] -> Theme
newTheme Attr
def ([(AttrName, Attr)] -> Theme) -> [(AttrName, Attr)] -> Theme
forall a b. (a -> b) -> a -> b
$ [Attr] -> [(AttrName, Attr)]
darkAttrs [Attr]
usernameColors16
        name :: Text
name = Text
"builtin:dark"
        def :: Attr
def = Attr
defAttr
        desc :: Text
desc = Text
"A 16-color theme for terminal windows with dark background colors"

darkColor256Theme :: InternalTheme
darkColor256Theme :: InternalTheme
darkColor256Theme = Text -> Theme -> Text -> InternalTheme
InternalTheme Text
name Theme
theme Text
desc
    where
        theme :: Theme
theme = Attr -> [(AttrName, Attr)] -> Theme
newTheme Attr
def ([(AttrName, Attr)] -> Theme) -> [(AttrName, Attr)] -> Theme
forall a b. (a -> b) -> a -> b
$ [Attr] -> [(AttrName, Attr)]
darkAttrs [Attr]
usernameColors256
        name :: Text
name = Text
"builtin:dark256"
        def :: Attr
def = Attr
defAttr
        desc :: Text
desc = Text
"Like builtin:dark, but with 256-color username colors"

usernameAttr :: Int -> AttrName
usernameAttr :: Int -> AttrName
usernameAttr Int
i = AttrName
"username" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> ([Char] -> AttrName
attrName ([Char] -> AttrName) -> [Char] -> AttrName
forall a b. (a -> b) -> a -> b
$ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i)

-- | Render a string with a color chosen based on the text of a
-- username.
--
-- This function takes some display text and renders it using an
-- attribute based on the username associated with the text. If the
-- username associated with the text is equal to the username of
-- the user running Matterhorn, the display text is formatted with
-- 'currentAttr'. Otherwise it is formatted with an attribute chosen
-- by hashing the associated username and choosing from amongst the
-- username color hash buckets with 'usernameAttr'.
--
-- Usually the first argument to this function will be @myUsername st@,
-- where @st@ is a 'ChatState'.
--
-- The most common way to call this function is
--
-- @colorUsername (myUsername st) u u
--
-- The third argument is allowed to vary from the second since sometimes
-- we call this with the user's status sigil as the third argument.
colorUsername :: Text
              -- ^ The username for the user currently running
              -- Matterhorn
              -> Text
              -- ^ The username associated with the text to render
              -> Text
              -- ^ The text to render
              -> Widget a
colorUsername :: Text -> Text -> Text -> Widget a
colorUsername Text
current Text
username Text
display =
    let aName :: AttrName
aName = Text -> AttrName
attrForUsername Text
username
        maybeWithCurrentAttr :: Widget n -> Widget n
maybeWithCurrentAttr = if Text
current Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
username
                               then AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
currentUserAttr
                               else Widget n -> Widget n
forall a. a -> a
id
    in AttrName -> Widget a -> Widget a
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
aName (Widget a -> Widget a) -> Widget a -> Widget a
forall a b. (a -> b) -> a -> b
$
       Widget a -> Widget a
forall n. Widget n -> Widget n
maybeWithCurrentAttr (Widget a -> Widget a) -> Widget a -> Widget a
forall a b. (a -> b) -> a -> b
$
       Text -> Widget a
forall n. Text -> Widget n
txt (Text
display)

-- | Return the attribute name to use for the specified username.
-- The input username is expected to be the username only (i.e. no
-- sigil).
--
-- If the input username is a special reserved username such as "all",
-- the @clientEmphAttr@ attribute name will be returned. Otherwise
-- a hash-bucket username attribute name will be returned based on
-- the hash value of the username and the number of hash buckets
-- (@usernameColorHashBuckets@).
attrForUsername :: Text
                -- ^ The username to get an attribute for
                -> AttrName
attrForUsername :: Text -> AttrName
attrForUsername Text
username =
    let normalizedUsername :: Text
normalizedUsername = Text -> Text
T.toLower Text
username
        aName :: AttrName
aName = if Text
normalizedUsername Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
specialUserMentions
                then AttrName
clientEmphAttr
                else Int -> AttrName
usernameAttr Int
h
        h :: Int
h = Text -> Int
forall a. Hashable a => a -> Int
hash Text
normalizedUsername Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
usernameColorHashBuckets
    in AttrName
aName

-- | The number of hash buckets to use when hashing usernames to choose
-- their colors.
usernameColorHashBuckets :: Int
usernameColorHashBuckets :: Int
usernameColorHashBuckets = Int
50

usernameColors16 :: [Attr]
usernameColors16 :: [Attr]
usernameColors16 =
    [ Color -> Attr
fg Color
red
    , Color -> Attr
fg Color
green
    , Color -> Attr
fg Color
yellow
    , Color -> Attr
fg Color
blue
    , Color -> Attr
fg Color
magenta
    , Color -> Attr
fg Color
cyan
    , Color -> Attr
fg Color
brightRed
    , Color -> Attr
fg Color
brightGreen
    , Color -> Attr
fg Color
brightYellow
    , Color -> Attr
fg Color
brightBlue
    , Color -> Attr
fg Color
brightMagenta
    , Color -> Attr
fg Color
brightCyan
    ]

usernameColors256 :: [Attr]
usernameColors256 :: [Attr]
usernameColors256 = (Integer, Integer, Integer) -> Attr
forall i. Integral i => (i, i, i) -> Attr
mkColor ((Integer, Integer, Integer) -> Attr)
-> [(Integer, Integer, Integer)] -> [Attr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Integer, Integer, Integer)]
username256ColorChoices
    where
        mkColor :: (i, i, i) -> Attr
mkColor (i
r, i
g, i
b) = Attr
defAttr Attr -> Color -> Attr
`withForeColor` i -> i -> i -> Color
forall i. Integral i => i -> i -> i -> Color
rgbColor i
r i
g i
b

username256ColorChoices :: [(Integer, Integer, Integer)]
username256ColorChoices :: [(Integer, Integer, Integer)]
username256ColorChoices =
    [ (Integer
255, Integer
0, Integer
86)
    , (Integer
158, Integer
0, Integer
142)
    , (Integer
14, Integer
76, Integer
161)
    , (Integer
255, Integer
229, Integer
2)
    , (Integer
149, Integer
0, Integer
58)
    , (Integer
255, Integer
147, Integer
126)
    , (Integer
164, Integer
36, Integer
0)
    , (Integer
98, Integer
14, Integer
0)
    , (Integer
0, Integer
0, Integer
255)
    , (Integer
106, Integer
130, Integer
108)
    , (Integer
0, Integer
174, Integer
126)
    , (Integer
194, Integer
140, Integer
159)
    , (Integer
0, Integer
143, Integer
156)
    , (Integer
95, Integer
173, Integer
78)
    , (Integer
255, Integer
2, Integer
157)
    , (Integer
255, Integer
116, Integer
163)
    , (Integer
152, Integer
255, Integer
82)
    , (Integer
167, Integer
87, Integer
64)
    , (Integer
254, Integer
137, Integer
0)
    , (Integer
1, Integer
208, Integer
255)
    , (Integer
187, Integer
136, Integer
0)
    , (Integer
117, Integer
68, Integer
177)
    , (Integer
165, Integer
255, Integer
210)
    , (Integer
122, Integer
71, Integer
130)
    , (Integer
0, Integer
71, Integer
84)
    , (Integer
181, Integer
0, Integer
255)
    , (Integer
144, Integer
251, Integer
146)
    , (Integer
189, Integer
211, Integer
147)
    , (Integer
229, Integer
111, Integer
254)
    , (Integer
222, Integer
255, Integer
116)
    , (Integer
0, Integer
255, Integer
120)
    , (Integer
0, Integer
155, Integer
255)
    , (Integer
0, Integer
100, Integer
1)
    , (Integer
0, Integer
118, Integer
255)
    , (Integer
133, Integer
169, Integer
0)
    , (Integer
0, Integer
185, Integer
23)
    , (Integer
120, Integer
130, Integer
49)
    , (Integer
0, Integer
255, Integer
198)
    , (Integer
255, Integer
110, Integer
65)
    ]

-- Functions for dealing with Skylighting styles

attrNameDescription :: ThemeDocumentation -> AttrName -> Maybe Text
attrNameDescription :: ThemeDocumentation -> AttrName -> Maybe Text
attrNameDescription ThemeDocumentation
td AttrName
an = AttrName -> Map AttrName Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup AttrName
an (ThemeDocumentation -> Map AttrName Text
themeDescriptions ThemeDocumentation
td)

themeDocs :: ThemeDocumentation
themeDocs :: ThemeDocumentation
themeDocs = Map AttrName Text -> ThemeDocumentation
ThemeDocumentation (Map AttrName Text -> ThemeDocumentation)
-> Map AttrName Text -> ThemeDocumentation
forall a b. (a -> b) -> a -> b
$ [(AttrName, Text)] -> Map AttrName Text
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(AttrName, Text)] -> Map AttrName Text)
-> [(AttrName, Text)] -> Map AttrName Text
forall a b. (a -> b) -> a -> b
$
    [ ( AttrName
timeAttr
      , Text
"Timestamps on chat messages"
      )
    , ( AttrName
channelHeaderAttr
      , Text
"Channel headers displayed above chat message lists"
      )
    , ( AttrName
channelListHeaderAttr
      , Text
"The heading of the channel list sections"
      )
    , ( AttrName
currentChannelNameAttr
      , Text
"The currently selected channel in the channel list"
      )
    , ( AttrName
unreadChannelAttr
      , Text
"A channel in the channel list with unread messages"
      )
    , ( AttrName
unreadGroupMarkerAttr
      , Text
"The channel group marker indicating unread messages"
      )
    , ( AttrName
mentionsChannelAttr
      , Text
"A channel in the channel list with unread mentions"
      )
    , ( AttrName
urlAttr
      , Text
"A URL in a chat message"
      )
    , ( AttrName
codeAttr
      , Text
"A code block in a chat message with no language indication"
      )
    , ( AttrName
emailAttr
      , Text
"An e-mail address in a chat message"
      )
    , ( AttrName
emojiAttr
      , Text
"A text emoji indication in a chat message"
      )
    , ( AttrName
reactionAttr
      , Text
"An emoji reaction on a chat message"
      )
    , ( AttrName
myReactionAttr
      , Text
"An emoji reaction that the current user has posted on a chat message"
      )
    , ( AttrName
channelNameAttr
      , Text
"A channel name in a chat message"
      )
    , ( AttrName
clientMessageAttr
      , Text
"A Matterhorn diagnostic or informative message"
      )
    , ( AttrName
clientHeaderAttr
      , Text
"Markdown heading"
      )
    , ( AttrName
strikeThroughAttr
      , Text
"Markdown strikethrough text"
      )
    , ( AttrName
clientEmphAttr
      , Text
"Markdown 'emphasized' text"
      )
    , ( AttrName
clientStrongAttr
      , Text
"Markdown 'strong' text"
      )
    , ( AttrName
dateTransitionAttr
      , Text
"Date transition lines between chat messages on different days"
      )
    , ( AttrName
pinnedMessageIndicatorAttr
      , Text
"The indicator for messages that have been pinned"
      )
    , ( AttrName
newMessageTransitionAttr
      , Text
"The 'New Messages' line that appears above unread messages"
      )
    , ( AttrName
tabSelectedAttr
      , Text
"Selected tabs in tabbed windows"
      )
    , ( AttrName
tabUnselectedAttr
      , Text
"Unselected tabs in tabbed windows"
      )
    , ( AttrName
errorMessageAttr
      , Text
"Matterhorn error messages"
      )
    , ( AttrName
gapMessageAttr
      , Text
"Matterhorn message gap information"
      )
    , ( AttrName
helpAttr
      , Text
"The help screen text"
      )
    , ( AttrName
helpEmphAttr
      , Text
"The help screen's emphasized text"
      )
    , ( AttrName
helpKeyEventAttr
      , Text
"The help screen's mention of key event names"
      )
    , ( AttrName
channelSelectPromptAttr
      , Text
"Channel selection: prompt"
      )
    , ( AttrName
channelSelectMatchAttr
      , Text
"Channel selection: the portion of a channel name that matches"
      )
    , ( AttrName
completionAlternativeListAttr
      , Text
"Tab completion alternatives"
      )
    , ( AttrName
completionAlternativeCurrentAttr
      , Text
"The currently-selected tab completion alternative"
      )
    , ( AttrName
permalinkAttr
      , Text
"A post permalink"
      )
    , ( AttrName
dialogAttr
      , Text
"Dialog box text"
      )
    , ( AttrName
dialogEmphAttr
      , Text
"Dialog box emphasized text"
      )
    , ( AttrName
recentMarkerAttr
      , Text
"The marker indicating the channel last visited"
      )
    , ( AttrName
replyParentAttr
      , Text
"The first line of parent messages appearing above reply messages"
      )
    , ( AttrName
loadMoreAttr
      , Text
"The 'Load More' line that appears at the top of a chat message list"
      )
    , ( AttrName
urlListSelectedAttr
      , Text
"URL list: the selected URL"
      )
    , ( AttrName
messageSelectAttr
      , Text
"Message selection: the currently-selected message"
      )
    , ( AttrName
messageSelectStatusAttr
      , Text
"Message selection: the message selection actions"
      )
    , ( AttrName
urlSelectStatusAttr
      , Text
"Link selection: the message selection actions"
      )
    , ( AttrName
misspellingAttr
      , Text
"A misspelled word in the chat message editor"
      )
    , ( AttrName
editedMarkingAttr
      , Text
"The 'edited' marking that appears on edited messages"
      )
    , ( AttrName
editedRecentlyMarkingAttr
      , Text
"The 'edited' marking that appears on newly-edited messages"
      )
    , ( AttrName
highlightedCodeBlockAttr
      , Text
"The base attribute for syntax-highlighted code blocks"
      )
    , ( TokenType -> AttrName
attrNameForTokenType TokenType
KeywordTok
      , Text
"Syntax highlighting: Keyword"
      )
    , ( TokenType -> AttrName
attrNameForTokenType TokenType
DataTypeTok
      , Text
"Syntax highlighting: DataType"
      )
    , ( TokenType -> AttrName
attrNameForTokenType TokenType
DecValTok
      , Text
"Syntax highlighting: Declaration"
      )
    , ( TokenType -> AttrName
attrNameForTokenType TokenType
BaseNTok
      , Text
"Syntax highlighting: BaseN"
      )
    , ( TokenType -> AttrName
attrNameForTokenType TokenType
FloatTok
      , Text
"Syntax highlighting: Float"
      )
    , ( TokenType -> AttrName
attrNameForTokenType TokenType
ConstantTok
      , Text
"Syntax highlighting: Constant"
      )
    , ( TokenType -> AttrName
attrNameForTokenType TokenType
CharTok
      , Text
"Syntax highlighting: Char"
      )
    , ( TokenType -> AttrName
attrNameForTokenType TokenType
SpecialCharTok
      , Text
"Syntax highlighting: Special Char"
      )
    , ( TokenType -> AttrName
attrNameForTokenType TokenType
StringTok
      , Text
"Syntax highlighting: String"
      )
    , ( TokenType -> AttrName
attrNameForTokenType TokenType
VerbatimStringTok
      , Text
"Syntax highlighting: Verbatim String"
      )
    , ( TokenType -> AttrName
attrNameForTokenType TokenType
SpecialStringTok
      , Text
"Syntax highlighting: Special String"
      )
    , ( TokenType -> AttrName
attrNameForTokenType TokenType
ImportTok
      , Text
"Syntax highlighting: Import"
      )
    , ( TokenType -> AttrName
attrNameForTokenType TokenType
CommentTok
      , Text
"Syntax highlighting: Comment"
      )
    , ( TokenType -> AttrName
attrNameForTokenType TokenType
DocumentationTok
      , Text
"Syntax highlighting: Documentation"
      )
    , ( TokenType -> AttrName
attrNameForTokenType TokenType
AnnotationTok
      , Text
"Syntax highlighting: Annotation"
      )
    , ( TokenType -> AttrName
attrNameForTokenType TokenType
CommentVarTok
      , Text
"Syntax highlighting: Comment"
      )
    , ( TokenType -> AttrName
attrNameForTokenType TokenType
OtherTok
      , Text
"Syntax highlighting: Other"
      )
    , ( TokenType -> AttrName
attrNameForTokenType TokenType
FunctionTok
      , Text
"Syntax highlighting: Function"
      )
    , ( TokenType -> AttrName
attrNameForTokenType TokenType
VariableTok
      , Text
"Syntax highlighting: Variable"
      )
    , ( TokenType -> AttrName
attrNameForTokenType TokenType
ControlFlowTok
      , Text
"Syntax highlighting: Control Flow"
      )
    , ( TokenType -> AttrName
attrNameForTokenType TokenType
OperatorTok
      , Text
"Syntax highlighting: Operator"
      )
    , ( TokenType -> AttrName
attrNameForTokenType TokenType
BuiltInTok
      , Text
"Syntax highlighting: Built-In"
      )
    , ( TokenType -> AttrName
attrNameForTokenType TokenType
ExtensionTok
      , Text
"Syntax highlighting: Extension"
      )
    , ( TokenType -> AttrName
attrNameForTokenType TokenType
PreprocessorTok
      , Text
"Syntax highlighting: Preprocessor"
      )
    , ( TokenType -> AttrName
attrNameForTokenType TokenType
AttributeTok
      , Text
"Syntax highlighting: Attribute"
      )
    , ( TokenType -> AttrName
attrNameForTokenType TokenType
RegionMarkerTok
      , Text
"Syntax highlighting: Region Marker"
      )
    , ( TokenType -> AttrName
attrNameForTokenType TokenType
InformationTok
      , Text
"Syntax highlighting: Information"
      )
    , ( TokenType -> AttrName
attrNameForTokenType TokenType
WarningTok
      , Text
"Syntax highlighting: Warning"
      )
    , ( TokenType -> AttrName
attrNameForTokenType TokenType
AlertTok
      , Text
"Syntax highlighting: Alert"
      )
    , ( TokenType -> AttrName
attrNameForTokenType TokenType
ErrorTok
      , Text
"Syntax highlighting: Error"
      )
    , ( TokenType -> AttrName
attrNameForTokenType TokenType
NormalTok
      , Text
"Syntax highlighting: Normal text"
      )
    , ( AttrName
listSelectedFocusedAttr
      , Text
"The selected channel"
      )
    , ( AttrName
focusedFormInputAttr
      , Text
"A form input that has focus"
      )
    , ( AttrName
FB.fileBrowserAttr
      , Text
"The base file browser attribute"
      )
    , ( AttrName
FB.fileBrowserCurrentDirectoryAttr
      , Text
"The file browser current directory attribute"
      )
    , ( AttrName
FB.fileBrowserSelectionInfoAttr
      , Text
"The file browser selection information attribute"
      )
    , ( AttrName
FB.fileBrowserDirectoryAttr
      , Text
"Attribute for directories in the file browser"
      )
    , ( AttrName
FB.fileBrowserBlockDeviceAttr
      , Text
"Attribute for block devices in the file browser"
      )
    , ( AttrName
FB.fileBrowserRegularFileAttr
      , Text
"Attribute for regular files in the file browser"
      )
    , ( AttrName
FB.fileBrowserCharacterDeviceAttr
      , Text
"Attribute for character devices in the file browser"
      )
    , ( AttrName
FB.fileBrowserNamedPipeAttr
      , Text
"Attribute for named pipes in the file browser"
      )
    , ( AttrName
FB.fileBrowserSymbolicLinkAttr
      , Text
"Attribute for symbolic links in the file browser"
      )
    , ( AttrName
FB.fileBrowserUnixSocketAttr
      , Text
"Attribute for Unix sockets in the file browser"
      )
    , ( AttrName
buttonAttr
      , Text
"Attribute for input form buttons"
      )
    , ( AttrName
buttonFocusedAttr
      , Text
"Attribute for focused input form buttons"
      )
    , ( AttrName
currentUserAttr
      , Text
"Attribute for the username of the user running Matterhorn"
      )
    , ( AttrName
currentTeamAttr
      , Text
"The currently-selected team"
      )
    , ( AttrName
verbatimTruncateMessageAttr
      , Text
"Attribute for a message indicating that a verbatim or code block has been only partially displayed"
      )
    , ( AttrName
scrollbarAttr
      , Text
"Base aAttribute for scroll bars"
      )
    , ( AttrName
scrollbarTroughAttr
      , Text
"Attribute for scroll bar troughs"
      )
    , ( AttrName
scrollbarHandleAttr
      , Text
"Attribute for scroll bar handles"
      )
    , ( AttrName
threadAttr
      , Text
"Base attribute for the thread window"
      )
    , ( AttrName
focusedEditorPromptAttr
      , Text
"The attribute for the prompt of the focused message editor"
      )
    ] [(AttrName, Text)] -> [(AttrName, Text)] -> [(AttrName, Text)]
forall a. Semigroup a => a -> a -> a
<> [ (Int -> AttrName
usernameAttr Int
i, [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"Username color " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i)
         | Int
i <- [Int
0..Int
usernameColorHashBucketsInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
         ]