{-# Language TemplateHaskell, OverloadedLists, OverloadedStrings #-}
{-|
Module      : Client.Image.Palette
Description : Palette of colors used to render the UI
Copyright   : (c) Eric Mertens, 2016
License     : ISC
Maintainer  : emertens@gmail.com

This module provides names for all of the colors used in the UI.
-}
module Client.Image.Palette
  (
  -- * Palette type
    Palette(..)

  -- * Lenses
  , palNicks
  , palSelf
  , palSelfHighlight
  , palTime
  , palMeta
  , palSigil
  , palLabel
  , palLatency
  , palWindowName
  , palError
  , palTextBox
  , palActivity
  , palMention
  , palCommand
  , palCommandReady
  , palCommandPlaceholder
  , palCommandPrefix
  , palCommandError
  , palCommandPrompt
  , palWindowDivider
  , palLineMarker
  , palCModes
  , palUModes
  , palSnomask
  , palAway
  , palMonospace

  , paletteMap

  -- * Defaults
  , defaultPalette
  ) where

import           Control.Lens
import           Data.Text (Text)
import           Data.Vector (Vector)
import           Graphics.Vty.Attributes
import           Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap

-- | Color palette used for rendering the client UI
data Palette = Palette
  { Palette -> Vector Attr
_palNicks         :: Vector Attr -- ^ highlighting nicknames
  , Palette -> Attr
_palSelf          :: Attr -- ^ own nickname(s)
  , Palette -> Attr
_palSelfHighlight :: Attr -- ^ own nickname(s) in mentions
  , Palette -> Attr
_palTime          :: Attr -- ^ message timestamps
  , Palette -> Attr
_palMeta          :: Attr -- ^ coalesced metadata
  , Palette -> Attr
_palSigil         :: Attr -- ^ sigils (e.g. @+)
  , Palette -> Attr
_palLabel         :: Attr -- ^ information labels
  , Palette -> Attr
_palLatency       :: Attr -- ^ ping latency
  , Palette -> Attr
_palWindowName    :: Attr -- ^ window name
  , Palette -> Attr
_palError         :: Attr -- ^ error messages
  , Palette -> Attr
_palTextBox       :: Attr -- ^ textbox markers
  , Palette -> Attr
_palActivity      :: Attr -- ^ window name with activity
  , Palette -> Attr
_palMention       :: Attr -- ^ window name with mention
  , Palette -> Attr
_palCommand       :: Attr -- ^ known command
  , Palette -> Attr
_palCommandReady  :: Attr -- ^ known command with complete arguments
  , Palette -> Attr
_palCommandPrefix :: Attr -- ^ prefix of known command
  , Palette -> Attr
_palCommandError  :: Attr -- ^ unknown command
  , Palette -> Attr
_palCommandPlaceholder :: Attr -- ^ command argument placeholder
  , Palette -> Attr
_palCommandPrompt :: Attr -- ^ Command input prefix @CMD:@
  , Palette -> Attr
_palWindowDivider :: Attr -- ^ Divider between split windows
  , Palette -> Attr
_palLineMarker    :: Attr -- ^ Divider between new and old messages
  , Palette -> Attr
_palAway          :: Attr -- ^ color of nickname when away
  , Palette -> Attr
_palMonospace     :: Attr -- ^ rendering of monospace formatting text
  , Palette -> HashMap Char Attr
_palCModes        :: HashMap Char Attr -- ^ channel mode attributes
  , Palette -> HashMap Char Attr
_palUModes        :: HashMap Char Attr -- ^ user mode attributes
  , Palette -> HashMap Char Attr
_palSnomask       :: HashMap Char Attr -- ^ snotice mask attributes
  }
  deriving Int -> Palette -> ShowS
[Palette] -> ShowS
Palette -> String
(Int -> Palette -> ShowS)
-> (Palette -> String) -> ([Palette] -> ShowS) -> Show Palette
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Palette] -> ShowS
$cshowList :: [Palette] -> ShowS
show :: Palette -> String
$cshow :: Palette -> String
showsPrec :: Int -> Palette -> ShowS
$cshowsPrec :: Int -> Palette -> ShowS
Show

makeLenses ''Palette

