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

style fixes

Browse Source
This commit is contained in:
Felix Dilke 2026-01-27 17:33:44 +00:00
parent 94bc4f1faa
commit 4b358a8d6f
1 changed files with 5 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -2,7 +2,6 @@
{-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
module Datalog.NaiveDatabase where module Datalog.NaiveDatabase where
@ -70,7 +69,7 @@ withFacts facts =
where where
extractFact :: Text -> Literal extractFact :: Text -> Literal
extractFact factText = extractFact factText =
case (parseDatalog factText) of case parseDatalog factText of
Right (Fact fact) -> fact Right (Fact fact) -> fact
Right otherStatement -> throw $ NonFactException factText otherStatement Right otherStatement -> throw $ NonFactException factText otherStatement
Left ex -> throw $ CannotParseStatementException factText ex Left ex -> throw $ CannotParseStatementException factText ex
@ -88,8 +87,7 @@ lookupRelation relationName relationMap newArity tuples =
case Map.lookup relationName relationMap of case Map.lookup relationName relationMap of
Nothing -> Relation relationName newArity tuples [] Nothing -> Relation relationName newArity tuples []
Just relation -> Just relation ->
if (_arity relation == newArity) if _arity relation == newArity then
then
let newTuples = Set.union tuples $ _tuples relation let newTuples = Set.union tuples $ _tuples relation
in Relation relationName newArity newTuples [] in Relation relationName newArity newTuples []
else throw $ BadArityException relationName newArity else throw $ BadArityException relationName newArity
@ -117,8 +115,8 @@ maybeConstant (RuleElementConstant constant) = Just constant
maybeConstant _ = Nothing maybeConstant _ = Nothing
withFactsAndRules :: [Text] -> [Text] -> NaiveDatabase withFactsAndRules :: [Text] -> [Text] -> NaiveDatabase
withFactsAndRules facts rules = withFactsAndRules facts =
foldr addRule (withFacts facts) (extractRule <$> rules) foldr (addRule . extractRule) (withFacts facts)
where where
extractRule :: Text -> (Literal, [Literal]) extractRule :: Text -> (Literal, [Literal])
extractRule ruleText = extractRule ruleText =
@ -139,7 +137,7 @@ withFactsAndRules facts rules =
relationMap' = Map.insert relationName relation relationMap relationMap' = Map.insert relationName relation relationMap
extraVariables = toElement <$> terms extraVariables = toElement <$> terms
variables' = nub extraVariables variables' = nub extraVariables
extraConstants = catMaybes $ maybeConstant <$> variables' extraConstants = mapMaybe maybeConstant variables'
constants' = Set.union (constants db) $ Set.fromList extraConstants constants' = Set.union (constants db) $ Set.fromList extraConstants
digestBody :: RuleContext -> Literal -> RuleContext digestBody :: RuleContext -> Literal -> RuleContext
digestBody context (Literal neg subRelationName terms) = digestBody context (Literal neg subRelationName terms) =