initial handling of rules

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
+import Datalog.DatalogParser(parseDatalog, Literal(Literal), Statement(..))
 import qualified Data.Map as Map
 import Text.Megaparsec (ParseErrorBundle)
 import Data.Void
@@ -71,6 +71,21 @@ withFacts facts =
         newRelations = Map.insert relationName newRelation relations 
         newConstants = Set.union constants $ Set.fromList terms
 
+withFactsAndRules :: [Text] -> [Text] -> NaiveDatabase
+withFactsAndRules facts rules =
+  foldl addRule (withFacts facts) (extractRule <$> rules) where
+    extractRule:: Text -> (Literal, [Literal])
+    extractRule ruleText =
+      case (parseDatalog ruleText) of
+        Right (Rule 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 =
+      NaiveDatabase newRelations newConstants where
+        newRelations = relations 
+        newConstants = constants
+ 
 query :: NaiveDatabase -> Text -> Text
 query db qText =
   case (parseDatalog qText) of
@@ -81,6 +96,7 @@ query db qText =
 data NaiveDatabaseException
   = CannotParseStatementException Text (ParseErrorBundle Text Void) |
     NonFactException Text Statement |
+    NonRuleException Text Statement |
     NonQueryException Text Statement |
     BadArityException Text Int
   deriving (Show)

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

@@ -35,6 +35,19 @@ spec = do
           ("parent",  
             Relation 2 $ Set.fromList $ [Sym <$> ["bob", "carol"]])
         ]
+    it "can ingest facts and rules" $ do
+      let db = NaiveDatabase.withFactsAndRules 
+            [ "parent(\"alice\", \"bob\")."
+            , "parent(\"bob\", \"carol\")." ]
+            [ "ancestor(X,Y) :- parent(X,Y)."
+            , "ancestor(X,Y) :- parent(X,Z), ancestor(Z,Y)." ]
+      constants db `shouldBe` 
+        (Set.fromList $ Sym <$> ["alice", "bob", "carol"])
+      relations db `shouldBe`
+        Map.fromList [
+          ("parent",  
+            Relation 2 $ Set.fromList $ [Sym <$> ["bob", "carol"]])
+        ]
 
     it "can do basic queries" $ do
       let db = NaiveDatabase.withFacts