on master help sign in
Ensure that necessary effect manager functions exist
commit2d3311617b496da002a0db631838d079cac53c2d authorEvan Czaplicki <info@elm-lang.org> dateSun 6 Mar 2016, 13:46 (11 years ago) parent59f162b
1 file changed+69−7
src/Validate.hs+69−7
src/Validate.hs+69−7
@@ -38,14 +38,17 @@ module' (Module.Module name path info) =
3838 (Module.Source tag settings docs exports imports decls) =
3939 info
4040 in
41− do validEffects <- validateModuleDecl tag settings
42− validDecls <- declarations decls
41+ do validDecls <- declarations decls
42+ validEffects <- validateEffects tag settings validDecls
4343
4444 return $ Module.Module name path $
4545 Module.Valid docs exports (addDefaults pkgName imports) validDecls validEffects
4646
4747
48−-- determine if default imports should be added, only elm-lang/core is exempt
48+
49+-- IMPORTS
50+
51+
4952addDefaults
5053 :: Package.Name
5154 -> [Module.UserImport]
@@ -59,11 +62,16 @@ addDefaults pkgName imports =
5962 Imports.defaults
6063
6164
62−validateModuleDecl
65+
66+-- EFFECTS
67+
68+
69+validateEffects
6370 :: Module.SourceTag
6471 -> Module.SourceSettings
72+ -> [D.Valid]
6573 -> Result.Result wrn Error.Error Fx.Effects
66−validateModuleDecl tag settings@(A.A _ pairs) =
74+validateEffects tag settings@(A.A _ pairs) decls =
6775 case tag of
6876 Module.Normal ->
6977 do noSettings Error.SettingsOnNormalModule settings
@@ -82,8 +90,8 @@ validateModuleDecl tag settings@(A.A _ pairs) =
8290 foldr collectSettings Map.empty pairs
8391 in
8492 do managerType <- toManagerType tagRegion settingsDict
85− return $ Fx.Effect $
86− Fx.Info tagRegion (error "TODO") (error "TODO") (error "TODO") managerType
93+ (r0, r1, r2) <- getManagerRegions tagRegion Nothing Nothing Nothing decls
94+ return (Fx.Effect (Fx.Info tagRegion r0 r1 r2 managerType))
8795
8896
8997noSettings
@@ -155,6 +163,60 @@ extractOne name settingsDict =
155163
156164
157165
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+
158220-- COLLAPSE COMMENTS
159221
160222