added relation references

This commit is contained in:
Felix Dilke 2026-01-27 12:41:23 +00:00
parent 585da9f794
commit 7855e5ce20
2 changed files with 37 additions and 35 deletions

View File

@ -33,9 +33,14 @@ data RuleElement = -- entry occurring in a head or body relation - constant or v
RuleElementVariable Text RuleElementVariable Text
deriving (Show, Eq) deriving (Show, Eq)
data RuleBodyElement = RuleBodyElement {
_subRelationName :: Text,
_ruleElements :: [RuleElement]
} deriving (Show, Eq)
data RelationRule = RelationRule { data RelationRule = RelationRule {
headVariables :: [Text], headVariables :: [Text],
body :: [(Relation, [RuleElement])] bodyElements :: [RuleBodyElement]
} deriving (Show, Eq) } deriving (Show, Eq)
data Relation = Relation { data Relation = Relation {
@ -201,11 +206,14 @@ withFactsAndRules facts rules =
extractVarName (RuleElementConstant constant) = throw $ UnexpectedConstantException constant extractVarName (RuleElementConstant constant) = throw $ UnexpectedConstantException constant
newRule = RelationRule { newRule = RelationRule {
headVariables = extractVarName <$> variables', headVariables = extractVarName <$> variables',
body = fromBodyConstraint <$> (_bodyConstraints context'') bodyElements = fromBodyConstraint <$> (_bodyConstraints context'')
} where } where
fromBodyConstraint :: BodyConstraint -> (Relation, [RuleElement]) fromBodyConstraint :: BodyConstraint -> RuleBodyElement
fromBodyConstraint (BodyConstraint subRelation elements) = fromBodyConstraint (BodyConstraint subRelation elements) =
(subRelation, toRuleElement <$> elements) RuleBodyElement {
_subRelationName = _name subRelation,
_ruleElements = toRuleElement <$> elements
}
toRuleElement :: ConstraintElement -> RuleElement toRuleElement :: ConstraintElement -> RuleElement
toRuleElement (ConstraintElementConstant constant) = RuleElementConstant constant toRuleElement (ConstraintElementConstant constant) = RuleElementConstant constant
toRuleElement (ConstraintElementIndex index) = variables' !! index toRuleElement (ConstraintElementIndex index) = variables' !! index

View File

@ -50,40 +50,34 @@ spec = do
map (Sym <$>) [["alice", "bob"], ["bob", "carol"]], map (Sym <$>) [["alice", "bob"], ["bob", "carol"]],
_rules = [] _rules = []
} }
let ancestorRule = RelationRule {
headVariables = [ "X", "Y", "Z" ],
bodyElements = [
RuleBodyElement {
_subRelationName = "parent",
_ruleElements = [
RuleElementVariable "X", RuleElementVariable "Z"
]
},
RuleBodyElement {
_subRelationName = "ancestor",
_ruleElements = [
RuleElementVariable "Z",RuleElementVariable "Y"
]
}
]
}
let ancestorRelation = Relation { let ancestorRelation = Relation {
_arity = 2, _arity = 2,
_name = "ancestor", _name = "ancestor",
_tuples = Set.empty, _tuples = Set.empty,
_rules = [] _rules = [ ancestorRule ]
} }
relations db `shouldBe` relations db `shouldBe`
Map.fromList [ Map.fromList [
("ancestor", ("ancestor", ancestorRelation),
Relation { ("parent", parentRelation )
_arity = 2, ]
_name = "ancestor",
_tuples = Set.empty,
_rules = [
RelationRule {
headVariables = [ "X", "Y", "Z" ],
body = [
(
parentRelation, [
RuleElementVariable "X",
RuleElementVariable "Z"
]
),(
ancestorRelation,[
RuleElementVariable "Z",
RuleElementVariable "Y"
]
)
]
}
]
} ),
("parent", parentRelation )
]
it "can do basic queries" $ do it "can do basic queries" $ do
let db = NaiveDatabase.withFacts let db = NaiveDatabase.withFacts