{-# LANGUAGE RankNTypes #-}
module ProjectM36.DatabaseContext where
import ProjectM36.Base
import Control.Monad (void)
import qualified Data.Map as M
import qualified Data.HashSet as HS
import ProjectM36.DataTypes.Basic
import ProjectM36.AtomFunctions.Basic
import ProjectM36.Relation
import ProjectM36.DatabaseContextFunction
empty :: DatabaseContext
empty :: DatabaseContext
empty = DatabaseContext { inclusionDependencies :: InclusionDependencies
inclusionDependencies = forall k a. Map k a
M.empty,
relationVariables :: RelationVariables
relationVariables = forall k a. Map k a
M.empty,
notifications :: Notifications
notifications = forall k a. Map k a
M.empty,
atomFunctions :: AtomFunctions
atomFunctions = forall a. HashSet a
HS.empty,
dbcFunctions :: DatabaseContextFunctions
dbcFunctions = forall a. HashSet a
HS.empty,
typeConstructorMapping :: TypeConstructorMapping
typeConstructorMapping = forall a. Monoid a => a
mempty,
registeredQueries :: RegisteredQueries
registeredQueries = forall a. Monoid a => a
mempty }
stripGraphRefRelationalExpr :: GraphRefRelationalExpr -> RelationalExpr
stripGraphRefRelationalExpr :: GraphRefRelationalExpr -> RelationalExpr
stripGraphRefRelationalExpr = forall (f :: * -> *) a. Functor f => f a -> f ()
void
databaseContextAsDatabaseContextExpr :: DatabaseContext -> DatabaseContextExpr
databaseContextAsDatabaseContextExpr :: DatabaseContext -> DatabaseContextExpr
databaseContextAsDatabaseContextExpr DatabaseContext
context = forall a. [DatabaseContextExprBase a] -> DatabaseContextExprBase a
MultipleExpr forall a b. (a -> b) -> a -> b
$ [DatabaseContextExpr]
relVarsExprs forall a. [a] -> [a] -> [a]
++ [DatabaseContextExpr]
incDepsExprs forall a. [a] -> [a] -> [a]
++ forall {a}. [a]
funcsExprs
where
relVarsExprs :: [DatabaseContextExpr]
relVarsExprs = forall a b. (a -> b) -> [a] -> [b]
map (\(RelVarName
name, GraphRefRelationalExpr
rel) -> forall a.
RelVarName -> RelationalExprBase a -> DatabaseContextExprBase a
Assign RelVarName
name (GraphRefRelationalExpr -> RelationalExpr
stripGraphRefRelationalExpr GraphRefRelationalExpr
rel)) (forall k a. Map k a -> [(k, a)]
M.toList (DatabaseContext -> RelationVariables
relationVariables DatabaseContext
context))
incDepsExprs :: [DatabaseContextExpr]
incDepsExprs :: [DatabaseContextExpr]
incDepsExprs = forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a.
RelVarName -> InclusionDependency -> DatabaseContextExprBase a
AddInclusionDependency) (forall k a. Map k a -> [(k, a)]
M.toList (DatabaseContext -> InclusionDependencies
inclusionDependencies DatabaseContext
context))
funcsExprs :: [a]
funcsExprs = []
basicDatabaseContext :: DatabaseContext
basicDatabaseContext :: DatabaseContext
basicDatabaseContext = DatabaseContext { inclusionDependencies :: InclusionDependencies
inclusionDependencies = forall k a. Map k a
M.empty,
relationVariables :: RelationVariables
relationVariables = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(RelVarName
"true", forall a. Relation -> RelationalExprBase a
ExistingRelation Relation
relationTrue),
(RelVarName
"false", forall a. Relation -> RelationalExprBase a
ExistingRelation Relation
relationFalse)],
atomFunctions :: AtomFunctions
atomFunctions = AtomFunctions
basicAtomFunctions,
dbcFunctions :: DatabaseContextFunctions
dbcFunctions = DatabaseContextFunctions
basicDatabaseContextFunctions,
notifications :: Notifications
notifications = forall k a. Map k a
M.empty,
typeConstructorMapping :: TypeConstructorMapping
typeConstructorMapping = TypeConstructorMapping
basicTypeConstructorMapping,
registeredQueries :: RegisteredQueries
registeredQueries = forall k a. k -> a -> Map k a
M.singleton RelVarName
"booleans" (forall a.
RelationalExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Union (forall a. RelVarName -> a -> RelationalExprBase a
RelationVariable RelVarName
"true" ()) (forall a. RelVarName -> a -> RelationalExprBase a
RelationVariable RelVarName
"false" ()))
}
someDatabaseContextExprs :: [DatabaseContextExpr] -> DatabaseContextExpr
someDatabaseContextExprs :: [DatabaseContextExpr] -> DatabaseContextExpr
someDatabaseContextExprs [DatabaseContextExpr
s] = DatabaseContextExpr
s
someDatabaseContextExprs (DatabaseContextExpr
s:[DatabaseContextExpr]
ss) = forall a. [DatabaseContextExprBase a] -> DatabaseContextExprBase a
MultipleExpr (DatabaseContextExpr
sforall a. a -> [a] -> [a]
:[DatabaseContextExpr]
ss)
someDatabaseContextExprs [] = forall a. DatabaseContextExprBase a
NoOperation