From 7126f0e75b00a844e0624149f16c3bb66260e2f2 Mon Sep 17 00:00:00 2001
From: Felix Dilke <felix.dilke@obsidian.systems>
Date: Tue, 27 Jan 2026 16:08:37 +0000
Subject: [PATCH] refactored digestHead ; it didn't need a rule context as
 input

---
 .../src/Datalog/NaiveDatabase.hs              | 35 +++++--------------
 1 file changed, 9 insertions(+), 26 deletions(-)

diff --git a/haskell-experiments/src/Datalog/NaiveDatabase.hs b/haskell-experiments/src/Datalog/NaiveDatabase.hs
index 99aadc4..75ecd77 100644
--- a/haskell-experiments/src/Datalog/NaiveDatabase.hs
+++ b/haskell-experiments/src/Datalog/NaiveDatabase.hs
@@ -124,22 +124,20 @@ withFactsAndRules facts rules =
         Right (Rule (HeadSingle lhs) rhs) -> (lhs, rhs)
         Right otherStatement -> throw $ NonRuleException ruleText otherStatement
         Left ex -> throw $ CannotParseStatementException ruleText ex
-    digestHead :: RuleContext -> Literal -> RuleContext
-    digestHead  context (Literal neg relationName terms) =
+    digestHead :: NaiveDatabase -> Relation -> Literal -> RuleContext
+    digestHead db relation (Literal neg relationName terms) =
       RuleContext { 
         __relation = relation, 
         _headVariables = variables', 
-        _bodyConstraints = _bodyConstraints context, 
+        _bodyConstraints = [], 
         _db = NaiveDatabase relationMap' constants'
       } where
-        newArity = length terms
-        relation = __relation context
-        relationMap :: Map RelationId Relation = (relations (_db context))
+        relationMap :: Map RelationId Relation = relations db
         relationMap' = Map.insert relationName relation relationMap
         extraVariables = toElement <$> terms
-        extraConstants = catMaybes $ maybeConstant <$> extraVariables
-        variables' = nub $ _headVariables context ++ extraVariables
-        constants' = Set.union (constants (_db context)) $ Set.fromList extraConstants
+        variables' = nub extraVariables
+        extraConstants = catMaybes $ maybeConstant <$> variables'
+        constants' = Set.union (constants db) $ Set.fromList extraConstants
     digestBody :: RuleContext -> Literal -> RuleContext
     digestBody context (Literal neg subRelationName terms) =
       RuleContext { 
@@ -166,7 +164,6 @@ withFactsAndRules facts rules =
             Just index -> index
             Nothing -> throw $ VariableLookupException name variables'
         toConstraint :: Term -> ConstraintElement
-        -- toConstraint thing = ConstraintElementIndex 0
         toConstraint (Var name) = ConstraintElementIndex (varIndex name)
         toConstraint constant = ConstraintElementConstant constant
     addRule :: NaiveDatabase -> (Literal, [Literal]) -> NaiveDatabase
@@ -175,26 +172,12 @@ withFactsAndRules facts rules =
         relationName = predName ruleHead
         terms = arguments ruleHead
         newArity = length terms
-        relation = lookupRelation relationName (relations (_db context)) newArity Set.empty
-        context = RuleContext { 
-          __relation = relation, 
-          _headVariables = [], 
-          _bodyConstraints = [], 
-          _db = db
-        }
-        context' = digestHead context ruleHead
+        relation = lookupRelation relationName (relations db) newArity Set.empty
+        context' = digestHead db relation ruleHead
         context'' = foldl digestBody context' body
         db' = _db context''
         relationMap = relations db'
         variables' = _headVariables context''
-        varIndex :: Text -> Int -- TODO unify with the above
-        varIndex name =
-          case elemIndex (RuleElementVariable name) variables' of
-            Just index -> index
-            Nothing -> throw $ VariableLookupException name variables'
-        toConstraintElement :: RuleElement -> ConstraintElement
-        toConstraintElement (RuleElementConstant constant) = ConstraintElementConstant constant
-        toConstraintElement (RuleElementVariable varName) = ConstraintElementIndex (varIndex varName)
         extractVarName :: RuleElement -> Maybe Text
         extractVarName (RuleElementVariable varName) = Just varName
         extractVarName (RuleElementConstant constant) = Nothing