git.iko.soy/elk
on 86148e8 help sign in
elk/src/Generate/JavaScript/Builder.hs
552 lines 12 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Generate.JavaScript.Builder
4 ( stmtToBuilder
5 , exprToBuilder
6 , Expr(..), Id(..), LValue(..)
7 , Stmt(..), Case(..), VarDecl(..)
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
20import Data.Monoid ((<>))
21import Data.Text (Text)
22import qualified Data.Text.Encoding as Text
26-- EXPRESSIONS
29data Expr
30 = String Text
31 | Float Double
32 | Int Int
33 | Bool Bool
34 | Null
35 | Array [Expr]
36 | Object [(Id, Expr)]
37 | VarRef Id
38 | DotRef Expr Id -- ^ @foo.bar@, spec 11.2.1
39 | BracketRef 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 Id) [Id] [Stmt]
48newtype Id = Id Text
51data LValue
52 = LVar Text
53 | LDot Expr Text
54 | LBracket Expr Expr
58-- STATEMENTS
61data Stmt
62 = Block [Stmt] -- {stmts}
63 | EmptyStmt -- ;
64 | ExprStmt Expr -- expr;
65 | IfStmt Expr Stmt Stmt -- if (e) stmt1 else stmt2
66 | IfSingleStmt Expr Stmt -- if (e) stmt
67 | Switch Expr [Case] -- switch (e) clauses
68 | While Expr Stmt -- while (e) do stmt
69 | DoWhile Stmt Expr -- do stmt while (e);
70 | Break (Maybe Id) -- break lab;
71 | Continue (Maybe Id) -- continue lab;
72 | Labelled Id Stmt -- lab: stmt
73 | Return (Maybe Expr) -- return expr;
74 | VarDeclStmt [VarDecl] -- var x, y=42;
75 | FunctionStmt Id [Id] [Stmt] -- function f(x, y, z) {...}
78data Case
79 = Case Expr [Stmt]
80 | Default [Stmt]
83data VarDecl = VarDecl Id (Maybe Expr)
87-- OPERATORS
90data InfixOp
91 = OpLT -- <
92 | OpLEq -- <=
93 | OpGT -- >
94 | OpGEq -- >=
95 | OpIn -- in
96 | OpInstanceof -- instanceof
97 | OpEq -- ==
98 | OpNEq -- !=
99 | OpStrictEq -- ===
100 | OpStrictNEq -- !===
101 | OpLAnd -- &&
102 | OpLOr -- ||
103 | OpMul -- *
104 | OpDiv -- /
105 | OpMod -- %
106 | OpSub -- -
107 | OpLShift -- <<
108 | OpSpRShift -- >>
109 | OpZfRShift -- >>>
110 | OpBAnd -- &
111 | OpBXor -- ^
112 | OpBOr -- |
113 | OpAdd -- +
116data PrefixOp
117 = PrefixLNot -- !
118 | PrefixBNot -- ~
119 | PrefixPlus -- +
120 | PrefixMinus -- -
121 | PrefixTypeof -- typeof
125-- ENCODE
128stmtToBuilder :: Stmt -> Builder
129stmtToBuilder stmts =
130 fromStmt "" stmts
133exprToBuilder :: Expr -> Builder
134exprToBuilder expr =
135 snd $ fromExpr "" Whatever expr
139-- HELPERS
142deeper :: Builder -> Builder
143deeper indent =
144 "\t" <> indent
147commaSep :: [Builder] -> Builder
148commaSep builders =
149 mconcat (List.intersperse ", " builders)
152commaNewlineSep :: Builder -> [Builder] -> Builder
153commaNewlineSep indent builders =
154 mconcat (List.intersperse (",\n" <> deeper indent) builders)
158-- STATEMENTS
161fromStmtBlock :: Builder -> [Stmt] -> Builder
162fromStmtBlock indent stmts =
163 mconcat (map (fromStmt indent) stmts)
166fromStmt :: Builder -> Stmt -> Builder
167fromStmt indent statement =
168 case statement of
169 Block stmts ->
170 fromStmtBlock indent stmts
172 EmptyStmt ->
173 mempty
175 ExprStmt expr ->
176 indent <> snd (fromExpr indent Whatever expr) <> ";\n"
178 IfStmt condition thenStmt elseStmt ->
179 mconcat
180 [ indent, "if (", snd (fromExpr indent Whatever condition), ") {\n"
181 , fromStmt (deeper indent) thenStmt
182 , indent, "} else {\n"
183 , fromStmt (deeper indent) elseStmt
184 , indent, "}\n"
185 ]
187 IfSingleStmt condition thenStmt ->
188 mconcat
189 [ indent, "if (", snd (fromExpr indent Whatever condition), ") {\n"
190 , fromStmt (deeper indent) thenStmt
191 , indent, "}\n"
192 ]
194 Switch expr clauses ->
195 mconcat
196 [ indent, "switch (", snd (fromExpr indent Whatever expr), ") {\n"
197 , mconcat (map (fromClause (deeper indent)) clauses)
198 , indent, "}\n"
199 ]
201 While expr stmt ->
202 mconcat
203 [ indent, "while (", snd (fromExpr indent Whatever expr), ") {\n"
204 , fromStmt (deeper indent) stmt
205 , indent, "}\n"
206 ]
208 DoWhile stmt expr ->
209 mconcat
210 [ indent, "do {\n"
211 , fromStmt (deeper indent) stmt
212 , indent, "} while(", snd (fromExpr indent Whatever expr), ");\n"
213 ]
215 Break Nothing ->
216 indent <> "break;\n"
218 Break (Just label) ->
219 indent <> "break " <> fromId label <> ";\n"
221 Continue Nothing ->
222 indent <> "continue;\n"
224 Continue (Just label) ->
225 indent <> "continue " <> fromId label <> ";\n"
227 Labelled label stmt ->
228 mconcat
229 [ indent, fromId label, ":\n"
230 , fromStmt indent stmt
231 ]
233 Return Nothing ->
234 indent <> "return;\n"
236 Return (Just expr) ->
237 indent <> "return " <> snd (fromExpr indent Whatever expr) <> ";\n"
239 VarDeclStmt [] ->
240 mempty
242 VarDeclStmt decls ->
243 indent <> "var " <> commaNewlineSep indent (map (fromVarDecl indent) decls) <> ";\n"
245 FunctionStmt name args stmts ->
246 indent <> "function " <> fromId name <> "(" <> commaSep (map fromId args) <> ") {\n"
247 <>
248 fromStmtBlock (deeper indent) stmts
249 <>
250 indent <> "}\n"
254-- SWITCH CLAUSES
257fromClause :: Builder -> Case -> Builder
258fromClause indent clause =
259 case clause of
260 Case expr stmts ->
261 indent <> "case " <> snd (fromExpr indent Whatever expr) <> ":\n"
262 <> fromStmtBlock (deeper indent) stmts
264 Default stmts ->
265 indent <> "default:\n"
266 <> fromStmtBlock (deeper indent) stmts
270-- ID
273fromId :: Id -> Builder
274fromId (Id name) =
275 Text.encodeUtf8Builder name
279-- VAR DECLS
282fromVarDecl :: Builder -> VarDecl -> Builder
283fromVarDecl indent (VarDecl (Id name) maybeExpr) =
284 case maybeExpr of
285 Nothing ->
286 Text.encodeUtf8Builder name
288 Just expr ->
289 Text.encodeUtf8Builder name <> " = " <> snd (fromExpr indent Whatever expr)
293-- EXPRESSIONS
296data Lines = One | Many deriving (Eq)
299merge :: Lines -> Lines -> Lines
300merge a b =
301 if a == Many || b == Many then Many else One
304linesMap :: (a -> (Lines, b)) -> [a] -> (Bool, [b])
305linesMap func xs =
306 let
307 pairs =
308 map func xs
309 in
310 ( any ((==) Many . fst) pairs
311 , map snd pairs
312 )
315data Grouping = Atomic | Whatever
318parensFor :: Grouping -> Builder -> Builder
319parensFor grouping builder =
320 case grouping of
321 Atomic ->
322 "(" <> builder <> ")"
324 Whatever ->
325 builder
328fromExpr :: Builder -> Grouping -> Expr -> (Lines, Builder)
329fromExpr indent grouping expression =
330 case expression of
331 String string ->
332 (One, "'" <> Text.encodeUtf8Builder string <> "'")
334 Float n ->
335 (One, doubleDec n)
337 Int n ->
338 (One, intDec n)
340 Bool bool ->
341 (One, if bool then "true" else "false")
343 Null ->
344 (One, "null")
346 Array exprs ->
347 (,) Many $
348 let
349 (anyMany, builders) =
350 linesMap (fromExpr indent Whatever) exprs
351 in
352 if anyMany then
353 "[\n"
354 <> deeper indent
355 <> commaNewlineSep indent builders
356 <> "\n" <> indent <> "]"
358 else
359 "[" <> commaSep builders <> "]"
361 Object fields ->
362 (,) Many $
363 let
364 deeperIndent =
365 deeper indent
367 (anyMany, builders) =
368 linesMap (fromField deeperIndent) fields
369 in
370 if anyMany then
371 "{\n"
372 <> deeperIndent
373 <> commaNewlineSep indent builders
374 <> "\n" <> indent <> "}"
376 else
377 "{" <> commaSep builders <> "}"
379 VarRef name ->
380 (One, fromId name)
382 DotRef expr (Id name) ->
383 makeDot indent expr name
385 BracketRef expr bracketedExpr ->
386 makeBracketed indent expr bracketedExpr
388 Prefix op expr ->
389 let
390 (lines, builder) =
391 fromExpr indent Atomic expr
392 in
393 ( lines
394 , parensFor grouping (fromPrefix op <> builder)
395 )
397 Infix op leftExpr rightExpr ->
398 let
399 (leftLines, left) =
400 fromExpr indent Atomic leftExpr
402 (rightLines, right) =
403 fromExpr indent Atomic rightExpr
404 in
405 ( merge leftLines rightLines
406 , parensFor grouping (left <> fromInfix op <> right)
407 )
409 If condExpr thenExpr elseExpr ->
410 let
411 condB = snd (fromExpr indent Atomic condExpr)
412 thenB = snd (fromExpr indent Atomic thenExpr)
413 elseB = snd (fromExpr indent Atomic elseExpr)
414 in
415 ( Many
416 , parensFor grouping (condB <> " ? " <> thenB <> " : " <> elseB)
417 )
419 Assign lValue expr ->
420 let
421 (leftLines, left) =
422 fromLValue indent lValue
424 (rightLines, right) =
425 fromExpr indent Whatever expr
426 in
427 ( merge leftLines rightLines
428 , parensFor grouping (left <> " = " <> right)
429 )
431 Call function args ->
432 (,) Many $
433 let
434 deeperIndent =
435 deeper indent
437 funcB =
438 snd (fromExpr indent Atomic function)
440 (anyMany, argsB) =
441 linesMap (fromExpr deeperIndent Whatever) args
442 in
443 if anyMany then
444 funcB <> "(\n" <> deeperIndent <> commaNewlineSep indent argsB <> ")"
446 else
447 funcB <> "(" <> commaSep argsB <> ")"
449 Function maybeName args stmts ->
450 (,) Many $
451 "function " <> maybe mempty fromId maybeName <> "(" <> commaSep (map fromId args) <> ") {\n"
452 <>
453 fromStmtBlock (deeper indent) stmts
454 <>
455 indent <> "}"
459-- FIELDS
462fromField :: Builder -> (Id, Expr) -> (Lines, Builder)
463fromField indent (field, expr) =
464 let
465 (lines, builder) =
466 fromExpr indent Whatever expr
467 in
468 ( lines
469 , fromId field <> ": " <> builder
470 )
474-- VALUES
477fromLValue :: Builder -> LValue -> (Lines, Builder)
478fromLValue indent lValue =
479 case lValue of
480 LVar name ->
481 (One, Text.encodeUtf8Builder name)
483 LDot expr field ->
484 makeDot indent expr field
486 LBracket expr bracketedExpr ->
487 makeBracketed indent expr bracketedExpr
490makeDot :: Builder -> Expr -> Text -> (Lines, Builder)
491makeDot indent expr field =
492 let
493 (lines, builder) =
494 fromExpr indent Atomic expr
495 in
496 (lines, builder <> "." <> Text.encodeUtf8Builder field)
499makeBracketed :: Builder -> Expr -> Expr -> (Lines, Builder)
500makeBracketed indent expr bracketedExpr =
501 let
502 (lines, builder) =
503 fromExpr indent Atomic expr
505 (bracketedLines, bracketedBuilder) =
506 fromExpr indent Whatever bracketedExpr
507 in
508 ( merge lines bracketedLines
509 , builder <> "[" <> bracketedBuilder <> "]"
510 )
514-- OPERATORS
517fromPrefix :: PrefixOp -> Builder
518fromPrefix op =
519 case op of
520 PrefixLNot -> "!"
521 PrefixBNot -> "~"
522 PrefixPlus -> "+"
523 PrefixMinus -> "-"
524 PrefixTypeof -> "typeof "
527fromInfix :: InfixOp -> Builder
528fromInfix op =
529 case op of
530 OpLT -> " < "
531 OpLEq -> " <= "
532 OpGT -> " > "
533 OpGEq -> " >= "
534 OpIn -> " in "
535 OpInstanceof -> " instanceof "
536 OpEq -> " == "
537 OpNEq -> " != "
538 OpStrictEq -> " === "
539 OpStrictNEq -> " !=== "
540 OpLAnd -> " && "
541 OpLOr -> " || "
542 OpMul -> " * "
543 OpDiv -> " / "
544 OpMod -> " % "
545 OpSub -> " - "
546 OpLShift -> " << "
547 OpSpRShift -> " >> "
548 OpZfRShift -> " >>> "
549 OpBAnd -> " & "
550 OpBXor -> " ^ "
551 OpBOr -> " | "
552 OpAdd -> " + "