diff --git a/haskell-experiments/src/Datalog/DatalogDB.hs b/haskell-experiments/src/Datalog/DatalogDB.hs index 3b110a6..2e2f6ff 100644 --- a/haskell-experiments/src/Datalog/DatalogDB.hs +++ b/haskell-experiments/src/Datalog/DatalogDB.hs @@ -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 = diff --git a/haskell-experiments/src/Datalog/InMemoryDB.hs b/haskell-experiments/src/Datalog/InMemoryDB.hs index e635f23..ca5a91f 100644 --- a/haskell-experiments/src/Datalog/InMemoryDB.hs +++ b/haskell-experiments/src/Datalog/InMemoryDB.hs @@ -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 diff --git a/haskell-experiments/test/Test/Datalog/InMemoryDBSpec.hs b/haskell-experiments/test/Test/Datalog/InMemoryDBSpec.hs index dc76676..dc42644 100644 --- a/haskell-experiments/test/Test/Datalog/InMemoryDBSpec.hs +++ b/haskell-experiments/test/Test/Datalog/InMemoryDBSpec.hs @@ -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 =