git.iko.soy/elk
on abd5880 help sign in
elk/src/Generate/JavaScript/Builder.hs
579 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 fromText name
278fromText :: Text -> Builder
279fromText txt =
280 byteString (Text.encodeUtf8 txt)
284-- VAR DECLS
287fromVarDecl :: Builder -> VarDecl -> Builder
288fromVarDecl indent (VarDecl (Id name) maybeExpr) =
289 case maybeExpr of
290 Nothing ->
291 fromText name
293 Just expr ->
294 fromText name <> " = " <> snd (fromExpr indent Whatever expr)
298-- EXPRESSIONS
301data Lines = One | Many deriving (Eq)
304merge :: Lines -> Lines -> Lines
305merge a b =
306 if a == Many || b == Many then Many else One
309linesMap :: (a -> (Lines, b)) -> [a] -> (Bool, [b])
310linesMap func xs =
311 let
312 pairs =
313 map func xs
314 in
315 ( any ((==) Many . fst) pairs
316 , map snd pairs
317 )
320data Grouping = Atomic | Whatever
323parensFor :: Grouping -> Builder -> Builder
324parensFor grouping builder =
325 case grouping of
326 Atomic ->
327 "(" <> builder <> ")"
329 Whatever ->
330 builder
333fromExpr :: Builder -> Grouping -> Expr -> (Lines, Builder)
334fromExpr indent grouping expression =
335 case expression of
336 String string ->
337 (One, quoted string)
339 Float n ->
340 (One, doubleDec n)
342 Int n ->
343 (One, intDec n)
345 Bool bool ->
346 (One, if bool then "true" else "false")
348 Null ->
349 (One, "null")
351 Array exprs ->
352 (,) Many $
353 let
354 (anyMany, builders) =
355 linesMap (fromExpr indent Whatever) exprs
356 in
357 if anyMany then
358 "[\n"
359 <> deeper indent
360 <> commaNewlineSep indent builders
361 <> "\n" <> indent <> "]"
363 else
364 "[" <> commaSep builders <> "]"
366 Object fields ->
367 (,) Many $
368 let
369 deeperIndent =
370 deeper indent
372 (anyMany, builders) =
373 linesMap (fromField deeperIndent) fields
374 in
375 if anyMany then
376 "{\n"
377 <> deeperIndent
378 <> commaNewlineSep indent builders
379 <> "\n" <> indent <> "}"
381 else
382 "{" <> commaSep builders <> "}"
384 VarRef name ->
385 (One, fromId name)
387 DotRef expr (Id name) ->
388 makeDot indent expr name
390 BracketRef expr bracketedExpr ->
391 makeBracketed indent expr bracketedExpr
393 Prefix op expr ->
394 let
395 (lines, builder) =
396 fromExpr indent Atomic expr
397 in
398 ( lines
399 , parensFor grouping (fromPrefix op <> builder)
400 )
402 Infix op leftExpr rightExpr ->
403 let
404 (leftLines, left) =
405 fromExpr indent Atomic leftExpr
407 (rightLines, right) =
408 fromExpr indent Atomic rightExpr
409 in
410 ( merge leftLines rightLines
411 , parensFor grouping (left <> fromInfix op <> right)
412 )
414 If condExpr thenExpr elseExpr ->
415 let
416 condB = snd (fromExpr indent Atomic condExpr)
417 thenB = snd (fromExpr indent Atomic thenExpr)
418 elseB = snd (fromExpr indent Atomic elseExpr)
419 in
420 ( Many
421 , parensFor grouping (condB <> " ? " <> thenB <> " : " <> elseB)
422 )
424 Assign lValue expr ->
425 let
426 (leftLines, left) =
427 fromLValue indent lValue
429 (rightLines, right) =
430 fromExpr indent Whatever expr
431 in
432 ( merge leftLines rightLines
433 , parensFor grouping (left <> " = " <> right)
434 )
436 Call function args ->
437 (,) Many $
438 let
439 deeperIndent =
440 deeper indent
442 funcB =
443 snd (fromExpr indent Atomic function)
445 (anyMany, argsB) =
446 linesMap (fromExpr deeperIndent Whatever) args
447 in
448 if anyMany then
449 funcB <> "(\n" <> deeperIndent <> commaNewlineSep indent argsB <> ")"
451 else
452 funcB <> "(" <> commaSep argsB <> ")"
454 Function maybeName args stmts ->
455 (,) Many $
456 "function " <> maybe mempty fromId maybeName <> "(" <> commaSep (map fromId args) <> ") {\n"
457 <>
458 fromStmtBlock (deeper indent) stmts
459 <>
460 indent <> "}"
464-- FIELDS
467fromField :: Builder -> (Prop, Expr) -> (Lines, Builder)
468fromField indent (prop, expr) =
469 let
470 (lines, builder) =
471 fromExpr indent Whatever expr
472 in
473 ( lines
474 , fromProp prop <> ": " <> builder
475 )
478fromProp :: Prop -> Builder
479fromProp prop =
480 case prop of
481 IdProp name ->
482 fromId name
484 StringProp string ->
485 quoted string
487 IntProp n ->
488 intDec n
492-- STRINGS
495quoted :: Text -> Builder
496quoted str =
497 "'" <> fromText str <> "'"
501-- VALUES
504fromLValue :: Builder -> LValue -> (Lines, Builder)
505fromLValue indent lValue =
506 case lValue of
507 LVar name ->
508 (One, fromText name)
510 LDot expr field ->
511 makeDot indent expr field
513 LBracket expr bracketedExpr ->
514 makeBracketed indent expr bracketedExpr
517makeDot :: Builder -> Expr -> Text -> (Lines, Builder)
518makeDot indent expr field =
519 let
520 (lines, builder) =
521 fromExpr indent Atomic expr
522 in
523 (lines, builder <> "." <> fromText field)
526makeBracketed :: Builder -> Expr -> Expr -> (Lines, Builder)
527makeBracketed indent expr bracketedExpr =
528 let
529 (lines, builder) =
530 fromExpr indent Atomic expr
532 (bracketedLines, bracketedBuilder) =
533 fromExpr indent Whatever bracketedExpr
534 in
535 ( merge lines bracketedLines
536 , builder <> "[" <> bracketedBuilder <> "]"
537 )
541-- OPERATORS
544fromPrefix :: PrefixOp -> Builder
545fromPrefix op =
546 case op of
547 PrefixLNot -> "!"
548 PrefixBNot -> "~"
549 PrefixPlus -> "+"
550 PrefixMinus -> "-"
551 PrefixTypeof -> "typeof "
554fromInfix :: InfixOp -> Builder
555fromInfix op =
556 case op of
557 OpLT -> " < "
558 OpLEq -> " <= "
559 OpGT -> " > "
560 OpGEq -> " >= "
561 OpIn -> " in "
562 OpInstanceof -> " instanceof "
563 OpEq -> " == "
564 OpNEq -> " != "
565 OpStrictEq -> " === "
566 OpStrictNEq -> " !=== "
567 OpLAnd -> " && "
568 OpLOr -> " || "
569 OpMul -> " * "
570 OpDiv -> " / "
571 OpMod -> " % "
572 OpSub -> " - "
573 OpLShift -> " << "
574 OpSpRShift -> " >> "
575 OpZfRShift -> " >>> "
576 OpBAnd -> " & "
577 OpBXor -> " ^ "
578 OpBOr -> " | "
579 OpAdd -> " + "