content: {-# Language OverloadedStrings, ApplicativeDo, LambdaCase, BlockArguments #-}
  
  {-|
  Module      : Client.Configuration
  Description : Client configuration format and operations
  Copyright   : (c) Eric Mertens, 2016
  License     : ISC
  Maintainer  : emertens@gmail.com
  
  This module defines the top-level configuration information for the client.
  -}
  
  module Client.Configuration.Colors
    ( colorSpec
    , attrSpec
    ) where
  
  import Config.Schema
  import Data.HashMap.Strict (HashMap)
  import Data.HashMap.Strict qualified as HashMap
  import Data.Text (Text)
  import Graphics.Vty.Attributes
  
  -- | Parse a text attribute. This value should be a sections with the @fg@ and/or
  -- @bg@ attributes. Otherwise it should be a color entry that will be used
  -- for the foreground color. An empty sections value will result in 'defAttr'
  attrSpec :: ValueSpec Attr
  attrSpec = namedSpec "attr" $
             withForeColor defAttr <$> colorSpec
         <!> fullAttrSpec
  
  fullAttrSpec :: ValueSpec Attr
  fullAttrSpec = sectionsSpec "full-attr" $
    do mbFg <- optSection' "fg"    colorSpec "Foreground color"
       mbBg <- optSection' "bg"    colorSpec "Background color"
       mbSt <- optSection' "style" stylesSpec "Terminal font style"
       return ( aux withForeColor mbFg
              $ aux withBackColor mbBg
              $ aux (foldl withStyle) mbSt
              $ defAttr)
    where
      aux f xs z = foldl f z xs
  
  
  stylesSpec :: ValueSpec [Style]
  stylesSpec = oneOrList styleSpec
  
  styleSpec :: ValueSpec Style
  styleSpec = namedSpec "style" $
        blink        <$ atomSpec "blink"
    <!> bold         <$ atomSpec "bold"
    <!> dim          <$ atomSpec "dim"
    <!> italic       <$ atomSpec "italic"
    <!> reverseVideo <$ atomSpec "reverse-video"
    <!> standout     <$ atomSpec "standout"
    <!> strikethrough<$ atomSpec "strikethrough"
    <!> underline    <$ atomSpec "underline"
  
  
  -- | Parse a color. Support formats are:
  --
  -- * Number between 0-255
  -- * Name of color
  -- * RGB values of color as a list
  colorSpec :: ValueSpec Color
  colorSpec = namedSpec "color" (colorNumberSpec <!> colorNameSpec <!> rgbSpec)
  
  colorNameSpec :: ValueSpec Color
  colorNameSpec = customSpec "color name" anyAtomSpec
                $ \name -> case HashMap.lookup name namedColors of
                             Nothing -> Left "unknown color"
                             Just c  -> Right c
  
  -- | Match integers between 0 and 255 as Terminal colors.
  colorNumberSpec :: ValueSpec Color
  colorNumberSpec = customSpec "terminal color" anySpec $ \i ->
    if      i <   0 then Left "minimum color is 0"
    else if i <  16 then Right (ISOColor (fromInteger i))
    else if i < 256 then Right (Color240 (fromInteger (i - 16)))
    else Left "maximum color is 255"
  
  -- | Configuration section that matches 3 integers in the range 0-255
  -- representing red, green, and blue values.
  rgbSpec :: ValueSpec Color
  rgbSpec = customSpec "RGB" anySpec \case
    [r,g,b] -> rgbColor <$> valid r <*> valid g <*> valid b
    _       -> Left "expected 3 numbers"
    where
      valid x
        | x < 0     = Left "minimum color value is 0"
        | x < 256   = Right (x :: Integer)
        | otherwise = Left "maximum color value is 255"
  
  namedColors :: HashMap Text Color
  namedColors = HashMap.fromList
    [ ("black"         , black        )
    , ("red"           , red          )
    , ("green"         , green        )
    , ("yellow"        , yellow       )
    , ("blue"          , blue         )
    , ("magenta"       , magenta      )
    , ("cyan"          , cyan         )
    , ("white"         , white        )
    , ("bright-black"  , brightBlack  )
    , ("bright-red"    , brightRed    )
    , ("bright-green"  , brightGreen  )
    , ("bright-yellow" , brightYellow )
    , ("bright-blue"   , brightBlue   )
    , ("bright-magenta", brightMagenta)
    , ("bright-cyan"   , brightCyan   )
    , ("bright-white"  , brightWhite  )
    ]
  