git.iko.soy/elk
on master help sign in
Add "pkg" field to effect managers
f24673bEvan Czaplicki
src/AST/Effects.hs+5−4
compare with master
unifiedsplit
@@ -1,6 +1,7 @@
1module AST.Effects where
1module AST.Effects where
2
2
3import qualified AST.Type as Type
3import qualified AST.Type as Type
4+import qualified Elm.Package as Pkg
4import qualified Reporting.Annotation as A
5import qualified Reporting.Annotation as A
5import qualified Reporting.Region as R
6import qualified Reporting.Region as R
6
7
@@ -9,18 +10,18 @@ import qualified Reporting.Region as R
9-- EFFECTS
10-- EFFECTS
10
11
11
12
12−data Effects foreigns
13+data Effects pkg foreigns
13 = None
14 = None
14− | Manager Info
15+ | Manager pkg Info
15 | Foreign foreigns
16 | Foreign foreigns
16
17
17
18
18type Raw =
19type Raw =
19− Effects [A.Commented ForeignRaw]
20+ Effects () [A.Commented ForeignRaw]
20
21
21
22
22type Canonical =
23type Canonical =
23− Effects [A.Commented ForeignCanonical]
24+ Effects Pkg.Name [A.Commented ForeignCanonical]
24
25
25
26
26
27
src/Canonicalize/Body.hs+1−1
@@ -123,7 +123,7 @@ effectsToDefs moduleName effects =
123 Effects.Foreign foreigns ->
123 Effects.Foreign foreigns ->
124 map foreignToDef foreigns
124 map foreignToDef foreigns
125
125
126− Effects.Manager info ->
126+ Effects.Manager _ info ->
127 let
127 let
128 cmdToDef (A.A region name) =
128 cmdToDef (A.A region name) =
129 definition
129 definition
src/Canonicalize/Effects.hs+3−3
@@ -25,7 +25,7 @@ toValues effects =
25 Effects.None ->
25 Effects.None ->
26 []
26 []
27
27
28− Effects.Manager _ ->
28+ Effects.Manager _ _ ->
29 []
29 []
30
30
31 Effects.Foreign foreigns ->
31 Effects.Foreign foreigns ->
@@ -42,8 +42,8 @@ canonicalize env effects =
42 Effects.None ->
42 Effects.None ->
43 Result.ok Effects.None
43 Result.ok Effects.None
44
44
45− Effects.Manager info ->
45+ Effects.Manager _ info ->
46− Result.ok (Effects.Manager info)
46+ Result.ok (Effects.Manager (Env.getPackage env) info)
47
47
48 Effects.Foreign rawForeigns ->
48 Effects.Foreign rawForeigns ->
49 Effects.Foreign <$> T.traverse (canonicalizeRawForeign env) rawForeigns
49 Effects.Foreign <$> T.traverse (canonicalizeRawForeign env) rawForeigns
src/Canonicalize/Environment.hs+7
@@ -1,6 +1,7 @@
1{-# OPTIONS_GHC -Wall #-}
1{-# OPTIONS_GHC -Wall #-}
2module Canonicalize.Environment
2module Canonicalize.Environment
3 ( Environment(..)
3 ( Environment(..)
4+ , getPackage
4 , insert
5 , insert
5 , Patch(..), fromPatches, addPattern
6 , Patch(..), fromPatches, addPattern
6 , builtinPatches
7 , builtinPatches
@@ -17,6 +18,7 @@ import qualified AST.Module.Name as ModuleName
17import qualified AST.Pattern as P
18import qualified AST.Pattern as P
18import qualified AST.Type as Type
19import qualified AST.Type as Type
19import qualified AST.Variable as Var
20import qualified AST.Variable as Var
21+import qualified Elm.Package as Pkg
20
22
21
23
22
24
@@ -50,6 +52,11 @@ addPattern pattern env =
50 addPatches patches env
52 addPatches patches env
51
53
52
54
55+getPackage :: Environment -> Pkg.Name
56+getPackage env =
57+ ModuleName._package (_home env)
58+
59+
53
60
54-- PATCHES
61-- PATCHES
55
62
src/Canonicalize/Setup.hs+1−1
@@ -375,7 +375,7 @@ effectsToPatches moduleName effects =
375 in
375 in
376 map toPatch foreigns
376 map toPatch foreigns
377
377
378− Effects.Manager info ->
378+ Effects.Manager _ info ->
379 map (\name -> Env.Value name (Var.topLevel moduleName name)) $
379 map (\name -> Env.Value name (Var.topLevel moduleName name)) $
380 case Effects._managerType info of
380 case Effects._managerType info of
381 Effects.CmdManager _ ->
381 Effects.CmdManager _ ->
src/Generate/JavaScript.hs+11−9
@@ -7,6 +7,7 @@ import qualified Language.ECMAScript3.Syntax as JS
7import qualified AST.Effects as Effects
7import qualified AST.Effects as Effects
8import qualified AST.Module as Module
8import qualified AST.Module as Module
9import qualified AST.Module.Name as ModuleName
9import qualified AST.Module.Name as ModuleName
10+import qualified Elm.Package as Pkg
10import qualified Generate.JavaScript.Builder as Builder
11import qualified Generate.JavaScript.Builder as Builder
11import qualified Generate.JavaScript.Expression as JS
12import qualified Generate.JavaScript.Expression as JS
12import qualified Generate.JavaScript.Helpers as JS
13import qualified Generate.JavaScript.Helpers as JS
@@ -44,7 +45,7 @@ generateEffectManager moduleName effects =
44 Effects.Foreign _ ->
45 Effects.Foreign _ ->
45 []
46 []
46
47
47− Effects.Manager (Effects.Info _ _ _ _ managerType) ->
48+ Effects.Manager pkgName (Effects.Info _ _ _ _ managerType) ->
48 let
49 let
49 managers =
50 managers =
50 Var.native (ModuleName.inCore ["Native","Platform"]) "globalManagerInfo"
51 Var.native (ModuleName.inCore ["Native","Platform"]) "globalManagerInfo"
@@ -58,7 +59,8 @@ generateEffectManager moduleName effects =
58 )
59 )
59
60
60 managerEntries =
61 managerEntries =
62+ [ "pkg" ==> Pkg.toString pkgName
61− [ entry "init"
63+ , entry "init"
62 , entry "onEffects"
64 , entry "onEffects"
63 , entry "onSelfMsg"
65 , entry "onSelfMsg"
64 ]
66 ]
@@ -66,13 +68,13 @@ generateEffectManager moduleName effects =
66 otherEntries =
68 otherEntries =
67 case managerType of
69 case managerType of
68 Effects.CmdManager _ ->
70 Effects.CmdManager _ ->
69− [ tagEntry "cmd", entry "cmdMap" ]
71+ [ "tag" ==> "cmd", entry "cmdMap" ]
70
72
71 Effects.SubManager _ ->
73 Effects.SubManager _ ->
72− [ tagEntry "sub", entry "subMap" ]
74+ [ "tag" ==> "sub", entry "subMap" ]
73
75
74 Effects.FxManager _ _ ->
76 Effects.FxManager _ _ ->
75− [ tagEntry "fx", entry "cmdMap", entry "subMap" ]
77+ [ "tag" ==> "fx", entry "cmdMap", entry "subMap" ]
76
78
77 addManager =
79 addManager =
78 JS.AssignExpr () JS.OpAssign
80 JS.AssignExpr () JS.OpAssign
@@ -82,8 +84,8 @@ generateEffectManager moduleName effects =
82 [ JS.ExprStmt () addManager ]
84 [ JS.ExprStmt () addManager ]
83
85
84
86
85−tagEntry :: String -> ( JS.Prop (), JS.Expression () )
87+(==>) :: String -> String -> ( JS.Prop (), JS.Expression () )
86−tagEntry tag =
88+(==>) key value =
87− ( JS.PropId () (JS.Id () "tag")
89+ ( JS.PropId () (JS.Id () key)
88− , JS.StringLit () tag
90+ , JS.StringLit () value
89 )
91 )
src/Type/Constrain/Effects.hs+1−1
@@ -27,7 +27,7 @@ constrain env moduleName effects =
27 Effects.Foreign _ ->
27 Effects.Foreign _ ->
28 return CSaveEnv
28 return CSaveEnv
29
29
30− Effects.Manager info ->
30+ Effects.Manager _ info ->
31 constrainHelp env moduleName info
31 constrainHelp env moduleName info
32
32
33
33
src/Validate.hs+1−1
@@ -102,7 +102,7 @@ validateEffects tag settings@(A.A _ pairs) foreigns validDefs =
102 do noForeigns foreigns
102 do noForeigns foreigns
103 managerType <- toManagerType tagRegion settingsDict
103 managerType <- toManagerType tagRegion settingsDict
104 (r0, r1, r2) <- checkManager tagRegion managerType validDefs
104 (r0, r1, r2) <- checkManager tagRegion managerType validDefs
105− return (Effects.Manager (Effects.Info tagRegion r0 r1 r2 managerType))
105+ return (Effects.Manager () (Effects.Info tagRegion r0 r1 r2 managerType))
106
106
107
107
108noSettings :: Error.Error -> Module.SourceSettings -> Result wrn ()
108noSettings :: Error.Error -> Module.SourceSettings -> Result wrn ()