content: {-# 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(..)
    , NetworkPalette(..)
  
    -- * Lenses
    , palNicks
    , palSelf
    , palSelfHighlight
    , palTime
    , palMeta
    , palSigil
    , palUnidentSigil
    , palOperSigil
    , palLabel
    , palLatency
    , palWindowName
    , palError
    , palTextBox
    , palActivity
    , palMention
    , palCommand
    , palCommandReady
    , palCommandPlaceholder
    , palCommandPrefix
    , palCommandError
    , palWindowDivider
    , palLineMarker
    , palAway
    , palMonospace
    , palJoin
    , palPart
    , palModes
    , palUsrChg
    , palIgnore
    , palTagmsg
  
    -- * Lenses (Network)
    , palCModes
    , palUModes
    , palSnomask
    , palIdOverride
  
    , paletteMap
    , unifyNetworkPalette
  
    -- * Defaults
    , defaultPalette
    , defaultNetworkPalette
    ) where
  
  import Control.Lens (makeLenses, ReifiedLens(Lens), ReifiedLens')
  import Data.HashMap.Strict (HashMap)
  import Data.HashMap.Strict qualified as HashMap
  import Data.Text (Text)
  import Data.Vector (Vector)
  import Graphics.Vty.Attributes
  import Irc.Identifier
  
  -- | Color palette used for rendering the client UI
  data Palette = Palette
    { _palNicks         :: Vector Attr -- ^ highlighting identifiers
    , _palIdOverride    :: HashMap Identifier Attr -- ^ overrides for specific identifiers
    , _palSelf          :: Attr -- ^ own nickname(s)
    , _palSelfHighlight :: Attr -- ^ own nickname(s) in mentions
    , _palTime          :: Attr -- ^ message timestamps
    , _palMeta          :: Attr -- ^ coalesced metadata
    , _palSigil         :: Attr -- ^ channel mode sigils (e.g. @+)
    , _palUnidentSigil  :: Attr -- ^ unidentified sigil (~)
    , _palOperSigil     :: Attr -- ^ operator sigil (◆)
    , _palLabel         :: Attr -- ^ information labels
    , _palLatency       :: Attr -- ^ ping latency
    , _palWindowName    :: Attr -- ^ window name
    , _palError         :: Attr -- ^ error messages
    , _palTextBox       :: Attr -- ^ textbox markers
    , _palActivity      :: Attr -- ^ window name with activity
    , _palMention       :: Attr -- ^ window name with mention
    , _palCommand       :: Attr -- ^ known command
    , _palCommandReady  :: Attr -- ^ known command with complete arguments
    , _palCommandPrefix :: Attr -- ^ prefix of known command
    , _palCommandError  :: Attr -- ^ unknown command
    , _palCommandPlaceholder :: Attr -- ^ command argument placeholder
    , _palWindowDivider :: Attr -- ^ Divider between split windows
    , _palLineMarker    :: Attr -- ^ Divider between new and old messages
    , _palAway          :: Attr -- ^ color of nickname when away
    , _palMonospace     :: Attr -- ^ rendering of monospace formatting text
    , _palModes         :: Attr -- ^ mode lines
    , _palJoin          :: Attr
    , _palPart          :: Attr
    , _palUsrChg        :: Attr
    , _palIgnore        :: Attr
    , _palTagmsg        :: Attr -- ^ color of TAGMSG sigil
    }
    deriving Show
  
  data NetworkPalette = NetworkPalette
    { _palCModes        :: HashMap Char Attr -- ^ channel mode attributes
    , _palUModes        :: HashMap Char Attr -- ^ user mode attributes
    , _palSnomask       :: HashMap Char Attr -- ^ snotice mask attributes
    }
    deriving Show
  
  makeLenses ''Palette
  makeLenses ''NetworkPalette
  
  -- | Default UI colors
  defaultPalette :: Palette
  defaultPalette = Palette
    { _palNicks              = defaultNickColorPalette
    , _palIdOverride         = HashMap.empty
    , _palSelf               = withForeColor defAttr brightWhite
    , _palSelfHighlight      = defAttr `withBackColor` brightYellow `withForeColor` black
    , _palTime               = withForeColor defAttr brightBlack
    , _palMeta               = metaNo
    , _palSigil              = defAttr `withStyle` bold `withForeColor` brightYellow
    , _palUnidentSigil       = withForeColor defAttr brightBlack
    , _palOperSigil          = withForeColor defAttr brightBlack
    , _palLabel              = withForeColor defAttr cyan
    , _palLatency            = withForeColor defAttr green
    , _palWindowName         = withForeColor defAttr brightCyan
    , _palError              = defAttr `withStyle` bold `withForeColor` red
    , _palTextBox            = withForeColor defAttr brightBlack
    , _palActivity           = metaLo
    , _palMention            = metaHi
    , _palCommand            = withForeColor defAttr yellow
    , _palCommandReady       = withForeColor defAttr brightGreen
    , _palCommandPrefix      = withForeColor defAttr yellow
    , _palCommandError       = withForeColor defAttr red
    , _palCommandPlaceholder = withForeColor defAttr brightBlack
    , _palWindowDivider      = withStyle defAttr reverseVideo
    , _palLineMarker         = withForeColor defAttr cyan
    , _palAway               = withForeColor defAttr blue
    , _palMonospace          = defAttr
    , _palJoin               = withForeColor defAttr brightGreen
    , _palPart               = withForeColor defAttr brightRed
    , _palModes              = metaLo
    , _palUsrChg             = metaLo
    , _palIgnore             = withForeColor defAttr white
    , _palTagmsg             = metaLo
    }
    where
      metaNo = withForeColor defAttr brightBlack
      metaLo = withForeColor defAttr brightBlue
      metaHi = defAttr `withStyle` bold `withBackColor` brightMagenta `withForeColor` black
  
  defaultNetworkPalette :: NetworkPalette
  defaultNetworkPalette = NetworkPalette
    { _palCModes = HashMap.empty
    , _palUModes = HashMap.empty
    , _palSnomask= HashMap.empty
    }
  -- | Default nick highlighting colors that look nice in my dark solarized
  -- color scheme.
  defaultNickColorPalette :: Vector Attr
  defaultNickColorPalette =
    withForeColor defAttr <$>
      [ Color240  18, Color240  19, Color240  20, Color240  21, Color240  22, Color240  23
      , Color240  24, Color240  25, Color240  26, Color240  27, Color240  28, Color240  29
      , Color240 192, Color240 193, Color240 194, Color240 195, Color240 196, Color240 197
      , Color240 198, Color240 199, Color240 200, Color240 201, Color240 202, Color240 203
      ]
  
  -- | Combine one NetworkPalette with another.
  unifyNetworkPalette :: NetworkPalette -> NetworkPalette -> NetworkPalette
  unifyNetworkPalette defaults net = NetworkPalette
    { _palCModes     = HashMap.union (_palCModes net)     (_palCModes defaults)
    , _palUModes     = HashMap.union (_palUModes net)     (_palUModes defaults)
    , _palSnomask    = HashMap.union (_palSnomask net)    (_palSnomask defaults)
    } -- TODO: Replace the above with a nicer lens pattern later.
  
  -- | List of palette entry names and lenses for accessing that component
  -- of the palette.
  paletteMap :: [(Text, ReifiedLens' Palette Attr)]
  paletteMap =
    [ ("self"             , Lens palSelf)
    , ("self-highlight"   , Lens palSelfHighlight)
    , ("time"             , Lens palTime)
    , ("meta"             , Lens palMeta)
    , ("modes"            , Lens palModes)
    , ("sigil"            , Lens palSigil)
    , ("unidentsigil"     , Lens palUnidentSigil)
    , ("opersigil"        , Lens palOperSigil)
    , ("label"            , Lens palLabel)
    , ("latency"          , Lens palLatency)
    , ("window-name"      , Lens palWindowName)
    , ("error"            , Lens palError)
    , ("textbox"          , Lens palTextBox)
    , ("activity"         , Lens palActivity)
    , ("mention"          , Lens palMention)
    , ("command"          , Lens palCommand)
    , ("command-ready"    , Lens palCommandReady)
    , ("command-placeholder", Lens palCommandPlaceholder)
    , ("command-prefix"   , Lens palCommandPrefix)
    , ("command-error"    , Lens palCommandError)
    , ("window-divider"   , Lens palWindowDivider)
    , ("line-marker"      , Lens palLineMarker)
    , ("away"             , Lens palAway)
    , ("monospace"        , Lens palMonospace)
    , ("join"             , Lens palJoin)
    , ("part"             , Lens palPart)
    , ("user-change"      , Lens palUsrChg)
    , ("ignore"           , Lens palIgnore)
    , ("tagmsg"           , Lens palTagmsg)
    ]
  