git.iko.soy/elk
on bc3983f help sign in
elk/src/Generate/JavaScript/Builder.hs
580 lines 12 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Generate.JavaScript.Builder
4 ( stmtToBuilder
5 , exprToBuilder
6 , Expr(..), Id(..), Prop(..), 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 [(Prop, 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 Prop
52 = StringProp Text
53 | IntProp Int
54 | IdProp Id
57data LValue
58 = LVar Text
59 | LDot Expr Text
60 | LBracket Expr Expr
64-- STATEMENTS
67data Stmt
68 = Block [Stmt] -- {stmts}
69 | EmptyStmt -- ;
70 | ExprStmt Expr -- expr;
71 | IfStmt Expr Stmt Stmt -- if (e) stmt1 else stmt2
72 | IfSingleStmt Expr Stmt -- if (e) stmt
73 | Switch Expr [Case] -- switch (e) clauses
74 | While Expr Stmt -- while (e) do stmt
75 | DoWhile Stmt Expr -- do stmt while (e);
76 | Break (Maybe Id) -- break lab;
77 | Continue (Maybe Id) -- continue lab;
78 | Labelled Id Stmt -- lab: stmt
79 | Return (Maybe Expr) -- return expr;
80 | VarDeclStmt [VarDecl] -- var x, y=42;
81 | FunctionStmt Id [Id] [Stmt] -- function f(x, y, z) {...}
84data Case
85 = Case Expr [Stmt]
86 | Default [Stmt]
89data VarDecl = VarDecl Id (Maybe Expr)
93-- OPERATORS
96data InfixOp
97 = OpLT -- <
98 | OpLEq -- <=
99 | OpGT -- >
100 | OpGEq -- >=
101 | OpIn -- in
102 | OpInstanceof -- instanceof
103 | OpEq -- ==
104 | OpNEq -- !=
105 | OpStrictEq -- ===
106 | OpStrictNEq -- !===
107 | OpLAnd -- &&
108 | OpLOr -- ||
109 | OpMul -- *
110 | OpDiv -- /
111 | OpMod -- %
112 | OpSub -- -
113 | OpLShift -- <<
114 | OpSpRShift -- >>
115 | OpZfRShift -- >>>
116 | OpBAnd -- &
117 | OpBXor -- ^
118 | OpBOr -- |
119 | OpAdd -- +
122data PrefixOp
123 = PrefixLNot -- !
124 | PrefixBNot -- ~
125 | PrefixPlus -- +
126 | PrefixMinus -- -
127 | PrefixTypeof -- typeof
131-- ENCODE
134stmtToBuilder :: Stmt -> Builder
135stmtToBuilder stmts =
136 fromStmt "" stmts
139exprToBuilder :: Expr -> Builder
140exprToBuilder expr =
141 snd $ fromExpr "" Whatever expr
145-- HELPERS
148deeper :: Builder -> Builder
149deeper indent =
150 "\t" <> indent
153commaSep :: [Builder] -> Builder
154commaSep builders =
155 mconcat (List.intersperse ", " builders)
158commaNewlineSep :: Builder -> [Builder] -> Builder
159commaNewlineSep indent builders =
160 mconcat (List.intersperse (",\n" <> deeper indent) builders)
164-- STATEMENTS
167fromStmtBlock :: Builder -> [Stmt] -> Builder
168fromStmtBlock indent stmts =
169 mconcat (map (fromStmt indent) stmts)
172fromStmt :: Builder -> Stmt -> Builder
173fromStmt indent statement =
174 case statement of
175 Block stmts ->
176 fromStmtBlock indent stmts
178 EmptyStmt ->
179 mempty
181 ExprStmt expr ->
182 indent <> snd (fromExpr indent Whatever expr) <> ";\n"
184 IfStmt condition thenStmt elseStmt ->
185 mconcat
186 [ indent, "if (", snd (fromExpr indent Whatever condition), ") {\n"
187 , fromStmt (deeper indent) thenStmt
188 , indent, "} else {\n"
189 , fromStmt (deeper indent) elseStmt
190 , indent, "}\n"
191 ]
193 IfSingleStmt condition thenStmt ->
194 mconcat
195 [ indent, "if (", snd (fromExpr indent Whatever condition), ") {\n"
196 , fromStmt (deeper indent) thenStmt
197 , indent, "}\n"
198 ]
200 Switch expr clauses ->
201 mconcat
202 [ indent, "switch (", snd (fromExpr indent Whatever expr), ") {\n"
203 , mconcat (map (fromClause (deeper indent)) clauses)
204 , indent, "}\n"
205 ]
207 While expr stmt ->
208 mconcat
209 [ indent, "while (", snd (fromExpr indent Whatever expr), ") {\n"
210 , fromStmt (deeper indent) stmt
211 , indent, "}\n"
212 ]
214 DoWhile stmt expr ->
215 mconcat
216 [ indent, "do {\n"
217 , fromStmt (deeper indent) stmt
218 , indent, "} while(", snd (fromExpr indent Whatever expr), ");\n"
219 ]
221 Break Nothing ->
222 indent <> "break;\n"
224 Break (Just label) ->
225 indent <> "break " <> fromId label <> ";\n"
227 Continue Nothing ->
228 indent <> "continue;\n"
230 Continue (Just label) ->
231 indent <> "continue " <> fromId label <> ";\n"
233 Labelled label stmt ->
234 mconcat
235 [ indent, fromId label, ":\n"
236 , fromStmt indent stmt
237 ]
239 Return Nothing ->
240 indent <> "return;\n"
242 Return (Just expr) ->
243 indent <> "return " <> snd (fromExpr indent Whatever expr) <> ";\n"
245 VarDeclStmt [] ->
246 mempty
248 VarDeclStmt decls ->
249 indent <> "var " <> commaNewlineSep indent (map (fromVarDecl indent) decls) <> ";\n"
251 FunctionStmt name args stmts ->
252 indent <> "function " <> fromId name <> "(" <> commaSep (map fromId args) <> ") {\n"
253 <>
254 fromStmtBlock (deeper indent) stmts
255 <>
256 indent <> "}\n"
260-- SWITCH CLAUSES
263fromClause :: Builder -> Case -> Builder
264fromClause indent clause =
265 case clause of
266 Case expr stmts ->
267 indent <> "case " <> snd (fromExpr indent Whatever expr) <> ":\n"
268 <> fromStmtBlock (deeper indent) stmts
270 Default stmts ->
271 indent <> "default:\n"
272 <> fromStmtBlock (deeper indent) stmts
276-- ID
279fromId :: Id -> Builder
280fromId (Id name) =
281 Text.encodeUtf8Builder name
285-- VAR DECLS
288fromVarDecl :: Builder -> VarDecl -> Builder
289fromVarDecl indent (VarDecl (Id name) maybeExpr) =
290 case maybeExpr of
291 Nothing ->
292 Text.encodeUtf8Builder name
294 Just expr ->
295 Text.encodeUtf8Builder name <> " = " <> snd (fromExpr indent Whatever expr)
299-- EXPRESSIONS
302data Lines = One | Many deriving (Eq)
305merge :: Lines -> Lines -> Lines
306merge a b =
307 if a == Many || b == Many then Many else One
310linesMap :: (a -> (Lines, b)) -> [a] -> (Bool, [b])
311linesMap func xs =
312 let
313 pairs =
314 map func xs
315 in
316 ( any ((==) Many . fst) pairs
317 , map snd pairs
318 )
321data Grouping = Atomic | Whatever
324parensFor :: Grouping -> Builder -> Builder
325parensFor grouping builder =
326 case grouping of
327 Atomic ->
328 "(" <> builder <> ")"
330 Whatever ->
331 builder
334fromExpr :: Builder -> Grouping -> Expr -> (Lines, Builder)
335fromExpr indent grouping expression =
336 case expression of
337 String string ->
338 (One, quoted string)
340 Float n ->
341 (One, doubleDec n)
343 Int n ->
344 (One, intDec n)
346 Bool bool ->
347 (One, if bool then "true" else "false")
349 Null ->
350 (One, "null")
352 Array exprs ->
353 (,) Many $
354 let
355 (anyMany, builders) =
356 linesMap (fromExpr indent Whatever) exprs
357 in
358 if anyMany then
359 "[\n"
360 <> deeper indent
361 <> commaNewlineSep indent builders
362 <> "\n" <> indent <> "]"
364 else
365 "[" <> commaSep builders <> "]"
367 Object fields ->
368 (,) Many $
369 let
370 deeperIndent =
371 deeper indent
373 (anyMany, builders) =
374 linesMap (fromField deeperIndent) fields
375 in
376 if anyMany then
377 "{\n"
378 <> deeperIndent
379 <> commaNewlineSep indent builders
380 <> "\n" <> indent <> "}"
382 else
383 "{" <> commaSep builders <> "}"
385 VarRef name ->
386 (One, fromId name)
388 DotRef expr (Id name) ->
389 makeDot indent expr name
391 BracketRef expr bracketedExpr ->
392 makeBracketed indent expr bracketedExpr
394 Prefix op expr ->
395 let
396 (lines, builder) =
397 fromExpr indent Atomic expr
398 in
399 ( lines
400 , parensFor grouping (fromPrefix op <> builder)
401 )
403 Infix op leftExpr rightExpr ->
404 let
405 (leftLines, left) =
406 fromExpr indent Atomic leftExpr
408 (rightLines, right) =
409 fromExpr indent Atomic rightExpr
410 in
411 ( merge leftLines rightLines
412 , parensFor grouping (left <> fromInfix op <> right)
413 )
415 If condExpr thenExpr elseExpr ->
416 let
417 condB = snd (fromExpr indent Atomic condExpr)
418 thenB = snd (fromExpr indent Atomic thenExpr)
419 elseB = snd (fromExpr indent Atomic elseExpr)
420 in
421 ( Many
422 , parensFor grouping (condB <> " ? " <> thenB <> " : " <> elseB)
423 )
425 Assign lValue expr ->
426 let
427 (leftLines, left) =
428 fromLValue indent lValue
430 (rightLines, right) =
431 fromExpr indent Whatever expr
432 in
433 ( merge leftLines rightLines
434 , parensFor grouping (left <> " = " <> right)
435 )
437 Call function args ->
438 (,) Many $
439 let
440 deeperIndent =
441 deeper indent
443 funcB =
444 snd (fromExpr indent Atomic function)
446 (anyMany, argsB) =
447 linesMap (fromExpr deeperIndent Whatever) args
448 in
449 if anyMany then
450 funcB <> "(\n" <> deeperIndent <> commaNewlineSep indent argsB <> ")"
452 else
453 funcB <> "(" <> commaSep argsB <> ")"
455 Function maybeName args stmts ->
456 (,) Many $
457 "function " <> maybe mempty fromId maybeName <> "(" <> commaSep (map fromId args) <> ") {\n"
458 <>
459 fromStmtBlock (deeper indent) stmts
460 <>
461 indent <> "}"
465-- FIELDS
468fromField :: Builder -> (Prop, Expr) -> (Lines, Builder)
469fromField indent (prop, expr) =
470 let
471 (lines, builder) =
472 fromExpr indent Whatever expr
473 in
474 ( lines
475 , fromProp prop <> ": " <> builder
476 )
479fromProp :: Prop -> Builder
480fromProp prop =
481 case prop of
482 IdProp name ->
483 fromId name
485 StringProp string ->
486 quoted string
488 IntProp n ->
489 intDec n
493-- STRINGS
496quoted :: Text -> Builder
497quoted str =
498 "'" <> Text.encodeUtf8Builder str <> "'"
502-- VALUES
505fromLValue :: Builder -> LValue -> (Lines, Builder)
506fromLValue indent lValue =
507 case lValue of
508 LVar name ->
509 (One, Text.encodeUtf8Builder name)
511 LDot expr field ->
512 makeDot indent expr field
514 LBracket expr bracketedExpr ->
515 makeBracketed indent expr bracketedExpr
518makeDot :: Builder -> Expr -> Text -> (Lines, Builder)
519makeDot indent expr field =
520 let
521 (lines, builder) =
522 fromExpr indent Atomic expr
523 in
524 (lines, builder <> "." <> Text.encodeUtf8Builder field)
527makeBracketed :: Builder -> Expr -> Expr -> (Lines, Builder)
528makeBracketed indent expr bracketedExpr =
529 let
530 (lines, builder) =
531 fromExpr indent Atomic expr
533 (bracketedLines, bracketedBuilder) =
534 fromExpr indent Whatever bracketedExpr
535 in
536 ( merge lines bracketedLines
537 , builder <> "[" <> bracketedBuilder <> "]"
538 )
542-- OPERATORS
545fromPrefix :: PrefixOp -> Builder
546fromPrefix op =
547 case op of
548 PrefixLNot -> "!"
549 PrefixBNot -> "~"
550 PrefixPlus -> "+"
551 PrefixMinus -> "-"
552 PrefixTypeof -> "typeof "
555fromInfix :: InfixOp -> Builder
556fromInfix op =
557 case op of
558 OpLT -> " < "
559 OpLEq -> " <= "
560 OpGT -> " > "
561 OpGEq -> " >= "
562 OpIn -> " in "
563 OpInstanceof -> " instanceof "
564 OpEq -> " == "
565 OpNEq -> " != "
566 OpStrictEq -> " === "
567 OpStrictNEq -> " !=== "
568 OpLAnd -> " && "
569 OpLOr -> " || "
570 OpMul -> " * "
571 OpDiv -> " / "
572 OpMod -> " % "
573 OpSub -> " - "
574 OpLShift -> " << "
575 OpSpRShift -> " >> "
576 OpZfRShift -> " >>> "
577 OpBAnd -> " & "
578 OpBXor -> " ^ "
579 OpBOr -> " | "
580 OpAdd -> " + "