git.iko.soy/elk
on f232da4 help sign in
elk/src/Generate/JavaScript/Builder.hs
574 lines 12 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Generate.JavaScript.Builder
4 ( encodeUtf8
5 , Expr(..), Id(..), Prop(..), LValue(..)
6 , Stmt(..), Case(..), VarDecl(..)
7 , InfixOp(..), PrefixOp(..)
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.ByteString.Builder
19import Data.Monoid ((<>))
20import Data.Text (Text)
21import qualified Data.Text.Encoding as Text
25-- EXPRESSIONS
28data Expr
29 = String Text
30 | Float Double
31 | Int Int
32 | Bool Bool
33 | Null
34 | Array [Expr]
35 | Object [(Prop, Expr)]
36 | VarRef Id
37 | DotRef Expr Id -- ^ @foo.bar@, spec 11.2.1
38 | BracketRef Expr Expr -- ^ @foo[bar]@, spec 11.2.1
39 | Prefix PrefixOp Expr
40 | Infix InfixOp Expr Expr
41 | If Expr Expr Expr
42 | Assign LValue Expr
43 | Call Expr [Expr] -- ^ @f(x,y,z)@, spec 11.2.3
44 | Function (Maybe Id) [Id] [Stmt]
47newtype Id = Id Text
50data Prop
51 = StringProp Text
52 | IntProp Int
53 | IdProp Id
56data LValue
57 = LVar Text
58 | LDot Expr Text
59 | LBracket Expr Expr
63-- STATEMENTS
66data Stmt
67 = Block [Stmt] -- {stmts}
68 | EmptyStmt -- ;
69 | ExprStmt Expr -- expr;
70 | IfStmt Expr Stmt Stmt -- if (e) stmt1 else stmt2
71 | IfSingleStmt Expr Stmt -- if (e) stmt
72 | Switch Expr [Case] -- switch (e) clauses
73 | While Expr Stmt -- while (e) do stmt
74 | DoWhile Stmt Expr -- do stmt while (e);
75 | Break (Maybe Id) -- break lab;
76 | Continue (Maybe Id) -- continue lab;
77 | Labelled Id Stmt -- lab: stmt
78 | Return (Maybe Expr) -- return expr;
79 | VarDeclStmt [VarDecl] -- var x, y=42;
80 | FunctionStmt Id [Id] [Stmt] -- function f(x, y, z) {...}
83data Case
84 = Case Expr [Stmt]
85 | Default [Stmt]
88data VarDecl = VarDecl Id (Maybe Expr)
92-- OPERATORS
95data InfixOp
96 = OpLT -- <
97 | OpLEq -- <=
98 | OpGT -- >
99 | OpGEq -- >=
100 | OpIn -- in
101 | OpInstanceof -- instanceof
102 | OpEq -- ==
103 | OpNEq -- !=
104 | OpStrictEq -- ===
105 | OpStrictNEq -- !===
106 | OpLAnd -- &&
107 | OpLOr -- ||
108 | OpMul -- *
109 | OpDiv -- /
110 | OpMod -- %
111 | OpSub -- -
112 | OpLShift -- <<
113 | OpSpRShift -- >>
114 | OpZfRShift -- >>>
115 | OpBAnd -- &
116 | OpBXor -- ^
117 | OpBOr -- |
118 | OpAdd -- +
121data PrefixOp
122 = PrefixLNot -- !
123 | PrefixBNot -- ~
124 | PrefixPlus -- +
125 | PrefixMinus -- -
126 | PrefixTypeof -- typeof
130-- ENCODE
133encodeUtf8 :: [Stmt] -> Builder
134encodeUtf8 stmts =
135 fromStmtBlock "" stmts
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, quoted 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 -> (Prop, Expr) -> (Lines, Builder)
463fromField indent (prop, expr) =
464 let
465 (lines, builder) =
466 fromExpr indent Whatever expr
467 in
468 ( lines
469 , fromProp prop <> ": " <> builder
470 )
473fromProp :: Prop -> Builder
474fromProp prop =
475 case prop of
476 IdProp name ->
477 fromId name
479 StringProp string ->
480 quoted string
482 IntProp n ->
483 intDec n
487-- STRINGS
490quoted :: Text -> Builder
491quoted str =
492 "'" <> Text.encodeUtf8Builder str <> "'"
496-- VALUES
499fromLValue :: Builder -> LValue -> (Lines, Builder)
500fromLValue indent lValue =
501 case lValue of
502 LVar name ->
503 (One, Text.encodeUtf8Builder name)
505 LDot expr field ->
506 makeDot indent expr field
508 LBracket expr bracketedExpr ->
509 makeBracketed indent expr bracketedExpr
512makeDot :: Builder -> Expr -> Text -> (Lines, Builder)
513makeDot indent expr field =
514 let
515 (lines, builder) =
516 fromExpr indent Atomic expr
517 in
518 (lines, builder <> "." <> Text.encodeUtf8Builder field)
521makeBracketed :: Builder -> Expr -> Expr -> (Lines, Builder)
522makeBracketed indent expr bracketedExpr =
523 let
524 (lines, builder) =
525 fromExpr indent Atomic expr
527 (bracketedLines, bracketedBuilder) =
528 fromExpr indent Whatever bracketedExpr
529 in
530 ( merge lines bracketedLines
531 , builder <> "[" <> bracketedBuilder <> "]"
532 )
536-- OPERATORS
539fromPrefix :: PrefixOp -> Builder
540fromPrefix op =
541 case op of
542 PrefixLNot -> "!"
543 PrefixBNot -> "~"
544 PrefixPlus -> "+"
545 PrefixMinus -> "-"
546 PrefixTypeof -> "typeof "
549fromInfix :: InfixOp -> Builder
550fromInfix op =
551 case op of
552 OpLT -> " < "
553 OpLEq -> " <= "
554 OpGT -> " > "
555 OpGEq -> " >= "
556 OpIn -> " in "
557 OpInstanceof -> " instanceof "
558 OpEq -> " == "
559 OpNEq -> " != "
560 OpStrictEq -> " === "
561 OpStrictNEq -> " !=== "
562 OpLAnd -> " && "
563 OpLOr -> " || "
564 OpMul -> " * "
565 OpDiv -> " / "
566 OpMod -> " % "
567 OpSub -> " - "
568 OpLShift -> " << "
569 OpSpRShift -> " >> "
570 OpZfRShift -> " >>> "
571 OpBAnd -> " & "
572 OpBXor -> " ^ "
573 OpBOr -> " | "
574 OpAdd -> " + "