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
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
|
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}
module Pretty
( Doc (..),
Pretty,
pretty,
Diagram,
diagram,
module Pretty.Color,
color,
colorDull,
)
where
import Pretty.Color
data Doc
= Col [Doc]
| Lit (Maybe (Intensity, Color)) String
deriving (Show, Eq)
class Pretty a where
pretty :: a -> Doc
instance Pretty Doc where
pretty = id
instance Pretty Char where
pretty = pretty . (: [])
instance Pretty String where
pretty = Lit Nothing
instance Pretty Float where
pretty = pretty . Diagram 1 . (: [])
data Diagram a = Diagram Int a deriving (Functor, Show)
diagram :: Int -> a -> Diagram a
diagram = Diagram
instance Pretty (Diagram [Float]) where
pretty (Diagram ((2 *) -> n) (take n -> xs)) = Col (map chart (discretize xs'))
where
xs' = replicate (n - length xs) 0 ++ xs
chart :: (Int, Int) -> Doc
chart n = colorize n (pretty (chart' n))
chart' (0, 0) = '⠀'
chart' (0, 1) = '⢀'
chart' (0, 2) = '⢠'
chart' (0, 3) = '⢰'
chart' (0, 4) = '⢸'
chart' (1, 0) = '⡀'
chart' (1, 1) = '⣀'
chart' (1, 2) = '⣠'
chart' (1, 3) = '⣰'
chart' (1, 4) = '⣸'
chart' (2, 0) = '⡄'
chart' (2, 1) = '⣄'
chart' (2, 2) = '⣤'
chart' (2, 3) = '⣴'
chart' (2, 4) = '⣼'
chart' (3, 0) = '⡆'
chart' (3, 1) = '⣆'
chart' (3, 2) = '⣦'
chart' (3, 3) = '⣶'
chart' (3, 4) = '⣾'
chart' (4, 0) = '⡇'
chart' (4, 1) = '⣇'
chart' (4, 2) = '⣧'
chart' (4, 3) = '⣷'
chart' (4, 4) = '⣿'
chart' x = error (show x)
colorize (n, m) = colorize' (max n m)
colorize' 0 = colorDull Green
colorize' 1 = color Green
colorize' 2 = colorDull Yellow
colorize' 3 = color Yellow
colorize' 4 = color Red
colorize' x = error (show x)
discretize :: [Float] -> [(Int, Int)]
discretize [] = []
discretize (_ : []) = []
discretize (x1 : x2 : xs) =
(round (x1 * 4), round (x2 * 4)) : discretize xs
color :: Color -> Doc -> Doc
color c = color' (Vivid, c)
colorDull :: Color -> Doc -> Doc
colorDull c = color' (Dull, c)
color' :: (Intensity, Color) -> Doc -> Doc
color' c (Lit _ s) = Lit (Just c) s
color' c (Col ds) = Col (map (color' c) ds)
|
