forked from erikd/language-javascript
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathPrinter.hs
340 lines (272 loc) · 16.9 KB
/
Printer.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
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
{-# LANGUAGE FlexibleInstances, NoOverloadedStrings, TypeSynonymInstances #-}
module Language.JavaScript.Pretty.Printer
( -- * Printing
renderJS
, renderToString
, renderToText
) where
import Blaze.ByteString.Builder (Builder, toLazyByteString)
import Data.List
import Data.Monoid (mempty)
import Data.Semigroup ((<>))
import Data.Text.Lazy (Text)
import Language.JavaScript.Parser.AST
import Language.JavaScript.Parser.SrcLocation
import Language.JavaScript.Parser.Token
import qualified Blaze.ByteString.Builder.Char.Utf8 as BS
import qualified Data.ByteString.Lazy as LB
import qualified Data.Text.Lazy.Encoding as LT
import qualified Codec.Binary.UTF8.String as US
-- ---------------------------------------------------------------------
data PosAccum = PosAccum (Int, Int) Builder
-- ---------------------------------------------------------------------
-- Pretty printer stuff via blaze-builder
str :: String -> Builder
str = BS.fromString
-- ---------------------------------------------------------------------
renderJS :: JSAST -> Builder
renderJS node = bb
where
PosAccum _ bb = PosAccum (1,1) mempty |> node
renderToString :: JSAST -> String
-- need to be careful to not lose the unicode encoding on output
renderToString js = US.decode $ LB.unpack $ toLazyByteString $ renderJS js
renderToText :: JSAST -> Text
-- need to be careful to not lose the unicode encoding on output
renderToText = LT.decodeUtf8 . toLazyByteString . renderJS
class RenderJS a where
-- Render node.
(|>) :: PosAccum -> a -> PosAccum
instance RenderJS JSAST where
(|>) pacc (JSAstProgram xs a) = pacc |> xs |> a
(|>) pacc (JSAstModule xs a) = pacc |> xs |> a
(|>) pacc (JSAstStatement s a) = pacc |> s |> a
(|>) pacc (JSAstExpression e a) = pacc |> e |> a
(|>) pacc (JSAstLiteral x a) = pacc |> x |> a
instance RenderJS JSExpression where
-- Terminals
(|>) pacc (JSIdentifier annot s) = pacc |> annot |> s
(|>) pacc (JSDecimal annot i) = pacc |> annot |> i
(|>) pacc (JSLiteral annot l) = pacc |> annot |> l
(|>) pacc (JSHexInteger annot i) = pacc |> annot |> i
(|>) pacc (JSOctal annot i) = pacc |> annot |> i
(|>) pacc (JSStringLiteral annot s) = pacc |> annot |> s
(|>) pacc (JSRegEx annot s) = pacc |> annot |> s
-- Non-Terminals
(|>) pacc (JSArrayLiteral als xs ars) = pacc |> als |> "[" |> xs |> ars |> "]"
(|>) pacc (JSArrowExpression xs a x) = pacc |> xs |> a |> "=>" |> x
(|>) pacc (JSAssignExpression lhs op rhs) = pacc |> lhs |> op |> rhs
(|>) pacc (JSCallExpression ex lb xs rb) = pacc |> ex |> lb |> "(" |> xs |> rb |> ")"
(|>) pacc (JSCallExpressionDot ex os xs) = pacc |> ex |> os |> "." |> xs
(|>) pacc (JSCallExpressionSquare ex als xs ars) = pacc |> ex |> als |> "[" |> xs |> ars |> "]"
(|>) pacc (JSCommaExpression le c re) = pacc |> le |> c |> "," |> re
(|>) pacc (JSExpressionBinary lhs op rhs) = pacc |> lhs |> op |> rhs
(|>) pacc (JSExpressionParen alp e arp) = pacc |> alp |> "(" |> e |> arp |> ")"
(|>) pacc (JSExpressionPostfix xs op) = pacc |> xs |> op
(|>) pacc (JSExpressionTernary cond h v1 c v2) = pacc |> cond |> h |> "?" |> v1 |> c |> ":" |> v2
(|>) pacc (JSFunctionExpression annot n lb x2s rb x3) = pacc |> annot |> "function" |> n |> lb |> "(" |> x2s |> rb |> ")" |> x3
(|>) pacc (JSMemberDot xs dot n) = pacc |> xs |> "." |> dot |> n
(|>) pacc (JSMemberExpression e lb a rb) = pacc |> e |> lb |> "(" |> a |> rb |> ")"
(|>) pacc (JSMemberNew a lb n rb s) = pacc |> a |> "new" |> lb |> "(" |> n |> rb |> ")" |> s
(|>) pacc (JSMemberSquare xs als e ars) = pacc |> xs |> als |> "[" |> e |> ars |> "]"
(|>) pacc (JSNewExpression n e) = pacc |> n |> "new" |> e
(|>) pacc (JSObjectLiteral alb xs arb) = pacc |> alb |> "{" |> xs |> arb |> "}"
(|>) pacc (JSUnaryExpression op x) = pacc |> op |> x
(|>) pacc (JSVarInitExpression x1 x2) = pacc |> x1 |> x2
(|>) pacc (JSSpreadExpression a e) = pacc |> a |> "..." |> e
instance RenderJS JSArrowParameterList where
(|>) pacc (JSUnparenthesizedArrowParameter p) = pacc |> p
(|>) pacc (JSParenthesizedArrowParameterList lb ps rb) = pacc |> lb |> "(" |> ps |> ")" |> rb
-- -----------------------------------------------------------------------------
-- Need an instance of RenderJS for every component of every JSExpression or JSAnnot
-- constuctor.
-- -----------------------------------------------------------------------------
instance RenderJS JSAnnot where
(|>) pacc (JSAnnot p cs) = pacc |> cs |> p
(|>) pacc JSNoAnnot = pacc
(|>) pacc JSAnnotSpace = pacc |> " "
instance RenderJS String where
(|>) (PosAccum (r,c) bb) s = PosAccum (r',c') (bb <> str s)
where
(r',c') = foldl' (\(row,col) ch -> go (row,col) ch) (r,c) s
go (rx,_) '\n' = (rx+1,1)
go (rx,cx) '\t' = (rx,cx+8)
go (rx,cx) _ = (rx,cx+1)
instance RenderJS TokenPosn where
(|>) (PosAccum (lcur,ccur) bb) (TokenPn _ ltgt ctgt) = PosAccum (lnew,cnew) (bb <> bb')
where
(bbline,ccur') = if lcur < ltgt then (str (replicate (ltgt - lcur) '\n'),1) else (mempty,ccur)
bbcol = if ccur' < ctgt then str (replicate (ctgt - ccur') ' ') else mempty
bb' = bbline <> bbcol
lnew = if lcur < ltgt then ltgt else lcur
cnew = if ccur' < ctgt then ctgt else ccur'
instance RenderJS [CommentAnnotation] where
(|>) = foldl' (|>)
instance RenderJS CommentAnnotation where
(|>) pacc NoComment = pacc
(|>) pacc (CommentA p s) = pacc |> p |> s
(|>) pacc (WhiteSpace p s) = pacc |> p |> s
instance RenderJS [JSExpression] where
(|>) = foldl' (|>)
instance RenderJS JSBinOp where
(|>) pacc (JSBinOpAnd annot) = pacc |> annot |> "&&"
(|>) pacc (JSBinOpAs annot) = pacc |> annot |> "as"
(|>) pacc (JSBinOpBitAnd annot) = pacc |> annot |> "&"
(|>) pacc (JSBinOpBitOr annot) = pacc |> annot |> "|"
(|>) pacc (JSBinOpBitXor annot) = pacc |> annot |> "^"
(|>) pacc (JSBinOpDivide annot) = pacc |> annot |> "/"
(|>) pacc (JSBinOpEq annot) = pacc |> annot |> "=="
(|>) pacc (JSBinOpGe annot) = pacc |> annot |> ">="
(|>) pacc (JSBinOpGt annot) = pacc |> annot |> ">"
(|>) pacc (JSBinOpIn annot) = pacc |> annot |> "in"
(|>) pacc (JSBinOpInstanceOf annot) = pacc |> annot |> "instanceof"
(|>) pacc (JSBinOpLe annot) = pacc |> annot |> "<="
(|>) pacc (JSBinOpLsh annot) = pacc |> annot |> "<<"
(|>) pacc (JSBinOpLt annot) = pacc |> annot |> "<"
(|>) pacc (JSBinOpMinus annot) = pacc |> annot |> "-"
(|>) pacc (JSBinOpMod annot) = pacc |> annot |> "%"
(|>) pacc (JSBinOpNeq annot) = pacc |> annot |> "!="
(|>) pacc (JSBinOpOf annot) = pacc |> annot |> "of"
(|>) pacc (JSBinOpOr annot) = pacc |> annot |> "||"
(|>) pacc (JSBinOpPlus annot) = pacc |> annot |> "+"
(|>) pacc (JSBinOpRsh annot) = pacc |> annot |> ">>"
(|>) pacc (JSBinOpStrictEq annot) = pacc |> annot |> "==="
(|>) pacc (JSBinOpStrictNeq annot) = pacc |> annot |> "!=="
(|>) pacc (JSBinOpTimes annot) = pacc |> annot |> "*"
(|>) pacc (JSBinOpUrsh annot) = pacc |> annot |> ">>>"
instance RenderJS JSUnaryOp where
(|>) pacc (JSUnaryOpDecr annot) = pacc |> annot |> "--"
(|>) pacc (JSUnaryOpDelete annot) = pacc |> annot |> "delete"
(|>) pacc (JSUnaryOpIncr annot) = pacc |> annot |> "++"
(|>) pacc (JSUnaryOpMinus annot) = pacc |> annot |> "-"
(|>) pacc (JSUnaryOpNot annot) = pacc |> annot |> "!"
(|>) pacc (JSUnaryOpPlus annot) = pacc |> annot |> "+"
(|>) pacc (JSUnaryOpTilde annot) = pacc |> annot |> "~"
(|>) pacc (JSUnaryOpTypeof annot) = pacc |> annot |> "typeof"
(|>) pacc (JSUnaryOpVoid annot) = pacc |> annot |> "void"
instance RenderJS JSAssignOp where
(|>) pacc (JSAssign annot) = pacc |> annot |> "="
(|>) pacc (JSTimesAssign annot) = pacc |> annot |> "*="
(|>) pacc (JSDivideAssign annot) = pacc |> annot |> "/="
(|>) pacc (JSModAssign annot) = pacc |> annot |> "%="
(|>) pacc (JSPlusAssign annot) = pacc |> annot |> "+="
(|>) pacc (JSMinusAssign annot) = pacc |> annot |> "-="
(|>) pacc (JSLshAssign annot) = pacc |> annot |> "<<="
(|>) pacc (JSRshAssign annot) = pacc |> annot |> ">>="
(|>) pacc (JSUrshAssign annot) = pacc |> annot |> ">>>="
(|>) pacc (JSBwAndAssign annot) = pacc |> annot |> "&="
(|>) pacc (JSBwXorAssign annot) = pacc |> annot |> "^="
(|>) pacc (JSBwOrAssign annot) = pacc |> annot |> "|="
instance RenderJS JSSemi where
(|>) pacc (JSSemi annot) = pacc |> annot |> ";"
(|>) pacc JSSemiAuto = pacc
instance RenderJS JSTryCatch where
(|>) pacc (JSCatch anc alb x1 arb x3) = pacc |> anc |> "catch" |> alb |> "(" |> x1 |> arb |> ")" |> x3
(|>) pacc (JSCatchIf anc alb x1 aif ex arb x3) = pacc |> anc |> "catch" |> alb |> "(" |> x1 |> aif |> "if" |> ex |> arb |> ")" |> x3
instance RenderJS [JSTryCatch] where
(|>) = foldl' (|>)
instance RenderJS JSTryFinally where
(|>) pacc (JSFinally annot x) = pacc |> annot |> "finally" |> x
(|>) pacc JSNoFinally = pacc
instance RenderJS JSSwitchParts where
(|>) pacc (JSCase annot x1 c x2s) = pacc |> annot |> "case" |> x1 |> c |> ":" |> x2s
(|>) pacc (JSDefault annot c xs) = pacc |> annot |> "default" |> c |> ":" |> xs
instance RenderJS [JSSwitchParts] where
(|>) = foldl' (|>)
instance RenderJS JSStatement where
(|>) pacc (JSStatementBlock alb blk arb s) = pacc |> alb |> "{" |> blk |> arb |> "}" |> s
(|>) pacc (JSBreak annot mi s) = pacc |> annot |> "break" |> mi |> s
(|>) pacc (JSContinue annot mi s) = pacc |> annot |> "continue" |> mi |> s
(|>) pacc (JSConstant annot xs s) = pacc |> annot |> "const" |> xs |> s
(|>) pacc (JSDoWhile ad x1 aw alb x2 arb x3) = pacc |> ad |> "do" |> x1 |> aw |> "while" |> alb |> "(" |> x2 |> arb |> ")" |> x3
(|>) pacc (JSEmptyStatement a) = pacc |> a |> ";"
(|>) pacc (JSFor af alb x1s s1 x2s s2 x3s arb x4) = pacc |> af |> "for" |> alb |> "(" |> x1s |> s1 |> ";" |> x2s |> s2 |> ";" |> x3s |> arb |> ")" |> x4
(|>) pacc (JSForIn af alb x1s i x2 arb x3) = pacc |> af |> "for" |> alb |> "(" |> x1s |> i |> x2 |> arb |> ")" |> x3
(|>) pacc (JSForVar af alb v x1s s1 x2s s2 x3s arb x4) = pacc |> af |> "for" |> alb |> "(" |> "var" |> v |> x1s |> s1 |> ";" |> x2s |> s2 |> ";" |> x3s |> arb |> ")" |> x4
(|>) pacc (JSForVarIn af alb v x1 i x2 arb x3) = pacc |> af |> "for" |> alb |> "(" |> "var" |> v |> x1 |> i |> x2 |> arb |> ")" |> x3
(|>) pacc (JSForLet af alb v x1s s1 x2s s2 x3s arb x4) = pacc |> af |> "for" |> alb |> "(" |> "let" |> v |> x1s |> s1 |> ";" |> x2s |> s2 |> ";" |> x3s |> arb |> ")" |> x4
(|>) pacc (JSForLetIn af alb v x1 i x2 arb x3) = pacc |> af |> "for" |> alb |> "(" |> "let" |> v |> x1 |> i |> x2 |> arb |> ")" |> x3
(|>) pacc (JSForLetOf af alb v x1 i x2 arb x3) = pacc |> af |> "for" |> alb |> "(" |> "let" |> v |> x1 |> i |> x2 |> arb |> ")" |> x3
(|>) pacc (JSForOf af alb x1s i x2 arb x3) = pacc |> af |> "for" |> alb |> "(" |> x1s |> i |> x2 |> arb |> ")" |> x3
(|>) pacc (JSForVarOf af alb v x1 i x2 arb x3) = pacc |> af |> "for" |> alb |> "(" |> "var" |> v |> x1 |> i |> x2 |> arb |> ")" |> x3
(|>) pacc (JSFunction af n alb x2s arb x3 s) = pacc |> af |> "function" |> n |> alb |> "(" |> x2s |> arb |> ")" |> x3 |> s
(|>) pacc (JSIf annot alb x1 arb x2s) = pacc |> annot |> "if" |> alb |> "(" |> x1 |> arb |> ")" |> x2s
(|>) pacc (JSIfElse annot alb x1 arb x2s ea x3s) = pacc |> annot |> "if" |> alb |> "(" |> x1 |> arb |> ")" |> x2s |> ea |> "else" |> x3s
(|>) pacc (JSLabelled l c v) = pacc |> l |> c |> ":" |> v
(|>) pacc (JSLet annot xs s) = pacc |> annot |> "let" |> xs |> s
(|>) pacc (JSExpressionStatement l s) = pacc |> l |> s
(|>) pacc (JSAssignStatement lhs op rhs s) = pacc |> lhs |> op |> rhs |> s
(|>) pacc (JSMethodCall e lp a rp s) = pacc |> e |> lp |> "(" |> a |> rp |> ")" |> s
(|>) pacc (JSReturn annot me s) = pacc |> annot |> "return" |> me |> s
(|>) pacc (JSSwitch annot alp x arp alb x2 arb s) = pacc |> annot |> "switch" |> alp |> "(" |> x |> arp |> ")" |> alb |> "{" |> x2 |> arb |> "}" |> s
(|>) pacc (JSThrow annot x s) = pacc |> annot |> "throw" |> x |> s
(|>) pacc (JSTry annot tb tcs tf) = pacc |> annot |> "try" |> tb |> tcs |> tf
(|>) pacc (JSVariable annot xs s) = pacc |> annot |> "var" |> xs |> s
(|>) pacc (JSWhile annot alp x1 arp x2) = pacc |> annot |> "while" |> alp |> "(" |> x1 |> arp |> ")" |> x2
(|>) pacc (JSWith annot alp x1 arp x s) = pacc |> annot |> "with" |> alp |> "(" |> x1 |> arp |> ")" |> x |> s
instance RenderJS [JSStatement] where
(|>) = foldl' (|>)
instance RenderJS [JSModuleItem] where
(|>) = foldl' (|>)
instance RenderJS JSModuleItem where
(|>) pacc (JSModuleImportDeclaration annot decl) = pacc |> annot |> "import" |> decl
(|>) pacc (JSModuleExportDeclaration annot decl) = pacc |> annot |> "export" |> decl
(|>) pacc (JSModuleStatementListItem s) = pacc |> s
instance RenderJS JSBlock where
(|>) pacc (JSBlock alb ss arb) = pacc |> alb |> "{" |> ss |> arb |> "}"
instance RenderJS JSObjectProperty where
(|>) pacc (JSPropertyAccessor s n alp ps arp b) = pacc |> s |> n |> alp |> "(" |> ps |> arp |> ")" |> b
(|>) pacc (JSPropertyNameandValue n c vs) = pacc |> n |> c |> ":" |> vs
instance RenderJS JSPropertyName where
(|>) pacc (JSPropertyIdent a s) = pacc |> a |> s
(|>) pacc (JSPropertyString a s) = pacc |> a |> s
(|>) pacc (JSPropertyNumber a s) = pacc |> a |> s
instance RenderJS JSAccessor where
(|>) pacc (JSAccessorGet annot) = pacc |> annot |> "get"
(|>) pacc (JSAccessorSet annot) = pacc |> annot |> "set"
instance RenderJS JSArrayElement where
(|>) pacc (JSArrayElement e) = pacc |> e
(|>) pacc (JSArrayComma a) = pacc |> a |> ","
instance RenderJS [JSArrayElement] where
(|>) = foldl' (|>)
instance RenderJS JSImportDeclaration where
(|>) pacc (JSImportDeclaration imp from annot) = pacc |> imp |> from |> annot
instance RenderJS JSImportClause where
(|>) pacc (JSImportClauseDefault x) = pacc |> x
(|>) pacc (JSImportClauseNameSpace x) = pacc |> x
(|>) pacc (JSImportClauseNamed x) = pacc |> x
(|>) pacc (JSImportClauseDefaultNameSpace x1 annot x2) = pacc |> x1 |> annot |> "," |> x2
(|>) pacc (JSImportClauseDefaultNamed x1 annot x2) = pacc |> x1 |> annot |> "," |> x2
instance RenderJS JSFromClause where
(|>) pacc (JSFromClause from annot m) = pacc |> from |> "from" |> annot |> m
instance RenderJS JSImportNameSpace where
(|>) pacc (JSImportNameSpace star as x) = pacc |> star |> as |> x
instance RenderJS JSImportsNamed where
(|>) pacc (JSImportsNamed lb xs rb) = pacc |> lb |> "{" |> xs |> rb |> "}"
instance RenderJS JSImportSpecifier where
(|>) pacc (JSImportSpecifier x1) = pacc |> x1
(|>) pacc (JSImportSpecifierAs x1 as x2) = pacc |> x1 |> as |> x2
instance RenderJS JSExportDeclaration where
(|>) pacc (JSExport x1 s) = pacc |> " " |> x1 |> s
(|>) pacc (JSExportLocals alb JSLNil arb semi) = pacc |> alb |> "{" |> arb |> "}" |> semi
(|>) pacc (JSExportLocals alb s arb semi) = pacc |> alb |> "{" |> s |> arb |> "}" |> semi
instance RenderJS JSExportLocalSpecifier where
(|>) pacc (JSExportLocalSpecifier i) = pacc |> i
(|>) pacc (JSExportLocalSpecifierAs x1 as x2) = pacc |> x1 |> as |> x2
instance RenderJS a => RenderJS (JSCommaList a) where
(|>) pacc (JSLCons pl a i) = pacc |> pl |> a |> "," |> i
(|>) pacc (JSLOne i) = pacc |> i
(|>) pacc JSLNil = pacc
instance RenderJS a => RenderJS (JSCommaTrailingList a) where
(|>) pacc (JSCTLComma xs a) = pacc |> xs |> a |> ","
(|>) pacc (JSCTLNone xs) = pacc |> xs
instance RenderJS JSIdent where
(|>) pacc (JSIdentName a s) = pacc |> a |> s
(|>) pacc JSIdentNone = pacc
instance RenderJS (Maybe JSExpression) where
(|>) pacc (Just e) = pacc |> e
(|>) pacc Nothing = pacc
instance RenderJS JSVarInitializer where
(|>) pacc (JSVarInit a x) = pacc |> a |> "=" |> x
(|>) pacc JSVarInitNone = pacc
-- EOF