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 qualified Data.ByteString.Lazy as BL
import ProjectM36.DatabaseContextFunction
import Codec.Winery
import ProjectM36.Function as F

empty :: DatabaseContext
empty :: DatabaseContext
empty = DatabaseContext :: InclusionDependencies
-> RelationVariables
-> AtomFunctions
-> DatabaseContextFunctions
-> Notifications
-> TypeConstructorMapping
-> 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 = [] }

-- | 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
-> 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
                                         }

--for building the Merkle hash
hashBytes :: DatabaseContext -> BL.ByteString
hashBytes :: DatabaseContext -> ByteString
hashBytes DatabaseContext
ctx = [ByteString] -> ByteString
BL.fromChunks [ByteString
incDeps, ByteString
rvs, ByteString
nots, ByteString
tConsMap] ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
atomFs ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
dbcFs
  where
    incDeps :: ByteString
incDeps = InclusionDependencies -> ByteString
forall a. Serialise a => a -> ByteString
serialise (DatabaseContext -> InclusionDependencies
inclusionDependencies DatabaseContext
ctx)
    rvs :: ByteString
rvs = RelationVariables -> ByteString
forall a. Serialise a => a -> ByteString
serialise (DatabaseContext -> RelationVariables
relationVariables DatabaseContext
ctx)
    atomFs :: ByteString
atomFs = (Function AtomFunctionBodyType -> ByteString -> ByteString)
-> ByteString -> AtomFunctions -> ByteString
forall b a. (b -> a -> a) -> a -> HashSet b -> a
HS.foldr (ByteString -> ByteString -> ByteString
forall a. Monoid a => a -> a -> a
mappend (ByteString -> ByteString -> ByteString)
-> (Function AtomFunctionBodyType -> ByteString)
-> Function AtomFunctionBodyType
-> ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Function AtomFunctionBodyType -> ByteString
forall a. Function a -> ByteString
F.hashBytes) ByteString
forall a. Monoid a => a
mempty (DatabaseContext -> AtomFunctions
atomFunctions DatabaseContext
ctx)
    dbcFs :: ByteString
dbcFs = (Function DatabaseContextFunctionBodyType
 -> ByteString -> ByteString)
-> ByteString -> DatabaseContextFunctions -> ByteString
forall b a. (b -> a -> a) -> a -> HashSet b -> a
HS.foldr (ByteString -> ByteString -> ByteString
forall a. Monoid a => a -> a -> a
mappend (ByteString -> ByteString -> ByteString)
-> (Function DatabaseContextFunctionBodyType -> ByteString)
-> Function DatabaseContextFunctionBodyType
-> ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Function DatabaseContextFunctionBodyType -> ByteString
forall a. Function a -> ByteString
F.hashBytes) ByteString
forall a. Monoid a => a
mempty (DatabaseContext -> DatabaseContextFunctions
dbcFunctions DatabaseContext
ctx)
    nots :: ByteString
nots = Notifications -> ByteString
forall a. Serialise a => a -> ByteString
serialise (DatabaseContext -> Notifications
notifications DatabaseContext
ctx)
    tConsMap :: ByteString
tConsMap = TypeConstructorMapping -> ByteString
forall a. Serialise a => a -> ByteString
serialise (DatabaseContext -> TypeConstructorMapping
typeConstructorMapping DatabaseContext
ctx)