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
deriving (Show, Eq)
data RuleBodyElement = RuleBodyElement {
_subRelationName :: Text,
_ruleElements :: [RuleElement]
} deriving (Show, Eq)
data RelationRule = RelationRule {
headVariables :: [Text],
body :: [(Relation, [RuleElement])]
bodyElements :: [RuleBodyElement]
} deriving (Show, Eq)
data Relation = Relation {
@ -201,11 +206,14 @@ withFactsAndRules facts rules =
extractVarName (RuleElementConstant constant) = throw $ UnexpectedConstantException constant
newRule = RelationRule {
headVariables = extractVarName <$> variables',
body = fromBodyConstraint <$> (_bodyConstraints context'')
bodyElements = fromBodyConstraint <$> (_bodyConstraints context'')
} where
fromBodyConstraint :: BodyConstraint -> (Relation, [RuleElement])
fromBodyConstraint :: BodyConstraint -> RuleBodyElement
fromBodyConstraint (BodyConstraint subRelation elements) =
(subRelation, toRuleElement <$> elements)
RuleBodyElement {
_subRelationName = _name subRelation,
_ruleElements = toRuleElement <$> elements
}
toRuleElement :: ConstraintElement -> RuleElement
toRuleElement (ConstraintElementConstant constant) = RuleElementConstant constant
toRuleElement (ConstraintElementIndex index) = variables' !! index

View File

@ -50,40 +50,34 @@ spec = do
map (Sym <$>) [["alice", "bob"], ["bob", "carol"]],
_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 {
_arity = 2,
_name = "ancestor",
_tuples = Set.empty,
_rules = []
}
_arity = 2,
_name = "ancestor",
_tuples = Set.empty,
_rules = [ ancestorRule ]
}
relations db `shouldBe`
Map.fromList [
("ancestor",
Relation {
_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 )
]
("ancestor", ancestorRelation),
("parent", parentRelation )
]
it "can do basic queries" $ do
let db = NaiveDatabase.withFacts