digestHead abstracts DatalogDB

This commit is contained in:
Felix Dilke 2026-01-30 11:07:40 +00:00
parent 6dda089bfe
commit 136412a4dd

View File

@ -118,15 +118,15 @@ withFacts =
newRelationMap = Map.insert relationName newRelation relationMap newRelationMap = Map.insert relationName newRelation relationMap
newConstantSet = Set.union constantSet $ Set.fromList terms newConstantSet = Set.union constantSet $ Set.fromList terms
data RuleContext = RuleContext data (DatalogDB db) => RuleContext db = RuleContext
{ __relation :: Relation { __relation :: Relation
, _variableNames :: [Text] , _variableNames :: [Text]
, _headEntries :: [RuleElement] , _headEntries :: [RuleElement]
, _bodyConstraints :: [BodyConstraint] , _bodyConstraints :: [BodyConstraint]
, _db :: NaiveDatabase , _db :: db
} }
digestHead :: NaiveDatabase -> Relation -> Literal -> RuleContext digestHead :: forall db . (DatalogDB db) => db -> Relation -> Literal -> RuleContext db
digestHead db relation (Literal neg relationName terms) = digestHead db relation (Literal neg relationName terms) =
RuleContext RuleContext
{ __relation = relation { __relation = relation
@ -147,7 +147,7 @@ digestHead db relation (Literal neg relationName terms) =
extractConstant :: RuleElement -> Maybe Constant extractConstant :: RuleElement -> Maybe Constant
extractConstant (RuleElementConstant constant) = Just constant extractConstant (RuleElementConstant constant) = Just constant
extractConstant _ = Nothing extractConstant _ = Nothing
digestBody :: Literal -> RuleContext -> RuleContext digestBody :: Literal -> RuleContext NaiveDatabase -> RuleContext NaiveDatabase
digestBody (Literal neg subRelationName subTerms) context = digestBody (Literal neg subRelationName subTerms) context =
context { context {
_variableNames = variableNames _variableNames = variableNames