rearranging modules

This commit is contained in:
Felix Dilke 2026-01-30 10:27:26 +00:00
parent f7d89f89c9
commit b997ee635e
4 changed files with 45 additions and 27 deletions

View File

@ -93,6 +93,7 @@ library langfeatures
Datalog.DatalogParser
Datalog.NaiveDatabase
Datalog.Rules
Datalog.DatalogDB
ghc-options: -Wall
default-extensions:
OverloadedStrings

View File

@ -0,0 +1,25 @@
{-# HLINT ignore "Redundant flip" #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
module Datalog.DatalogDB where
import Control.Exception.Base
import Data.List
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Maybe
import Data.Set (Set)
import Data.Set qualified as Set
import Data.Text (Text)
import Data.Void
import Datalog.DatalogParser (Head (HeadSingle), Literal (..), Statement (..), Term (..), parseDatalog)
import Text.Megaparsec (ParseErrorBundle)
import Datalog.Rules
class DatalogDB db where
emptyDB :: db
lookupRelation :: db -> Text -> Maybe Relation
insertRelation :: db -> Relation -> db

View File

@ -20,6 +20,7 @@ import Data.Void
import Datalog.DatalogParser (Head (HeadSingle), Literal (..), Statement (..), Term (..), parseDatalog)
import Text.Megaparsec (ParseErrorBundle)
import Datalog.Rules
import Datalog.DatalogDB
data NaiveDatabase = NaiveDatabase
{ relations :: Map RelationId Relation
@ -95,11 +96,6 @@ withFacts =
newRelationMap = Map.insert relationName newRelation relationMap
newConstantSet = Set.union constantSet $ Set.fromList terms
data BodyConstraint = BodyConstraint
{ _subRelation :: Relation
, _elements :: [RuleElement]
}
data RuleContext = RuleContext
{ __relation :: Relation
, _variableNames :: [Text]
@ -108,24 +104,6 @@ data RuleContext = RuleContext
, _db :: NaiveDatabase
}
appendRule :: Relation -> RelationRule -> Relation
appendRule relation rule =
relation {
_rules = rule : (_rules relation)
}
-- Relation { _name = _name relation
-- , _arity = _arity relation
-- , _tuples = _tuples relation
-- , _rules = rule : (_rules relation)
-- }
toRuleBodyElement :: BodyConstraint -> RuleBodyElement
toRuleBodyElement (BodyConstraint subRelation elements) =
RuleBodyElement {
_subRelationId = _name subRelation
, _ruleElements = elements
}
withFactsAndRules :: [Text] -> [Text] -> NaiveDatabase
withFactsAndRules facts = foldr (addRule . extractRule) (withFacts facts)
where

View File

@ -47,7 +47,21 @@ data Relation = Relation
type Constant = Term
type RelationId = Text
class DatalogDB db where
emptyDB :: db
lookupRelation :: db -> Text -> Maybe Relation
insertRelation :: db -> Relation -> db
data BodyConstraint = BodyConstraint
{ _subRelation :: Relation
, _elements :: [RuleElement]
}
appendRule :: Relation -> RelationRule -> Relation
appendRule relation rule =
relation {
_rules = rule : (_rules relation)
}
toRuleBodyElement :: BodyConstraint -> RuleBodyElement
toRuleBodyElement (BodyConstraint subRelation elements) =
RuleBodyElement {
_subRelationId = _name subRelation
, _ruleElements = elements
}