~jaro/balkon

ref: 84f9c76357b7b7a2d88316f31d7a39c1ed335bd0 balkon/test/Data/Text/ParagraphLayout/PrettyShow.hs -rw-r--r-- 3.2 KiB
84f9c763Jaro Prepare for test modules sharing PrettyShow. 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
module Data.Text.ParagraphLayout.PrettyShow
    ( PrettyShow
    , prettyShow
    , Pages (..)
    , ShapedRuns (..)
    )
where

import Data.Text.ParagraphLayout
import Data.Text.ParagraphLayout.Internal.Fragment (ShapedRun)

class PrettyShow a where
    prettyShow :: a -> String

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

instance PrettyShow ShapedRuns where
    prettyShow (ShapedRuns xs) = concat
        [ "["
        , concat $ indentedList indent0 $ map (prettyShow . ShapedRun') xs
        , "]"
        ]

newtype ShapedRun' = ShapedRun' ShapedRun

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

type Page = (PageContinuity, ParagraphLayout)

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

instance PrettyShow Pages where
    prettyShow (Pages ps) = concat
        [ "["
        , concat $ indentedList indent0 $ map (prettyShow . Page') ps
        , "]"
        ]

newtype Page' = Page' Page

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

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

instance PrettyShow SpanLayout where
    prettyShow (SpanLayout frags) = concat
        [ "SpanLayout ["
        , concat $ inlineList $ map prettyShow frags
        , "]"
        ]

instance PrettyShow Fragment where
    prettyShow (Fragment r pen glyphs) = concat
        [ "Fragment {fragmentRect = "
        , show r
        , commaSpace
        , "fragmentPen = "
        , show pen
        , commaSpace
        , "fragmentGlyphs ="
        , newline
        , indent2
        , "["
        , concat $ indentedList indent2 $ map show glyphs
        , "]"
        , newline
        , indent1
        , "}"
        ]

inlineList :: [String] -> [String]
inlineList items = suffixInit commaSpace items

indentedList :: String -> [String] -> [String]
indentedList indent items = prefixTail indent $ suffixInit commaNewline 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)

indent0 :: String
indent0 = ""

indent1 :: String
indent1 = "    "

indent2 :: String
indent2 = indent1 ++ indent1

newline :: String
newline = "\n"

commaSpace :: String
commaSpace = ", "

commaNewline :: String
commaNewline = "," ++ newline