-- | Default UI colors that look nice in my dark solarized color scheme
defaultPalette :: Palette
defaultPalette :: Palette
defaultPalette = Palette :: Vector Attr
-> Attr
-> Attr
-> Attr
-> Attr
-> Attr
-> Attr
-> Attr
-> Attr
-> Attr
-> Attr
-> Attr
-> Attr
-> Attr
-> Attr
-> Attr
-> Attr
-> Attr
-> Attr
-> Attr
-> Attr
-> Attr
-> Attr
-> HashMap Char Attr
-> HashMap Char Attr
-> HashMap Char Attr
-> Palette
Palette
  { _palNicks :: Vector Attr
_palNicks                   = Vector Attr
defaultNickColorPalette
  , _palSelf :: Attr
_palSelf                    = Attr -> Color -> Attr
withForeColor Attr
defAttr Color
red
  , _palSelfHighlight :: Attr
_palSelfHighlight           = Attr -> Color -> Attr
withForeColor Attr
defAttr Color
red
  , _palTime :: Attr
_palTime                    = Attr -> Color -> Attr
withForeColor Attr
defAttr Color
brightBlack
  , _palMeta :: Attr
_palMeta                    = Attr -> Color -> Attr
withForeColor Attr
defAttr Color
brightBlack
  , _palSigil :: Attr
_palSigil                   = Attr -> Color -> Attr
withForeColor Attr
defAttr Color
cyan
  , _palLabel :: Attr
_palLabel                   = Attr -> Color -> Attr
withForeColor Attr
defAttr Color
green
  , _palLatency :: Attr
_palLatency                 = Attr -> Color -> Attr
withForeColor Attr
defAttr Color
yellow
  , _palWindowName :: Attr
_palWindowName              = Attr -> Color -> Attr
withForeColor Attr
defAttr Color
cyan
  , _palError :: Attr
_palError                   = Attr -> Color -> Attr
withForeColor Attr
defAttr Color
red
  , _palTextBox :: Attr
_palTextBox                 = Attr -> Color -> Attr
withForeColor Attr
defAttr Color
brightBlack
  , _palActivity :: Attr
_palActivity                = Attr -> Color -> Attr
withForeColor Attr
defAttr Color
green
  , _palMention :: Attr
_palMention                 = Attr -> Color -> Attr
withForeColor Attr
defAttr Color
red
  , _palCommand :: Attr
_palCommand                 = Attr -> Color -> Attr
withForeColor Attr
defAttr Color
yellow
  , _palCommandReady :: Attr
_palCommandReady            = Attr -> Color -> Attr
withForeColor Attr
defAttr Color
green
  , _palCommandPrefix :: Attr
_palCommandPrefix           = Attr -> Color -> Attr
withForeColor Attr
defAttr Color
blue
  , _palCommandError :: Attr
_palCommandError            = Attr -> Color -> Attr
withForeColor Attr
defAttr Color
red
  , _palCommandPlaceholder :: Attr
_palCommandPlaceholder      = Attr -> Style -> Attr
withStyle Attr
defAttr Style
reverseVideo
  , _palCommandPrompt :: Attr
_palCommandPrompt           = Attr
defAttr Attr -> Style -> Attr
`withStyle` Style
bold Attr -> Color -> Attr
`withBackColor` Color
green Attr -> Color -> Attr
`withForeColor` Color
white
  , _palWindowDivider :: Attr
_palWindowDivider           = Attr -> Style -> Attr
withStyle Attr
defAttr Style
reverseVideo
  , _palLineMarker :: Attr
_palLineMarker              = Attr
defAttr
  , _palAway :: Attr
_palAway                    = Attr -> Color -> Attr
withForeColor Attr
defAttr Color
brightBlack
  , _palMonospace :: Attr
_palMonospace               = Attr
defAttr
  , _palCModes :: HashMap Char Attr
_palCModes                  = HashMap Char Attr
forall k v. HashMap k v
HashMap.empty
  , _palUModes :: HashMap Char Attr
_palUModes                  = HashMap Char Attr
forall k v. HashMap k v
HashMap.empty
  , _palSnomask :: HashMap Char Attr
_palSnomask                 = HashMap Char Attr
forall k v. HashMap k v
HashMap.empty
  }

-- | Default nick highlighting colors that look nice in my dark solarized
-- color scheme.
defaultNickColorPalette :: Vector Attr
defaultNickColorPalette :: Vector Attr
defaultNickColorPalette =
  Attr -> Color -> Attr
withForeColor Attr
defAttr (Color -> Attr) -> Vector Color -> Vector Attr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    [Item (Vector Color)
Color
cyan, Item (Vector Color)
Color
magenta, Item (Vector Color)
Color
green, Item (Vector Color)
Color
yellow, Item (Vector Color)
Color
blue,
     Item (Vector Color)
Color
brightCyan, Item (Vector Color)
Color
brightMagenta, Item (Vector Color)
Color
brightGreen, Item (Vector Color)
Color
brightBlue]

