rearranging modules
This commit is contained in:
parent
f7d89f89c9
commit
b997ee635e
@ -93,6 +93,7 @@ library langfeatures
|
|||||||
Datalog.DatalogParser
|
Datalog.DatalogParser
|
||||||
Datalog.NaiveDatabase
|
Datalog.NaiveDatabase
|
||||||
Datalog.Rules
|
Datalog.Rules
|
||||||
|
Datalog.DatalogDB
|
||||||
ghc-options: -Wall
|
ghc-options: -Wall
|
||||||
default-extensions:
|
default-extensions:
|
||||||
OverloadedStrings
|
OverloadedStrings
|
||||||
|
|||||||
25
haskell-experiments/src/Datalog/DatalogDB.hs
Normal file
25
haskell-experiments/src/Datalog/DatalogDB.hs
Normal 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
|
||||||
@ -20,6 +20,7 @@ import Data.Void
|
|||||||
import Datalog.DatalogParser (Head (HeadSingle), Literal (..), Statement (..), Term (..), parseDatalog)
|
import Datalog.DatalogParser (Head (HeadSingle), Literal (..), Statement (..), Term (..), parseDatalog)
|
||||||
import Text.Megaparsec (ParseErrorBundle)
|
import Text.Megaparsec (ParseErrorBundle)
|
||||||
import Datalog.Rules
|
import Datalog.Rules
|
||||||
|
import Datalog.DatalogDB
|
||||||
|
|
||||||
data NaiveDatabase = NaiveDatabase
|
data NaiveDatabase = NaiveDatabase
|
||||||
{ relations :: Map RelationId Relation
|
{ relations :: Map RelationId Relation
|
||||||
@ -95,11 +96,6 @@ 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 BodyConstraint = BodyConstraint
|
|
||||||
{ _subRelation :: Relation
|
|
||||||
, _elements :: [RuleElement]
|
|
||||||
}
|
|
||||||
|
|
||||||
data RuleContext = RuleContext
|
data RuleContext = RuleContext
|
||||||
{ __relation :: Relation
|
{ __relation :: Relation
|
||||||
, _variableNames :: [Text]
|
, _variableNames :: [Text]
|
||||||
@ -108,24 +104,6 @@ data RuleContext = RuleContext
|
|||||||
, _db :: NaiveDatabase
|
, _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 :: [Text] -> [Text] -> NaiveDatabase
|
||||||
withFactsAndRules facts = foldr (addRule . extractRule) (withFacts facts)
|
withFactsAndRules facts = foldr (addRule . extractRule) (withFacts facts)
|
||||||
where
|
where
|
||||||
|
|||||||
@ -47,7 +47,21 @@ data Relation = Relation
|
|||||||
type Constant = Term
|
type Constant = Term
|
||||||
type RelationId = Text
|
type RelationId = Text
|
||||||
|
|
||||||
class DatalogDB db where
|
data BodyConstraint = BodyConstraint
|
||||||
emptyDB :: db
|
{ _subRelation :: Relation
|
||||||
lookupRelation :: db -> Text -> Maybe Relation
|
, _elements :: [RuleElement]
|
||||||
insertRelation :: db -> Relation -> db
|
}
|
||||||
|
|
||||||
|
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
|
||||||
|
}
|
||||||
|
|
||||||
|
|||||||
Loading…
x
Reference in New Issue
Block a user