From e01a1ba3dfb0ae892df386cc3a93b6c9f2ccbbe9 Mon Sep 17 00:00:00 2001
From: Felix Dilke <felix.dilke@obsidian.systems>
Date: Fri, 30 Jan 2026 12:08:29 +0000
Subject: [PATCH] digestBody uses the typeclass

---
 haskell-experiments/src/Datalog/NaiveDatabase.hs | 11 +++++------
 1 file changed, 5 insertions(+), 6 deletions(-)

diff --git a/haskell-experiments/src/Datalog/NaiveDatabase.hs b/haskell-experiments/src/Datalog/NaiveDatabase.hs
index 61d9f90..ec64aec 100644
--- a/haskell-experiments/src/Datalog/NaiveDatabase.hs
+++ b/haskell-experiments/src/Datalog/NaiveDatabase.hs
@@ -150,24 +150,23 @@ digestHead db relation (Literal neg relationName terms) =
     extractConstant :: RuleElement -> Maybe Constant
     extractConstant (RuleElementConstant constant) = Just constant
     extractConstant _ = Nothing
-digestBody :: Literal -> RuleContext NaiveDatabase -> RuleContext NaiveDatabase
+digestBody :: forall db . (DatalogDB db) => Literal -> RuleContext db -> RuleContext db
 digestBody (Literal neg subRelationName subTerms) context =
   context { 
     _variableNames = variableNames
     , _bodyConstraints = newConstraint : constraints
-    , _db = NaiveDatabase relationMap' constants'
+    , _db = insertRelation (addConstants db constants') subRelation
     }
  where
+  db = _db context
   variableNames = nub $ _variableNames context ++ extractVariableNames subTerms
   newArity = length subTerms
   subRelation = lookupRelation0 subRelationName (_db context) newArity Set.empty
-  relationMap :: Map RelationId Relation = relations (_db context)
-  relationMap' = Map.insert subRelationName subRelation relationMap
   extraConstants = mapMaybe constantFromTerm subTerms where
     constantFromTerm :: Term -> Maybe Constant
     constantFromTerm (Var _) = Nothing
     constantFromTerm constant = Just constant
-  constants' = Set.union (constants (_db context)) $ Set.fromList extraConstants
+  constants' = Set.fromList extraConstants
   constraints = _bodyConstraints context
   newConstraint = BodyConstraint subRelation subRuleElements where
     subRuleElements = toRuleElement <$> subTerms
@@ -182,7 +181,7 @@ lookupVariable varName variableNames =
 headTermToElement :: [Text] -> Term -> RuleElement
 headTermToElement variableNames (Var name) = 
   RuleElementVariable $ lookupVariable name variableNames
-headTermToElement variableNames constant = RuleElementConstant constant
+headTermToElement _ constant = RuleElementConstant constant
 
 withFactsAndRules :: [Text] -> [Text] -> NaiveDatabase
 withFactsAndRules facts = foldr (addRule . extractRule) (withFacts facts)