From 069733e47437c0f7188d35b3c44fc8bcea4b85cd Mon Sep 17 00:00:00 2001
From: Felix Dilke <felix.dilke@obsidian.systems>
Date: Thu, 29 Jan 2026 17:02:27 +0000
Subject: [PATCH] adding typeclass APIs

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

diff --git a/haskell-experiments/src/Datalog/NaiveDatabase.hs b/haskell-experiments/src/Datalog/NaiveDatabase.hs
index 81e62ae..ba12d09 100644
--- a/haskell-experiments/src/Datalog/NaiveDatabase.hs
+++ b/haskell-experiments/src/Datalog/NaiveDatabase.hs
@@ -33,14 +33,16 @@ instance DatalogDB NaiveDatabase where
     , constants = Set.empty -- the Herbrand universe
     }
 
-  -- lookupRelation :: NaiveDatabase -> Text -> Maybe Relation -> NaiveDatabase
-  -- lookupRelation = _
+  lookupRelation :: NaiveDatabase -> Text -> Maybe Relation
+  lookupRelation db relationName =
+    Map.lookup relationName $ relations db
+
   -- insertRelation :: NaiveDatabase -> Text -> Relation -> NaiveDatabase
   -- insertRelation = _
 
-lookupRelation :: RelationId -> Map RelationId Relation -> Int -> Set [Term] -> Relation
-lookupRelation relationName relationMap newArity tuples =
-  case Map.lookup relationName relationMap of
+lookupRelation0 :: RelationId -> NaiveDatabase -> Int -> Set [Term] -> Relation
+lookupRelation0 relationName db newArity tuples =
+  case lookupRelation db relationName of
     Nothing -> Relation relationName newArity tuples []
     Just relation ->
       if _arity relation == newArity then
@@ -59,11 +61,11 @@ withFacts =
       Right otherStatement -> throw $ NonFactException factText otherStatement
       Left ex -> throw $ CannotParseStatementException factText ex
   addFact :: Literal -> NaiveDatabase -> NaiveDatabase
-  addFact (Literal neg relationName terms) (NaiveDatabase relationMap constantSet) =
+  addFact (Literal neg relationName terms) db@(NaiveDatabase relationMap constantSet) =
     NaiveDatabase newRelationMap newConstantSet
    where
     newArity = length terms
-    newRelation = lookupRelation relationName relationMap newArity (Set.singleton terms)
+    newRelation = lookupRelation0 relationName db newArity (Set.singleton terms)
     newRelationMap = Map.insert relationName newRelation relationMap
     newConstantSet = Set.union constantSet $ Set.fromList terms
 
@@ -142,7 +144,7 @@ digestBody (Literal neg subRelationName subTerms) context =
  where
   variableNames = nub $ _variableNames context ++ extractVariableNames subTerms
   newArity = length subTerms
-  subRelation = lookupRelation subRelationName relationMap newArity Set.empty
+  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
@@ -168,7 +170,7 @@ addRule (ruleHead, body) db  =
     relationName = predName ruleHead
     terms = arguments ruleHead
     newArity = length terms
-    relation = lookupRelation relationName (relations db) newArity Set.empty
+    relation = lookupRelation0 relationName db newArity Set.empty
     context = digestHead db relation ruleHead
     context' = foldr digestBody context body
     db' = _db context'
diff --git a/haskell-experiments/src/Datalog/Rules.hs b/haskell-experiments/src/Datalog/Rules.hs
index a0b1f8f..46bf6d2 100644
--- a/haskell-experiments/src/Datalog/Rules.hs
+++ b/haskell-experiments/src/Datalog/Rules.hs
@@ -49,5 +49,5 @@ type RelationId = Text
 
 class DatalogDB db where
   emptyDB :: db
-  -- lookupRelation :: db -> Text -> Maybe Relation -> db
+  lookupRelation :: db -> Text -> Maybe Relation
   -- insertRelation :: db -> Text -> Relation -> db