-- | The all-important theming engine!
--
-- Cf
-- https://hackage.haskell.org/package/vty/docs/Graphics-Vty-Attributes.html
-- http://hackage.haskell.org/package/brick/docs/Brick-AttrMap.html
-- http://hackage.haskell.org/package/brick-0.1/docs/Brick-Util.html
-- http://hackage.haskell.org/package/brick-0.1/docs/Brick-Widgets-Core.html#g:5
-- http://hackage.haskell.org/package/brick-0.1/docs/Brick-Widgets-Border.html

{-# LANGUAGE OverloadedStrings #-}

module Hledger.UI.Theme (
   defaultTheme
  ,getTheme
  ,themes
  ,themeNames
)
where

import qualified Data.Map as M
import Data.Maybe
import Graphics.Vty
import Brick
import Safe (headErr)

defaultTheme :: AttrMap
defaultTheme :: AttrMap
defaultTheme = AttrMap -> Maybe AttrMap -> AttrMap
forall a. a -> Maybe a -> a
fromMaybe ((String, AttrMap) -> AttrMap
forall a b. (a, b) -> b
snd ((String, AttrMap) -> AttrMap) -> (String, AttrMap) -> AttrMap
forall a b. (a -> b) -> a -> b
$ [(String, AttrMap)] -> (String, AttrMap)
forall a. Partial => [a] -> a
headErr [(String, AttrMap)]
themesList) (Maybe AttrMap -> AttrMap) -> Maybe AttrMap -> AttrMap
forall a b. (a -> b) -> a -> b
$ String -> Maybe AttrMap
getTheme String
"white"  -- PARTIAL headErr succeeds because themesList is non-null
  -- the theme named here should exist;
  -- otherwise it will take the first one from the list,
  -- which must be non-empty.

-- | Look up the named theme, if it exists.
getTheme :: String -> Maybe AttrMap
getTheme :: String -> Maybe AttrMap
getTheme String
name = String -> Map String AttrMap -> Maybe AttrMap
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
name Map String AttrMap
themes

-- | A selection of named themes specifying terminal colours and styles.
-- One of these is active at a time.
--
-- A hledger-ui theme is a vty/brick AttrMap.  Each theme specifies a
-- default style (Attr), plus extra styles which are applied when
-- their (hierarchical) name matches the widget rendering context.
-- "More specific styles, if present, are used and only fall back to
-- more general ones when the more specific ones are absent, but also
-- these styles get merged, so that if a more specific style only
-- provides the foreground color, its more general parent style can
-- set the background color, too."
-- For example: rendering a widget named "b" inside a widget named "a",
-- - if a style named "a" <> "b" exists, it will be used. Anything it
--   does not specify will be taken from a style named "a" if that
--   exists, otherwise from the default style.
-- - otherwise if a style named "a" exists, it will be used, and
--   anything it does not specify will be taken from the default style.
-- - otherwise (you guessed it) the default style is used.
--
themes :: M.Map String AttrMap
themes :: Map String AttrMap
themes = [(String, AttrMap)] -> Map String AttrMap
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(String, AttrMap)]
themesList

themeNames :: [String]
themeNames :: [String]
themeNames = ((String, AttrMap) -> String) -> [(String, AttrMap)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, AttrMap) -> String
forall a b. (a, b) -> a
fst [(String, AttrMap)]
themesList

& :: Attr -> Style -> Attr
(&) = Attr -> Style -> Attr
withStyle
active :: Attr
active = Color -> Attr
fg Color
brightWhite Attr -> Style -> Attr
& Style
bold
selectbg :: Color
selectbg = Color
yellow
select :: Attr
select = Color
black Color -> Color -> Attr
`on` Color
selectbg

