diff --git a/haskell-experiments/src/Datalog/NaiveDatabase.hs b/haskell-experiments/src/Datalog/NaiveDatabase.hs index 690183e..99e98cd 100644 --- a/haskell-experiments/src/Datalog/NaiveDatabase.hs +++ b/haskell-experiments/src/Datalog/NaiveDatabase.hs @@ -11,12 +11,10 @@ import Data.Map (Map) import Data.Set (Set) import Data.Set qualified as Set import Data.Text (Text) -import qualified Data.Text as T import Datalog.DatalogParser(parseDatalog, Literal(..), Statement(..), Term (..), Head (HeadSingle)) import qualified Data.Map as Map import Text.Megaparsec (ParseErrorBundle) import Data.Void -import Control.Exception (Exception) import Control.Exception.Base import Data.List import Data.Maybe @@ -36,7 +34,7 @@ data RuleElement = -- entry occurring in a head or body relation - constant or v deriving (Show, Eq) data RelationRule = RelationRule { - headVariables :: [RuleElement], + headVariables :: [Text], body :: [(Relation, [RuleElement])] } deriving (Show, Eq) @@ -195,7 +193,9 @@ withFactsAndRules facts rules = toConstraintElement :: RuleElement -> ConstraintElement toConstraintElement (RuleElementConstant constant) = ConstraintElementConstant constant toConstraintElement (RuleElementVariable varName) = ConstraintElementIndex (varIndex varName) - + extractVarName :: RuleElement -> Text + extractVarName (RuleElementVariable varName) = varName + extractVarName (RuleElementConstant constant) = throw $ UnexpectedConstantException constant -- toBodyConstraint :: (Relation, [RuleElement]) -> BodyConstraint -- toBodyConstraint (subRelation, ruleElements) = -- BodyConstraint { @@ -203,7 +203,7 @@ withFactsAndRules facts rules = -- _elements = toConstraintElement <$> ruleElements -- } newRule = RelationRule { - headVariables = variables', + headVariables = extractVarName <$> variables', body = fromBodyConstraint <$> (_bodyConstraints context'') } where fromBodyConstraint :: BodyConstraint -> (Relation, [RuleElement]) @@ -237,7 +237,8 @@ data NaiveDatabaseException NonRuleException Text Statement | NonQueryException Text Statement | BadArityException Text Int | - VariableLookupException Text [RuleElement] + VariableLookupException Text [RuleElement] | + UnexpectedConstantException Constant deriving (Show) instance Exception NaiveDatabaseException \ No newline at end of file diff --git a/haskell-experiments/test/Test/Datalog/NaiveDatabaseSpec.hs b/haskell-experiments/test/Test/Datalog/NaiveDatabaseSpec.hs index b421f16..873b152 100644 --- a/haskell-experiments/test/Test/Datalog/NaiveDatabaseSpec.hs +++ b/haskell-experiments/test/Test/Datalog/NaiveDatabaseSpec.hs @@ -53,11 +53,7 @@ spec = do ], _rules = [ RelationRule { - headVariables = [ - RuleElementVariable "X", - RuleElementVariable "Y", - RuleElementVariable "Z" - ], + headVariables = [ "X", "Y", "Z" ], body = [ ( Relation {