{-# LANGUAGE CPP #-}

module Test.Sandwich.Formatters.TerminalUI.AttrMap where

import Brick
import Brick.Widgets.ProgressBar
import qualified Graphics.Vty as V
import Test.Sandwich.Types.RunTree
import Test.Sandwich.Types.Spec

#if MIN_VERSION_brick(1,0,0)
mkAttrName :: String -> AttrName
mkAttrName :: String -> AttrName
mkAttrName = String -> AttrName
attrName
#else
import Data.String

mkAttrName :: String -> AttrName
mkAttrName = fromString
#endif


mainAttrMap :: AttrMap
mainAttrMap :: AttrMap
mainAttrMap = Attr -> [(AttrName, Attr)] -> AttrMap
attrMap Attr
V.defAttr [
  -- (listAttr, V.white `on` V.blue)
   -- (listSelectedAttr, V.blue `on` V.white)
  -- (listSelectedAttr, bg (V.Color240 $ V.rgbColorToColor240 0 1 0))
  -- (selectedAttr, bg (V.Color240 $ V.rgbColorToColor240 0 1 0))

  -- Top bar
  (AttrName
visibilityThresholdNotSelectedAttr, Color -> Attr
fg Color
midGray)
  , (AttrName
visibilityThresholdSelectedAttr, Color -> Attr
fg Color
solarizedBase2)

  -- Statuses
  -- , (notStartedAttr, fg V.)
  , (AttrName
runningAttr, Color -> Attr
fg Color
V.blue)
  , (AttrName
pendingAttr, Color -> Attr
fg Color
V.yellow)
  , (AttrName
successAttr, Color -> Attr
fg Color
V.green)
  , (AttrName
failureAttr, Color -> Attr
fg Color
V.red)
  , (AttrName
totalAttr, Color -> Attr
fg Color
solarizedCyan)

  -- Logging
  , (AttrName
debugAttr, Color -> Attr
fg Color
V.blue), (AttrName
infoAttr, Color -> Attr
fg Color
V.yellow), (AttrName
warnAttr, Color -> Attr
fg Color
V.red), (AttrName
errorAttr, Color -> Attr
fg Color
V.red), (AttrName
otherAttr, Attr
V.defAttr)
  , (AttrName
logTimestampAttr, Color -> Attr
fg Color
midGray)
  , (AttrName
logFilenameAttr, Color -> Attr
fg Color
solarizedViolet)
  , (AttrName
logModuleAttr, Color -> Attr
fg Color
solarizedMagenta)
  , (AttrName
logPackageAttr, Color -> Attr
fg Color
solarizedGreen)
  , (AttrName
logLineAttr, Color -> Attr
fg Color
solarizedCyan)
  , (AttrName
logChAttr, Color -> Attr
fg Color
solarizedOrange)
  , (AttrName
logFunctionAttr, Color -> Attr
fg Color
solarizedMagenta)

  -- Progress bar
  , (AttrName
progressCompleteAttr, Color -> Attr
bg (Word8 -> Color
V.Color240 Word8
235))
  , (AttrName
progressIncompleteAttr, Color -> Attr
bg (Word8 -> Color
V.Color240 Word8
225))

  -- Main list
  , (AttrName
toggleMarkerAttr, Color -> Attr
fg Color
midGray)
  , (AttrName
openMarkerAttr, Color -> Attr
fg Color
midGray)
  , (AttrName
visibilityThresholdIndicatorMutedAttr, Color -> Attr
fg (Color -> Attr) -> Color -> Attr
forall a b. (a -> b) -> a -> b
$ Integer -> Color
forall {i}. Integral i => i -> Color
grayAt Integer
50)
  , (AttrName
visibilityThresholdIndicatorAttr, Color -> Attr
fg (Color -> Attr) -> Color -> Attr
forall a b. (a -> b) -> a -> b
$ Integer -> Color
forall {i}. Integral i => i -> Color
grayAt Integer
150)

  -- Hotkey stuff
  , (AttrName
hotkeyAttr, Color -> Attr
fg Color
V.blue)
  , (AttrName
disabledHotkeyAttr, Color -> Attr
fg Color
midGray)
  , (AttrName
hotkeyMessageAttr, Color -> Attr
fg Color
brightWhite)
  , (AttrName
disabledHotkeyMessageAttr, Color -> Attr
fg Color
brightGray)

  -- Exceptions and pretty printing
  , (AttrName
expectedAttr, Color -> Attr
fg Color
midWhite)
  , (AttrName
sawAttr, Color -> Attr
fg Color
midWhite)
  , (AttrName
integerAttr, Color -> Attr
fg Color
solarizedMagenta)
  , (AttrName
floatAttr, Color -> Attr
fg Color
solarizedMagenta)
  , (AttrName
charAttr, Color -> Attr
fg Color
solarizedCyan)
  , (AttrName
stringAttr, Color -> Attr
fg Color
solarizedYellow)
  , (AttrName
dateAttr, Color -> Attr
fg Color
solarizedBase2)
  , (AttrName
timeAttr, Color -> Attr
fg Color
solarizedBase1)
  , (AttrName
quoteAttr, Color -> Attr
fg Color
solarizedBase1)
  , (AttrName
slashAttr, Color -> Attr
fg Color
solarizedViolet)
  , (AttrName
negAttr, Color -> Attr
fg Color
solarizedViolet)
  , (AttrName
listBracketAttr, Color -> Attr
fg Color
solarizedOrange) -- TODO: make green?
  , (AttrName
tupleBracketAttr, Color -> Attr
fg Color
solarizedGreen)
  , (AttrName
braceAttr, Color -> Attr
fg Color
solarizedGreen)
  , (AttrName
ellipsesAttr, Color -> Attr
fg Color
solarizedBase0)
  , (AttrName
recordNameAttr, Color -> Attr
fg Color
solarizedRed)
  , (AttrName
fieldNameAttr, Color -> Attr
fg Color
solarizedYellow)
  , (AttrName
constructorNameAttr, Color -> Attr
fg Color
solarizedViolet)
  ]

-- selectedAttr :: AttrName
-- selectedAttr = "list_line_selected"

visibilityThresholdNotSelectedAttr :: AttrName
visibilityThresholdNotSelectedAttr :: AttrName
visibilityThresholdNotSelectedAttr = String -> AttrName
mkAttrName String
"visibility_threshold_not_selected"

visibilityThresholdSelectedAttr :: AttrName
visibilityThresholdSelectedAttr :: AttrName
visibilityThresholdSelectedAttr = String -> AttrName
mkAttrName String
"visibility_threshold_selected"

runningAttr :: AttrName
runningAttr :: AttrName
runningAttr = String -> AttrName
mkAttrName String
"running"

notStartedAttr :: AttrName
notStartedAttr :: AttrName
notStartedAttr = String -> AttrName
mkAttrName String
"not_started"

pendingAttr :: AttrName
pendingAttr :: AttrName
pendingAttr = String -> AttrName
mkAttrName String
"pending"

totalAttr :: AttrName
totalAttr :: AttrName
totalAttr = String -> AttrName
mkAttrName String
"total"

successAttr :: AttrName
successAttr :: AttrName
successAttr = String -> AttrName
mkAttrName String
"success"

failureAttr :: AttrName
failureAttr :: AttrName
failureAttr = String -> AttrName
mkAttrName String
"failure"

toggleMarkerAttr :: AttrName
toggleMarkerAttr :: AttrName
toggleMarkerAttr = String -> AttrName
mkAttrName String
"toggleMarker"

openMarkerAttr :: AttrName
openMarkerAttr :: AttrName
openMarkerAttr = String -> AttrName
mkAttrName String
"openMarker"

visibilityThresholdIndicatorAttr :: AttrName
visibilityThresholdIndicatorAttr :: AttrName
visibilityThresholdIndicatorAttr = String -> AttrName
mkAttrName String
"visibilityThresholdIndicator"

visibilityThresholdIndicatorMutedAttr :: AttrName
visibilityThresholdIndicatorMutedAttr :: AttrName
visibilityThresholdIndicatorMutedAttr = String -> AttrName
mkAttrName String
"visibilityThresholdMutedIndicator"

hotkeyAttr, disabledHotkeyAttr, hotkeyMessageAttr, disabledHotkeyMessageAttr :: AttrName
hotkeyAttr :: AttrName
hotkeyAttr = String -> AttrName
mkAttrName String
"hotkey"
disabledHotkeyAttr :: AttrName
disabledHotkeyAttr = String -> AttrName
mkAttrName String
"disableHotkey"
hotkeyMessageAttr :: AttrName
hotkeyMessageAttr = String -> AttrName
mkAttrName String
"hotkeyMessage"
disabledHotkeyMessageAttr :: AttrName
disabledHotkeyMessageAttr = String -> AttrName
mkAttrName String
"disabledHotkeyMessage"

chooseAttr :: Status -> AttrName
chooseAttr :: Status -> AttrName
chooseAttr Status
NotStarted = AttrName
notStartedAttr
chooseAttr (Running {}) = AttrName
runningAttr
chooseAttr (Done UTCTime
_ UTCTime
_ Maybe NominalDiffTime
_ Maybe NominalDiffTime
_ (Success {})) = AttrName
successAttr
chooseAttr (Done UTCTime
_ UTCTime
_ Maybe NominalDiffTime
_ Maybe NominalDiffTime
_ (Failure (Pending {}))) = AttrName
pendingAttr
chooseAttr (Done UTCTime
_ UTCTime
_ Maybe NominalDiffTime
_ Maybe NominalDiffTime
_ (Failure {})) = AttrName
failureAttr
chooseAttr (Done UTCTime
_ UTCTime
_ Maybe NominalDiffTime
_ Maybe NominalDiffTime
_ Result
DryRun) = AttrName
notStartedAttr
chooseAttr (Done UTCTime
_ UTCTime
_ Maybe NominalDiffTime
_ Maybe NominalDiffTime
_ Result
Cancelled) = AttrName
failureAttr

-- * Logging and callstacks

debugAttr, infoAttr, warnAttr, errorAttr, otherAttr :: AttrName
debugAttr :: AttrName
debugAttr = String -> AttrName
attrNameString
"log_debug"
infoAttr :: AttrName
infoAttr = String -> AttrName
attrNameString
"log_info"
warnAttr :: AttrName
warnAttr = String -> AttrName
attrNameString
"log_warn"
errorAttr :: AttrName
errorAttr = String -> AttrName
attrNameString
"log_error"
otherAttr :: AttrName
otherAttr = String -> AttrName
mkAttrName String
"log_other"

logTimestampAttr :: AttrName
logTimestampAttr :: AttrName
logTimestampAttr = String -> AttrName
mkAttrName String
"log_timestamp"

logFilenameAttr, logModuleAttr, logPackageAttr, logLineAttr, logChAttr :: AttrName
logFilenameAttr :: AttrName
logFilenameAttr = String -> AttrName
mkAttrName String
"logFilename"
logModuleAttr :: AttrName
logModuleAttr = String -> AttrName
mkAttrName String
"logModule"
logPackageAttr :: AttrName
logPackageAttr = String -> AttrName
mkAttrName String
"logPackage"
logLineAttr :: AttrName
logLineAttr = String -> AttrName
mkAttrName String
"logLine"
logChAttr :: AttrName
logChAttr = String -> AttrName
mkAttrName String
"logCh"
logFunctionAttr :: AttrName
logFunctionAttr = String -> AttrName
mkAttrName String
"logFunction"

-- * Exceptions and pretty printing

expectedAttr, sawAttr :: AttrName
expectedAttr :: AttrName
expectedAttr = String -> AttrName
mkAttrName String
"expected"
sawAttr :: AttrName
sawAttr = String -> AttrName
mkAttrName String
"saw"

integerAttr, timeAttr, dateAttr, stringAttr, charAttr, floatAttr, quoteAttr, slashAttr, negAttr :: AttrName
listBracketAttr, tupleBracketAttr, braceAttr, ellipsesAttr, recordNameAttr, fieldNameAttr, constructorNameAttr :: AttrName
integerAttr :: AttrName
integerAttr = String -> AttrName
mkAttrName String
"integer"
floatAttr :: AttrName
floatAttr = String -> AttrName
mkAttrName String
"float"
charAttr :: AttrName
charAttr = String -> AttrName
mkAttrName String
"char"
stringAttr :: AttrName
stringAttr = String -> AttrName
mkAttrName String
"string"
dateAttr :: AttrName
dateAttr = String -> AttrName
mkAttrName String
"date"
timeAttr :: AttrName
timeAttr = String -> AttrName
mkAttrName String
"time"
quoteAttr :: AttrName
quoteAttr = String -> AttrName
mkAttrName String
"quote"
slashAttr :: AttrName
slashAttr = String -> AttrName
mkAttrName String
"slash"
negAttr :: AttrName
negAttr = String -> AttrName
mkAttrName String
"neg"
listBracketAttr :: AttrName
listBracketAttr = String -> AttrName
mkAttrName String
"listBracket"
tupleBracketAttr :: AttrName
tupleBracketAttr = String -> AttrName
mkAttrName String
"tupleBracket"
braceAttr :: AttrName
braceAttr = String -> AttrName
mkAttrName String
"brace"
ellipsesAttr :: AttrName
ellipsesAttr = String -> AttrName
mkAttrName String
"ellipses"
recordNameAttr :: AttrName
recordNameAttr = String -> AttrName
mkAttrName String
"recordName"
fieldNameAttr :: AttrName
fieldNameAttr = String -> AttrName
mkAttrName String
"fieldName"
constructorNameAttr :: AttrName
constructorNameAttr = String -> AttrName
mkAttrName String
"fieldName"

-- * Colors

solarizedBase03 :: Color
solarizedBase03 = Integer -> Integer -> Integer -> Color
forall i. Integral i => i -> i -> i -> Color
V.rgbColor Integer
0x00 Integer
0x2b Integer
0x36
solarizedBase02 :: Color
solarizedBase02 = Integer -> Integer -> Integer -> Color
forall i. Integral i => i -> i -> i -> Color
V.rgbColor Integer
0x07 Integer
0x36 Integer
0x42
solarizedBase01 :: Color
solarizedBase01 = Integer -> Integer -> Integer -> Color
forall i. Integral i => i -> i -> i -> Color
V.rgbColor Integer
0x58 Integer
0x6e Integer
0x75
solarizedbase00 :: Color
solarizedbase00 = Integer -> Integer -> Integer -> Color
forall i. Integral i => i -> i -> i -> Color
V.rgbColor Integer
0x65 Integer
0x7b Integer
0x83
solarizedBase0 :: Color
solarizedBase0 = Integer -> Integer -> Integer -> Color
forall i. Integral i => i -> i -> i -> Color
V.rgbColor Integer
0x83 Integer
0x94 Integer
0x96
solarizedBase1 :: Color
solarizedBase1 = Integer -> Integer -> Integer -> Color
forall i. Integral i => i -> i -> i -> Color
V.rgbColor Integer
0x93 Integer
0xa1 Integer
0xa1
solarizedBase2 :: Color
solarizedBase2 = Integer -> Integer -> Integer -> Color
forall i. Integral i => i -> i -> i -> Color
V.rgbColor Integer
0xee Integer
0xe8 Integer
0xd5
solarizedBase3 :: Color
solarizedBase3 = Integer -> Integer -> Integer -> Color
forall i. Integral i => i -> i -> i -> Color
V.rgbColor Integer
0xfd Integer
0xf6 Integer
0xe3
solarizedYellow :: Color
solarizedYellow = Integer -> Integer -> Integer -> Color
forall i. Integral i => i -> i -> i -> Color
V.rgbColor Integer
0xb5 Integer
0x89 Integer
0x00
solarizedOrange :: Color
solarizedOrange = Integer -> Integer -> Integer -> Color
forall i. Integral i => i -> i -> i -> Color
V.rgbColor Integer
0xcb Integer
0x4b Integer
0x16
solarizedRed :: Color
solarizedRed = Integer -> Integer -> Integer -> Color
forall i. Integral i => i -> i -> i -> Color
V.rgbColor Integer
0xdc Integer
0x32 Integer
0x2f
solarizedMagenta :: Color
solarizedMagenta = Integer -> Integer -> Integer -> Color
forall i. Integral i => i -> i -> i -> Color
V.rgbColor Integer
0xd3 Integer
0x36 Integer
0x82
solarizedViolet :: Color
solarizedViolet = Integer -> Integer -> Integer -> Color
forall i. Integral i => i -> i -> i -> Color
V.rgbColor Integer
0x6c Integer
0x71 Integer
0xc4
solarizedBlue :: Color
solarizedBlue = Integer -> Integer -> Integer -> Color
forall i. Integral i => i -> i -> i -> Color
V.rgbColor Integer
0x26 Integer
0x8b Integer
0xd2
solarizedCyan :: Color
solarizedCyan = Integer -> Integer -> Integer -> Color
forall i. Integral i => i -> i -> i -> Color
V.rgbColor Integer
0x2a Integer
0xa1 Integer
0x98
solarizedGreen :: Color
solarizedGreen = Integer -> Integer -> Integer -> Color
forall i. Integral i => i -> i -> i -> Color
V.rgbColor Integer
0x85 Integer
0x99 Integer
0x00

midGray :: Color
midGray = Integer -> Color
forall {i}. Integral i => i -> Color
grayAt Integer
50
brightGray :: Color
brightGray = Integer -> Color
forall {i}. Integral i => i -> Color
grayAt Integer
80
midWhite :: Color
midWhite = Integer -> Color
forall {i}. Integral i => i -> Color
grayAt Integer
140
brightWhite :: Color
brightWhite = Integer -> Color
forall {i}. Integral i => i -> Color
grayAt Integer
200

grayAt :: i -> Color
grayAt i
level = i -> i -> i -> Color
forall i. Integral i => i -> i -> i -> Color
V.rgbColor i
level i
level i
level
-- grayAt level = V.Color240 $ V.rgbColorToColor240 level level level