git.iko.soy/elk
on 740341f help sign in
elk/src/Generate/JavaScript/Builder.hs
521 lines 11 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Generate.JavaScript.Builder
4 ( stmtToBuilder
5 , exprToBuilder
6 , Expr(..), LValue(..)
7 , Stmt(..), Case(..)
8 , InfixOp(..), PrefixOp(..)
9 )
10 where
12-- Based on the language-ecmascript package.
13-- https://hackage.haskell.org/package/language-ecmascript
14-- They did the hard work of reading the spec to figure out
15-- how all the types should fit together.
17import Prelude hiding (lines)
18import qualified Data.List as List
19import Data.ByteString.Builder as B
20import Data.Monoid ((<>))
21import qualified Generate.JavaScript.Name as Name
22import Generate.JavaScript.Name (Name)
26-- EXPRESSIONS
29data Expr
30 = String Builder
31 | Float Double
32 | Int Int
33 | Bool Bool
34 | Null
35 | Array [Expr]
36 | Object [(Name, Expr)]
37 | Ref Name
38 | Access Expr Name -- ^ @foo.bar@, spec 11.2.1
39 | Index Expr Expr -- ^ @foo[bar]@, spec 11.2.1
40 | Prefix PrefixOp Expr
41 | Infix InfixOp Expr Expr
42 | If Expr Expr Expr
43 | Assign LValue Expr
44 | Call Expr [Expr] -- ^ @f(x,y,z)@, spec 11.2.3
45 | Function (Maybe Name) [Name] [Stmt]
48data LValue
49 = LRef Name
50 | LDot Expr Name
51 | LBracket Expr Expr
55-- STATEMENTS
58data Stmt
59 = Block [Stmt] -- {stmts}
60 | EmptyStmt -- ;
61 | ExprStmt Expr -- expr;
62 | IfStmt Expr Stmt Stmt -- if (e) stmt1 else stmt2
63 | Switch Expr [Case] -- switch (e) clauses
64 | While Expr Stmt -- while (e) do stmt
65 | Break (Maybe Name) -- break lab;
66 | Continue (Maybe Name) -- continue lab;
67 | Labelled Name Stmt -- lab: stmt
68 | Return (Maybe Expr) -- return expr;
69 | Var [(Name, Maybe Expr)] -- var x, y=42;
70 | FunctionStmt Name [Name] [Stmt] -- function f(x, y, z) {...}
73data Case
74 = Case Expr [Stmt]
75 | Default [Stmt]
79-- OPERATORS
82data InfixOp
83 = OpLT -- <
84 | OpLEq -- <=
85 | OpGT -- >
86 | OpGEq -- >=
87 | OpIn -- in
88 | OpInstanceof -- instanceof
89 | OpEq -- ==
90 | OpNEq -- !=
91 | OpStrictEq -- ===
92 | OpStrictNEq -- !===
93 | OpLAnd -- &&
94 | OpLOr -- ||
95 | OpMul -- *
96 | OpDiv -- /
97 | OpMod -- %
98 | OpSub -- -
99 | OpLShift -- <<
100 | OpSpRShift -- >>
101 | OpZfRShift -- >>>
102 | OpBAnd -- &
103 | OpBXor -- ^
104 | OpBOr -- |
105 | OpAdd -- +
108data PrefixOp
109 = PrefixLNot -- !
110 | PrefixBNot -- ~
111 | PrefixPlus -- +
112 | PrefixMinus -- -
113 | PrefixTypeof -- typeof
117-- ENCODE
120stmtToBuilder :: Stmt -> Builder
121stmtToBuilder stmts =
122 fromStmt "" stmts
125exprToBuilder :: Expr -> Builder
126exprToBuilder expr =
127 snd $ fromExpr "" Whatever expr
131-- HELPERS
134deeper :: Builder -> Builder
135deeper indent =
136 "\t" <> indent
139commaSep :: [Builder] -> Builder
140commaSep builders =
141 mconcat (List.intersperse ", " builders)
144commaNewlineSep :: Builder -> [Builder] -> Builder
145commaNewlineSep indent builders =
146 mconcat (List.intersperse (",\n" <> deeper indent) builders)
150-- STATEMENTS
153fromStmtBlock :: Builder -> [Stmt] -> Builder
154fromStmtBlock indent stmts =
155 mconcat (map (fromStmt indent) stmts)
158fromStmt :: Builder -> Stmt -> Builder
159fromStmt indent statement =
160 case statement of
161 Block stmts ->
162 fromStmtBlock indent stmts
164 EmptyStmt ->
165 mempty
167 ExprStmt expr ->
168 indent <> snd (fromExpr indent Whatever expr) <> ";\n"
170 IfStmt condition thenStmt elseStmt ->
171 mconcat
172 [ indent, "if (", snd (fromExpr indent Whatever condition), ") {\n"
173 , fromStmt (deeper indent) thenStmt
174 , indent, "} else {\n"
175 , fromStmt (deeper indent) elseStmt
176 , indent, "}\n"
177 ]
179 Switch expr clauses ->
180 mconcat
181 [ indent, "switch (", snd (fromExpr indent Whatever expr), ") {\n"
182 , mconcat (map (fromClause (deeper indent)) clauses)
183 , indent, "}\n"
184 ]
186 While expr stmt ->
187 mconcat
188 [ indent, "while (", snd (fromExpr indent Whatever expr), ") {\n"
189 , fromStmt (deeper indent) stmt
190 , indent, "}\n"
191 ]
193 Break Nothing ->
194 indent <> "break;\n"
196 Break (Just label) ->
197 indent <> "break " <> Name.toBuilder label <> ";\n"
199 Continue Nothing ->
200 indent <> "continue;\n"
202 Continue (Just label) ->
203 indent <> "continue " <> Name.toBuilder label <> ";\n"
205 Labelled label stmt ->
206 mconcat
207 [ indent, Name.toBuilder label, ":\n"
208 , fromStmt indent stmt
209 ]
211 Return Nothing ->
212 indent <> "return;\n"
214 Return (Just expr) ->
215 indent <> "return " <> snd (fromExpr indent Whatever expr) <> ";\n"
217 Var [] ->
218 mempty
220 Var vars ->
221 indent <> "var " <> commaNewlineSep indent (map (varToBuilder indent) vars) <> ";\n"
223 FunctionStmt name args stmts ->
224 indent <> "function " <> Name.toBuilder name <> "(" <> commaSep (map Name.toBuilder args) <> ") {\n"
225 <>
226 fromStmtBlock (deeper indent) stmts
227 <>
228 indent <> "}\n"
232-- SWITCH CLAUSES
235fromClause :: Builder -> Case -> Builder
236fromClause indent clause =
237 case clause of
238 Case expr stmts ->
239 indent <> "case " <> snd (fromExpr indent Whatever expr) <> ":\n"
240 <> fromStmtBlock (deeper indent) stmts
242 Default stmts ->
243 indent <> "default:\n"
244 <> fromStmtBlock (deeper indent) stmts
248-- VAR DECLS
251varToBuilder :: Builder -> (Name, Maybe Expr) -> Builder
252varToBuilder indent (name, maybeExpr) =
253 case maybeExpr of
254 Nothing ->
255 Name.toBuilder name
257 Just expr ->
258 Name.toBuilder name <> " = " <> snd (fromExpr indent Whatever expr)
262-- EXPRESSIONS
265data Lines = One | Many deriving (Eq)
268merge :: Lines -> Lines -> Lines
269merge a b =
270 if a == Many || b == Many then Many else One
273linesMap :: (a -> (Lines, b)) -> [a] -> (Bool, [b])
274linesMap func xs =
275 let
276 pairs =
277 map func xs
278 in
279 ( any ((==) Many . fst) pairs
280 , map snd pairs
281 )
284data Grouping = Atomic | Whatever
287parensFor :: Grouping -> Builder -> Builder
288parensFor grouping builder =
289 case grouping of
290 Atomic ->
291 "(" <> builder <> ")"
293 Whatever ->
294 builder
297fromExpr :: Builder -> Grouping -> Expr -> (Lines, Builder)
298fromExpr indent grouping expression =
299 case expression of
300 String string ->
301 (One, "'" <> string <> "'")
303 Float n ->
304 (One, B.doubleDec n)
306 Int n ->
307 (One, B.intDec n)
309 Bool bool ->
310 (One, if bool then "true" else "false")
312 Null ->
313 (One, "null")
315 Array exprs ->
316 (,) Many $
317 let
318 (anyMany, builders) =
319 linesMap (fromExpr indent Whatever) exprs
320 in
321 if anyMany then
322 "[\n"
323 <> deeper indent
324 <> commaNewlineSep indent builders
325 <> "\n" <> indent <> "]"
327 else
328 "[" <> commaSep builders <> "]"
330 Object fields ->
331 (,) Many $
332 let
333 deeperIndent =
334 deeper indent
336 (anyMany, builders) =
337 linesMap (fromField deeperIndent) fields
338 in
339 if anyMany then
340 "{\n"
341 <> deeperIndent
342 <> commaNewlineSep indent builders
343 <> "\n" <> indent <> "}"
345 else
346 "{" <> commaSep builders <> "}"
348 Ref name ->
349 (One, Name.toBuilder name)
351 Access expr field ->
352 makeDot indent expr field
354 Index expr bracketedExpr ->
355 makeBracketed indent expr bracketedExpr
357 Prefix op expr ->
358 let
359 (lines, builder) =
360 fromExpr indent Atomic expr
361 in
362 ( lines
363 , parensFor grouping (fromPrefix op <> builder)
364 )
366 Infix op leftExpr rightExpr ->
367 let
368 (leftLines, left) =
369 fromExpr indent Atomic leftExpr
371 (rightLines, right) =
372 fromExpr indent Atomic rightExpr
373 in
374 ( merge leftLines rightLines
375 , parensFor grouping (left <> fromInfix op <> right)
376 )
378 If condExpr thenExpr elseExpr ->
379 let
380 condB = snd (fromExpr indent Atomic condExpr)
381 thenB = snd (fromExpr indent Atomic thenExpr)
382 elseB = snd (fromExpr indent Atomic elseExpr)
383 in
384 ( Many
385 , parensFor grouping (condB <> " ? " <> thenB <> " : " <> elseB)
386 )
388 Assign lValue expr ->
389 let
390 (leftLines, left) =
391 fromLValue indent lValue
393 (rightLines, right) =
394 fromExpr indent Whatever expr
395 in
396 ( merge leftLines rightLines
397 , parensFor grouping (left <> " = " <> right)
398 )
400 Call function args ->
401 (,) Many $
402 let
403 deeperIndent =
404 deeper indent
406 funcB =
407 snd (fromExpr indent Atomic function)
409 (anyMany, argsB) =
410 linesMap (fromExpr deeperIndent Whatever) args
411 in
412 if anyMany then
413 funcB <> "(\n" <> deeperIndent <> commaNewlineSep indent argsB <> ")"
415 else
416 funcB <> "(" <> commaSep argsB <> ")"
418 Function maybeName args stmts ->
419 (,) Many $
420 "function " <> maybe mempty Name.toBuilder maybeName <> "(" <> commaSep (map Name.toBuilder args) <> ") {\n"
421 <>
422 fromStmtBlock (deeper indent) stmts
423 <>
424 indent <> "}"
428-- FIELDS
431fromField :: Builder -> (Name, Expr) -> (Lines, Builder)
432fromField indent (field, expr) =
433 let
434 (lines, builder) =
435 fromExpr indent Whatever expr
436 in
437 ( lines
438 , Name.toBuilder field <> ": " <> builder
439 )
443-- VALUES
446fromLValue :: Builder -> LValue -> (Lines, Builder)
447fromLValue indent lValue =
448 case lValue of
449 LRef name ->
450 (One, Name.toBuilder name)
452 LDot expr field ->
453 makeDot indent expr field
455 LBracket expr bracketedExpr ->
456 makeBracketed indent expr bracketedExpr
459makeDot :: Builder -> Expr -> Name -> (Lines, Builder)
460makeDot indent expr field =
461 let
462 (lines, builder) =
463 fromExpr indent Atomic expr
464 in
465 (lines, builder <> "." <> Name.toBuilder field)
468makeBracketed :: Builder -> Expr -> Expr -> (Lines, Builder)
469makeBracketed indent expr bracketedExpr =
470 let
471 (lines, builder) =
472 fromExpr indent Atomic expr
474 (bracketedLines, bracketedBuilder) =
475 fromExpr indent Whatever bracketedExpr
476 in
477 ( merge lines bracketedLines
478 , builder <> "[" <> bracketedBuilder <> "]"
479 )
483-- OPERATORS
486fromPrefix :: PrefixOp -> Builder
487fromPrefix op =
488 case op of
489 PrefixLNot -> "!"
490 PrefixBNot -> "~"
491 PrefixPlus -> "+"
492 PrefixMinus -> "-"
493 PrefixTypeof -> "typeof "
496fromInfix :: InfixOp -> Builder
497fromInfix op =
498 case op of
499 OpLT -> " < "
500 OpLEq -> " <= "
501 OpGT -> " > "
502 OpGEq -> " >= "
503 OpIn -> " in "
504 OpInstanceof -> " instanceof "
505 OpEq -> " == "
506 OpNEq -> " != "
507 OpStrictEq -> " === "
508 OpStrictNEq -> " !=== "
509 OpLAnd -> " && "
510 OpLOr -> " || "
511 OpMul -> " * "
512 OpDiv -> " / "
513 OpMod -> " % "
514 OpSub -> " - "
515 OpLShift -> " << "
516 OpSpRShift -> " >> "
517 OpZfRShift -> " >>> "
518 OpBAnd -> " & "
519 OpBXor -> " ^ "
520 OpBOr -> " | "
521 OpAdd -> " + "