Clean up (and fix) the context matching function

Co-authored-by: Nikolai Kudasov <[email protected]>
objectionary · Feb 7, 2024 · 4d68a2f · 4d68a2f
1 parent 0b78d54
commit 4d68a2f
Showing 1 changed file with 7 additions and 8 deletions.
diff --git a/eo-phi-normalizer/src/Language/EO/Phi/Rules/Yaml.hs b/eo-phi-normalizer/src/Language/EO/Phi/Rules/Yaml.hs
@@ -81,7 +81,7 @@ parseRuleSetFromFile = Yaml.decodeFileThrow
 convertRule :: Rule -> Common.Rule
 convertRule Rule{..} ctx obj =
   [ obj'
-  | contextSubsts <- matchContext ctx obj context
+  | contextSubsts <- matchContext ctx context
   , let pattern' = applySubst contextSubsts pattern
   , let result' = applySubst contextSubsts result
   , subst <- matchObject pattern' obj
@@ -90,13 +90,12 @@ convertRule Rule{..} ctx obj =
   , not (objectHasMetavars obj')
   ]
 
-matchContext :: Common.Context -> Object -> Maybe RuleContext -> [Subst]
-matchContext Common.Context{..} obj = \case
-  Nothing -> [emptySubst]
-  Just (RuleContext Nothing Nothing) -> [emptySubst]
-  Just (RuleContext (Just pattern) Nothing) -> matchObject pattern globalObject
-  Just (RuleContext Nothing (Just pattern)) -> matchObject pattern thisObject
-  Just (RuleContext (Just globalPattern) (Just thisPattern)) -> matchObject globalPattern globalObject ++ matchObject thisPattern thisObject
+matchContext :: Common.Context -> Maybe RuleContext -> [Subst]
+matchContext Common.Context{} Nothing = [emptySubst]
+matchContext Common.Context{..} (Just (RuleContext p1 p2)) = do
+  subst1 <- maybe [emptySubst] (`matchObject` globalObject) p1
+  subst2 <- maybe [emptySubst] ((`matchObject` thisObject) . applySubst subst1) p2
+  return (subst1 <> subst2)
  where
   globalObject = NonEmpty.last outerFormations
   thisObject = NonEmpty.head outerFormations