126 lines
3.9 KiB
Haskell
126 lines
3.9 KiB
Haskell
{-# LANGUAGE DuplicateRecordFields #-}
|
|
{-# LANGUAGE ImportQualifiedPost #-}
|
|
{-# LANGUAGE OverloadedRecordDot #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# HLINT ignore "Use const" #-}
|
|
{-# HLINT ignore "Unused LANGUAGE pragma" #-}
|
|
{-# HLINT ignore "Avoid lambda" #-}
|
|
{-# LANGUAGE ScopedTypeVariables #-}
|
|
{-# LANGUAGE TypeApplications #-}
|
|
{-# LANGUAGE NoFieldSelectors #-}
|
|
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
|
|
{-# LANGUAGE BlockArguments #-}
|
|
|
|
module Test.Datalog.NaiveDatabaseSpec where
|
|
|
|
import Data.Map qualified as Map
|
|
import Data.Set qualified as Set
|
|
import Datalog.DatalogParser
|
|
import Datalog.NaiveDatabase
|
|
import Datalog.NaiveDatabase qualified as NaiveDatabase
|
|
import Test.Hspec
|
|
|
|
spec :: Spec
|
|
spec = do
|
|
describe "NaiveDatabase operations" do
|
|
it "can ingest facts into relations & a universe" $ do
|
|
let db =
|
|
NaiveDatabase.withFacts
|
|
[ "parent(\"alice\", \"bob\")."
|
|
, "parent(\"bob\", \"carol\")."
|
|
]
|
|
constants db
|
|
`shouldBe` Set.fromList (Sym <$> ["alice", "bob", "carol"])
|
|
relations db
|
|
`shouldBe` Map.fromList
|
|
[
|
|
( "parent"
|
|
, Relation "parent" 2 (Set.fromList $ map (Sym <$>) [["alice", "bob"], ["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)."
|
|
]
|
|
parentRelation =
|
|
Relation
|
|
{ _name = "parent"
|
|
, _arity = 2
|
|
, _tuples =
|
|
Set.fromList $
|
|
map (Sym <$>) [["alice", "bob"], ["bob", "carol"]]
|
|
, _rules = []
|
|
}
|
|
ancestorRule =
|
|
RelationRule
|
|
{ headVariables = ["X", "Y", "Z"]
|
|
, bodyElements =
|
|
[ RuleBodyElement
|
|
{ _subRelationId = "parent"
|
|
, _ruleElements =
|
|
[ RuleElementVariable "X"
|
|
, RuleElementVariable "Z"
|
|
]
|
|
}
|
|
, RuleBodyElement
|
|
{ _subRelationId = "ancestor"
|
|
, _ruleElements =
|
|
[ RuleElementVariable "Z"
|
|
, RuleElementVariable "Y"
|
|
]
|
|
}
|
|
]
|
|
}
|
|
ancestorRelation =
|
|
Relation
|
|
{ _arity = 2
|
|
, _name = "ancestor"
|
|
, _tuples = Set.empty
|
|
, _rules = [ancestorRule]
|
|
}
|
|
constants db
|
|
`shouldBe` (Set.fromList $ Sym <$> ["alice", "bob", "carol"])
|
|
relations db
|
|
`shouldBe` Map.fromList
|
|
[ ("ancestor", ancestorRelation)
|
|
, ("parent", parentRelation)
|
|
]
|
|
|
|
it "can ingest facts and rules with constants" do
|
|
let db =
|
|
NaiveDatabase.withFactsAndRules
|
|
[]
|
|
["ancestor(X,\"patriarch\") :- ."]
|
|
ancestorRule =
|
|
RelationRule
|
|
{ headVariables = ["X"]
|
|
, bodyElements = []
|
|
}
|
|
ancestorRelation =
|
|
Relation
|
|
{ _arity = 2
|
|
, _name = "ancestor"
|
|
, _tuples = Set.empty
|
|
, _rules = [ancestorRule]
|
|
}
|
|
relations db
|
|
`shouldBe` Map.fromList
|
|
[ ("ancestor", ancestorRelation)
|
|
]
|
|
|
|
constants db
|
|
`shouldBe` (Set.fromList $ Sym <$> ["patriarch"])
|
|
|
|
it "can do basic queries" do
|
|
let db =
|
|
NaiveDatabase.withFacts
|
|
[ "parent(\"alice\", \"bob\")."
|
|
, "parent(\"bob\", \"carol\")."
|
|
]
|
|
query db "?- parent(alice,X)." `shouldBe` "#NYI" -- ideally, 'bob'
|