fdilke/pyrites
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

tidying up dependencies

Browse Source
This commit is contained in:
Felix Dilke 2026-01-30 10:32:10 +00:00
parent b997ee635e
commit 15f84e414d
2 changed files with 24 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
haskell-experiments/src/Datalog/NaiveDatabase.hs
View File

@ -108,12 +108,6 @@ withFactsAndRules :: [Text] -> [Text] -> NaiveDatabase
withFactsAndRules facts = foldr (addRule . extractRule) (withFacts facts) withFactsAndRules facts = foldr (addRule . extractRule) (withFacts facts)
where where
extractRule :: Text -> (Literal, [Literal])
extractRule ruleText =
case parseDatalog ruleText of
Right (Rule (HeadSingle lhs) rhs) -> (lhs, rhs)
Right otherStatement -> throw $ NonRuleException ruleText otherStatement
Left ex -> throw $ CannotParseStatementException ruleText ex
digestHead :: NaiveDatabase -> Relation -> Literal -> RuleContext digestHead :: NaiveDatabase -> Relation -> Literal -> RuleContext
digestHead db relation (Literal neg relationName terms) = digestHead db relation (Literal neg relationName terms) =
RuleContext RuleContext
@ -186,12 +180,6 @@ addRule (ruleHead, body) db =
relationMap' = Map.insert relationName relation' relationMap relationMap' = Map.insert relationName relation' relationMap
constants' = constants db' constants' = constants db'
extractVariableNames :: [Term] -> [Text]
extractVariableNames = mapMaybe extractVariableName where
extractVariableName :: Term -> Maybe Text
extractVariableName (Var name) = Just name
extractVariableName _ = Nothing
query :: NaiveDatabase -> Text -> Text query :: NaiveDatabase -> Text -> Text
query db qText = query db qText =
case parseDatalog qText of case parseDatalog qText of
@ -199,14 +187,3 @@ query db qText =
Right otherStatement -> throw $ NonQueryException qText otherStatement Right otherStatement -> throw $ NonQueryException qText otherStatement
Left ex -> throw $ CannotParseStatementException qText ex Left ex -> throw $ CannotParseStatementException qText ex
data NaiveDatabaseException
= CannotParseStatementException Text (ParseErrorBundle Text Void)
| NonFactException Text Statement
| NonRuleException Text Statement
| NonQueryException Text Statement
| BadArityException Text Int
| VariableLookupException Text [Text]
| UnexpectedConstantException Constant
deriving (Show)
instance Exception NaiveDatabaseException

24
haskell-experiments/src/Datalog/Rules.hs
View File

@ -52,6 +52,13 @@ data BodyConstraint = BodyConstraint
, _elements :: [RuleElement] , _elements :: [RuleElement]
} }
extractRule :: Text -> (Literal, [Literal])
extractRule ruleText =
case parseDatalog ruleText of
Right (Rule (HeadSingle lhs) rhs) -> (lhs, rhs)
Right otherStatement -> throw $ NonRuleException ruleText otherStatement
Left ex -> throw $ CannotParseStatementException ruleText ex
appendRule :: Relation -> RelationRule -> Relation appendRule :: Relation -> RelationRule -> Relation
appendRule relation rule = appendRule relation rule =
relation { relation {
@ -65,3 +72,20 @@ toRuleBodyElement (BodyConstraint subRelation elements) =
, _ruleElements = elements , _ruleElements = elements
} }
extractVariableNames :: [Term] -> [Text]
extractVariableNames = mapMaybe extractVariableName where
extractVariableName :: Term -> Maybe Text
extractVariableName (Var name) = Just name
extractVariableName _ = Nothing
data DatalogDBException
= CannotParseStatementException Text (ParseErrorBundle Text Void)
| NonFactException Text Statement
| NonRuleException Text Statement
| NonQueryException Text Statement
| BadArityException Text Int
| VariableLookupException Text [Text]
| UnexpectedConstantException Constant
deriving (Show)
instance Exception DatalogDBException