{-# Language OverloadedStrings, ApplicativeDo, LambdaCase, BlockArguments #-}
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
attrSpec :: ValueSpec Attr
attrSpec :: ValueSpec Attr
attrSpec = forall a. Text -> ValueSpec a -> ValueSpec a
namedSpec Text
"attr" forall a b. (a -> b) -> a -> b
$
Attr -> Color -> Attr
withForeColor Attr
defAttr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ValueSpec Color
colorSpec
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> ValueSpec Attr
fullAttrSpec
fullAttrSpec :: ValueSpec Attr
fullAttrSpec :: ValueSpec Attr
fullAttrSpec = forall a. Text -> SectionsSpec a -> ValueSpec a
sectionsSpec Text
"full-attr" forall a b. (a -> b) -> a -> b
$
do Maybe Color
mbFg <- forall a. Text -> ValueSpec a -> Text -> SectionsSpec (Maybe a)
optSection' Text
"fg" ValueSpec Color
colorSpec Text
"Foreground color"
Maybe Color
mbBg <- forall a. Text -> ValueSpec a -> Text -> SectionsSpec (Maybe a)
optSection' Text
"bg" ValueSpec Color
colorSpec Text
"Background color"
Maybe [Word8]
mbSt <- forall a. Text -> ValueSpec a -> Text -> SectionsSpec (Maybe a)
optSection' Text
"style" ValueSpec [Word8]
stylesSpec Text
"Terminal font style"
return ( forall {t :: * -> *} {b} {a}.
Foldable t =>
(b -> a -> b) -> t a -> b -> b
aux Attr -> Color -> Attr
withForeColor Maybe Color
mbFg
forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *} {b} {a}.
Foldable t =>
(b -> a -> b) -> t a -> b -> b
aux Attr -> Color -> Attr
withBackColor Maybe Color
mbBg
forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *} {b} {a}.
Foldable t =>
(b -> a -> b) -> t a -> b -> b
aux (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Attr -> Word8 -> Attr
withStyle) Maybe [Word8]
mbSt
forall a b. (a -> b) -> a -> b
$ Attr
defAttr)
where
aux :: (b -> a -> b) -> t a -> b -> b
aux b -> a -> b
f t a
xs b
z = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl b -> a -> b
f b
z t a
xs
stylesSpec :: ValueSpec [Style]
stylesSpec :: ValueSpec [Word8]
stylesSpec = forall a. ValueSpec a -> ValueSpec [a]
oneOrList ValueSpec Word8
styleSpec
styleSpec :: ValueSpec Style
styleSpec :: ValueSpec Word8
styleSpec = forall a. Text -> ValueSpec a -> ValueSpec a
namedSpec Text
"style" forall a b. (a -> b) -> a -> b
$
Word8
blink forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ValueSpec ()
atomSpec Text
"blink"
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> Word8
bold forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ValueSpec ()
atomSpec Text
"bold"
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> Word8
dim forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ValueSpec ()
atomSpec Text
"dim"
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> Word8
italic forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ValueSpec ()
atomSpec Text
"italic"
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> Word8
reverseVideo forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ValueSpec ()
atomSpec Text
"reverse-video"
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> Word8
standout forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ValueSpec ()
atomSpec Text
"standout"
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> Word8
strikethroughforall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ValueSpec ()
atomSpec Text
"strikethrough"
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> Word8
underline forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ValueSpec ()
atomSpec Text
"underline"
colorSpec :: ValueSpec Color
colorSpec :: ValueSpec Color
colorSpec = forall a. Text -> ValueSpec a -> ValueSpec a
namedSpec Text
"color" (ValueSpec Color
colorNumberSpec forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> ValueSpec Color
colorNameSpec forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> ValueSpec Color
rgbSpec)
colorNameSpec :: ValueSpec Color
colorNameSpec :: ValueSpec Color
colorNameSpec = forall a b.
Text -> ValueSpec a -> (a -> Either Text b) -> ValueSpec b
customSpec Text
"color name" ValueSpec Text
anyAtomSpec
forall a b. (a -> b) -> a -> b
$ \Text
name -> case forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
name HashMap Text Color
namedColors of
Maybe Color
Nothing -> forall a b. a -> Either a b
Left Text
"unknown color"
Just Color
c -> forall a b. b -> Either a b
Right Color
c
colorNumberSpec :: ValueSpec Color
colorNumberSpec :: ValueSpec Color
colorNumberSpec = forall a b.
Text -> ValueSpec a -> (a -> Either Text b) -> ValueSpec b
customSpec Text
"terminal color" forall a. HasSpec a => ValueSpec a
anySpec forall a b. (a -> b) -> a -> b
$ \Integer
i ->
if Integer
i forall a. Ord a => a -> a -> Bool
< Integer
0 then forall a b. a -> Either a b
Left Text
"minimum color is 0"
else if Integer
i forall a. Ord a => a -> a -> Bool
< Integer
16 then forall a b. b -> Either a b
Right (Word8 -> Color
ISOColor (forall a. Num a => Integer -> a
fromInteger Integer
i))
else if Integer
i forall a. Ord a => a -> a -> Bool
< Integer
256 then forall a b. b -> Either a b
Right (Word8 -> Color
Color240 (forall a. Num a => Integer -> a
fromInteger (Integer
i forall a. Num a => a -> a -> a
- Integer
16)))
else forall a b. a -> Either a b
Left Text
"maximum color is 255"
rgbSpec :: ValueSpec Color
rgbSpec :: ValueSpec Color
rgbSpec = forall a b.
Text -> ValueSpec a -> (a -> Either Text b) -> ValueSpec b
customSpec Text
"RGB" forall a. HasSpec a => ValueSpec a
anySpec \case
[Integer
r,Integer
g,Integer
b] -> forall i. Integral i => i -> i -> i -> Color
rgbColor forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {a}. IsString a => Integer -> Either a Integer
valid Integer
r forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {a}. IsString a => Integer -> Either a Integer
valid Integer
g forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {a}. IsString a => Integer -> Either a Integer
valid Integer
b
[Integer]
_ -> forall a b. a -> Either a b
Left Text
"expected 3 numbers"
where
valid :: Integer -> Either a Integer
valid Integer
x
| Integer
x forall a. Ord a => a -> a -> Bool
< Integer
0 = forall a b. a -> Either a b
Left a
"minimum color value is 0"
| Integer
x forall a. Ord a => a -> a -> Bool
< Integer
256 = forall a b. b -> Either a b
Right (Integer
x :: Integer)
| Bool
otherwise = forall a b. a -> Either a b
Left a
"maximum color value is 255"
namedColors :: HashMap Text Color
namedColors :: HashMap Text Color
namedColors = forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
[ (Text
"black" , Color
black )
, (Text
"red" , Color
red )
, (Text
"green" , Color
green )
, (Text
"yellow" , Color
yellow )
, (Text
"blue" , Color
blue )
, (Text
"magenta" , Color
magenta )
, (Text
"cyan" , Color
cyan )
, (Text
"white" , Color
white )
, (Text
"bright-black" , Color
brightBlack )
, (Text
"bright-red" , Color
brightRed )
, (Text
"bright-green" , Color
brightGreen )
, (Text
"bright-yellow" , Color
brightYellow )
, (Text
"bright-blue" , Color
brightBlue )
, (Text
"bright-magenta", Color
brightMagenta)
, (Text
"bright-cyan" , Color
brightCyan )
, (Text
"bright-white" , Color
brightWhite )
]