adjust the DatalogDB API, give access to relation names
This commit is contained in:
parent
d51cd11da6
commit
ab610a6c78
@ -57,6 +57,7 @@ type RelationId = Text
|
||||
|
||||
class DatalogDB db where
|
||||
emptyDB :: db
|
||||
relationNames :: db -> [Text]
|
||||
lookupRelation :: db -> Text -> Maybe Relation
|
||||
insertRelation :: db -> Relation -> db
|
||||
addConstants :: db -> Set Constant -> db
|
||||
@ -79,7 +80,7 @@ addFact (Literal neg relationName terms) db =
|
||||
newRelation = lookupRelationArity relationName db newArity (Set.singleton terms)
|
||||
extraConstants = Set.fromList terms
|
||||
|
||||
-- the world isn't quite ready for these, as the 'update relation' pattern doesn't fir - maybe use a lens?
|
||||
-- the world isn't quite ready for these, as the 'update relation' pattern doesn't fit - maybe use a lens?
|
||||
-- lookupRelation00 :: DatalogDB db =>
|
||||
-- Text -> db -> Int -> (Relation -> Relation) -> db
|
||||
-- lookupRelation00 relationName db newArity update =
|
||||
|
||||
@ -8,7 +8,7 @@
|
||||
module Datalog.InMemoryDB where
|
||||
|
||||
import Control.Exception.Base
|
||||
import Data.Map (Map)
|
||||
import Data.Map (Map, keys)
|
||||
import Data.Map qualified as Map
|
||||
import Data.Set (Set)
|
||||
import Data.Set qualified as Set
|
||||
@ -45,7 +45,10 @@ instance DatalogDB InMemoryDB where
|
||||
_constants = Set.union newConstants (_constants db)
|
||||
}
|
||||
|
||||
withFacts :: DatalogDB db => [Text] -> db
|
||||
relationNames :: InMemoryDB -> [Text]
|
||||
relationNames db = keys (_relations db)
|
||||
|
||||
withFacts :: [Text] -> InMemoryDB
|
||||
withFacts =
|
||||
foldr (addFact . extractFact) emptyDB
|
||||
where
|
||||
|
||||
@ -40,6 +40,7 @@ spec = do
|
||||
, Relation "parent" 2 (Set.fromList $ Sym <<$>> [["alice", "bob"], ["bob", "carol"]]) []
|
||||
)
|
||||
]
|
||||
relationNames db `shouldBe` [ "parent" ]
|
||||
it "can ingest facts and rules" do
|
||||
let db =
|
||||
InMemoryDB.withFactsAndRules
|
||||
@ -86,6 +87,7 @@ spec = do
|
||||
[ ("ancestor", ancestorRelation)
|
||||
, ("parent", parentRelation)
|
||||
]
|
||||
Set.fromList (relationNames db) `shouldBe` Set.fromList [ "parent", "ancestor" ]
|
||||
|
||||
it "can ingest facts and rules with constants" do
|
||||
let db =
|
||||
@ -109,6 +111,7 @@ spec = do
|
||||
|
||||
_constants db
|
||||
`shouldBe` Set.fromList (Sym <$> ["patriarch"])
|
||||
Set.fromList (relationNames db) `shouldBe` Set.fromList [ "ancestor" ]
|
||||
|
||||
it "can ingest facts and rules with duplicate head entries" do
|
||||
let db =
|
||||
@ -132,6 +135,7 @@ spec = do
|
||||
|
||||
_constants db
|
||||
`shouldBe` Set.empty
|
||||
relationNames db `shouldBe` [ "equivalent" ]
|
||||
|
||||
it "can ingest a theory of equivalence relations" do
|
||||
let db =
|
||||
@ -172,6 +176,7 @@ spec = do
|
||||
|
||||
_constants db
|
||||
`shouldBe` Set.empty
|
||||
Set.fromList (relationNames db) `shouldBe` Set.fromList [ "equivalent" ]
|
||||
|
||||
it "can do basic queries" do
|
||||
let db :: InMemoryDB =
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user