adding rules to relations

haskell-experiments/src/Datalog/NaiveDatabase.hs

@@ -11,7 +11,7 @@ import Data.Set (Set)
 import Data.Set qualified as Set
 import Data.Text (Text)
 import qualified Data.Text as T
-import Datalog.DatalogParser(parseDatalog, Literal(Literal), Statement(..))
+import Datalog.DatalogParser(parseDatalog, Literal(Literal), Statement(..), Term, Head (HeadSingle))
 import qualified Data.Map as Map
 import Text.Megaparsec (ParseErrorBundle)
 import Data.Void
@@ -27,9 +27,20 @@ data NaiveDatabase = NaiveDatabase {
   constants :: Set Constant
 }
 
+data BodyEntry = -- entry occurring in a head or body relation - constant or variable
+  BodyEntryConstant Constant |
+  BodyEntryVariable Text
+  deriving (Show, Eq)
+
+data RelationRule = RelationRule {
+  headVariables :: [BodyEntry],
+  body :: [(Relation, [BodyEntry])]
+} deriving (Show, Eq)
+
 data Relation = Relation {
   arity :: Int,
-  tuples :: Set [Constant]
+  tuples :: Set [Constant],
+  rules :: [RelationRule]
 } deriving (Show, Eq)
 
 -- newtype RelationId = RelationId Text
@@ -63,10 +74,10 @@ withFacts facts =
         newArity = length terms
         newRelation =
           case Map.lookup relationName relations of
-            Nothing -> Relation (length terms) (Set.singleton terms)
+            Nothing -> Relation (length terms) (Set.singleton terms) []
             Just relation ->
               if (arity relation == newArity)
-                then Relation (length terms) (Set.singleton terms)
+                then Relation (length terms) (Set.singleton terms) []
                 else throw $ BadArityException relationName newArity
         newRelations = Map.insert relationName newRelation relations 
         newConstants = Set.union constants $ Set.fromList terms
@@ -77,11 +88,11 @@ withFactsAndRules facts rules =
     extractRule:: Text -> (Literal, [Literal])
     extractRule ruleText =
       case (parseDatalog ruleText) of
-        Right (Rule lhs rhs) -> (lhs, rhs)
+        Right (Rule (HeadSingle lhs) rhs) -> (lhs, rhs)
         Right otherStatement -> throw $ NonRuleException ruleText otherStatement
         Left ex -> throw $ CannotParseStatementException ruleText ex
-    addRule :: NaiveDatabase -> Literal -> [Literal] -> NaiveDatabase
-    addRule (NaiveDatabase relations constants) (Literal neg relationName terms) body =
+    addRule :: NaiveDatabase -> (Literal, [Literal]) -> NaiveDatabase
+    addRule (NaiveDatabase relations constants) ((Literal neg relationName terms), body) =
       NaiveDatabase newRelations newConstants where
         newRelations = relations 
         newConstants = constants

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

@@ -33,7 +33,7 @@ spec = do
       relations db `shouldBe`
         Map.fromList [
           ("parent",  
-            Relation 2 $ Set.fromList $ [Sym <$> ["bob", "carol"]])
+            Relation 2 (Set.fromList ([Sym <$> ["bob", "carol"]])) [] )
         ]
     it "can ingest facts and rules" $ do
       let db = NaiveDatabase.withFactsAndRules 
@@ -46,7 +46,7 @@ spec = do
       relations db `shouldBe`
         Map.fromList [
           ("parent",  
-            Relation 2 $ Set.fromList $ [Sym <$> ["bob", "carol"]])
+            Relation 2 (Set.fromList ([Sym <$> ["bob", "carol"]])) [] )
         ]
 
     it "can do basic queries" $ do