continou/Color.hs at master · gfixler/continou · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
module Color where

import Data.Monoid (Monoid, mempty, mappend, (<>))

data Color = None
           | Black
           | Red
           | Green
           | Yellow
           | Blue
           | Magenta
           | Cyan
           | LtGray
           | DkGray
           | LtRed
           | LtGreen
           | LtYellow
           | LtBlue
           | LtMagenta
           | LtCyan
           | White
           deriving (Bounded,Enum,Eq)

instance Show Color where
    show = flip withBG " "

instance Monoid Color where
    mempty = None
    None `mappend` c = c
    c `mappend` _ = c

data ColorPair = ColorPair (Color, Color)

instance Show ColorPair where
    show (ColorPair (t,b)) = withBGFG t b "▄"

instance Monoid ColorPair where
    mempty = ColorPair (None, None)
    ColorPair (t,b) `mappend` ColorPair (t',b') = ColorPair (t <> t', b <> b')

fgnum :: Color -> Int
fgnum None      = 39
fgnum Black     = 30
fgnum Red       = 31
fgnum Green     = 32
fgnum Yellow    = 33
fgnum Blue      = 34
fgnum Magenta   = 35
fgnum Cyan      = 36
fgnum LtGray    = 37
fgnum DkGray    = 90
fgnum LtRed     = 91
fgnum LtGreen   = 92
fgnum LtYellow  = 93
fgnum LtBlue    = 94
fgnum LtMagenta = 95
fgnum LtCyan    = 96
fgnum White     = 97

bgnum :: Color -> Int
bgnum = (+10) . fgnum

fg :: Color -> String
fg c = "\ESC[" ++ show (fgnum c) ++ "m"

bg :: Color -> String
bg c = "\ESC[" ++ show (bgnum c) ++ "m"

withFG :: Color -> String -> String
withFG c s = fg c ++ s ++ fg None

withBG :: Color -> String -> String
withBG c s = bg c ++ s ++ bg None

withBGFG :: Color -> Color -> String -> String
withBGFG bg fg = withBG bg . withFG fg