91 lines
3.0 KiB
Haskell
91 lines
3.0 KiB
Haskell
{-# 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.Datalog.DatalogParserSpec where
|
|
|
|
import Test.Hspec
|
|
import Datalog.DatalogParser
|
|
|
|
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"]
|
|
}])
|
|
|