tidier digestHead

haskell-experiments/src/Datalog/NaiveDatabase.hs

@@ -126,6 +126,14 @@ data (DatalogDB db) => RuleContext db = RuleContext
   , _db :: db
   }
 
+-- | equivalent(Q,Q) :- . |
+-- could be equivalent(Q, 3, 'zzz, Q, R)
+-- terms = Var Q, Num 3, Sym zzz, Var Q, Var R
+-- want to convert this to:
+-- (need constants 3, 'zzz)
+-- entries = [RuleElement] = (RuleElement 0), RuleElement Num 3, RuleElement Sym zzz, (RuleElement 0), (RuleElement 1)
+-- variableNames = ["Q" "R"]
+
 digestHead :: forall db . (DatalogDB db) => db -> Relation -> Literal -> RuleContext db
 digestHead db relation (Literal neg relationName terms) =
   RuleContext
@@ -137,12 +145,7 @@ digestHead db relation (Literal neg relationName terms) =
     }
  where
   variableNames = nub $ extractVariableNames terms
-  headTermToElement :: Term -> RuleElement
+  entries' = nub $ (headTermToElement variableNames) <$> terms
-  headTermToElement (Var name) = 
-    RuleElementVariable $ lookupVariable name variableNames
-  headTermToElement constant = RuleElementConstant constant
-  extraVariables = headTermToElement <$> terms
-  entries' = nub extraVariables
   extraConstants = Set.fromList $ mapMaybe extractConstant entries' where
     extractConstant :: RuleElement -> Maybe Constant
     extractConstant (RuleElementConstant constant) = Just constant
@@ -176,6 +179,10 @@ lookupVariable varName variableNames =
   case elemIndex varName variableNames of
       Just index -> index
       Nothing -> throw $ VariableLookupException varName variableNames
+headTermToElement :: [Text] -> Term -> RuleElement
+headTermToElement variableNames (Var name) = 
+  RuleElementVariable $ lookupVariable name variableNames
+headTermToElement variableNames constant = RuleElementConstant constant
 
 withFactsAndRules :: [Text] -> [Text] -> NaiveDatabase
 withFactsAndRules facts = foldr (addRule . extractRule) (withFacts facts)