git.iko.soy/elk
on c756a83 help sign in
elk/src/Generate/JavaScript/Builder.hs
576 lines 12 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Generate.JavaScript.Builder
4 ( Expr(..), Id(..), Prop(..), LValue(..)
5 , Stmt(..), Case(..), VarDecl(..)
6 , InfixOp(..), PrefixOp(..)
7 , stmtsToText
8 )
9 where
11-- Based on the language-ecmascript package.
12-- https://hackage.haskell.org/package/language-ecmascript
13-- They did the hard work of reading the spec to figure out
14-- how all the types should fit together.
16import Prelude hiding (lines)
17import qualified Data.List as List
18import Data.Monoid ((<>))
19import Data.Text (Text)
20import Data.Text.Lazy.Builder
21import Data.Text.Lazy.Builder.Int (decimal)
22import Data.Text.Lazy.Builder.RealFloat (realFloat)
23import qualified Data.Text.Lazy as LazyText
27-- EXPRESSIONS
30data Expr
31 = String Text
32 | Float Double
33 | Int Int
34 | Bool Bool
35 | Null
36 | Array [Expr]
37 | Object [(Prop, Expr)]
38 | VarRef Id
39 | DotRef Expr Id -- ^ @foo.bar@, spec 11.2.1
40 | BracketRef Expr Expr -- ^ @foo[bar]@, spec 11.2.1
41 | Prefix PrefixOp Expr
42 | Infix InfixOp Expr Expr
43 | If Expr Expr Expr
44 | Assign LValue Expr
45 | Call Expr [Expr] -- ^ @f(x,y,z)@, spec 11.2.3
46 | Function (Maybe Id) [Id] [Stmt]
49newtype Id = Id Text
52data Prop
53 = StringProp Text
54 | IntProp Int
55 | IdProp Id
58data LValue
59 = LVar Text
60 | LDot Expr Text
61 | LBracket Expr Expr
65-- STATEMENTS
68data Stmt
69 = Block [Stmt] -- {stmts}
70 | EmptyStmt -- ;
71 | ExprStmt Expr -- expr;
72 | IfStmt Expr Stmt Stmt -- if (e) stmt1 else stmt2
73 | IfSingleStmt Expr Stmt -- if (e) stmt
74 | Switch Expr [Case] -- switch (e) clauses
75 | While Expr Stmt -- while (e) do stmt
76 | DoWhile Stmt Expr -- do stmt while (e);
77 | Break (Maybe Id) -- break lab;
78 | Continue (Maybe Id) -- continue lab;
79 | Labelled Id Stmt -- lab: stmt
80 | Return (Maybe Expr) -- return expr;
81 | VarDeclStmt [VarDecl] -- var x, y=42;
82 | FunctionStmt Id [Id] [Stmt] -- function f(x, y, z) {...}
85data Case
86 = Case Expr [Stmt]
87 | Default [Stmt]
90data VarDecl = VarDecl Id (Maybe Expr)
94-- OPERATORS
97data InfixOp
98 = OpLT -- <
99 | OpLEq -- <=
100 | OpGT -- >
101 | OpGEq -- >=
102 | OpIn -- in
103 | OpInstanceof -- instanceof
104 | OpEq -- ==
105 | OpNEq -- !=
106 | OpStrictEq -- ===
107 | OpStrictNEq -- !===
108 | OpLAnd -- &&
109 | OpLOr -- ||
110 | OpMul -- *
111 | OpDiv -- /
112 | OpMod -- %
113 | OpSub -- -
114 | OpLShift -- <<
115 | OpSpRShift -- >>
116 | OpZfRShift -- >>>
117 | OpBAnd -- &
118 | OpBXor -- ^
119 | OpBOr -- |
120 | OpAdd -- +
123data PrefixOp
124 = PrefixLNot -- !
125 | PrefixBNot -- ~
126 | PrefixPlus -- +
127 | PrefixMinus -- -
128 | PrefixTypeof -- typeof
132-- CONVERT TO LAZY TEXT
135stmtsToText :: [Stmt] -> LazyText.Text
136stmtsToText stmts =
137 toLazyText (fromStmtBlock "" stmts)
141-- HELPERS
144deeper :: Builder -> Builder
145deeper indent =
146 "\t" <> indent
149commaSep :: [Builder] -> Builder
150commaSep builders =
151 mconcat (List.intersperse ", " builders)
154commaNewlineSep :: Builder -> [Builder] -> Builder
155commaNewlineSep indent builders =
156 mconcat (List.intersperse (",\n" <> deeper indent) builders)
160-- STATEMENTS
163fromStmtBlock :: Builder -> [Stmt] -> Builder
164fromStmtBlock indent stmts =
165 mconcat (map (fromStmt indent) stmts)
168fromStmt :: Builder -> Stmt -> Builder
169fromStmt indent statement =
170 case statement of
171 Block stmts ->
172 fromStmtBlock indent stmts
174 EmptyStmt ->
175 mempty
177 ExprStmt expr ->
178 indent <> snd (fromExpr indent Whatever expr) <> ";\n"
180 IfStmt condition thenStmt elseStmt ->
181 mconcat
182 [ indent, "if (", snd (fromExpr indent Whatever condition), ") {\n"
183 , fromStmt (deeper indent) thenStmt
184 , indent, "} else {\n"
185 , fromStmt (deeper indent) elseStmt
186 , indent, "}\n"
187 ]
189 IfSingleStmt condition thenStmt ->
190 mconcat
191 [ indent, "if (", snd (fromExpr indent Whatever condition), ") {\n"
192 , fromStmt (deeper indent) thenStmt
193 , indent, "}\n"
194 ]
196 Switch expr clauses ->
197 mconcat
198 [ indent, "switch (", snd (fromExpr indent Whatever expr), ") {\n"
199 , mconcat (map (fromClause (deeper indent)) clauses)
200 , indent, "}\n"
201 ]
203 While expr stmt ->
204 mconcat
205 [ indent, "while (", snd (fromExpr indent Whatever expr), ") {\n"
206 , fromStmt (deeper indent) stmt
207 , indent, "}\n"
208 ]
210 DoWhile stmt expr ->
211 mconcat
212 [ indent, "do {\n"
213 , fromStmt (deeper indent) stmt
214 , indent, "} while(", snd (fromExpr indent Whatever expr), ");\n"
215 ]
217 Break Nothing ->
218 indent <> "break;\n"
220 Break (Just label) ->
221 indent <> "break " <> fromId label <> ";\n"
223 Continue Nothing ->
224 indent <> "continue;\n"
226 Continue (Just label) ->
227 indent <> "continue " <> fromId label <> ";\n"
229 Labelled label stmt ->
230 mconcat
231 [ indent, fromId label, ":\n"
232 , fromStmt indent stmt
233 ]
235 Return Nothing ->
236 indent <> "return;\n"
238 Return (Just expr) ->
239 indent <> "return " <> snd (fromExpr indent Whatever expr) <> ";\n"
241 VarDeclStmt [] ->
242 mempty
244 VarDeclStmt decls ->
245 indent <> "var " <> commaNewlineSep indent (map (fromVarDecl indent) decls) <> ";\n"
247 FunctionStmt name args stmts ->
248 indent <> "function " <> fromId name <> "(" <> commaSep (map fromId args) <> ") {\n"
249 <>
250 fromStmtBlock (deeper indent) stmts
251 <>
252 indent <> "}\n"
256-- SWITCH CLAUSES
259fromClause :: Builder -> Case -> Builder
260fromClause indent clause =
261 case clause of
262 Case expr stmts ->
263 indent <> "case " <> snd (fromExpr indent Whatever expr) <> ":\n"
264 <> fromStmtBlock (deeper indent) stmts
266 Default stmts ->
267 indent <> "default:\n"
268 <> fromStmtBlock (deeper indent) stmts
272-- ID
275fromId :: Id -> Builder
276fromId (Id name) =
277 fromText name
281-- VAR DECLS
284fromVarDecl :: Builder -> VarDecl -> Builder
285fromVarDecl indent (VarDecl (Id name) maybeExpr) =
286 case maybeExpr of
287 Nothing ->
288 fromText name
290 Just expr ->
291 fromText name <> " = " <> snd (fromExpr indent Whatever expr)
295-- EXPRESSIONS
298data Lines = One | Many deriving (Eq)
301merge :: Lines -> Lines -> Lines
302merge a b =
303 if a == Many || b == Many then Many else One
306linesMap :: (a -> (Lines, b)) -> [a] -> (Bool, [b])
307linesMap func xs =
308 let
309 pairs =
310 map func xs
311 in
312 ( any ((==) Many . fst) pairs
313 , map snd pairs
314 )
317data Grouping = Atomic | Whatever
320parensFor :: Grouping -> Builder -> Builder
321parensFor grouping builder =
322 case grouping of
323 Atomic ->
324 "(" <> builder <> ")"
326 Whatever ->
327 builder
330fromExpr :: Builder -> Grouping -> Expr -> (Lines, Builder)
331fromExpr indent grouping expression =
332 case expression of
333 String string ->
334 (One, quoted string)
336 Float n ->
337 (One, realFloat n)
339 Int n ->
340 (One, decimal n)
342 Bool bool ->
343 (One, if bool then "true" else "false")
345 Null ->
346 (One, "null")
348 Array exprs ->
349 (,) Many $
350 let
351 (anyMany, builders) =
352 linesMap (fromExpr indent Whatever) exprs
353 in
354 if anyMany then
355 "[\n"
356 <> deeper indent
357 <> commaNewlineSep indent builders
358 <> "\n" <> indent <> "]"
360 else
361 "[" <> commaSep builders <> "]"
363 Object fields ->
364 (,) Many $
365 let
366 deeperIndent =
367 deeper indent
369 (anyMany, builders) =
370 linesMap (fromField deeperIndent) fields
371 in
372 if anyMany then
373 "{\n"
374 <> deeperIndent
375 <> commaNewlineSep indent builders
376 <> "\n" <> indent <> "}"
378 else
379 "{" <> commaSep builders <> "}"
381 VarRef name ->
382 (One, fromId name)
384 DotRef expr (Id name) ->
385 makeDot indent expr name
387 BracketRef expr bracketedExpr ->
388 makeBracketed indent expr bracketedExpr
390 Prefix op expr ->
391 let
392 (lines, builder) =
393 fromExpr indent Atomic expr
394 in
395 ( lines
396 , parensFor grouping (fromPrefix op <> builder)
397 )
399 Infix op leftExpr rightExpr ->
400 let
401 (leftLines, left) =
402 fromExpr indent Atomic leftExpr
404 (rightLines, right) =
405 fromExpr indent Atomic rightExpr
406 in
407 ( merge leftLines rightLines
408 , parensFor grouping (left <> fromInfix op <> right)
409 )
411 If condExpr thenExpr elseExpr ->
412 let
413 condB = snd (fromExpr indent Atomic condExpr)
414 thenB = snd (fromExpr indent Atomic thenExpr)
415 elseB = snd (fromExpr indent Atomic elseExpr)
416 in
417 ( Many
418 , parensFor grouping (condB <> " ? " <> thenB <> " : " <> elseB)
419 )
421 Assign lValue expr ->
422 let
423 (leftLines, left) =
424 fromLValue indent lValue
426 (rightLines, right) =
427 fromExpr indent Whatever expr
428 in
429 ( merge leftLines rightLines
430 , parensFor grouping (left <> " = " <> right)
431 )
433 Call function args ->
434 (,) Many $
435 let
436 deeperIndent =
437 deeper indent
439 funcB =
440 snd (fromExpr indent Atomic function)
442 (anyMany, argsB) =
443 linesMap (fromExpr deeperIndent Whatever) args
444 in
445 if anyMany then
446 funcB <> "(\n" <> deeperIndent <> commaNewlineSep indent argsB <> ")"
448 else
449 funcB <> "(" <> commaSep argsB <> ")"
451 Function maybeName args stmts ->
452 (,) Many $
453 "function " <> maybe mempty fromId maybeName <> "(" <> commaSep (map fromId args) <> ") {\n"
454 <>
455 fromStmtBlock (deeper indent) stmts
456 <>
457 indent <> "}"
461-- FIELDS
464fromField :: Builder -> (Prop, Expr) -> (Lines, Builder)
465fromField indent (prop, expr) =
466 let
467 (lines, builder) =
468 fromExpr indent Whatever expr
469 in
470 ( lines
471 , fromProp prop <> ": " <> builder
472 )
475fromProp :: Prop -> Builder
476fromProp prop =
477 case prop of
478 IdProp name ->
479 fromId name
481 StringProp string ->
482 quoted string
484 IntProp n ->
485 decimal n
489-- STRINGS
492quoted :: Text -> Builder
493quoted str =
494 "'" <> fromText str <> "'"
498-- VALUES
501fromLValue :: Builder -> LValue -> (Lines, Builder)
502fromLValue indent lValue =
503 case lValue of
504 LVar name ->
505 (One, fromText name)
507 LDot expr field ->
508 makeDot indent expr field
510 LBracket expr bracketedExpr ->
511 makeBracketed indent expr bracketedExpr
514makeDot :: Builder -> Expr -> Text -> (Lines, Builder)
515makeDot indent expr field =
516 let
517 (lines, builder) =
518 fromExpr indent Atomic expr
519 in
520 (lines, builder <> "." <> fromText field)
523makeBracketed :: Builder -> Expr -> Expr -> (Lines, Builder)
524makeBracketed indent expr bracketedExpr =
525 let
526 (lines, builder) =
527 fromExpr indent Atomic expr
529 (bracketedLines, bracketedBuilder) =
530 fromExpr indent Whatever bracketedExpr
531 in
532 ( merge lines bracketedLines
533 , builder <> "[" <> bracketedBuilder <> "]"
534 )
538-- OPERATORS
541fromPrefix :: PrefixOp -> Builder
542fromPrefix op =
543 case op of
544 PrefixLNot -> "!"
545 PrefixBNot -> "~"
546 PrefixPlus -> "+"
547 PrefixMinus -> "-"
548 PrefixTypeof -> "typeof "
551fromInfix :: InfixOp -> Builder
552fromInfix op =
553 case op of
554 OpLT -> " < "
555 OpLEq -> " <= "
556 OpGT -> " > "
557 OpGEq -> " >= "
558 OpIn -> " in "
559 OpInstanceof -> " instanceof "
560 OpEq -> " == "
561 OpNEq -> " != "
562 OpStrictEq -> " === "
563 OpStrictNEq -> " !=== "
564 OpLAnd -> " && "
565 OpLOr -> " || "
566 OpMul -> " * "
567 OpDiv -> " / "
568 OpMod -> " % "
569 OpSub -> " - "
570 OpLShift -> " << "
571 OpSpRShift -> " >> "
572 OpZfRShift -> " >>> "
573 OpBAnd -> " & "
574 OpBXor -> " ^ "
575 OpBOr -> " | "
576 OpAdd -> " + "