{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE OverloadedRecordDot #-} {-# HLINT ignore "Use const" #-} {-# HLINT ignore "Unused LANGUAGE pragma" #-} {-# HLINT ignore "Avoid lambda" #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE NoFieldSelectors #-} {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} {-# LANGUAGE TypeApplications #-} module Test.DatalogParserSpec where import Test.Hspec import DatalogParser -- checkParse :: String -> Expr -> Expectation -- checkParse text expectedExpr = -- parse parseExpr "" text `shouldBe` Right expectedExpr -- checkEval :: String -> Int -> Expectation -- checkEval text expectedVal = -- fmap eval (parse parseExpr "" text) `shouldBe` Right expectedVal spec :: Spec spec = do describe "evaluate expressions" $ do it "parsing facts" $ do parseDatalog "parent(\"alice\", \"bob\")." `shouldBe` Right (Fact Literal { positive = True, 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"] }])