From 429d64ee73463feda99f22c2788db490483f1e10 Mon Sep 17 00:00:00 2001
From: Felix Dilke <felix.dilke@obsidian.systems>
Date: Tue, 27 Jan 2026 17:55:19 +0000
Subject: [PATCH] extracting variable names in a rule

---
 haskell-experiments/src/Datalog/NaiveDatabase.hs | 12 ++++++++++--
 1 file changed, 10 insertions(+), 2 deletions(-)

diff --git a/haskell-experiments/src/Datalog/NaiveDatabase.hs b/haskell-experiments/src/Datalog/NaiveDatabase.hs
index 5c8a38d..398bddb 100644
--- a/haskell-experiments/src/Datalog/NaiveDatabase.hs
+++ b/haskell-experiments/src/Datalog/NaiveDatabase.hs
@@ -17,6 +17,7 @@ import Data.Text (Text)
 import Data.Void
 import Datalog.DatalogParser (Head (HeadSingle), Literal (..), Statement (..), Term (..), parseDatalog)
 import Text.Megaparsec (ParseErrorBundle)
+import GHC.TypeError (ErrorMessage(Text))
 
 data Value
   = ValueInt Int
@@ -104,8 +105,8 @@ data BodyConstraint = BodyConstraint
 
 data RuleContext = RuleContext
   { __relation :: Relation
-  , -- _variableNames :: [Text],
-    _headEntries :: [RuleElement]
+  , _variableNames :: [Text]
+  , _headEntries :: [RuleElement]
   , _bodyConstraints :: [BodyConstraint]
   , _db :: NaiveDatabase
   }
@@ -128,6 +129,7 @@ withFactsAndRules facts =
   digestHead db relation (Literal neg relationName terms) =
     RuleContext
       { __relation = relation
+      , _variableNames = extractVariableNames terms
       , _headEntries = variables'
       , _bodyConstraints = []
       , _db = NaiveDatabase relationMap' constants'
@@ -143,6 +145,7 @@ withFactsAndRules facts =
   digestBody context (Literal neg subRelationName terms) =
     RuleContext
       { __relation = relation
+      , _variableNames = _variableNames context
       , _headEntries = variables'
       , _bodyConstraints = constraints'
       , _db = NaiveDatabase relationMap' constants'
@@ -211,6 +214,11 @@ withFactsAndRules facts =
   toElement :: Term -> RuleElement
   toElement (Var name) = RuleElementVariable name
   toElement constant = RuleElementConstant constant
+  extractVariableNames :: [Term] -> [Text]
+  extractVariableNames = mapMaybe extractVariableName where
+    extractVariableName :: Term -> Maybe Text
+    extractVariableName (Var name) = Just name
+    extractVariableName _ = Nothing
 
 query :: NaiveDatabase -> Text -> Text
 query db qText =