themesList :: [(String, AttrMap)]
themesList :: [(String, AttrMap)]
themesList = [
   (String
"default", Attr -> [(AttrName, Attr)] -> AttrMap
attrMap (Color
black Color -> Color -> Attr
`on` Color
white) [
     (String -> AttrName
attrName String
"border"                                        , Color
white Color -> Color -> Attr
`on` Color
black Attr -> Style -> Attr
& Style
dim)
    ,(String -> AttrName
attrName String
"border" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"bold"                              , Attr
currentAttr Attr -> Style -> Attr
& Style
bold)
    ,(String -> AttrName
attrName String
"border" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"depth"                             , Attr
active)
    ,(String -> AttrName
attrName String
"border" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"filename"                          , Attr
currentAttr)
    ,(String -> AttrName
attrName String
"border" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"key"                               , Attr
active)
    ,(String -> AttrName
attrName String
"border" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"minibuffer"                        , Color
white Color -> Color -> Attr
`on` Color
black Attr -> Style -> Attr
& Style
bold)
    ,(String -> AttrName
attrName String
"border" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"query"                             , Attr
active)
    ,(String -> AttrName
attrName String
"border" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"selected"                          , Attr
active)
    ,(String -> AttrName
attrName String
"error"                                         , Color -> Attr
fg Color
red)
    ,(String -> AttrName
attrName String
"help"                                          , Color
white Color -> Color -> Attr
`on` Color
black Attr -> Style -> Attr
& Style
dim)
    ,(String -> AttrName
attrName String
"help" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"heading"                             , Color -> Attr
fg Color
yellow)
    ,(String -> AttrName
attrName String
"help" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"key"                                 , Attr
active)
    -- ,(attrName "list"                                          , black `on` white)
    -- ,(attrName "list" <> attrName "amount"                              , currentAttr)
    ,(String -> AttrName
attrName String
"list" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"amount" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"decrease"                , Color -> Attr
fg Color
red)
    -- ,(attrName "list" <> attrName "amount" <> attrName "increase"                , fg green)
    ,(String -> AttrName
attrName String
"list" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"amount" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"decrease" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"selected"  , Color
red Color -> Color -> Attr
`on` Color
selectbg Attr -> Style -> Attr
& Style
bold)
    -- ,(attrName "list" <> attrName "amount" <> attrName "increase" <> attrName "selected"  , green `on` selectbg & bold)
    ,(String -> AttrName
attrName String
"list" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"balance"                             , Attr
currentAttr Attr -> Style -> Attr
& Style
bold)
    ,(String -> AttrName
attrName String
"list" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"balance" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"negative"               , Color -> Attr
fg Color
red)
    ,(String -> AttrName
attrName String
"list" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"balance" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"positive"               , Color -> Attr
fg Color
black)
    ,(String -> AttrName
attrName String
"list" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"balance" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"negative" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"selected" , Color
red Color -> Color -> Attr
`on` Color
selectbg Attr -> Style -> Attr
& Style
bold)
    ,(String -> AttrName
attrName String
"list" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"balance" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"positive" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"selected" , Attr
select Attr -> Style -> Attr
& Style
bold)
    ,(String -> AttrName
attrName String
"list" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"selected"                            , Attr
select)
    -- ,(attrName "list" <> attrName "accounts"                         , white `on` brightGreen)
    -- ,(attrName "list" <> attrName "selected"                         , black `on` brightYellow)
  ])

  ,(String
"greenterm", Attr -> [(AttrName, Attr)] -> AttrMap
attrMap (Color
green Color -> Color -> Attr
`on` Color
black) [
    (String -> AttrName
attrName String
"list" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"selected"                             , Color
black Color -> Color -> Attr
`on` Color
green)
  ])

  ,(String
"terminal", Attr -> [(AttrName, Attr)] -> AttrMap
attrMap Attr
defAttr [
    (String -> AttrName
attrName String
"border"                                         , Color
white Color -> Color -> Attr
`on` Color
black),
    (String -> AttrName
attrName String
"list"                                           , Attr
defAttr),
    (String -> AttrName
attrName String
"list" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"selected"                             , Attr
defAttr Attr -> Style -> Attr
& Style
reverseVideo)
  ])

  ,(String
"dark", Attr -> [(AttrName, Attr)] -> AttrMap
attrMap (Color
white Color -> Color -> Attr
`on` Color
black Attr -> Style -> Attr
& Style
dim) [
      (String -> AttrName
attrName String
"border"                                                                   , Color
white Color -> Color -> Attr
`on` Color
black)
    , (String -> AttrName
attrName String
"border" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"bold"                                                , Attr
currentAttr Attr -> Style -> Attr
& Style
bold)
    , (String -> AttrName
attrName String
"border" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"depth"                                               , Attr
active)
    , (String -> AttrName
attrName String
"border" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"filename"                                            , Attr
currentAttr)
    , (String -> AttrName
attrName String
"border" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"key"                                                 , Attr
active)
    , (String -> AttrName
attrName String
"border" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"minibuffer"                                          , Color
white Color -> Color -> Attr
`on` Color
black Attr -> Style -> Attr
& Style
bold)
    , (String -> AttrName
attrName String
"border" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"query"                                               , Attr
active)
    , (String -> AttrName
attrName String
"border" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"selected"                                            , Attr
active)
    , (String -> AttrName
attrName String
"error"                                                                    , Color -> Attr
fg Color
red)
    , (String -> AttrName
attrName String
"help"                                                                     , Attr
currentAttr Attr -> Style -> Attr
& Style
bold)
    , (String -> AttrName
attrName String
"help" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"heading"                                               , Color -> Attr
fg Color
blue)
    , (String -> AttrName
attrName String
"help" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"key"                                                   , Attr
active)
    , (String -> AttrName
attrName String
"list" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"amount" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"decrease"                         , Color -> Attr
fg Color
red)
    , (String -> AttrName
attrName String
"list" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"amount" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"decrease" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"selected"  , Color
red Color -> Color -> Attr
`on` Color
black Attr -> Style -> Attr
& Style
bold)
    , (String -> AttrName
attrName String
"list" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"balance"                                               , Attr
currentAttr)
    , (String -> AttrName
attrName String
"list" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"balance" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"negative"                        , Color -> Attr
fg Color
red)
    , (String -> AttrName
attrName String
"list" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"balance" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"positive"                        , Color -> Attr
fg Color
white)
    , (String -> AttrName
attrName String
"list" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"balance" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"negative" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"selected" , Color
red Color -> Color -> Attr
`on` Color
black    Attr -> Style -> Attr
& Style
bold)
    , (String -> AttrName
attrName String
"list" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"balance" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"positive" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"selected" , Color
yellow Color -> Color -> Attr
`on` Color
black Attr -> Style -> Attr
& Style
bold)
    , (String -> AttrName
attrName String
"list" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"selected"                                              , Color
yellow Color -> Color -> Attr
`on` Color
black Attr -> Style -> Attr
& Style
bold)
  ])

  ]

-- halfbrightattr = defAttr & dim
-- reverseattr = defAttr & reverseVideo
-- redattr = defAttr `withForeColor` red
-- greenattr = defAttr `withForeColor` green
-- reverseredattr = defAttr & reverseVideo `withForeColor` red
-- reversegreenattr= defAttr & reverseVideo `withForeColor` green