git.iko.soy/project-m36
on fbfa2ea help sign in
project-m36/src/lib/ProjectM36/TransGraphRelationalExpression.hs
154 lines 8.9 kB history raw
1{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
2{-# OPTIONS_GHC -fno-warn-orphans #-}
3--really, a better name for this module could be "TransTransactionGraphRelationalExpr", but that name is too long
4module ProjectM36.TransGraphRelationalExpression where
5import ProjectM36.Base
6import ProjectM36.TransactionGraph
7import ProjectM36.Transaction
8import ProjectM36.RelationalExpression
9import ProjectM36.Error
10import ProjectM36.Tuple
11import ProjectM36.AtomType
12import qualified Data.Map as M
13import Control.Monad.Trans.Reader
14import Data.Binary
16-- | The TransGraphRelationalExpression is equivalent to a relational expression except that relation variables can reference points in the transaction graph (at previous points in time).
17type TransGraphRelationalExpr = RelationalExprBase TransactionIdLookup
19instance Binary TransGraphRelationalExpr
21type TransGraphExtendTupleExpr = ExtendTupleExprBase TransactionIdLookup
23instance Binary TransGraphExtendTupleExpr
25type TransGraphTupleExpr = TupleExprBase TransactionIdLookup
27instance Binary TransGraphTupleExpr
29type TransGraphRestrictionPredicateExpr = RestrictionPredicateExprBase TransactionIdLookup
31instance Binary TransGraphRestrictionPredicateExpr
33type TransGraphAtomExpr = AtomExprBase TransactionIdLookup
35instance Binary TransGraphAtomExpr
37type TransGraphAttributeExpr = AttributeExprBase TransactionIdLookup
39-- OUTDATED a previous attempt at this function attempted to convert TransGraphRelationalExpr to RelationalExpr by resolving the transaction lookups. However, there is no way to resolve a FunctionAtomExpr to an Atom without fully evaluating the higher levels (TupleExpr, etc.). An anonymous function expression cannot be serialized, so that workaround is out. Still, I suspect we can reuse the existing static optimizer logic to work on both structures. The current conversion reduces the chance of whole-query optimization due to full-evaluation on top of full-evaluation, so this function would benefit from some re-design.
40evalTransGraphRelationalExpr :: TransGraphRelationalExpr -> TransactionGraph -> Either RelationalError RelationalExpr
41evalTransGraphRelationalExpr (MakeRelationFromExprs mAttrExprs tupleExprs) graph = do
42 tupleExprs' <- mapM (evalTransGraphTupleExpr graph) tupleExprs
43 case mAttrExprs of
44 Nothing -> pure (MakeRelationFromExprs Nothing tupleExprs')
45 Just attrExprs -> do
46 attrExprs' <- mapM (evalTransGraphAttributeExpr graph) attrExprs
47 pure (MakeRelationFromExprs (Just attrExprs') tupleExprs')
48evalTransGraphRelationalExpr (MakeStaticRelation attrs tupSet) _ = pure (MakeStaticRelation attrs tupSet)
49evalTransGraphRelationalExpr (ExistingRelation rel) _ = pure (ExistingRelation rel)
50evalTransGraphRelationalExpr (RelationVariable rvname transLookup) graph = do
51 trans <- lookupTransaction graph transLookup
52 rel <- runReader (evalRelationalExpr (RelationVariable rvname ())) (RelationalExprStateElems (concreteDatabaseContext trans))
53 pure (ExistingRelation rel)
54evalTransGraphRelationalExpr (Project attrNames expr) graph = do
55 expr' <- evalTransGraphRelationalExpr expr graph
56 pure (Project attrNames expr')
57evalTransGraphRelationalExpr (Union exprA exprB) graph = do
58 exprA' <- evalTransGraphRelationalExpr exprA graph
59 exprB' <- evalTransGraphRelationalExpr exprB graph
60 pure (Union exprA' exprB')
61evalTransGraphRelationalExpr (Join exprA exprB) graph = do
62 exprA' <- evalTransGraphRelationalExpr exprA graph
63 exprB' <- evalTransGraphRelationalExpr exprB graph
64 pure (Join exprA' exprB')
65evalTransGraphRelationalExpr (Rename attrName1 attrName2 expr) graph = do
66 expr' <- evalTransGraphRelationalExpr expr graph
67 pure (Rename attrName1 attrName2 expr')
68evalTransGraphRelationalExpr (Difference exprA exprB) graph = do
69 exprA' <- evalTransGraphRelationalExpr exprA graph
70 exprB' <- evalTransGraphRelationalExpr exprB graph
71 pure (Difference exprA' exprB')
72evalTransGraphRelationalExpr (Group attrNames attrName expr) graph = do
73 expr' <- evalTransGraphRelationalExpr expr graph
74 pure (Group attrNames attrName expr')
75evalTransGraphRelationalExpr (Ungroup attrName expr) graph = do
76 expr' <- evalTransGraphRelationalExpr expr graph
77 pure (Ungroup attrName expr')
78evalTransGraphRelationalExpr (Restrict predicateExpr expr) graph = do
79 expr' <- evalTransGraphRelationalExpr expr graph
80 predicateExpr' <- evalTransGraphRestrictionPredicateExpr predicateExpr graph
81 pure (Restrict predicateExpr' expr')
82evalTransGraphRelationalExpr (Equals exprA exprB) graph = do
83 exprA' <- evalTransGraphRelationalExpr exprA graph
84 exprB' <- evalTransGraphRelationalExpr exprB graph
85 pure (Equals exprA' exprB')
86evalTransGraphRelationalExpr (NotEquals exprA exprB) graph = do
87 exprA' <- evalTransGraphRelationalExpr exprA graph
88 exprB' <- evalTransGraphRelationalExpr exprB graph
89 pure (NotEquals exprA' exprB')
90evalTransGraphRelationalExpr (Extend extendExpr expr) graph = do
91 extendExpr' <- evalTransGraphExtendTupleExpr extendExpr graph
92 expr' <- evalTransGraphRelationalExpr expr graph
93 pure (Extend extendExpr' expr')
95evalTransGraphTupleExpr :: TransactionGraph -> TransGraphTupleExpr -> Either RelationalError TupleExpr
96evalTransGraphTupleExpr graph (TupleExpr attrMap) = do
97 attrAssoc <- mapM (\(attrName, atomExpr) -> do
98 aExpr <- evalTransGraphAtomExpr graph atomExpr
99 pure (attrName, aExpr)
100 ) (M.toList attrMap)
101 pure (TupleExpr (M.fromList attrAssoc))
103evalTransGraphAtomExpr :: TransactionGraph -> TransGraphAtomExpr -> Either RelationalError AtomExpr
104evalTransGraphAtomExpr _ (AttributeAtomExpr aname) = pure $ AttributeAtomExpr aname
105evalTransGraphAtomExpr _ (NakedAtomExpr atom) = pure $ NakedAtomExpr atom
106evalTransGraphAtomExpr graph (FunctionAtomExpr funcName args tLookup) = do
107 trans <- lookupTransaction graph tLookup
108 --I can't return a FunctionAtomExpr because the function needs to be resolved at a specific context
109 args' <- mapM (evalTransGraphAtomExpr graph) args
110 atom <- runReader (evalAtomExpr emptyTuple (FunctionAtomExpr funcName args' ())) (RelationalExprStateElems (concreteDatabaseContext trans))
111 pure (NakedAtomExpr atom)
112evalTransGraphAtomExpr graph (RelationAtomExpr expr) = do
113 expr' <- evalTransGraphRelationalExpr expr graph
114 pure (RelationAtomExpr expr')
115evalTransGraphAtomExpr graph (ConstructedAtomExpr dConsName args tLookup) = do
116 trans <- lookupTransaction graph tLookup
117 args' <- mapM (evalTransGraphAtomExpr graph) args
118 atom <- runReader (evalAtomExpr emptyTuple (ConstructedAtomExpr dConsName args' ())) (RelationalExprStateElems (concreteDatabaseContext trans))
119 pure (NakedAtomExpr atom)
121evalTransGraphRestrictionPredicateExpr :: TransGraphRestrictionPredicateExpr -> TransactionGraph -> Either RelationalError RestrictionPredicateExpr
122evalTransGraphRestrictionPredicateExpr TruePredicate _ = pure TruePredicate
123evalTransGraphRestrictionPredicateExpr (AndPredicate exprA exprB) graph = do
124 exprA' <- evalTransGraphRestrictionPredicateExpr exprA graph
125 exprB' <- evalTransGraphRestrictionPredicateExpr exprB graph
126 pure (AndPredicate exprA' exprB')
127evalTransGraphRestrictionPredicateExpr (OrPredicate exprA exprB) graph = do
128 exprA' <- evalTransGraphRestrictionPredicateExpr exprA graph
129 exprB' <- evalTransGraphRestrictionPredicateExpr exprB graph
130 pure (OrPredicate exprA' exprB')
131evalTransGraphRestrictionPredicateExpr (NotPredicate expr) graph = do
132 expr' <- evalTransGraphRestrictionPredicateExpr expr graph
133 pure (NotPredicate expr')
134evalTransGraphRestrictionPredicateExpr (RelationalExprPredicate expr) graph = do
135 expr' <- evalTransGraphRelationalExpr expr graph
136 pure (RelationalExprPredicate expr')
137evalTransGraphRestrictionPredicateExpr (AtomExprPredicate expr) graph = do
138 expr' <- evalTransGraphAtomExpr graph expr
139 pure (AtomExprPredicate expr')
140evalTransGraphRestrictionPredicateExpr (AttributeEqualityPredicate attrName expr) graph = do
141 expr' <- evalTransGraphAtomExpr graph expr
142 pure (AttributeEqualityPredicate attrName expr')
144evalTransGraphExtendTupleExpr :: TransGraphExtendTupleExpr -> TransactionGraph -> Either RelationalError ExtendTupleExpr
145evalTransGraphExtendTupleExpr (AttributeExtendTupleExpr attrName expr) graph = do
146 expr' <- evalTransGraphAtomExpr graph expr
147 pure (AttributeExtendTupleExpr attrName expr')
149evalTransGraphAttributeExpr :: TransactionGraph -> TransGraphAttributeExpr -> Either RelationalError AttributeExpr
150evalTransGraphAttributeExpr graph (AttributeAndTypeNameExpr attrName tCons tLookup) = do
151 trans <- lookupTransaction graph tLookup
152 aType <- atomTypeForTypeConstructor tCons (typeConstructorMapping (concreteDatabaseContext trans))
153 pure (NakedAttributeExpr (Attribute attrName aType))
154evalTransGraphAttributeExpr _ (NakedAttributeExpr attr) = pure (NakedAttributeExpr attr)