module ProjectM36.DDLType where
import ProjectM36.HashSecurely
import ProjectM36.Base
import ProjectM36.RelationalExpression
import ProjectM36.Error
import ProjectM36.Attribute
import qualified Data.Map as M
import ProjectM36.Relation
import ProjectM36.InclusionDependency
import ProjectM36.AtomFunction
import ProjectM36.DatabaseContextFunction
import ProjectM36.IsomorphicSchema
ddlHash :: DatabaseContext -> TransactionGraph -> Either RelationalError SecureHash
ddlHash :: DatabaseContext
-> TransactionGraph -> Either RelationalError SecureHash
ddlHash DatabaseContext
ctx TransactionGraph
tgraph = do
Map RelVarName Relation
rvtypemap <- DatabaseContext
-> TransactionGraph
-> Either RelationalError (Map RelVarName Relation)
typesForRelationVariables DatabaseContext
ctx TransactionGraph
tgraph
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ DatabaseContext -> Map RelVarName Relation -> SecureHash
mkDDLHash DatabaseContext
ctx Map RelVarName Relation
rvtypemap
typesForRelationVariables :: DatabaseContext -> TransactionGraph -> Either RelationalError (M.Map RelVarName Relation)
typesForRelationVariables :: DatabaseContext
-> TransactionGraph
-> Either RelationalError (Map RelVarName Relation)
typesForRelationVariables DatabaseContext
ctx TransactionGraph
tgraph = do
let gfEnv :: GraphRefRelationalExprEnv
gfEnv = Maybe DatabaseContext
-> TransactionGraph -> GraphRefRelationalExprEnv
freshGraphRefRelationalExprEnv (forall a. a -> Maybe a
Just DatabaseContext
ctx) TransactionGraph
tgraph
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(RelVarName
rvname, GraphRefRelationalExpr
rvexpr) -> do
Relation
rvtype <- forall a.
GraphRefRelationalExprEnv
-> GraphRefRelationalExprM a -> Either RelationalError a
runGraphRefRelationalExprM GraphRefRelationalExprEnv
gfEnv (GraphRefRelationalExpr -> GraphRefRelationalExprM Relation
typeForGraphRefRelationalExpr GraphRefRelationalExpr
rvexpr)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelVarName
rvname, Relation
rvtype)
) (forall k a. Map k a -> [(k, a)]
M.toList (DatabaseContext -> RelationVariables
relationVariables DatabaseContext
ctx))
ddlType :: Schema -> DatabaseContext -> TransactionGraph -> Either RelationalError Relation
ddlType :: Schema
-> DatabaseContext
-> TransactionGraph
-> Either RelationalError Relation
ddlType Schema
schema DatabaseContext
ctx TransactionGraph
tgraph = do
Relation
incDepsRel <- Schema
-> InclusionDependencies
-> Either RelationalError InclusionDependencies
inclusionDependenciesInSchema Schema
schema (DatabaseContext -> InclusionDependencies
inclusionDependencies DatabaseContext
ctx) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= InclusionDependencies -> Either RelationalError Relation
inclusionDependenciesAsRelation
Relation
atomFuncsRel <- AtomFunctions -> Either RelationalError Relation
atomFunctionsAsRelation (DatabaseContext -> AtomFunctions
atomFunctions DatabaseContext
ctx)
Relation
dbcFuncsRel <- DatabaseContextFunctions -> Either RelationalError Relation
databaseContextFunctionsAsRelation (DatabaseContext -> DatabaseContextFunctions
dbcFunctions DatabaseContext
ctx)
Relation
typesRel <- TypeConstructorMapping -> Either RelationalError Relation
typesAsRelation (DatabaseContext -> TypeConstructorMapping
typeConstructorMapping DatabaseContext
ctx)
Relation
relvarTypesRel <- DatabaseContext
-> Schema -> TransactionGraph -> Either RelationalError Relation
relationVariablesAsRelationInSchema DatabaseContext
ctx Schema
schema TransactionGraph
tgraph
let attrsAssocs :: [(RelVarName, Relation)]
attrsAssocs = [(RelVarName
"inclusion_dependencies", Relation
incDepsRel),
(RelVarName
"atom_functions", Relation
atomFuncsRel),
(RelVarName
"database_context_functions", Relation
dbcFuncsRel),
(RelVarName
"types", Relation
typesRel),
(RelVarName
"relation_variables", Relation
relvarTypesRel)]
attrs :: Attributes
attrs = [Attribute] -> Attributes
attributesFromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(RelVarName
n, Relation
rv) -> RelVarName -> AtomType -> Attribute
Attribute RelVarName
n (Attributes -> AtomType
RelationAtomType (Relation -> Attributes
attributes Relation
rv))) [(RelVarName, Relation)]
attrsAssocs
tuples :: [[Atom]]
tuples = [[Relation -> Atom
RelationAtom Relation
incDepsRel,
Relation -> Atom
RelationAtom Relation
atomFuncsRel,
Relation -> Atom
RelationAtom Relation
dbcFuncsRel,
Relation -> Atom
RelationAtom Relation
typesRel,
Relation -> Atom
RelationAtom Relation
relvarTypesRel]]
Attributes -> [[Atom]] -> Either RelationalError Relation
mkRelationFromList Attributes
attrs [[Atom]]
tuples