pyrites/haskell-experiments/test/Test/Datalog/DatalogParserSpec.hs

{-# 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"]
        }])