parsing facts/rules/queries

haskell-experiments/src/DatalogParser.hs

@@ -166,23 +166,3 @@ parseDatalog = parse (statement <* sc <* eof) "<datalog>"
 parseDatalogFile :: Text -> Either (ParseErrorBundle Text Void) [Statement]
 parseDatalogFile src = parse (many (statement <* sc)) "<datalog-file>" src
 
--- Typical examples it can now parse
--- text-- Fact
--- parent("alice", "bob").
-
--- -- Fact with variables (uncommon but allowed)
--- edge(X, Y).
-
--- -- Rule
--- ancestor(X,Y) :- parent(X,Y).
--- ancestor(X,Y) :- parent(X,Z), ancestor(Z,Y).
-
--- -- Query styles
--- ?- parent(alice,X).
--- ?- ancestor(X,Y), not blocked(X,Y).
--- ?- knows(a,X), friend(X,Y) → X,Y.
--- ?- edge(A,B), edge(B,C) → A,C .
-
--- -- With disjunction (rare but supported)
--- reached(X) :- start(X); via(Y), edge(Y,X).
-

haskell-experiments/src/SimpleParser.hs

@@ -22,8 +22,7 @@ import Control.Monad.Combinators.Expr
 import Data.Functor (($>))
 import Data.Void (Void)
 import Text.Megaparsec
-import Text.Megaparsec.Byte.Lexer (lexeme)
+import Text.Megaparsec.Char (char)
-import Text.Megaparsec.Char (char, space)
 import Text.Megaparsec.Char.Lexer (decimal)
 
 type Parser = Parsec Void String

haskell-experiments/test/Test/DatalogParserSpec.hs

@@ -32,9 +32,69 @@ spec = do
         predName = "parent",
         arguments = [Sym "alice", Sym "bob"]
       })
+    it "parsing a fact with variables" $ do
+      parseDatalog "edge(X, Y)." `shouldBe` Right (Fact Literal {
+          positive = True,
+          predName = "edge",
+          arguments = [Var "X", Var "Y"]
+        })
+    it "parsing a rule" $ do
+      parseDatalog "ancestor(X,Y) :- parent(X,Y)." `shouldBe` Right (Rule (HeadSingle Literal {
+          positive = True,
+          predName = "ancestor",
+          arguments = [Var "X", Var "Y"]
+        }) [Literal {
+          positive = True,
+          predName = "parent",
+          arguments = [Var "X", Var "Y"]
+        }])
+    it "parsing a more complex rule" $ do
+      parseDatalog "ancestor(X,Y) :- parent(X,Z), ancestor(Z,Y)." `shouldBe` Right (Rule (HeadSingle (Literal {
+          positive = True, 
+          predName = "ancestor", 
+          arguments = [Var "X",Var "Y"]
+        })) [
+          Literal {
+            positive = True, 
+            predName = "parent", 
+            arguments = [Var "X",Var "Z"]
+          },
+          Literal {
+            positive = True, 
+            predName = "ancestor", 
+            arguments = [Var "Z",Var "Y"]}
+        ])
+    it "parsing assorted queries" $ do
+      parseDatalog "?- parent(alice,X)." `shouldBe` Right (Query [] [Literal {
+          positive = True,
+          predName = "parent",
+          arguments = [Sym "alice", Var "X"]
+        }])
+      parseDatalog "?- ancestor(X,Y), not blocked(X,Y)." `shouldBe` Right (Query [] [Literal {
+          positive = True,
+          predName = "ancestor",
+          arguments = [Var "X", Var "Y"]
+        }, Literal {
+          positive = False,
+          predName = "blocked",
+          arguments = [Var "X", Var "Y"]
+        }])
+      parseDatalog "?- knows(a,X), friend(X,Y) → X,Y." `shouldBe` Right (Query ["X", "Y"] [Literal {
+          positive = True,
+          predName = "knows",
+          arguments = [Sym "a", Var "X"]
+        }, Literal {
+          positive = True,
+          predName = "friend",
+          arguments = [Var "X", Var "Y"]
+        }])
+      parseDatalog "?- edge(A,B), edge(B,C) → A,C ." `shouldBe` Right (Query ["A", "C"] [Literal {
+          positive = True,
+          predName = "edge",
+          arguments = [Var "A", Var "B"]
+        }, Literal {
+          positive = True,
+          predName = "edge",
+          arguments = [Var "B", Var "C"]
+        }])
 
-      -- eval (BinaryExpr Add (Literal 2) (Literal 3) ) `shouldBe` 5
-      -- eval (BinaryExpr Subtract (Literal 2) (Literal 3) ) `shouldBe` -1
-      -- eval (BinaryExpr Multiply (Literal 2) (Literal 3) ) `shouldBe` 6
-      -- eval (BinaryExpr Divide (Literal 7) (Literal 3) ) `shouldBe` 2
-      -- eval (UnaryExpr Negate (Literal 7) ) `shouldBe` -7