correctly handling duplicate head entries

haskell-experiments/src/Datalog/NaiveDatabase.hs

@@ -120,7 +120,7 @@ withFactsAndRules facts = foldr (addRule . extractRule) (withFacts facts)
       , _db = NaiveDatabase relationMap' constants'
       }
    where
-    variableNames = extractVariableNames terms
+    variableNames = nub $ extractVariableNames terms
     headTermToElement :: Term -> RuleElement
     headTermToElement (Var name) = 
       RuleElementVariable $ lookupVariable name variableNames

haskell-experiments/test/Test/Datalog/NaiveDatabaseSpec.hs

@@ -25,11 +25,10 @@ spec :: Spec
 spec = do
   describe "NaiveDatabase operations" do
     it "can ingest facts into relations & a universe" $ do
-      let db =
-            NaiveDatabase.withFacts
-              [ "parent(\"alice\", \"bob\")."
-              , "parent(\"bob\", \"carol\")."
-              ]
+      let db = NaiveDatabase.withFacts
+            [ "parent(\"alice\", \"bob\")."
+            , "parent(\"bob\", \"carol\")."
+            ]
       constants db
         `shouldBe` Set.fromList (Sym <$> ["alice", "bob", "carol"])
       relations db
@@ -40,15 +39,14 @@ spec = do
             )
           ]
     it "can ingest facts and rules" do
-      let db =
-            NaiveDatabase.withFactsAndRules
-              [ "parent(\"alice\", \"bob\")."
-              , "parent(\"bob\", \"carol\")."
-              ]
-              [
-                "ancestor(X,Y) :- parent(X,Z), ancestor(Z,Y)."
-              , "ancestor(X,Y) :- parent(X,Y)." 
-              ]
+      let db = NaiveDatabase.withFactsAndRules
+            [ "parent(\"alice\", \"bob\")."
+            , "parent(\"bob\", \"carol\")."
+            ]
+            [
+              "ancestor(X,Y) :- parent(X,Z), ancestor(Z,Y)."
+            , "ancestor(X,Y) :- parent(X,Y)." 
+            ]
           parentRelation =
             Relation
               { _name = "parent"
@@ -111,19 +109,39 @@ spec = do
               , _rules = [ancestorRule]
               }
       relations db
-        `shouldBe` Map.fromList
-          [ ("ancestor", ancestorRelation)
-          ]
+        `shouldBe` Map.singleton "ancestor" ancestorRelation
 
       constants db
         `shouldBe` Set.fromList (Sym <$> ["patriarch"])
 
-    it "can do basic queries" do
+    it "can ingest facts and rules with duplicate head entries" do
       let db =
-            NaiveDatabase.withFacts
-              [ "parent(\"alice\", \"bob\")."
-              , "parent(\"bob\", \"carol\")."
-              ]
+            NaiveDatabase.withFactsAndRules
+              []
+              ["equivalent(Q,Q) :- ."]
+          equivalentRule =
+            RelationRule
+              { headVariables = ["Q"]
+              , bodyElements = []
+              }
+          equivalentRelation =
+            Relation
+              { _arity = 2
+              , _name = "equivalent"
+              , _tuples = Set.empty
+              , _rules = [equivalentRule]
+              }
+      relations db
+        `shouldBe` Map.singleton "equivalent" equivalentRelation
+
+      constants db
+        `shouldBe` Set.empty
+
+    it "can do basic queries" do
+      let db = NaiveDatabase.withFacts
+            [ "parent(\"alice\", \"bob\")."
+            , "parent(\"bob\", \"carol\")."
+            ]
       query db "?- parent(alice,X)." `shouldBe` "#NYI" -- ideally, 'bob'
 
 (<<$>>) :: (Functor f1, Functor f2) => (a -> b) -> f1 (f2 a) -> f1 (f2 b)