module ProjectM36.GraphRefRelationalExpr where
--evaluate relational expressions across the entire transaction graph to support cross-transaction referencing
import ProjectM36.Base
import qualified Data.Set as S

--import Debug.Trace

data SingularTransactionRef = SingularTransactionRef GraphRefTransactionMarker |
                              MultipleTransactionsRef |
                              NoTransactionsRef
                              deriving (SingularTransactionRef -> SingularTransactionRef -> Bool
(SingularTransactionRef -> SingularTransactionRef -> Bool)
-> (SingularTransactionRef -> SingularTransactionRef -> Bool)
-> Eq SingularTransactionRef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SingularTransactionRef -> SingularTransactionRef -> Bool
$c/= :: SingularTransactionRef -> SingularTransactionRef -> Bool
== :: SingularTransactionRef -> SingularTransactionRef -> Bool
$c== :: SingularTransactionRef -> SingularTransactionRef -> Bool
Eq, Int -> SingularTransactionRef -> ShowS
[SingularTransactionRef] -> ShowS
SingularTransactionRef -> String
(Int -> SingularTransactionRef -> ShowS)
-> (SingularTransactionRef -> String)
-> ([SingularTransactionRef] -> ShowS)
-> Show SingularTransactionRef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SingularTransactionRef] -> ShowS
$cshowList :: [SingularTransactionRef] -> ShowS
show :: SingularTransactionRef -> String
$cshow :: SingularTransactionRef -> String
showsPrec :: Int -> SingularTransactionRef -> ShowS
$cshowsPrec :: Int -> SingularTransactionRef -> ShowS
Show)

instance Semigroup SingularTransactionRef where
  SingularTransactionRef
NoTransactionsRef <> :: SingularTransactionRef
-> SingularTransactionRef -> SingularTransactionRef
<> SingularTransactionRef
x = SingularTransactionRef
x
  SingularTransactionRef
MultipleTransactionsRef <> SingularTransactionRef
_ = SingularTransactionRef
MultipleTransactionsRef
  SingularTransactionRef GraphRefTransactionMarker
tidA <> s :: SingularTransactionRef
s@(SingularTransactionRef GraphRefTransactionMarker
tidB) =
    if GraphRefTransactionMarker
tidA GraphRefTransactionMarker -> GraphRefTransactionMarker -> Bool
forall a. Eq a => a -> a -> Bool
== GraphRefTransactionMarker
tidB then
      SingularTransactionRef
s
    else
      SingularTransactionRef
MultipleTransactionsRef
  s :: SingularTransactionRef
s@SingularTransactionRef{} <> SingularTransactionRef
NoTransactionsRef = SingularTransactionRef
s
  SingularTransactionRef
_ <> SingularTransactionRef
MultipleTransactionsRef = SingularTransactionRef
MultipleTransactionsRef

instance Monoid SingularTransactionRef where
  mempty :: SingularTransactionRef
mempty = SingularTransactionRef
NoTransactionsRef
  
-- | return `Just transid` if this GraphRefRelationalExpr refers to just one transaction in the graph. This is useful for determining if certain optimizations can apply.
singularTransaction :: Foldable t => t GraphRefTransactionMarker -> SingularTransactionRef
singularTransaction :: t GraphRefTransactionMarker -> SingularTransactionRef
singularTransaction t GraphRefTransactionMarker
expr
  | Set GraphRefTransactionMarker -> Bool
forall a. Set a -> Bool
S.null Set GraphRefTransactionMarker
transSet = SingularTransactionRef
NoTransactionsRef
  | Set GraphRefTransactionMarker -> Int
forall a. Set a -> Int
S.size Set GraphRefTransactionMarker
transSet Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = GraphRefTransactionMarker -> SingularTransactionRef
SingularTransactionRef ([GraphRefTransactionMarker] -> GraphRefTransactionMarker
forall a. [a] -> a
head (Set GraphRefTransactionMarker -> [GraphRefTransactionMarker]
forall a. Set a -> [a]
S.toList Set GraphRefTransactionMarker
transSet))
  | Bool
otherwise = SingularTransactionRef
MultipleTransactionsRef
  where
    transSet :: Set GraphRefTransactionMarker
transSet = (GraphRefTransactionMarker
 -> Set GraphRefTransactionMarker -> Set GraphRefTransactionMarker)
-> Set GraphRefTransactionMarker
-> t GraphRefTransactionMarker
-> Set GraphRefTransactionMarker
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr GraphRefTransactionMarker
-> Set GraphRefTransactionMarker -> Set GraphRefTransactionMarker
forall a. Ord a => a -> Set a -> Set a
S.insert Set GraphRefTransactionMarker
forall a. Set a
S.empty t GraphRefTransactionMarker
expr

-- | Return True if two 'GraphRefRelationalExpr's both refer exclusively to the same transaction (or none at all).
inSameTransaction :: GraphRefRelationalExpr -> GraphRefRelationalExpr -> Maybe GraphRefTransactionMarker
inSameTransaction :: GraphRefRelationalExpr
-> GraphRefRelationalExpr -> Maybe GraphRefTransactionMarker
inSameTransaction GraphRefRelationalExpr
exprA GraphRefRelationalExpr
exprB = case (SingularTransactionRef
stA, SingularTransactionRef
stB) of
  (SingularTransactionRef GraphRefTransactionMarker
tA, SingularTransactionRef GraphRefTransactionMarker
tB) | GraphRefTransactionMarker
tA GraphRefTransactionMarker -> GraphRefTransactionMarker -> Bool
forall a. Eq a => a -> a -> Bool
== GraphRefTransactionMarker
tB -> GraphRefTransactionMarker -> Maybe GraphRefTransactionMarker
forall a. a -> Maybe a
Just GraphRefTransactionMarker
tA
  (SingularTransactionRef, SingularTransactionRef)
_ -> Maybe GraphRefTransactionMarker
forall a. Maybe a
Nothing
  where stA :: SingularTransactionRef
stA = GraphRefRelationalExpr -> SingularTransactionRef
forall (t :: * -> *).
Foldable t =>
t GraphRefTransactionMarker -> SingularTransactionRef
singularTransaction GraphRefRelationalExpr
exprA
        stB :: SingularTransactionRef
stB = GraphRefRelationalExpr -> SingularTransactionRef
forall (t :: * -> *).
Foldable t =>
t GraphRefTransactionMarker -> SingularTransactionRef
singularTransaction GraphRefRelationalExpr
exprB

singularTransactions :: (Foldable f, Foldable t) => f (t GraphRefTransactionMarker) -> SingularTransactionRef
singularTransactions :: f (t GraphRefTransactionMarker) -> SingularTransactionRef
singularTransactions = (t GraphRefTransactionMarker -> SingularTransactionRef)
-> f (t GraphRefTransactionMarker) -> SingularTransactionRef
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap t GraphRefTransactionMarker -> SingularTransactionRef
forall (t :: * -> *).
Foldable t =>
t GraphRefTransactionMarker -> SingularTransactionRef
singularTransaction