@@ -1,21 +1,89 @@
11module Generate.JavaScript (generate) where
22
3−import Control.Monad.State as State
4−import Language.ECMAScript3.PrettyPrint as ES
3+import qualified Control.Monad.State as State
4+import qualified Language.ECMAScript3.PrettyPrint as ES
5+import qualified Language.ECMAScript3.Syntax as JS
56import qualified Text.PrettyPrint.Leijen as PP
67
8+import qualified AST.Effects as Fx
79import qualified AST.Module as Module
10+import qualified AST.Module.Name as ModuleName
811import qualified Generate.JavaScript.Expression as JS
12+import qualified Generate.JavaScript.Helpers as JS
13+import qualified Generate.JavaScript.Variable as Var
14+
15+
16+
17+-- GENERATE JAVASCRIPT
918
1019
1120generate :: Module.Optimized -> String
12−generate (Module.Module _ _ info) =
21+generate (Module.Module moduleName _ info) =
1322 let
1423 genBody =
15− concat <$> mapM JS.generateDef (Module.program info)
24+ do defsList <- mapM JS.generateDef (Module.program info)
25+ let managerStmts = generateEffectManager moduleName (Module.effects info)
26+ return (concat (defsList ++ [managerStmts]))
1627
1728 body =
1829 State.evalState genBody 0
1930 in
2031 PP.displayS (PP.renderPretty 1 160 (ES.prettyPrint body)) ""
2132
33+
34+
35+-- GENERATE EFFECT MANAGER
36+
37+
38+generateEffectManager :: ModuleName.Canonical -> Fx.Effects -> [JS.Statement ()]
39+generateEffectManager moduleName effects =
40+ case effects of
41+ Fx.None ->
42+ []
43+
44+ Fx.Foreign ->
45+ []
46+
47+ Fx.Effect (Fx.Info _ _ _ _ managerType) ->
48+ let
49+ managers =
50+ Var.native (ModuleName.inCore ["Native","Platform"]) "globalManagerInfo"
51+
52+ managerName =
53+ JS.StringLit () (ModuleName.canonicalToString moduleName)
54+
55+ entry name =
56+ ( JS.PropId () (JS.Id () name)
57+ , JS.ref (Var.qualified moduleName name)
58+ )
59+
60+ managerEntries =
61+ [ entry "init"
62+ , entry "onEffects"
63+ , entry "onSelfMsg"
64+ ]
65+
66+ otherEntries =
67+ case managerType of
68+ Fx.CmdManager _ ->
69+ [ tagEntry "cmd", entry "cmdMap" ]
70+
71+ Fx.SubManager _ ->
72+ [ tagEntry "sub", entry "subMap" ]
73+
74+ Fx.FxManager _ _ ->
75+ [ tagEntry "fx", entry "cmdMap", entry "subMap" ]
76+
77+ addManager =
78+ JS.AssignExpr () JS.OpAssign
79+ (JS.LBracket () managers managerName)
80+ (JS.ObjectLit () (managerEntries ++ otherEntries))
81+ in
82+ [ JS.ExprStmt () addManager ]
83+
84+
85+tagEntry :: String -> ( JS.Prop (), JS.Expression () )
86+tagEntry tag =
87+ ( JS.PropId () (JS.Id () "tag")
88+ , JS.StringLit () tag
89+ )