packages feed

project-m36-0.9.6: src/lib/ProjectM36/DDLType.hs

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

-- | Return a hash of just DDL-specific (schema) attributes. This is useful for determining if a client has the appropriate updates needed to work with the current schema.
ddlHash :: DatabaseContext -> TransactionGraph -> Either RelationalError SecureHash
ddlHash ctx tgraph = do
  -- we cannot merely hash the relational representation of the type because the order of items matters when hashing
  -- registered queries are not included here because a client could be compatible with a schema even if the queries are not registered. The client should validate registered query state up-front. Perhaps there should be another hash for registered queries.
  rvtypemap <- typesForRelationVariables ctx tgraph
  pure $ mkDDLHash ctx rvtypemap

-- | Process all relations within the context of the transaction graph to extract the relation variables types.
typesForRelationVariables :: DatabaseContext -> TransactionGraph -> Either RelationalError (M.Map RelVarName Relation)
typesForRelationVariables ctx tgraph = do
  let gfEnv = freshGraphRefRelationalExprEnv (Just ctx) tgraph
  M.fromList <$> mapM (\(rvname, rvexpr) -> do
           rvtype <- runGraphRefRelationalExprM gfEnv (typeForGraphRefRelationalExpr rvexpr)
           pure (rvname, rvtype)
                      ) (M.toList (relationVariables ctx))


-- | Return a Relation which represents the database context's current DDL schema.
ddlType :: Schema -> DatabaseContext -> TransactionGraph -> Either RelationalError Relation
ddlType schema ctx tgraph = do
  incDepsRel <- inclusionDependenciesInSchema schema (inclusionDependencies ctx) >>= inclusionDependenciesAsRelation
  atomFuncsRel <- atomFunctionsAsRelation (atomFunctions ctx)
  dbcFuncsRel <- databaseContextFunctionsAsRelation (dbcFunctions ctx)
  typesRel <- typesAsRelation (typeConstructorMapping ctx)
  relvarTypesRel <- relationVariablesAsRelationInSchema ctx schema tgraph
  let attrsAssocs = [("inclusion_dependencies", incDepsRel),
                     ("atom_functions", atomFuncsRel),
                     ("database_context_functions", dbcFuncsRel),
                     ("types", typesRel),
                     ("relation_variables", relvarTypesRel)]
      attrs = attributesFromList $ map (\(n, rv) -> Attribute n (RelationAtomType (attributes rv))) attrsAssocs
      tuples = [[RelationAtom incDepsRel,
                 RelationAtom atomFuncsRel,
                 RelationAtom dbcFuncsRel,
                 RelationAtom typesRel,
                 RelationAtom relvarTypesRel]]
  mkRelationFromList attrs tuples