git.iko.soy/elk
on master help sign in
Ensure that necessary effect manager functions exist
2d33116Evan Czaplicki
src/Validate.hs+69−7
compare with master
unifiedsplit
@@ -38,14 +38,17 @@ module' (Module.Module name path info) =
38 (Module.Source tag settings docs exports imports decls) =
38 (Module.Source tag settings docs exports imports decls) =
39 info
39 info
40 in
40 in
41+ do validDecls <- declarations decls
41− do validEffects <- validateModuleDecl tag settings
42+ validEffects <- validateEffects tag settings validDecls
42− validDecls <- declarations decls
43
43
44 return $ Module.Module name path $
44 return $ Module.Module name path $
45 Module.Valid docs exports (addDefaults pkgName imports) validDecls validEffects
45 Module.Valid docs exports (addDefaults pkgName imports) validDecls validEffects
46
46
47
47
48−-- determine if default imports should be added, only elm-lang/core is exempt
48+
49+-- IMPORTS
50+
51+
49addDefaults
52addDefaults
50 :: Package.Name
53 :: Package.Name
51 -> [Module.UserImport]
54 -> [Module.UserImport]
@@ -59,11 +62,16 @@ addDefaults pkgName imports =
59 Imports.defaults
62 Imports.defaults
60
63
61
64
62−validateModuleDecl
65+
66+-- EFFECTS
67+
68+
69+validateEffects
63 :: Module.SourceTag
70 :: Module.SourceTag
64 -> Module.SourceSettings
71 -> Module.SourceSettings
72+ -> [D.Valid]
65 -> Result.Result wrn Error.Error Fx.Effects
73 -> Result.Result wrn Error.Error Fx.Effects
66−validateModuleDecl tag settings@(A.A _ pairs) =
74+validateEffects tag settings@(A.A _ pairs) decls =
67 case tag of
75 case tag of
68 Module.Normal ->
76 Module.Normal ->
69 do noSettings Error.SettingsOnNormalModule settings
77 do noSettings Error.SettingsOnNormalModule settings
@@ -82,8 +90,8 @@ validateModuleDecl tag settings@(A.A _ pairs) =
82 foldr collectSettings Map.empty pairs
90 foldr collectSettings Map.empty pairs
83 in
91 in
84 do managerType <- toManagerType tagRegion settingsDict
92 do managerType <- toManagerType tagRegion settingsDict
85− return $ Fx.Effect $
93+ (r0, r1, r2) <- getManagerRegions tagRegion Nothing Nothing Nothing decls
86− Fx.Info tagRegion (error "TODO") (error "TODO") (error "TODO") managerType
94+ return (Fx.Effect (Fx.Info tagRegion r0 r1 r2 managerType))
87
95
88
96
89noSettings
97noSettings
@@ -155,6 +163,60 @@ extractOne name settingsDict =
155
163
156
164
157
165
166+-- EFFECT REGIONS
167+
168+
169+getManagerRegions
170+ :: R.Region
171+ -> Maybe R.Region
172+ -> Maybe R.Region
173+ -> Maybe R.Region
174+ -> [D.Valid]
175+ -> Result.Result w Error.Error (R.Region, R.Region, R.Region)
176+getManagerRegions tagRegion r0 r1 r2 decls =
177+ case decls of
178+ [] ->
179+ (,,)
180+ <$> requireRegion tagRegion "init" r0
181+ <*> requireRegion tagRegion "onEffects" r1
182+ <*> requireRegion tagRegion "onSelfMsg" r2
183+
184+ decl : rest ->
185+ case getDefInfo decl of
186+ Just ("init", region) ->
187+ getManagerRegions tagRegion (Just region) r1 r2 rest
188+
189+ Just ("onEffects", region) ->
190+ getManagerRegions tagRegion r0 (Just region) r2 rest
191+
192+ Just ("onSelfMsg", region) ->
193+ getManagerRegions tagRegion r0 r1 (Just region) rest
194+
195+ _ ->
196+ getManagerRegions tagRegion r0 r1 r2 rest
197+
198+
199+getDefInfo :: D.Valid -> Maybe (String, R.Region)
200+getDefInfo decl =
201+ case decl of
202+ A.A region (D.Def (Valid.Definition (A.A _ (Pattern.Var name)) _ _)) ->
203+ Just (name, fst region)
204+
205+ _ ->
206+ Nothing
207+
208+
209+requireRegion :: R.Region -> String -> Maybe R.Region -> Result.Result w Error.Error R.Region
210+requireRegion tagRegion name maybeRegion =
211+ case maybeRegion of
212+ Just region ->
213+ return region
214+
215+ Nothing ->
216+ Result.throw tagRegion (error $ "TODO - " ++ name)
217+
218+
219+
158-- COLLAPSE COMMENTS
220-- COLLAPSE COMMENTS
159
221
160
222