git.iko.soy/elk
on master help sign in
Add checks for cmdMap and subMap
cf4c998Evan Czaplicki
src/Validate.hs+57−14
compare with master
unifiedsplit
@@ -90,7 +90,7 @@ validateEffects tag settings@(A.A _ pairs) decls =
90 foldr collectSettings Map.empty pairs
90 foldr collectSettings Map.empty pairs
91 in
91 in
92 do managerType <- toManagerType tagRegion settingsDict
92 do managerType <- toManagerType tagRegion settingsDict
93− (r0, r1, r2) <- getManagerRegions tagRegion Nothing Nothing Nothing decls
93+ (r0, r1, r2) <- checkManagerImpl tagRegion managerType noInfo decls
94 return (Fx.Effect (Fx.Info tagRegion r0 r1 r2 managerType))
94 return (Fx.Effect (Fx.Info tagRegion r0 r1 r2 managerType))
95
95
96
96
@@ -166,34 +166,58 @@ extractOne name settingsDict =
166-- EFFECT REGIONS
166-- EFFECT REGIONS
167
167
168
168
169−getManagerRegions
169+data ManagerInfo =
170+ ManagerInfo
171+ { _cmdMap :: Bool
172+ , _subMap :: Bool
173+ , _init :: Maybe R.Region
174+ , _onEffects :: Maybe R.Region
175+ , _onSelfMsg :: Maybe R.Region
176+ }
177+
178+
179+noInfo :: ManagerInfo
180+noInfo =
181+ ManagerInfo False False Nothing Nothing Nothing
182+
183+
184+checkManagerImpl
170 :: R.Region
185 :: R.Region
171− -> Maybe R.Region
186+ -> Fx.ManagerType
172− -> Maybe R.Region
187+ -> ManagerInfo
173− -> Maybe R.Region
174 -> [D.Valid]
188 -> [D.Valid]
175 -> Result.Result w Error.Error (R.Region, R.Region, R.Region)
189 -> Result.Result w Error.Error (R.Region, R.Region, R.Region)
176−getManagerRegions tagRegion r0 r1 r2 decls =
190+checkManagerImpl tagRegion managerType info decls =
177 case decls of
191 case decls of
178 [] ->
192 [] ->
193+ let
194+ (ManagerInfo cmdMap subMap init onEffects onSelfMsg) = info
195+ in
179− (,,)
196+ const (,,)
197+ <$> requireMaps tagRegion managerType cmdMap subMap
180− <$> requireRegion tagRegion "init" r0
198+ <*> requireRegion tagRegion "init" init
181− <*> requireRegion tagRegion "onEffects" r1
199+ <*> requireRegion tagRegion "onEffects" onEffects
182− <*> requireRegion tagRegion "onSelfMsg" r2
200+ <*> requireRegion tagRegion "onSelfMsg" onSelfMsg
183
201
184 decl : rest ->
202 decl : rest ->
185 case getDefInfo decl of
203 case getDefInfo decl of
186 Just ("init", region) ->
204 Just ("init", region) ->
187− getManagerRegions tagRegion (Just region) r1 r2 rest
205+ checkManagerImpl tagRegion managerType (info { _init = Just region }) rest
188
206
189 Just ("onEffects", region) ->
207 Just ("onEffects", region) ->
190− getManagerRegions tagRegion r0 (Just region) r2 rest
208+ checkManagerImpl tagRegion managerType (info { _onEffects = Just region }) rest
191
209
192 Just ("onSelfMsg", region) ->
210 Just ("onSelfMsg", region) ->
193− getManagerRegions tagRegion r0 r1 (Just region) rest
211+ checkManagerImpl tagRegion managerType (info { _onSelfMsg = Just region }) rest
212+
213+ Just ("cmdMap", _) ->
214+ checkManagerImpl tagRegion managerType (info { _cmdMap = True }) rest
215+
216+ Just ("subMap", _) ->
217+ checkManagerImpl tagRegion managerType (info { _subMap = True }) rest
194
218
195 _ ->
219 _ ->
196− getManagerRegions tagRegion r0 r1 r2 rest
220+ checkManagerImpl tagRegion managerType info rest
197
221
198
222
199getDefInfo :: D.Valid -> Maybe (String, R.Region)
223getDefInfo :: D.Valid -> Maybe (String, R.Region)
@@ -206,6 +230,25 @@ getDefInfo decl =
206 Nothing
230 Nothing
207
231
208
232
233+requireMaps :: R.Region -> Fx.ManagerType -> Bool -> Bool -> Result.Result w Error.Error ()
234+requireMaps tagRegion managerType hasCmdMap hasSubMap =
235+ let
236+ check hasIt name =
237+ when (not hasIt) (Result.throw tagRegion (Error.MissingManagerOnEffectModule name))
238+ in
239+ case managerType of
240+ Fx.CmdManager _ ->
241+ check hasCmdMap "cmdMap"
242+
243+ Fx.SubManager _ ->
244+ check hasSubMap "subMap"
245+
246+ Fx.FxManager _ _ ->
247+ (\_ _ -> ())
248+ <$> check hasCmdMap "cmdMap"
249+ <*> check hasSubMap "subMap"
250+
251+
209requireRegion :: R.Region -> String -> Maybe R.Region -> Result.Result w Error.Error R.Region
252requireRegion :: R.Region -> String -> Maybe R.Region -> Result.Result w Error.Error R.Region
210requireRegion tagRegion name maybeRegion =
253requireRegion tagRegion name maybeRegion =
211 case maybeRegion of
254 case maybeRegion of