-- | List of palette entry names and lenses for accessing that component
-- of the palette.
paletteMap :: [(Text, ReifiedLens' Palette Attr)]
paletteMap :: [(Text, ReifiedLens' Palette Attr)]
paletteMap =
  [ (Text
"self"             , Lens Palette Palette Attr Attr -> ReifiedLens' Palette Attr
forall s t a b. Lens s t a b -> ReifiedLens s t a b
Lens Lens Palette Palette Attr Attr
palSelf)
  , (Text
"self-highlight"   , Lens Palette Palette Attr Attr -> ReifiedLens' Palette Attr
forall s t a b. Lens s t a b -> ReifiedLens s t a b
Lens Lens Palette Palette Attr Attr
palSelfHighlight)
  , (Text
"time"             , Lens Palette Palette Attr Attr -> ReifiedLens' Palette Attr
forall s t a b. Lens s t a b -> ReifiedLens s t a b
Lens Lens Palette Palette Attr Attr
palTime)
  , (Text
"meta"             , Lens Palette Palette Attr Attr -> ReifiedLens' Palette Attr
forall s t a b. Lens s t a b -> ReifiedLens s t a b
Lens Lens Palette Palette Attr Attr
palMeta)
  , (Text
"sigil"            , Lens Palette Palette Attr Attr -> ReifiedLens' Palette Attr
forall s t a b. Lens s t a b -> ReifiedLens s t a b
Lens Lens Palette Palette Attr Attr
palSigil)
  , (Text
"label"            , Lens Palette Palette Attr Attr -> ReifiedLens' Palette Attr
forall s t a b. Lens s t a b -> ReifiedLens s t a b
Lens Lens Palette Palette Attr Attr
palLabel)
  , (Text
"latency"          , Lens Palette Palette Attr Attr -> ReifiedLens' Palette Attr
forall s t a b. Lens s t a b -> ReifiedLens s t a b
Lens Lens Palette Palette Attr Attr
palLatency)
  , (Text
"window-name"      , Lens Palette Palette Attr Attr -> ReifiedLens' Palette Attr
forall s t a b. Lens s t a b -> ReifiedLens s t a b
Lens Lens Palette Palette Attr Attr
palWindowName)
  , (Text
"error"            , Lens Palette Palette Attr Attr -> ReifiedLens' Palette Attr
forall s t a b. Lens s t a b -> ReifiedLens s t a b
Lens Lens Palette Palette Attr Attr
palError)
  , (Text
"textbox"          , Lens Palette Palette Attr Attr -> ReifiedLens' Palette Attr
forall s t a b. Lens s t a b -> ReifiedLens s t a b
Lens Lens Palette Palette Attr Attr
palTextBox)
  , (Text
"activity"         , Lens Palette Palette Attr Attr -> ReifiedLens' Palette Attr
forall s t a b. Lens s t a b -> ReifiedLens s t a b
Lens Lens Palette Palette Attr Attr
palActivity)
  , (Text
"mention"          , Lens Palette Palette Attr Attr -> ReifiedLens' Palette Attr
forall s t a b. Lens s t a b -> ReifiedLens s t a b
Lens Lens Palette Palette Attr Attr
palMention)
  , (Text
"command"          , Lens Palette Palette Attr Attr -> ReifiedLens' Palette Attr
forall s t a b. Lens s t a b -> ReifiedLens s t a b
Lens Lens Palette Palette Attr Attr
palCommand)
  , (Text
"command-ready"    , Lens Palette Palette Attr Attr -> ReifiedLens' Palette Attr
forall s t a b. Lens s t a b -> ReifiedLens s t a b
Lens Lens Palette Palette Attr Attr
palCommandReady)
  , (Text
"command-placeholder", Lens Palette Palette Attr Attr -> ReifiedLens' Palette Attr
forall s t a b. Lens s t a b -> ReifiedLens s t a b
Lens Lens Palette Palette Attr Attr
palCommandPlaceholder)
  , (Text
"command-prefix"   , Lens Palette Palette Attr Attr -> ReifiedLens' Palette Attr
forall s t a b. Lens s t a b -> ReifiedLens s t a b
Lens Lens Palette Palette Attr Attr
palCommandPrefix)
  , (Text
"command-error"    , Lens Palette Palette Attr Attr -> ReifiedLens' Palette Attr
forall s t a b. Lens s t a b -> ReifiedLens s t a b
Lens Lens Palette Palette Attr Attr
palCommandError)
  , (Text
"command-prompt"   , Lens Palette Palette Attr Attr -> ReifiedLens' Palette Attr
forall s t a b. Lens s t a b -> ReifiedLens s t a b
Lens Lens Palette Palette Attr Attr
palCommandPrompt)
  , (Text
"window-divider"   , Lens Palette Palette Attr Attr -> ReifiedLens' Palette Attr
forall s t a b. Lens s t a b -> ReifiedLens s t a b
Lens Lens Palette Palette Attr Attr
palWindowDivider)
  , (Text
"line-marker"      , Lens Palette Palette Attr Attr -> ReifiedLens' Palette Attr
forall s t a b. Lens s t a b -> ReifiedLens s t a b
Lens Lens Palette Palette Attr Attr
palLineMarker)
  , (Text
"away"             , Lens Palette Palette Attr Attr -> ReifiedLens' Palette Attr
forall s t a b. Lens s t a b -> ReifiedLens s t a b
Lens Lens Palette Palette Attr Attr
palAway)
  , (Text
"monospace"        , Lens Palette Palette Attr Attr -> ReifiedLens' Palette Attr
forall s t a b. Lens s t a b -> ReifiedLens s t a b
Lens Lens Palette Palette Attr Attr
palMonospace)
  ]