on f7fc888 help sign in
project-m36/src/lib/ProjectM36/GraphRefRelationalExpr.hs
45 lines 2.0 kB history raw
1module ProjectM36.GraphRefRelationalExpr where
2--evaluate relational expressions across the entire transaction graph to support cross-transaction referencing
3import ProjectM36.Base
4import qualified Data.Set as S
6--import Debug.Trace
8data SingularTransactionRef = SingularTransactionRef GraphRefTransactionMarker |
9 MultipleTransactionsRef |
10 NoTransactionsRef
11 deriving (Eq, Show)
13instance Semigroup SingularTransactionRef where
14 NoTransactionsRef <> x = x
15 MultipleTransactionsRef <> _ = MultipleTransactionsRef
16 SingularTransactionRef tidA <> s@(SingularTransactionRef tidB) =
17 if tidA == tidB then
18 s
19 else
20 MultipleTransactionsRef
21 s@SingularTransactionRef{} <> NoTransactionsRef = s
22 _ <> MultipleTransactionsRef = MultipleTransactionsRef
24instance Monoid SingularTransactionRef where
25 mempty = NoTransactionsRef
27-- | return `Just transid` if this GraphRefRelationalExpr refers to just one transaction in the graph. This is useful for determining if certain optimizations can apply.
28singularTransaction :: Foldable t => t GraphRefTransactionMarker -> SingularTransactionRef
29singularTransaction expr
30 | S.null transSet = NoTransactionsRef
31 | S.size transSet == 1 = SingularTransactionRef (head (S.toList transSet))
32 | otherwise = MultipleTransactionsRef
33 where
34 transSet = foldr S.insert S.empty expr
36-- | Return True if two 'GraphRefRelationalExpr's both refer exclusively to the same transaction (or none at all).
37inSameTransaction :: GraphRefRelationalExpr -> GraphRefRelationalExpr -> Maybe GraphRefTransactionMarker
38inSameTransaction exprA exprB = case (stA, stB) of
39 (SingularTransactionRef tA, SingularTransactionRef tB) | tA == tB -> Just tA
40 _ -> Nothing
41 where stA = singularTransaction exprA
42 stB = singularTransaction exprB
44singularTransactions :: (Foldable f, Foldable t) => f (t GraphRefTransactionMarker) -> SingularTransactionRef
45singularTransactions = foldMap singularTransaction