renaming accessors
This commit is contained in:
parent
86c9b73ebe
commit
d51cd11da6
@ -18,31 +18,31 @@ import Datalog.Rules
|
||||
import Datalog.DatalogDB
|
||||
|
||||
data InMemoryDB = InMemoryDB
|
||||
{ relations :: Map RelationId Relation
|
||||
, constants :: Set Constant
|
||||
{ _relations :: Map RelationId Relation
|
||||
, _constants :: Set Constant
|
||||
} deriving (Show, Eq)
|
||||
|
||||
instance DatalogDB InMemoryDB where
|
||||
emptyDB :: InMemoryDB
|
||||
emptyDB = InMemoryDB
|
||||
{ relations = Map.empty
|
||||
, constants = Set.empty -- the Herbrand universe
|
||||
{ _relations = Map.empty
|
||||
, _constants = Set.empty -- the Herbrand universe
|
||||
}
|
||||
|
||||
lookupRelation :: InMemoryDB -> Text -> Maybe Relation
|
||||
lookupRelation db relationName =
|
||||
Map.lookup relationName $ relations db
|
||||
Map.lookup relationName $ _relations db
|
||||
|
||||
insertRelation :: InMemoryDB -> Relation -> InMemoryDB
|
||||
insertRelation db relation =
|
||||
db {
|
||||
relations = Map.insert (_name relation) relation (relations db)
|
||||
_relations = Map.insert (_name relation) relation (_relations db)
|
||||
}
|
||||
|
||||
addConstants :: InMemoryDB -> Set Constant -> InMemoryDB
|
||||
addConstants db newConstants =
|
||||
db {
|
||||
constants = Set.union newConstants (constants db)
|
||||
_constants = Set.union newConstants (_constants db)
|
||||
}
|
||||
|
||||
withFacts :: DatalogDB db => [Text] -> db
|
||||
|
||||
@ -28,7 +28,10 @@ data (DatalogDB db) => NaiveQE db = NaiveQE
|
||||
|
||||
instance QueryEngine NaiveQE where
|
||||
queryEngine :: (DatalogDB db) => db -> NaiveQE db
|
||||
queryEngine db = NaiveQE { }
|
||||
queryEngine db = NaiveQE {
|
||||
db = db,
|
||||
herbrand = computeHerbrand db
|
||||
}
|
||||
query :: (DatalogDB db) => NaiveQE db -> Text -> Text
|
||||
query qe queryText =
|
||||
case parseDatalog queryText of
|
||||
@ -36,3 +39,10 @@ instance QueryEngine NaiveQE where
|
||||
Right otherStatement -> throw $ NonQueryException queryText otherStatement
|
||||
Left ex -> throw $ CannotParseStatementException queryText ex
|
||||
|
||||
computeHerbrand :: (DatalogDB db) => db -> Map Text Relation
|
||||
computeHerbrand db =
|
||||
computeHerbrandSub Map.empty where
|
||||
computeHerbrandSub :: Map Text Relation -> Map Text Relation
|
||||
computeHerbrandSub facts = facts
|
||||
-- for_ (Map.toList myMap) $ \(k,v) ->
|
||||
|
||||
|
||||
@ -31,9 +31,9 @@ spec = do
|
||||
[ "parent(\"alice\", \"bob\")."
|
||||
, "parent(\"bob\", \"carol\")."
|
||||
]
|
||||
constants db
|
||||
_constants db
|
||||
`shouldBe` Set.fromList (Sym <$> ["alice", "bob", "carol"])
|
||||
relations db
|
||||
_relations db
|
||||
`shouldBe` Map.fromList
|
||||
[
|
||||
( "parent"
|
||||
@ -78,10 +78,10 @@ spec = do
|
||||
, _rules = [ancestorRule, ancestorRule2]
|
||||
}
|
||||
|
||||
constants db
|
||||
_constants db
|
||||
`shouldBe` Set.fromList (Sym <$> ["alice", "bob", "carol"])
|
||||
|
||||
relations db
|
||||
_relations db
|
||||
`shouldBe` Map.fromList
|
||||
[ ("ancestor", ancestorRelation)
|
||||
, ("parent", parentRelation)
|
||||
@ -104,10 +104,10 @@ spec = do
|
||||
, _tuples = Set.empty
|
||||
, _rules = [ancestorRule]
|
||||
}
|
||||
relations db
|
||||
_relations db
|
||||
`shouldBe` Map.singleton "ancestor" ancestorRelation
|
||||
|
||||
constants db
|
||||
_constants db
|
||||
`shouldBe` Set.fromList (Sym <$> ["patriarch"])
|
||||
|
||||
it "can ingest facts and rules with duplicate head entries" do
|
||||
@ -127,10 +127,10 @@ spec = do
|
||||
, _tuples = Set.empty
|
||||
, _rules = [equivalentRule]
|
||||
}
|
||||
relations db
|
||||
_relations db
|
||||
`shouldBe` Map.singleton "equivalent" equivalentRelation
|
||||
|
||||
constants db
|
||||
_constants db
|
||||
`shouldBe` Set.empty
|
||||
|
||||
it "can ingest a theory of equivalence relations" do
|
||||
@ -167,10 +167,10 @@ spec = do
|
||||
, _tuples = Set.empty
|
||||
, _rules = [rule1, rule2, rule3]
|
||||
}
|
||||
relations db
|
||||
_relations db
|
||||
`shouldBe` Map.singleton "equivalent" equivalentRelation
|
||||
|
||||
constants db
|
||||
_constants db
|
||||
`shouldBe` Set.empty
|
||||
|
||||
it "can do basic queries" do
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user