-
Notifications
You must be signed in to change notification settings - Fork 151
/
Extra.hs
188 lines (137 loc) · 4.55 KB
/
Extra.hs
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
175
176
177
178
179
180
181
182
183
184
185
186
187
188
{-# LANGUAGE FlexibleInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Data.Text.Prettyprint.Doc.Extra
( module Data.Text.Prettyprint.Doc.Extra
, LayoutOptions (..)
, PageWidth (..)
, layoutCompact
, layoutPretty
, renderLazy
)
where
import Control.Applicative
import Data.String (IsString (..))
import Data.Text as T
import Data.Text.Lazy as LT
import qualified Data.Text.Prettyprint.Doc as PP
import Data.Text.Prettyprint.Doc.Internal hiding (Doc)
import Data.Text.Prettyprint.Doc.Render.Text
type Doc = PP.Doc ()
layoutOneLine
:: PP.Doc ann
-> SimpleDocStream ann
layoutOneLine doc = scan 0 [doc]
where
scan _ [] = SEmpty
scan !col (d:ds) = case d of
Fail -> SFail
Empty -> scan col ds
Char c -> SChar c (scan (col+1) ds)
Text l t -> let !col' = col+l in SText l t (scan col' ds)
FlatAlt x _ -> scan col (x:ds)
Line -> scan col ds
Cat x y -> scan col (x:y:ds)
Nest _ x -> scan col (x:ds)
Union _ y -> scan col (y:ds)
Column f -> scan col (f col:ds)
WithPageWidth f -> scan col (f Unbounded : ds)
Nesting f -> scan col (f 0 : ds)
Annotated _ x -> scan col (x:ds)
renderOneLine
:: PP.Doc ann
-> LT.Text
renderOneLine = renderLazy . layoutOneLine
int :: Applicative f => Int -> f Doc
int = pure . PP.pretty
integer :: Applicative f => Integer -> f Doc
integer = pure . PP.pretty
char :: Applicative f => Char -> f Doc
char = pure . PP.pretty
lbrace :: Applicative f => f Doc
lbrace = pure PP.lbrace
rbrace :: Applicative f => f Doc
rbrace = pure PP.rbrace
colon :: Applicative f => f Doc
colon = pure PP.colon
semi :: Applicative f => f Doc
semi = pure PP.semi
equals :: Applicative f => f Doc
equals = pure PP.equals
comma :: Applicative f => f Doc
comma = pure PP.comma
dot :: Applicative f => f Doc
dot = pure PP.dot
lparen :: Applicative f => f Doc
lparen = pure PP.lparen
rparen :: Applicative f => f Doc
rparen = pure PP.rparen
space :: Applicative f => f Doc
space = pure PP.space
brackets :: Functor f => f Doc -> f Doc
brackets = fmap PP.brackets
braces :: Functor f => f Doc -> f Doc
braces = fmap PP.braces
tupled :: Functor f => f [Doc] -> f Doc
tupled = fmap PP.tupled
(<+>) :: Applicative f => f Doc -> f Doc -> f Doc
(<+>) = liftA2 (PP.<+>)
infixr 6 <+>
vcat :: Functor f => f [Doc] -> f Doc
vcat = fmap PP.vcat
hcat :: Functor f => f [Doc] -> f Doc
hcat = fmap PP.hcat
nest :: Functor f => Int -> f Doc -> f Doc
nest i = fmap (PP.nest i)
indent :: Functor f => Int -> f Doc -> f Doc
indent i = fmap (PP.indent i)
parens :: Functor f => f Doc -> f Doc
parens = fmap PP.parens
emptyDoc :: Applicative f => f Doc
emptyDoc = pure PP.emptyDoc
punctuate :: Applicative f => f Doc -> f [Doc] -> f [Doc]
punctuate = liftA2 PP.punctuate
encloseSep :: Applicative f => f Doc -> f Doc -> f Doc -> f [Doc] -> f Doc
encloseSep l r s is = PP.encloseSep <$> l <*> r <*> s <*> is
line :: Applicative f => f Doc
line = pure PP.line
line' :: Applicative f => f Doc
line' = pure PP.line'
softline :: Applicative f => f Doc
softline = pure PP.softline
softline' :: Applicative f => f Doc
softline' = pure PP.softline'
pretty :: (Applicative f, Pretty a) => a -> f Doc
pretty = pure . PP.pretty
stringS :: Applicative f => T.Text -> f Doc
stringS = pure . PP.pretty
string :: Applicative f => LT.Text -> f Doc
string = pure . PP.pretty
squotes :: Applicative f => f Doc -> f Doc
squotes = fmap PP.squotes
dquotes :: Functor f => f Doc -> f Doc
dquotes = fmap PP.dquotes
align :: Functor f => f Doc -> f Doc
align = fmap PP.align
hsep :: Functor f => f [Doc] -> f Doc
hsep = fmap PP.hsep
vsep :: Functor f => f [Doc] -> f Doc
vsep = fmap PP.vsep
isEmpty :: Doc -> Bool
isEmpty Empty = True
isEmpty _ = False
fill :: Applicative f => Int -> f Doc -> f Doc
fill = fmap . PP.fill
column :: Functor f => f (Int -> Doc) -> f Doc
column = fmap PP.column
nesting :: Functor f => f (Int -> Doc) -> f Doc
nesting = fmap PP.nesting
flatAlt :: Applicative f => f Doc -> f Doc -> f Doc
flatAlt = liftA2 PP.flatAlt
instance Applicative f => IsString (f Doc) where
fromString = string . fromString
comment :: Applicative f => T.Text -> T.Text -> f Doc
comment prefix comm =
let go s = PP.pretty prefix PP.<+> PP.pretty s in
pure (PP.vsep (Prelude.map go (T.lines comm)))
squote :: Applicative f => f Doc
squote = string (LT.pack "'")