git.iko.soy/elk
on ef280ed help sign in
elk/src/Generate/JavaScript.hs
162 lines 3.6 kB history raw
1module Generate.JavaScript (generate) where
3import Control.Monad.State as State
4import qualified Data.List as List
5import Language.ECMAScript3.PrettyPrint as ES
6import Language.ECMAScript3.Syntax
7import qualified Text.PrettyPrint.Leijen as PP
9import qualified AST.Expression.Optimized as Optimized
10import qualified AST.Helpers as Help
11import qualified AST.Module as Module
12import qualified AST.Module.Name as ModuleName
13import qualified AST.Variable as Variable
14import qualified Generate.JavaScript.Expression as JS
15import Generate.JavaScript.Helpers (call, function, localRuntime, obj, prop, ref, varDecl)
16import qualified Generate.JavaScript.Variable as Var
19generate :: Module.Optimized -> String
20generate module_ =
21 let
22 (ModuleName.Canonical _ name) =
23 Module.name module_
25 body =
26 concat
27 [ useStrict
28 , checkForCachedVersion name
29 , imports (Module.imports module_)
30 , definitions (Module.program (Module.body module_))
31 , exports name (Module.exports module_)
32 ]
34 make =
35 "Elm" : name ++ ["make"]
37 javascript =
38 buildIntermediateObjects make
39 ++
40 [ assign make (function [localRuntime] body)
41 ]
42 in
43 PP.displayS (PP.renderPretty 1 160 (ES.prettyPrint javascript)) ""
47-- INTRO
50useStrict :: [Statement ()]
51useStrict =
52 [ ExprStmt () (StringLit () "use strict")
53 ]
56checkForCachedVersion :: ModuleName.Raw -> [Statement ()]
57checkForCachedVersion name =
58 let
59 values =
60 localRuntime : name ++ ["values"]
62 valuesObject =
63 obj values
64 in
65 buildIntermediateObjects values
66 ++
67 [ IfSingleStmt () valuesObject (ReturnStmt () (Just valuesObject))
68 ]
71buildIntermediateObjects :: [String] -> [Statement ()]
72buildIntermediateObjects path =
73 let
74 create name =
75 assign name (InfixExpr () OpLOr (obj name) (ObjectLit () []))
77 paths =
78 drop 2 (init (List.inits path))
79 in
80 map create paths
83assign :: [String] -> Expression () -> Statement ()
84assign path expr =
85 case path of
86 [x] ->
87 VarDeclStmt () [ varDecl x expr ]
89 _ ->
90 ExprStmt () $
91 AssignExpr () OpAssign (LDot () (obj (init path)) (last path)) expr
95-- IMPORTS
98imports :: [ModuleName.Raw] -> [Statement ()]
99imports rawImports =
100 let
101 utils =
102 varDecl "_U" (call (obj ["Elm", "Native", "Utils", "make"]) [ref localRuntime])
103 in
104 [ VarDeclStmt () (utils : map jsImport rawImports) ]
107jsImport :: ModuleName.Raw -> VarDecl ()
108jsImport name =
109 let
110 make =
111 obj ("Elm" : name ++ ["make"])
112 in
113 varDecl (Var.modulePrefix name) (call make [ref localRuntime])
117-- DEFINITIONS
120definitions :: [Optimized.Def] -> [Statement ()]
121definitions defs =
122 let
123 setup =
124 Var.define "_op" (ObjectLit () [])
125 in
126 setup : State.evalState (mapM JS.generateDef defs) 0
130-- EXPORTS
133exports :: ModuleName.Raw -> [Variable.Value] -> [Statement ()]
134exports name exportedValues =
135 let
136 exportedFields =
137 map toField ("_op" : concatMap extract exportedValues)
139 toField x =
140 (prop x, ref x)
142 extract value =
143 case value of
144 Variable.Alias _ ->
145 []
147 Variable.Value x ->
148 if Help.isOp x then
149 []
151 else
152 [Var.safe x]
154 Variable.Union _ (Variable.Listing ctors _) ->
155 map Var.safe ctors
157 values =
158 LDot () (obj (localRuntime : name)) "values"
159 in
160 [ ReturnStmt () $ Just $
161 AssignExpr () OpAssign values (ObjectLit () exportedFields)
162 ]