adjust the DatalogDB API, give access to relation names

This commit is contained in:
Felix Dilke 2026-02-03 12:54:34 +00:00
parent d51cd11da6
commit ab610a6c78
3 changed files with 12 additions and 3 deletions

View File

@ -57,6 +57,7 @@ type RelationId = Text
class DatalogDB db where class DatalogDB db where
emptyDB :: db emptyDB :: db
relationNames :: db -> [Text]
lookupRelation :: db -> Text -> Maybe Relation lookupRelation :: db -> Text -> Maybe Relation
insertRelation :: db -> Relation -> db insertRelation :: db -> Relation -> db
addConstants :: db -> Set Constant -> db addConstants :: db -> Set Constant -> db
@ -79,7 +80,7 @@ addFact (Literal neg relationName terms) db =
newRelation = lookupRelationArity relationName db newArity (Set.singleton terms) newRelation = lookupRelationArity relationName db newArity (Set.singleton terms)
extraConstants = Set.fromList 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 => -- lookupRelation00 :: DatalogDB db =>
-- Text -> db -> Int -> (Relation -> Relation) -> db -- Text -> db -> Int -> (Relation -> Relation) -> db
-- lookupRelation00 relationName db newArity update = -- lookupRelation00 relationName db newArity update =

View File

@ -8,7 +8,7 @@
module Datalog.InMemoryDB where module Datalog.InMemoryDB where
import Control.Exception.Base import Control.Exception.Base
import Data.Map (Map) import Data.Map (Map, keys)
import Data.Map qualified as Map import Data.Map qualified as Map
import Data.Set (Set) import Data.Set (Set)
import Data.Set qualified as Set import Data.Set qualified as Set
@ -45,7 +45,10 @@ instance DatalogDB InMemoryDB where
_constants = Set.union newConstants (_constants db) _constants = Set.union newConstants (_constants db)
} }
withFacts :: DatalogDB db => [Text] -> db relationNames :: InMemoryDB -> [Text]
relationNames db = keys (_relations db)
withFacts :: [Text] -> InMemoryDB
withFacts = withFacts =
foldr (addFact . extractFact) emptyDB foldr (addFact . extractFact) emptyDB
where where

View File

@ -40,6 +40,7 @@ spec = do
, Relation "parent" 2 (Set.fromList $ Sym <<$>> [["alice", "bob"], ["bob", "carol"]]) [] , Relation "parent" 2 (Set.fromList $ Sym <<$>> [["alice", "bob"], ["bob", "carol"]]) []
) )
] ]
relationNames db `shouldBe` [ "parent" ]
it "can ingest facts and rules" do it "can ingest facts and rules" do
let db = let db =
InMemoryDB.withFactsAndRules InMemoryDB.withFactsAndRules
@ -86,6 +87,7 @@ spec = do
[ ("ancestor", ancestorRelation) [ ("ancestor", ancestorRelation)
, ("parent", parentRelation) , ("parent", parentRelation)
] ]
Set.fromList (relationNames db) `shouldBe` Set.fromList [ "parent", "ancestor" ]
it "can ingest facts and rules with constants" do it "can ingest facts and rules with constants" do
let db = let db =
@ -109,6 +111,7 @@ spec = do
_constants db _constants db
`shouldBe` Set.fromList (Sym <$> ["patriarch"]) `shouldBe` Set.fromList (Sym <$> ["patriarch"])
Set.fromList (relationNames db) `shouldBe` Set.fromList [ "ancestor" ]
it "can ingest facts and rules with duplicate head entries" do it "can ingest facts and rules with duplicate head entries" do
let db = let db =
@ -132,6 +135,7 @@ spec = do
_constants db _constants db
`shouldBe` Set.empty `shouldBe` Set.empty
relationNames db `shouldBe` [ "equivalent" ]
it "can ingest a theory of equivalence relations" do it "can ingest a theory of equivalence relations" do
let db = let db =
@ -172,6 +176,7 @@ spec = do
_constants db _constants db
`shouldBe` Set.empty `shouldBe` Set.empty
Set.fromList (relationNames db) `shouldBe` Set.fromList [ "equivalent" ]
it "can do basic queries" do it "can do basic queries" do
let db :: InMemoryDB = let db :: InMemoryDB =