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
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
|
{-# LANGUAGE DeriveAnyClass #-}
{-# 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 Control.DeepSeq
import Data.List.Split
import GHC.Generics (Generic)
import Pretty.Color
import Text.Printf
data Doc
= Col [Doc]
| Lit (Maybe (Intensity, Color)) String
deriving (Generic, Show, Eq, NFData)
class Pretty a where
pretty :: a -> Doc
instance (Monoid Doc) where
mempty = Col []
instance (Semigroup Doc) where
a <> b = Col [a, b]
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 . (: [])
instance (Pretty a) => Pretty (Maybe a) where
pretty maybeA =
case maybeA of
Nothing -> Lit Nothing "n/a"
Just a -> pretty a
data Diagram a = Diagram Int a deriving (Functor, Show)
diagram :: Int -> a -> Diagram a
diagram = Diagram
instance Pretty (Diagram [Float]) where
pretty (Diagram n (take n -> xs)) =
Col (map (\c -> colorize c (Lit Nothing (plot c))) (mapFirst tail (chunksOf 2 (map discretize (0 : xs')))))
where
xs' = replicate (n - length xs) 0 ++ xs
mapFirst f (x : xs) = f x : xs
plot [n, m] = chart (max 1 n, max 1 m)
plot [m] = chart (0, max 1 m)
colorize [n, m] = colorize' (max n m)
colorize [m] = colorize' m
colorize' 0 = color Black
colorize' 1 = color Green
colorize' 2 = colorDull Yellow
colorize' 3 = color Yellow
colorize' 4 = color Red
colorize' x = error (printf "Pretty.pretty.colorize': %d" x)
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 (printf "Pretty.pretty.chart: %x" (show x))
discretize :: Float -> Int
discretize x = round (x * 4)
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)
|
