git.iko.soy/elk
on master help sign in
Generate effect manager code if necessary
b6b74adEvan Czaplicki
src/Generate/JavaScript.hs+72−4
compare with master
unifiedsplit
@@ -1,21 +1,89 @@
1module Generate.JavaScript (generate) where
1module Generate.JavaScript (generate) where
2
2
3−import Control.Monad.State as State
3+import qualified Control.Monad.State as State
4−import Language.ECMAScript3.PrettyPrint as ES
4+import qualified Language.ECMAScript3.PrettyPrint as ES
5+import qualified Language.ECMAScript3.Syntax as JS
5import qualified Text.PrettyPrint.Leijen as PP
6import qualified Text.PrettyPrint.Leijen as PP
6
7
8+import qualified AST.Effects as Fx
7import qualified AST.Module as Module
9import qualified AST.Module as Module
10+import qualified AST.Module.Name as ModuleName
8import qualified Generate.JavaScript.Expression as JS
11import 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
9
18
10
19
11generate :: Module.Optimized -> String
20generate :: Module.Optimized -> String
12−generate (Module.Module _ _ info) =
21+generate (Module.Module moduleName _ info) =
13 let
22 let
14 genBody =
23 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]))
16
27
17 body =
28 body =
18 State.evalState genBody 0
29 State.evalState genBody 0
19 in
30 in
20 PP.displayS (PP.renderPretty 1 160 (ES.prettyPrint body)) ""
31 PP.displayS (PP.renderPretty 1 160 (ES.prettyPrint body)) ""
21
32
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+ )
src/Generate/JavaScript/BuiltIn.hs+4−3
@@ -13,18 +13,19 @@ import qualified Language.ECMAScript3.Syntax as JS
13
13
14import qualified AST.Module.Name as ModuleName
14import qualified AST.Module.Name as ModuleName
15import Generate.JavaScript.Helpers
15import Generate.JavaScript.Helpers
16+import qualified Generate.JavaScript.Variable as Var
16import qualified Reporting.Region as R
17import qualified Reporting.Region as R
17
18
18
19
19
20
20utils :: String -> [JS.Expression ()] -> JS.Expression ()
21utils :: String -> [JS.Expression ()] -> JS.Expression ()
21utils func args =
22utils func args =
22− obj ["_elm_lang$core$Native_Utils", func] `call` args
23+ Var.native (ModuleName.inCore ["Native","Utils"]) func `call` args
23
24
24
25
25nativeList :: String -> [JS.Expression ()] -> JS.Expression ()
26nativeList :: String -> [JS.Expression ()] -> JS.Expression ()
26nativeList func args =
27nativeList func args =
27− obj ["_elm_lang$core$Native_List", func] `call` args
28+ Var.native (ModuleName.inCore ["Native","List"]) func `call` args
28
29
29
30
30
31
@@ -87,7 +88,7 @@ cmp left right =
87
88
88effect :: ModuleName.Canonical -> JS.Expression ()
89effect :: ModuleName.Canonical -> JS.Expression ()
89effect effectName =
90effect effectName =
90− obj ["_elm_lang$core$Native_Platform", "leaf"] <|
91+ Var.native (ModuleName.inCore ["Native","Platform"]) "leaf" <|
91 JS.StringLit () (ModuleName.canonicalToString effectName)
92 JS.StringLit () (ModuleName.canonicalToString effectName)
92
93
93
94
src/Generate/JavaScript/Variable.hs+1
@@ -3,6 +3,7 @@ module Generate.JavaScript.Variable
3 ( fresh
3 ( fresh
4 , canonical
4 , canonical
5 , qualified
5 , qualified
6+ , native
6 , define
7 , define
7 , safe
8 , safe
8 )
9 )