@@ -1,25 +1,164 @@
11module Generate.JavaScript (generate) where
22
33import Control.Monad.State as State
4+import qualified Data.List as List
45import Language.ECMAScript3.PrettyPrint as ES
56import Language.ECMAScript3.Syntax
67import qualified Text.PrettyPrint.Leijen as PP
78
9+import qualified AST.Expression.Optimized as Optimized
10+import qualified AST.Helpers as Help
811import qualified AST.Module as Module
12+import qualified AST.Module.Name as ModuleName
13+import qualified AST.Variable as Variable
914import qualified Generate.JavaScript.Expression as JS
15+import Generate.JavaScript.Helpers (call, function, localRuntime, obj, prop, ref, varDecl)
1016import qualified Generate.JavaScript.Variable as Var
1117
1218
1319generate :: Module.Optimized -> String
1420generate module_ =
1521 let
16− definitions =
17− Module.program (Module.body module_)
22+ (ModuleName.Canonical _ name) =
23+ Module.name module_
1824
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+ ]
33+
34+ make =
35+ "Elm" : name ++ ["make"]
36+
37+ javascript =
38+ buildIntermediateObjects make
39+ ++
40+ [ assign make (function [localRuntime] body)
41+ ]
42+ in
43+ PP.displayS (PP.renderPretty 0.4 160 (ES.prettyPrint javascript)) ""
44+
45+
46+
47+-- INTRO
48+
49+
50+useStrict :: [Statement ()]
51+useStrict =
52+ [ ExprStmt () (StringLit () "use strict")
53+ ]
54+
55+
56+checkForCachedVersion :: ModuleName.Raw -> [Statement ()]
57+checkForCachedVersion name =
58+ let
59+ values =
60+ localRuntime : name ++ ["values"]
61+
62+ valuesObject =
63+ obj values
64+ in
65+ buildIntermediateObjects values
66+ ++
67+ [ IfSingleStmt () valuesObject (ReturnStmt () (Just valuesObject))
68+ ]
69+
70+
71+buildIntermediateObjects :: [String] -> [Statement ()]
72+buildIntermediateObjects path =
73+ let
74+ create name =
75+ assign name (InfixExpr () OpLOr (obj name) (ObjectLit () []))
76+
77+ paths =
78+ drop 2 (init (List.inits path))
79+ in
80+ map create paths
81+
82+
83+assign :: [String] -> Expression () -> Statement ()
84+assign path expr =
85+ case path of
86+ [x] ->
87+ VarDeclStmt () [ varDecl x expr ]
88+
89+ _ ->
90+ ExprStmt () $
91+ AssignExpr () OpAssign (LDot () (obj (init path)) (last path)) expr
92+
93+
94+
95+-- IMPORTS
96+
97+
98+imports :: [ModuleName.Raw] -> [Statement ()]
99+imports rawImports =
100+ case rawImports of
101+ [] ->
102+ []
103+
104+ _ ->
105+ [ VarDeclStmt () (map jsImport rawImports)
106+ ]
107+
108+
109+jsImport :: ModuleName.Raw -> VarDecl ()
110+jsImport name =
111+ let
112+ make =
113+ obj ("Elm" : name ++ ["make"])
114+ in
115+ varDecl (Var.modulePrefix name) (call make [ref localRuntime])
116+
117+
118+
119+-- DEFINITIONS
120+
121+
122+definitions :: [Optimized.Def] -> [Statement ()]
123+definitions defs =
124+ let
19125 setup =
20− Var.define "_op" (ObjectLit () [])
126+ Var.define "_op" (ObjectLit () [])
127+ in
128+ setup : State.evalState (mapM JS.generateDef defs) 0
129+
130+
131+
132+-- EXPORTS
133+
134+
135+exports :: ModuleName.Raw -> [Variable.Value] -> [Statement ()]
136+exports name exportedValues =
137+ let
138+ exportedFields =
139+ map toField ("_op" : concatMap extract exportedValues)
140+
141+ toField x =
142+ (prop x, ref x)
143+
144+ extract value =
145+ case value of
146+ Variable.Alias _ ->
147+ []
148+
149+ Variable.Value x ->
150+ if Help.isOp x then
151+ []
152+
153+ else
154+ [Var.safe x]
155+
156+ Variable.Union _ (Variable.Listing ctors _) ->
157+ map Var.safe ctors
21158
22− stmts =
23− State.evalState (mapM JS.generateDef definitions) 0
159+ values =
160+ LDot () (obj (localRuntime : name)) "values"
24161 in
25− PP.displayS (PP.renderPretty 0.4 160 (ES.prettyPrint (setup:stmts))) ""
162+ [ ReturnStmt () $ Just $
163+ AssignExpr () OpAssign values (ObjectLit () exportedFields)
164+ ]