added relation references
This commit is contained in:
parent
585da9f794
commit
7855e5ce20
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user