138 lines
4.6 KiB
Haskell
138 lines
4.6 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 #-}
|
|
{-# LANGUAGE NoMonomorphismRestriction #-}
|
|
|
|
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 $ 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,Z), ancestor(Z,Y)."
|
|
, "ancestor(X,Y) :- parent(X,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 0
|
|
, RuleElementVariable 2
|
|
]
|
|
}
|
|
, RuleBodyElement
|
|
{ _subRelationId = "ancestor"
|
|
, _ruleElements =
|
|
[ RuleElementVariable 2
|
|
, RuleElementVariable 1
|
|
]
|
|
}
|
|
]
|
|
}
|
|
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'
|
|
|
|
(<<$>>) :: (Functor f1, Functor f2) => (a -> b) -> f1 (f2 a) -> f1 (f2 b)
|
|
(<<$>>) = fmap fmap fmap
|
|
|
|
-- (<<<$>>>) :: (Functor f1, Functor f2, Functor f3) => f1 (f2 (a -> b)) -> f1 (f2 (f3 a -> f3 b))
|
|
-- (<<<$>>>) :: Functor f => (a1 -> b) -> (a2 -> a1) -> f a2 -> f b
|
|
-- (<<<$>>>) :: (Functor f1, Functor f2) => (a1 -> a2 -> b) -> f1 a1 -> f1 (f2 a2 -> f2 b)
|
|
-- (<<<$>>>) :: (Functor f1, Functor f2, Functor f3) => f1 (a -> b) -> f1 (f2 (f3 a) -> f2 (f3 b))
|
|
(<<<$>>>) :: (Functor f1, Functor f2, Functor f3) => (a -> b) -> f1 (f2 (f3 a)) -> f1 (f2 (f3 b))
|
|
(<<<$>>>) = fmap fmap fmap fmap fmap fmap fmap fmap
|