git.iko.soy/project-m36
on 01345d5 help sign in
project-m36/src/lib/ProjectM36/TransGraphRelationalExpression.hs
153 lines 8.7 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.RelationalExpression
8import ProjectM36.Error
9import Control.Monad.State
10import ProjectM36.Tuple
11import ProjectM36.AtomType
12import qualified Data.Map as M
13import Data.Binary
15-- | The TransGraphRelationalExpression is equivalent to a relational expression except that relation variables can reference points in the transaction graph (at previous points in time).
16type TransGraphRelationalExpr = RelationalExprBase TransactionIdLookup
18instance Binary TransGraphRelationalExpr
20type TransGraphExtendTupleExpr = ExtendTupleExprBase TransactionIdLookup
22instance Binary TransGraphExtendTupleExpr
24type TransGraphTupleExpr = TupleExprBase TransactionIdLookup
26instance Binary TransGraphTupleExpr
28type TransGraphRestrictionPredicateExpr = RestrictionPredicateExprBase TransactionIdLookup
30instance Binary TransGraphRestrictionPredicateExpr
32type TransGraphAtomExpr = AtomExprBase TransactionIdLookup
34instance Binary TransGraphAtomExpr
36type TransGraphAttributeExpr = AttributeExprBase TransactionIdLookup
38-- 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.
39evalTransGraphRelationalExpr :: TransGraphRelationalExpr -> TransactionGraph -> Either RelationalError RelationalExpr
40evalTransGraphRelationalExpr (MakeRelationFromExprs mAttrExprs tupleExprs) graph = do
41 tupleExprs' <- mapM (evalTransGraphTupleExpr graph) tupleExprs
42 case mAttrExprs of
43 Nothing -> pure (MakeRelationFromExprs Nothing tupleExprs')
44 Just attrExprs -> do
45 attrExprs' <- mapM (evalTransGraphAttributeExpr graph) attrExprs
46 pure (MakeRelationFromExprs (Just attrExprs') tupleExprs')
47evalTransGraphRelationalExpr (MakeStaticRelation attrs tupSet) _ = pure (MakeStaticRelation attrs tupSet)
48evalTransGraphRelationalExpr (ExistingRelation rel) _ = pure (ExistingRelation rel)
49evalTransGraphRelationalExpr (RelationVariable rvname transLookup) graph = do
50 trans <- lookupTransaction graph transLookup
51 rel <- evalState (evalRelationalExpr (RelationVariable rvname ())) (transactionContext trans)
52 pure (ExistingRelation rel)
53evalTransGraphRelationalExpr (Project attrNames expr) graph = do
54 expr' <- evalTransGraphRelationalExpr expr graph
55 pure (Project attrNames expr')
56evalTransGraphRelationalExpr (Union exprA exprB) graph = do
57 exprA' <- evalTransGraphRelationalExpr exprA graph
58 exprB' <- evalTransGraphRelationalExpr exprB graph
59 pure (Union exprA' exprB')
60evalTransGraphRelationalExpr (Join exprA exprB) graph = do
61 exprA' <- evalTransGraphRelationalExpr exprA graph
62 exprB' <- evalTransGraphRelationalExpr exprB graph
63 pure (Join exprA' exprB')
64evalTransGraphRelationalExpr (Rename attrName1 attrName2 expr) graph = do
65 expr' <- evalTransGraphRelationalExpr expr graph
66 pure (Rename attrName1 attrName2 expr')
67evalTransGraphRelationalExpr (Difference exprA exprB) graph = do
68 exprA' <- evalTransGraphRelationalExpr exprA graph
69 exprB' <- evalTransGraphRelationalExpr exprB graph
70 pure (Difference exprA' exprB')
71evalTransGraphRelationalExpr (Group attrNames attrName expr) graph = do
72 expr' <- evalTransGraphRelationalExpr expr graph
73 pure (Group attrNames attrName expr')
74evalTransGraphRelationalExpr (Ungroup attrName expr) graph = do
75 expr' <- evalTransGraphRelationalExpr expr graph
76 pure (Ungroup attrName expr')
77evalTransGraphRelationalExpr (Restrict predicateExpr expr) graph = do
78 expr' <- evalTransGraphRelationalExpr expr graph
79 predicateExpr' <- evalTransGraphRestrictionPredicateExpr predicateExpr graph
80 pure (Restrict predicateExpr' expr')
81evalTransGraphRelationalExpr (Equals exprA exprB) graph = do
82 exprA' <- evalTransGraphRelationalExpr exprA graph
83 exprB' <- evalTransGraphRelationalExpr exprB graph
84 pure (Equals exprA' exprB')
85evalTransGraphRelationalExpr (NotEquals exprA exprB) graph = do
86 exprA' <- evalTransGraphRelationalExpr exprA graph
87 exprB' <- evalTransGraphRelationalExpr exprB graph
88 pure (NotEquals exprA' exprB')
89evalTransGraphRelationalExpr (Extend extendExpr expr) graph = do
90 extendExpr' <- evalTransGraphExtendTupleExpr extendExpr graph
91 expr' <- evalTransGraphRelationalExpr expr graph
92 pure (Extend extendExpr' expr')
94evalTransGraphTupleExpr :: TransactionGraph -> TransGraphTupleExpr -> Either RelationalError TupleExpr
95evalTransGraphTupleExpr graph (TupleExpr attrMap) = do
96 attrAssoc <- mapM (\(attrName, atomExpr) -> do
97 aExpr <- evalTransGraphAtomExpr graph atomExpr
98 pure (attrName, aExpr)
99 ) (M.toList attrMap)
100 pure (TupleExpr (M.fromList attrAssoc))
102evalTransGraphAtomExpr :: TransactionGraph -> TransGraphAtomExpr -> Either RelationalError AtomExpr
103evalTransGraphAtomExpr _ (AttributeAtomExpr aname) = pure $ AttributeAtomExpr aname
104evalTransGraphAtomExpr _ (NakedAtomExpr atom) = pure $ NakedAtomExpr atom
105evalTransGraphAtomExpr graph (FunctionAtomExpr funcName args tLookup) = do
106 trans <- lookupTransaction graph tLookup
107 --I can't return a FunctionAtomExpr because the function needs to be resolved at a specific context
108 args' <- mapM (evalTransGraphAtomExpr graph) args
109 atom <- evalAtomExpr emptyTuple (transactionContext trans) (FunctionAtomExpr funcName args' ())
110 pure (NakedAtomExpr atom)
111evalTransGraphAtomExpr graph (RelationAtomExpr expr) = do
112 expr' <- evalTransGraphRelationalExpr expr graph
113 pure (RelationAtomExpr expr')
114evalTransGraphAtomExpr graph (ConstructedAtomExpr dConsName args tLookup) = do
115 trans <- lookupTransaction graph tLookup
116 args' <- mapM (evalTransGraphAtomExpr graph) args
117 atom <- evalAtomExpr emptyTuple (transactionContext trans) (ConstructedAtomExpr dConsName args' ())
118 pure (NakedAtomExpr atom)
120evalTransGraphRestrictionPredicateExpr :: TransGraphRestrictionPredicateExpr -> TransactionGraph -> Either RelationalError RestrictionPredicateExpr
121evalTransGraphRestrictionPredicateExpr TruePredicate _ = pure TruePredicate
122evalTransGraphRestrictionPredicateExpr (AndPredicate exprA exprB) graph = do
123 exprA' <- evalTransGraphRestrictionPredicateExpr exprA graph
124 exprB' <- evalTransGraphRestrictionPredicateExpr exprB graph
125 pure (AndPredicate exprA' exprB')
126evalTransGraphRestrictionPredicateExpr (OrPredicate exprA exprB) graph = do
127 exprA' <- evalTransGraphRestrictionPredicateExpr exprA graph
128 exprB' <- evalTransGraphRestrictionPredicateExpr exprB graph
129 pure (OrPredicate exprA' exprB')
130evalTransGraphRestrictionPredicateExpr (NotPredicate expr) graph = do
131 expr' <- evalTransGraphRestrictionPredicateExpr expr graph
132 pure (NotPredicate expr')
133evalTransGraphRestrictionPredicateExpr (RelationalExprPredicate expr) graph = do
134 expr' <- evalTransGraphRelationalExpr expr graph
135 pure (RelationalExprPredicate expr')
136evalTransGraphRestrictionPredicateExpr (AtomExprPredicate expr) graph = do
137 expr' <- evalTransGraphAtomExpr graph expr
138 pure (AtomExprPredicate expr')
139evalTransGraphRestrictionPredicateExpr (AttributeEqualityPredicate attrName expr) graph = do
140 expr' <- evalTransGraphAtomExpr graph expr
141 pure (AttributeEqualityPredicate attrName expr')
143evalTransGraphExtendTupleExpr :: TransGraphExtendTupleExpr -> TransactionGraph -> Either RelationalError ExtendTupleExpr
144evalTransGraphExtendTupleExpr (AttributeExtendTupleExpr attrName expr) graph = do
145 expr' <- evalTransGraphAtomExpr graph expr
146 pure (AttributeExtendTupleExpr attrName expr')
148evalTransGraphAttributeExpr :: TransactionGraph -> TransGraphAttributeExpr -> Either RelationalError AttributeExpr
149evalTransGraphAttributeExpr graph (AttributeAndTypeNameExpr attrName tCons tLookup) = do
150 trans <- lookupTransaction graph tLookup
151 aType <- atomTypeForTypeConstructor tCons (typeConstructorMapping (transactionContext trans))
152 pure (NakedAttributeExpr (Attribute attrName aType))
153evalTransGraphAttributeExpr _ (NakedAttributeExpr attr) = pure (NakedAttributeExpr attr)