~jaro/balkon

ref: 9927e551b32660d4bc536bd0b5aa1b3222613c4b balkon/test/Data/Text/ParagraphLayout/PrettyShow.hs -rw-r--r-- 4.1 KiB
9927e551Jaro Add line numbers to laid out fragments. 1 year, 6 months ago
                                                                                
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
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
module Data.Text.ParagraphLayout.PrettyShow
    ( PrettyShow
    , prettyShow
    , Pages (..)
    , ShapedRuns (..)
    )
where

import Data.List (intersperse)
import Data.Text.ParagraphLayout
import Data.Text.ParagraphLayout.Internal.Fragment (ShapedRun)
import qualified Data.Text.ParagraphLayout.Plain as Plain

class PrettyShow a where
    prettyShow :: a -> String

newtype ShapedRuns = ShapedRuns { getShapedRuns :: [ShapedRun] }
    deriving (Eq)

instance PrettyShow ShapedRuns where
    prettyShow (ShapedRuns xs) =
        concat $ commaFirstList indent0 $ map (prettyShow . ShapedRun') xs

newtype ShapedRun' = ShapedRun' ShapedRun

instance PrettyShow ShapedRun' where
    prettyShow (ShapedRun' (x, y, glyphs)) = concat
        [ "("
        , show x
        , ", "
        , show y
        , ", "
        , newline
        , concat $ commaFirstList indent1 $ map prettyShowPair glyphs
        , ")"
        ]

type Page = (PageContinuity, Plain.ParagraphLayout)

newtype Pages = Pages { getPages :: [Page] }
    deriving (Eq)

instance PrettyShow Pages where
    prettyShow (Pages ps) =
        concat (commaFirstList indent0 $ map (prettyShow . Page') ps)
        ++ newline

newtype Page' = Page' Page

instance PrettyShow Page' where
    prettyShow (Page' (c, pl)) = concat
        [ "("
        , show c
        , ", "
        , prettyShow pl
        , ")"
        ]

instance PrettyShow Plain.ParagraphLayout where
    prettyShow (Plain.ParagraphLayout pr sls) = concat
        [ "ParagraphLayout"
        , newline
        , indent1
        , "{ paragraphRect = "
        , show pr
        , newline
        , indent1
        , ", spanLayouts = ["
        , newline
        , concat $ commaAloneList indent2 $ map prettyShow sls
        , newline
        , indent1
        , "]}"
        , newline
        ]

instance PrettyShow Plain.SpanLayout where
    prettyShow (Plain.SpanLayout frags) = concat
        [ "SpanLayout"
        , newline
        , concat $ commaFirstList indent2 $ map prettyShow frags
        ]

instance PrettyShow Plain.Fragment where
    prettyShow (Plain.Fragment l r pen glyphs) = concat
        [ "Fragment"
        , newline
        , indent3
        , "{ fragmentLine = "
        , show l
        , newline
        , indent3
        , ", fragmentRect = "
        , show r
        , newline
        , indent3
        , ", fragmentPen = "
        , prettyShowPair pen
        , newline
        , indent3
        , ", fragmentGlyphs ="
        , newline
        , concat $ commaFirstList indent4 $ map prettyShowPair glyphs
        , newline
        , indent3
        , "}"
        ]

prettyShowPair :: (Show a, Show b) => (a, b) -> String
prettyShowPair (a, b) = "(" ++ show a ++ ", " ++ show b ++ ")"

commaAloneList :: String -> [String] -> [String]
commaAloneList indent items =
    map (indent ++) $
    suffixInit newline $
    intersperse "," $
    items

commaFirstList :: String -> [String] -> [String]
commaFirstList indent [] = [indent ++ "[]"]
commaFirstList indent items =
    prefixHead (indent ++ "[ ") $
    prefixTail (indent ++ ", ") $
    suffixInit newline $
    suffixLast (newline ++ indent ++ "]") $
    items

suffixInit :: String -> [String] -> [String]
suffixInit suffix = mapInit (++ suffix)

mapInit :: (a -> a) -> [a] -> [a]
mapInit _ [] = []
mapInit _ [x] = [x]
mapInit f (x : y : ys) = f x : mapInit f (y : ys)

prefixTail :: String -> [String] -> [String]
prefixTail prefix = mapTail (prefix ++)

mapTail :: (a -> a) -> [a] -> [a]
mapTail _ [] = []
mapTail f (x : xs) = x : (map f xs)

prefixHead :: String -> [String] -> [String]
prefixHead prefix = mapHead (prefix ++)

mapHead :: (a -> a) -> [a] -> [a]
mapHead _ [] = []
mapHead f (x : xs) = f x : xs

suffixLast :: String -> [String] -> [String]
suffixLast suffix = mapLast (++ suffix)

mapLast :: (a -> a) -> [a] -> [a]
mapLast _ [] = []
mapLast f [x] = [f x]
mapLast f (x : y : ys) = x : mapLast f (y : ys)

indent0 :: String
indent0 = ""

indent1 :: String
indent1 = "    "

indent2 :: String
indent2 = indent1 ++ indent1

indent3 :: String
indent3 = indent1 ++ indent2

indent4 :: String
indent4 = indent1 ++ indent3

newline :: String
newline = "\n"