src/lib/ProjectM36/DatabaseContext.hs · project-m36

1module ProjectM36.DatabaseContext where

2import ProjectM36.Base

3import Control.Monad (void)

4import qualified Data.Map as M

5import qualified Data.HashSet as HS

6import ProjectM36.DataTypes.Basic

7import ProjectM36.AtomFunctions.Basic

8import ProjectM36.Relation

9import qualified Data.ByteString.Lazy as BL

10import ProjectM36.AtomFunction as AF

11import ProjectM36.DatabaseContextFunction as DBCF

12import Codec.Winery

13

14empty :: DatabaseContext

15empty = DatabaseContext { inclusionDependencies = M.empty,

16 relationVariables = M.empty,

17 notifications = M.empty,

18 atomFunctions = HS.empty,

19 dbcFunctions = HS.empty,

20 typeConstructorMapping = [] }

21

22-- | Remove TransactionId markers on GraphRefRelationalExpr

23stripGraphRefRelationalExpr :: GraphRefRelationalExpr -> RelationalExpr

24stripGraphRefRelationalExpr = void

25

26-- | convert an existing database context into its constituent expression.

27databaseContextAsDatabaseContextExpr :: DatabaseContext -> DatabaseContextExpr

28databaseContextAsDatabaseContextExpr context = MultipleExpr $ relVarsExprs ++ incDepsExprs ++ funcsExprs

29 where

30 relVarsExprs = map (\(name, rel) -> Assign name (stripGraphRefRelationalExpr rel)) (M.toList (relationVariables context))

31 incDepsExprs :: [DatabaseContextExpr]

32 incDepsExprs = map (uncurry AddInclusionDependency) (M.toList (inclusionDependencies context))

33 funcsExprs = [] -- map (\func -> ) (HS.toList funcs) -- there are no databaseExprs to add atom functions yet-}

34

35basicDatabaseContext :: DatabaseContext

36basicDatabaseContext = DatabaseContext { inclusionDependencies = M.empty,

37 relationVariables = M.fromList [("true", ExistingRelation relationTrue),

38 ("false", ExistingRelation relationFalse)],

39 atomFunctions = basicAtomFunctions,

40 dbcFunctions = basicDatabaseContextFunctions,

41 notifications = M.empty,

42 typeConstructorMapping = basicTypeConstructorMapping

43 }

44

45--for building the Merkle hash

46hashBytes :: DatabaseContext -> BL.ByteString

47hashBytes ctx = BL.fromChunks [incDeps, rvs, nots, tConsMap] <> atomFs <> dbcFs

48 where

49 incDeps = serialise (inclusionDependencies ctx)

50 rvs = serialise (relationVariables ctx)

51 atomFs = HS.foldr (mappend . AF.hashBytes) mempty (atomFunctions ctx)

52 dbcFs = HS.foldr (mappend . DBCF.hashBytes) mempty (dbcFunctions ctx)

53 nots = serialise (notifications ctx)

54 tConsMap = serialise (typeConstructorMapping ctx)