From 55b12f5c00775cf6a48f861b791a11d7fe9fea36 Mon Sep 17 00:00:00 2001
From: Felix Dilke <felix.dilke@obsidian.systems>
Date: Fri, 30 Jan 2026 11:24:44 +0000
Subject: [PATCH] tidier digestHead

---
 .../src/Datalog/NaiveDatabase.hs              | 19 +++++++++++++------
 1 file changed, 13 insertions(+), 6 deletions(-)

diff --git a/haskell-experiments/src/Datalog/NaiveDatabase.hs b/haskell-experiments/src/Datalog/NaiveDatabase.hs
index 51da4be..61d9f90 100644
--- a/haskell-experiments/src/Datalog/NaiveDatabase.hs
+++ b/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
-  headTermToElement (Var name) = 
-    RuleElementVariable $ lookupVariable name variableNames
-  headTermToElement constant = RuleElementConstant constant
-  extraVariables = headTermToElement <$> terms
-  entries' = nub extraVariables
+  entries' = nub $ (headTermToElement variableNames) <$> terms
   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)