git.iko.soy/project-m36
on 63fbef0 help sign in
project-m36/src/lib/ProjectM36/TransGraphRelationalExpression.hs
175 lines 10.0 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 TransGraphAttributeNames = AttributeNamesBase TransactionIdLookup
23instance Binary TransGraphAttributeNames
25type TransGraphExtendTupleExpr = ExtendTupleExprBase TransactionIdLookup
27instance Binary TransGraphExtendTupleExpr
29type TransGraphTupleExpr = TupleExprBase TransactionIdLookup
31instance Binary TransGraphTupleExpr
33type TransGraphRestrictionPredicateExpr = RestrictionPredicateExprBase TransactionIdLookup
35instance Binary TransGraphRestrictionPredicateExpr
37type TransGraphAtomExpr = AtomExprBase TransactionIdLookup
39instance Binary TransGraphAtomExpr
41type TransGraphAttributeExpr = AttributeExprBase TransactionIdLookup
43-- 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.
44evalTransGraphRelationalExpr :: TransGraphRelationalExpr -> TransactionGraph -> Either RelationalError RelationalExpr
45evalTransGraphRelationalExpr (MakeRelationFromExprs mAttrExprs tupleExprs) graph = do
46 tupleExprs' <- mapM (evalTransGraphTupleExpr graph) tupleExprs
47 case mAttrExprs of
48 Nothing -> pure (MakeRelationFromExprs Nothing tupleExprs')
49 Just attrExprs -> do
50 attrExprs' <- mapM (evalTransGraphAttributeExpr graph) attrExprs
51 pure (MakeRelationFromExprs (Just attrExprs') tupleExprs')
52evalTransGraphRelationalExpr (MakeStaticRelation attrs tupSet) _ = pure (MakeStaticRelation attrs tupSet)
53evalTransGraphRelationalExpr (ExistingRelation rel) _ = pure (ExistingRelation rel)
54evalTransGraphRelationalExpr (RelationVariable rvname transLookup) graph = do
55 trans <- lookupTransaction graph transLookup
56 rel <- runReader (evalRelationalExpr (RelationVariable rvname ())) (RelationalExprStateElems (concreteDatabaseContext trans))
57 pure (ExistingRelation rel)
58evalTransGraphRelationalExpr (Project transAttrNames expr) graph = do
59 expr' <- evalTransGraphRelationalExpr expr graph
60 attrNames <- evalTransAttributeNames transAttrNames graph
61 pure (Project attrNames expr')
62evalTransGraphRelationalExpr (Union exprA exprB) graph = do
63 exprA' <- evalTransGraphRelationalExpr exprA graph
64 exprB' <- evalTransGraphRelationalExpr exprB graph
65 pure (Union exprA' exprB')
66evalTransGraphRelationalExpr (Join exprA exprB) graph = do
67 exprA' <- evalTransGraphRelationalExpr exprA graph
68 exprB' <- evalTransGraphRelationalExpr exprB graph
69 pure (Join exprA' exprB')
70evalTransGraphRelationalExpr (Rename attrName1 attrName2 expr) graph = do
71 expr' <- evalTransGraphRelationalExpr expr graph
72 pure (Rename attrName1 attrName2 expr')
73evalTransGraphRelationalExpr (Difference exprA exprB) graph = do
74 exprA' <- evalTransGraphRelationalExpr exprA graph
75 exprB' <- evalTransGraphRelationalExpr exprB graph
76 pure (Difference exprA' exprB')
77evalTransGraphRelationalExpr (Group transAttrNames attrName expr) graph = do
78 expr' <- evalTransGraphRelationalExpr expr graph
79 attrNames <- evalTransAttributeNames transAttrNames graph
80 pure (Group attrNames attrName expr')
81evalTransGraphRelationalExpr (Ungroup attrName expr) graph = do
82 expr' <- evalTransGraphRelationalExpr expr graph
83 pure (Ungroup attrName expr')
84evalTransGraphRelationalExpr (Restrict predicateExpr expr) graph = do
85 expr' <- evalTransGraphRelationalExpr expr graph
86 predicateExpr' <- evalTransGraphRestrictionPredicateExpr predicateExpr graph
87 pure (Restrict predicateExpr' expr')
88evalTransGraphRelationalExpr (Equals exprA exprB) graph = do
89 exprA' <- evalTransGraphRelationalExpr exprA graph
90 exprB' <- evalTransGraphRelationalExpr exprB graph
91 pure (Equals exprA' exprB')
92evalTransGraphRelationalExpr (NotEquals exprA exprB) graph = do
93 exprA' <- evalTransGraphRelationalExpr exprA graph
94 exprB' <- evalTransGraphRelationalExpr exprB graph
95 pure (NotEquals exprA' exprB')
96evalTransGraphRelationalExpr (Extend extendExpr expr) graph = do
97 extendExpr' <- evalTransGraphExtendTupleExpr extendExpr graph
98 expr' <- evalTransGraphRelationalExpr expr graph
99 pure (Extend extendExpr' expr')
101evalTransGraphTupleExpr :: TransactionGraph -> TransGraphTupleExpr -> Either RelationalError TupleExpr
102evalTransGraphTupleExpr graph (TupleExpr attrMap) = do
103 attrAssoc <- mapM (\(attrName, atomExpr) -> do
104 aExpr <- evalTransGraphAtomExpr graph atomExpr
105 pure (attrName, aExpr)
106 ) (M.toList attrMap)
107 pure (TupleExpr (M.fromList attrAssoc))
109evalTransGraphAtomExpr :: TransactionGraph -> TransGraphAtomExpr -> Either RelationalError AtomExpr
110evalTransGraphAtomExpr _ (AttributeAtomExpr aname) = pure $ AttributeAtomExpr aname
111evalTransGraphAtomExpr _ (NakedAtomExpr atom) = pure $ NakedAtomExpr atom
112evalTransGraphAtomExpr graph (FunctionAtomExpr funcName args tLookup) = do
113 trans <- lookupTransaction graph tLookup
114 --I can't return a FunctionAtomExpr because the function needs to be resolved at a specific context
115 args' <- mapM (evalTransGraphAtomExpr graph) args
116 atom <- runReader (evalAtomExpr emptyTuple (FunctionAtomExpr funcName args' ())) (RelationalExprStateElems (concreteDatabaseContext trans))
117 pure (NakedAtomExpr atom)
118evalTransGraphAtomExpr graph (RelationAtomExpr expr) = do
119 expr' <- evalTransGraphRelationalExpr expr graph
120 pure (RelationAtomExpr expr')
121evalTransGraphAtomExpr graph (ConstructedAtomExpr dConsName args tLookup) = do
122 trans <- lookupTransaction graph tLookup
123 args' <- mapM (evalTransGraphAtomExpr graph) args
124 atom <- runReader (evalAtomExpr emptyTuple (ConstructedAtomExpr dConsName args' ())) (RelationalExprStateElems (concreteDatabaseContext trans))
125 pure (NakedAtomExpr atom)
127evalTransGraphRestrictionPredicateExpr :: TransGraphRestrictionPredicateExpr -> TransactionGraph -> Either RelationalError RestrictionPredicateExpr
128evalTransGraphRestrictionPredicateExpr TruePredicate _ = pure TruePredicate
129evalTransGraphRestrictionPredicateExpr (AndPredicate exprA exprB) graph = do
130 exprA' <- evalTransGraphRestrictionPredicateExpr exprA graph
131 exprB' <- evalTransGraphRestrictionPredicateExpr exprB graph
132 pure (AndPredicate exprA' exprB')
133evalTransGraphRestrictionPredicateExpr (OrPredicate exprA exprB) graph = do
134 exprA' <- evalTransGraphRestrictionPredicateExpr exprA graph
135 exprB' <- evalTransGraphRestrictionPredicateExpr exprB graph
136 pure (OrPredicate exprA' exprB')
137evalTransGraphRestrictionPredicateExpr (NotPredicate expr) graph = do
138 expr' <- evalTransGraphRestrictionPredicateExpr expr graph
139 pure (NotPredicate expr')
140evalTransGraphRestrictionPredicateExpr (RelationalExprPredicate expr) graph = do
141 expr' <- evalTransGraphRelationalExpr expr graph
142 pure (RelationalExprPredicate expr')
143evalTransGraphRestrictionPredicateExpr (AtomExprPredicate expr) graph = do
144 expr' <- evalTransGraphAtomExpr graph expr
145 pure (AtomExprPredicate expr')
146evalTransGraphRestrictionPredicateExpr (AttributeEqualityPredicate attrName expr) graph = do
147 expr' <- evalTransGraphAtomExpr graph expr
148 pure (AttributeEqualityPredicate attrName expr')
150evalTransGraphExtendTupleExpr :: TransGraphExtendTupleExpr -> TransactionGraph -> Either RelationalError ExtendTupleExpr
151evalTransGraphExtendTupleExpr (AttributeExtendTupleExpr attrName expr) graph = do
152 expr' <- evalTransGraphAtomExpr graph expr
153 pure (AttributeExtendTupleExpr attrName expr')
155evalTransGraphAttributeExpr :: TransactionGraph -> TransGraphAttributeExpr -> Either RelationalError AttributeExpr
156evalTransGraphAttributeExpr graph (AttributeAndTypeNameExpr attrName tCons tLookup) = do
157 trans <- lookupTransaction graph tLookup
158 aType <- atomTypeForTypeConstructor tCons (typeConstructorMapping (concreteDatabaseContext trans)) M.empty
159 pure (NakedAttributeExpr (Attribute attrName aType))
160evalTransGraphAttributeExpr _ (NakedAttributeExpr attr) = pure (NakedAttributeExpr attr)
162evalTransAttributeNames :: TransGraphAttributeNames -> TransactionGraph -> Either RelationalError AttributeNames
163evalTransAttributeNames (AttributeNames names) _ = Right (AttributeNames names)
164evalTransAttributeNames (InvertedAttributeNames names) _ = Right (InvertedAttributeNames names)
165evalTransAttributeNames (UnionAttributeNames namesA namesB) graph = do
166 nA <- evalTransAttributeNames namesA graph
167 nB <- evalTransAttributeNames namesB graph
168 Right (UnionAttributeNames nA nB)
169evalTransAttributeNames (IntersectAttributeNames namesA namesB) graph = do
170 nA <- evalTransAttributeNames namesA graph
171 nB <- evalTransAttributeNames namesB graph
172 Right (IntersectAttributeNames nA nB)
173evalTransAttributeNames (RelationalExprAttributeNames expr) graph = do
174 evaldExpr <- evalTransGraphRelationalExpr expr graph
175 Right (RelationalExprAttributeNames evaldExpr)