{-# 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
-> RelationVariables
-> AtomFunctions
-> DatabaseContextFunctions
-> Notifications
-> TypeConstructorMapping
-> RegisteredQueries
-> DatabaseContext
DatabaseContext { inclusionDependencies :: InclusionDependencies
inclusionDependencies = InclusionDependencies
forall k a. Map k a
M.empty, 
                          relationVariables :: RelationVariables
relationVariables = RelationVariables
forall k a. Map k a
M.empty, 
                          notifications :: Notifications
notifications = Notifications
forall k a. Map k a
M.empty,
                          atomFunctions :: AtomFunctions
atomFunctions = AtomFunctions
forall a. HashSet a
HS.empty,
                          dbcFunctions :: DatabaseContextFunctions
dbcFunctions = DatabaseContextFunctions
forall a. HashSet a
HS.empty,
                          typeConstructorMapping :: TypeConstructorMapping
typeConstructorMapping = TypeConstructorMapping
forall a. Monoid a => a
mempty,
                          registeredQueries :: RegisteredQueries
registeredQueries = RegisteredQueries
forall a. Monoid a => a
mempty }

  
-- | Remove TransactionId markers on GraphRefRelationalExpr
stripGraphRefRelationalExpr :: GraphRefRelationalExpr -> RelationalExpr
stripGraphRefRelationalExpr :: GraphRefRelationalExpr -> RelationalExpr
stripGraphRefRelationalExpr = GraphRefRelationalExpr -> RelationalExpr
forall (f :: * -> *) a. Functor f => f a -> f ()
void
        
-- | convert an existing database context into its constituent expression.   
databaseContextAsDatabaseContextExpr :: DatabaseContext -> DatabaseContextExpr
databaseContextAsDatabaseContextExpr :: DatabaseContext -> DatabaseContextExpr
databaseContextAsDatabaseContextExpr DatabaseContext
context = [DatabaseContextExpr] -> DatabaseContextExpr
forall a. [DatabaseContextExprBase a] -> DatabaseContextExprBase a
MultipleExpr ([DatabaseContextExpr] -> DatabaseContextExpr)
-> [DatabaseContextExpr] -> DatabaseContextExpr
forall a b. (a -> b) -> a -> b
$ [DatabaseContextExpr]
relVarsExprs [DatabaseContextExpr]
-> [DatabaseContextExpr] -> [DatabaseContextExpr]
forall a. [a] -> [a] -> [a]
++ [DatabaseContextExpr]
incDepsExprs [DatabaseContextExpr]
-> [DatabaseContextExpr] -> [DatabaseContextExpr]
forall a. [a] -> [a] -> [a]
++ [DatabaseContextExpr]
forall a. [a]
funcsExprs
  where
    relVarsExprs :: [DatabaseContextExpr]
relVarsExprs = ((RelVarName, GraphRefRelationalExpr) -> DatabaseContextExpr)
-> [(RelVarName, GraphRefRelationalExpr)] -> [DatabaseContextExpr]
forall a b. (a -> b) -> [a] -> [b]
map (\(RelVarName
name, GraphRefRelationalExpr
rel) -> RelVarName -> RelationalExpr -> DatabaseContextExpr
forall a.
RelVarName -> RelationalExprBase a -> DatabaseContextExprBase a
Assign RelVarName
name (GraphRefRelationalExpr -> RelationalExpr
stripGraphRefRelationalExpr GraphRefRelationalExpr
rel)) (RelationVariables -> [(RelVarName, GraphRefRelationalExpr)]
forall k a. Map k a -> [(k, a)]
M.toList (DatabaseContext -> RelationVariables
relationVariables DatabaseContext
context))
    incDepsExprs :: [DatabaseContextExpr]
    incDepsExprs :: [DatabaseContextExpr]
incDepsExprs = ((RelVarName, InclusionDependency) -> DatabaseContextExpr)
-> [(RelVarName, InclusionDependency)] -> [DatabaseContextExpr]
forall a b. (a -> b) -> [a] -> [b]
map ((RelVarName -> InclusionDependency -> DatabaseContextExpr)
-> (RelVarName, InclusionDependency) -> DatabaseContextExpr
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry RelVarName -> InclusionDependency -> DatabaseContextExpr
forall a.
RelVarName -> InclusionDependency -> DatabaseContextExprBase a
AddInclusionDependency) (InclusionDependencies -> [(RelVarName, InclusionDependency)]
forall k a. Map k a -> [(k, a)]
M.toList (DatabaseContext -> InclusionDependencies
inclusionDependencies DatabaseContext
context))
    funcsExprs :: [a]
funcsExprs = [] -- map (\func -> ) (HS.toList funcs) -- there are no databaseExprs to add atom functions yet-}

basicDatabaseContext :: DatabaseContext
basicDatabaseContext :: DatabaseContext
basicDatabaseContext = DatabaseContext :: InclusionDependencies
-> RelationVariables
-> AtomFunctions
-> DatabaseContextFunctions
-> Notifications
-> TypeConstructorMapping
-> RegisteredQueries
-> DatabaseContext
DatabaseContext { inclusionDependencies :: InclusionDependencies
inclusionDependencies = InclusionDependencies
forall k a. Map k a
M.empty,
                                         relationVariables :: RelationVariables
relationVariables = [(RelVarName, GraphRefRelationalExpr)] -> RelationVariables
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(RelVarName
"true", Relation -> GraphRefRelationalExpr
forall a. Relation -> RelationalExprBase a
ExistingRelation Relation
relationTrue),
                                                                         (RelVarName
"false", Relation -> GraphRefRelationalExpr
forall a. Relation -> RelationalExprBase a
ExistingRelation Relation
relationFalse)],
                                         atomFunctions :: AtomFunctions
atomFunctions = AtomFunctions
basicAtomFunctions,
                                         dbcFunctions :: DatabaseContextFunctions
dbcFunctions = DatabaseContextFunctions
basicDatabaseContextFunctions,
                                         notifications :: Notifications
notifications = Notifications
forall k a. Map k a
M.empty,
                                         typeConstructorMapping :: TypeConstructorMapping
typeConstructorMapping = TypeConstructorMapping
basicTypeConstructorMapping,
                                         registeredQueries :: RegisteredQueries
registeredQueries = RelVarName -> RelationalExpr -> RegisteredQueries
forall k a. k -> a -> Map k a
M.singleton RelVarName
"booleans" (RelationalExpr -> RelationalExpr -> RelationalExpr
forall a.
RelationalExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Union (RelVarName -> () -> RelationalExpr
forall a. RelVarName -> a -> RelationalExprBase a
RelationVariable RelVarName
"true" ()) (RelVarName -> () -> RelationalExpr
forall a. RelVarName -> a -> RelationalExprBase a
RelationVariable RelVarName
"false" ()))
                                         }