{-# LANGUAGE CPP               #-}
{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes        #-}
{-# OPTIONS_GHC -Wno-unused-record-wildcards #-}
{-# OPTIONS_GHC -Wno-unused-matches #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}

{-
This module defined the attributes. Despite of brick's capability to have a hierarchy of attributes, here
we go for the most-simple-approach: a plain hierarchy
-}

module GHCup.Brick.Attributes where

import           Brick    ( AttrMap)
import qualified Brick
import qualified Brick.Widgets.List as L
import qualified Graphics.Vty                  as Vty

defaultAttributes :: Bool -> AttrMap
defaultAttributes :: Bool -> AttrMap
defaultAttributes Bool
no_color = Attr -> [(AttrName, Attr)] -> AttrMap
Brick.attrMap
  Attr
Vty.defAttr
  [ (AttrName
L.listSelectedFocusedAttr , Attr
Vty.defAttr Attr -> Color -> Attr
`withBackColor` Color
Vty.blue)
  , (AttrName
L.listSelectedAttr        , Attr
Vty.defAttr)
  , (AttrName
notInstalledAttr          , Attr
Vty.defAttr Attr -> Color -> Attr
`withForeColor` Color
Vty.red)
  , (AttrName
setAttr                   , Attr
Vty.defAttr Attr -> Color -> Attr
`withForeColor` Color
Vty.green)
  , (AttrName
installedAttr             , Attr
Vty.defAttr Attr -> Color -> Attr
`withForeColor` Color
Vty.green)
  , (AttrName
recommendedAttr           , Attr
Vty.defAttr Attr -> Color -> Attr
`withForeColor` Color
Vty.green)
  , (AttrName
hlsPoweredAttr            , Attr
Vty.defAttr Attr -> Color -> Attr
`withForeColor` Color
Vty.green)
  , (AttrName
latestAttr                , Attr
Vty.defAttr Attr -> Color -> Attr
`withForeColor` Color
Vty.yellow)
  , (AttrName
latestPrereleaseAttr      , Attr
Vty.defAttr Attr -> Color -> Attr
`withForeColor` Color
Vty.red)
  , (AttrName
latestNightlyAttr         , Attr
Vty.defAttr Attr -> Color -> Attr
`withForeColor` Color
Vty.red)
  , (AttrName
prereleaseAttr            , Attr
Vty.defAttr Attr -> Color -> Attr
`withForeColor` Color
Vty.red)
  , (AttrName
nightlyAttr               , Attr
Vty.defAttr Attr -> Color -> Attr
`withForeColor` Color
Vty.red)
  , (AttrName
compiledAttr              , Attr
Vty.defAttr Attr -> Color -> Attr
`withForeColor` Color
Vty.brightCyan)
  , (AttrName
strayAttr                 , Attr
Vty.defAttr Attr -> Color -> Attr
`withForeColor` Color
Vty.brightCyan)
  , (AttrName
dayAttr                   , Attr
Vty.defAttr Attr -> Color -> Attr
`withForeColor` Color
Vty.brightCyan)
  , (AttrName
helpAttr                  , Attr
Vty.defAttr Attr -> Style -> Attr
`withStyle`     Style
Vty.italic)
  , (AttrName
hoorayAttr                , Attr
Vty.defAttr Attr -> Color -> Attr
`withForeColor` Color
Vty.brightWhite)
  , (AttrName
helpMsgAttr               , Attr
Vty.defAttr Attr -> Color -> Attr
`withForeColor` Color
Vty.yellow)
  , (AttrName
errMsgAttr                , Attr
Vty.defAttr Attr -> Color -> Attr
`withForeColor` Color
Vty.red)
  ]
  where
    withForeColor :: Attr -> Color -> Attr
withForeColor | Bool
no_color  = Attr -> Color -> Attr
forall a b. a -> b -> a
const
                  | Bool
otherwise = Attr -> Color -> Attr
Vty.withForeColor
    withBackColor :: Attr -> Color -> Attr
withBackColor | Bool
no_color  = \Attr
attr Color
_ -> Attr
attr Attr -> Style -> Attr
`Vty.withStyle` Style
Vty.reverseVideo
                  | Bool
otherwise = Attr -> Color -> Attr
Vty.withBackColor
    withStyle :: Attr -> Style -> Attr
withStyle                 = Attr -> Style -> Attr
Vty.withStyle


notInstalledAttr, setAttr, installedAttr, recommendedAttr, hlsPoweredAttr :: Brick.AttrName
latestAttr, latestPrereleaseAttr, latestNightlyAttr, prereleaseAttr, nightlyAttr :: Brick.AttrName
compiledAttr, strayAttr, dayAttr, helpAttr, hoorayAttr, helpMsgAttr, errMsgAttr :: Brick.AttrName

notInstalledAttr :: AttrName
notInstalledAttr = String -> AttrName
Brick.attrName String
"not-installed"
setAttr :: AttrName
setAttr = String -> AttrName
Brick.attrName String
"set"
installedAttr :: AttrName
installedAttr = String -> AttrName
Brick.attrName String
"installed"
recommendedAttr :: AttrName
recommendedAttr = String -> AttrName
Brick.attrName String
"recommended"
hlsPoweredAttr :: AttrName
hlsPoweredAttr = String -> AttrName
Brick.attrName String
"hls-powered"
latestAttr :: AttrName
latestAttr = String -> AttrName
Brick.attrName String
"latest"
latestPrereleaseAttr :: AttrName
latestPrereleaseAttr = String -> AttrName
Brick.attrName String
"latest-prerelease"
latestNightlyAttr :: AttrName
latestNightlyAttr = String -> AttrName
Brick.attrName String
"latest-nightly"
prereleaseAttr :: AttrName
prereleaseAttr = String -> AttrName
Brick.attrName String
"prerelease"
nightlyAttr :: AttrName
nightlyAttr = String -> AttrName
Brick.attrName String
"nightly"
compiledAttr :: AttrName
compiledAttr = String -> AttrName
Brick.attrName String
"compiled"
strayAttr :: AttrName
strayAttr = String -> AttrName
Brick.attrName String
"stray"
dayAttr :: AttrName
dayAttr = String -> AttrName
Brick.attrName String
"day"
helpAttr :: AttrName
helpAttr = String -> AttrName
Brick.attrName String
"help"
hoorayAttr :: AttrName
hoorayAttr = String -> AttrName
Brick.attrName String
"hooray"
helpMsgAttr :: AttrName
helpMsgAttr = String -> AttrName
Brick.attrName String
"helpMsg"
errMsgAttr :: AttrName
errMsgAttr = String -> AttrName
Brick.attrName String
"errMsg"

dimAttributes :: Bool -> AttrMap
dimAttributes :: Bool -> AttrMap
dimAttributes Bool
no_color = Attr -> [(AttrName, Attr)] -> AttrMap
Brick.attrMap
  (Attr
Vty.defAttr Attr -> Style -> Attr
`Vty.withStyle` Style
Vty.dim)
  [ (String -> AttrName
Brick.attrName String
"active"    , Attr
Vty.defAttr Attr -> Color -> Attr
`withBackColor` Color
Vty.blue) -- has no effect ??
  , (String -> AttrName
Brick.attrName String
"no-bindist", Attr
Vty.defAttr Attr -> Style -> Attr
`Vty.withStyle` Style
Vty.dim)
  ]
  where
    withBackColor :: Attr -> Color -> Attr
withBackColor | Bool
no_color  = \Attr
attr Color
_ -> Attr
attr Attr -> Style -> Attr
`Vty.withStyle` Style
Vty.reverseVideo
                  | Bool
otherwise = Attr -> Color -> Attr
Vty.withBackColor