-- | Functions to convert all types of expresions into their GraphRef- equivalents.
module ProjectM36.NormalizeExpr where
import ProjectM36.Base
import Control.Monad.Trans.Reader as R
import qualified Data.Map as M

--used to process/normalize exprs to their respective graph ref forms
type ProcessExprM a = Reader GraphRefTransactionMarker a

type CurrentTransactionId = TransactionId

runProcessExprM :: GraphRefTransactionMarker -> ProcessExprM a -> a
runProcessExprM :: GraphRefTransactionMarker -> ProcessExprM a -> a
runProcessExprM GraphRefTransactionMarker
mtid ProcessExprM a
m = ProcessExprM a -> GraphRefTransactionMarker -> a
forall r a. Reader r a -> r -> a
runReader ProcessExprM a
m GraphRefTransactionMarker
mtid

askMarker :: ProcessExprM GraphRefTransactionMarker
askMarker :: ProcessExprM GraphRefTransactionMarker
askMarker = ProcessExprM GraphRefTransactionMarker
forall (m :: * -> *) r. Monad m => ReaderT r m r
R.ask

-- convert a RelationalExpr into a GraphRefRelationalExpr using the current trans Id
processRelationalExpr :: RelationalExpr -> ProcessExprM GraphRefRelationalExpr
processRelationalExpr :: RelationalExpr -> ProcessExprM GraphRefRelationalExpr
processRelationalExpr (MakeRelationFromExprs Maybe [AttributeExprBase ()]
mAttrs TupleExprsBase ()
tupleExprs) = do
  Maybe [GraphRefAttributeExpr]
mAttrs' <- case Maybe [AttributeExprBase ()]
mAttrs of
                  Maybe [AttributeExprBase ()]
Nothing -> Maybe [GraphRefAttributeExpr]
-> ReaderT
     GraphRefTransactionMarker Identity (Maybe [GraphRefAttributeExpr])
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe [GraphRefAttributeExpr]
forall a. Maybe a
Nothing
                  Just [AttributeExprBase ()]
mAttrs'' -> [GraphRefAttributeExpr] -> Maybe [GraphRefAttributeExpr]
forall a. a -> Maybe a
Just ([GraphRefAttributeExpr] -> Maybe [GraphRefAttributeExpr])
-> ReaderT
     GraphRefTransactionMarker Identity [GraphRefAttributeExpr]
-> ReaderT
     GraphRefTransactionMarker Identity (Maybe [GraphRefAttributeExpr])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AttributeExprBase ()
 -> ReaderT
      GraphRefTransactionMarker Identity GraphRefAttributeExpr)
-> [AttributeExprBase ()]
-> ReaderT
     GraphRefTransactionMarker Identity [GraphRefAttributeExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM AttributeExprBase ()
-> ReaderT GraphRefTransactionMarker Identity GraphRefAttributeExpr
processAttributeExpr [AttributeExprBase ()]
mAttrs''
  Maybe [GraphRefAttributeExpr]
-> TupleExprsBase GraphRefTransactionMarker
-> GraphRefRelationalExpr
forall a.
Maybe [AttributeExprBase a]
-> TupleExprsBase a -> RelationalExprBase a
MakeRelationFromExprs Maybe [GraphRefAttributeExpr]
mAttrs' (TupleExprsBase GraphRefTransactionMarker
 -> GraphRefRelationalExpr)
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (TupleExprsBase GraphRefTransactionMarker)
-> ProcessExprM GraphRefRelationalExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TupleExprsBase ()
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (TupleExprsBase GraphRefTransactionMarker)
processTupleExprs TupleExprsBase ()
tupleExprs
processRelationalExpr (MakeStaticRelation Attributes
attrs RelationTupleSet
tupSet) = GraphRefRelationalExpr -> ProcessExprM GraphRefRelationalExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Attributes -> RelationTupleSet -> GraphRefRelationalExpr
forall a. Attributes -> RelationTupleSet -> RelationalExprBase a
MakeStaticRelation Attributes
attrs RelationTupleSet
tupSet)
processRelationalExpr (ExistingRelation Relation
rel) = GraphRefRelationalExpr -> ProcessExprM GraphRefRelationalExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Relation -> GraphRefRelationalExpr
forall a. Relation -> RelationalExprBase a
ExistingRelation Relation
rel)
--requires current trans id and graph
processRelationalExpr (RelationVariable RelVarName
rv ()) = RelVarName -> GraphRefTransactionMarker -> GraphRefRelationalExpr
forall a. RelVarName -> a -> RelationalExprBase a
RelationVariable RelVarName
rv (GraphRefTransactionMarker -> GraphRefRelationalExpr)
-> ProcessExprM GraphRefTransactionMarker
-> ProcessExprM GraphRefRelationalExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProcessExprM GraphRefTransactionMarker
askMarker
processRelationalExpr (Project AttributeNamesBase ()
attrNames RelationalExpr
expr) = AttributeNamesBase GraphRefTransactionMarker
-> GraphRefRelationalExpr -> GraphRefRelationalExpr
forall a.
AttributeNamesBase a
-> RelationalExprBase a -> RelationalExprBase a
Project (AttributeNamesBase GraphRefTransactionMarker
 -> GraphRefRelationalExpr -> GraphRefRelationalExpr)
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (AttributeNamesBase GraphRefTransactionMarker)
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (GraphRefRelationalExpr -> GraphRefRelationalExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AttributeNamesBase ()
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (AttributeNamesBase GraphRefTransactionMarker)
processAttributeNames AttributeNamesBase ()
attrNames ReaderT
  GraphRefTransactionMarker
  Identity
  (GraphRefRelationalExpr -> GraphRefRelationalExpr)
-> ProcessExprM GraphRefRelationalExpr
-> ProcessExprM GraphRefRelationalExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RelationalExpr -> ProcessExprM GraphRefRelationalExpr
processRelationalExpr RelationalExpr
expr
processRelationalExpr (Union RelationalExpr
exprA RelationalExpr
exprB) = GraphRefRelationalExpr
-> GraphRefRelationalExpr -> GraphRefRelationalExpr
forall a.
RelationalExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Union (GraphRefRelationalExpr
 -> GraphRefRelationalExpr -> GraphRefRelationalExpr)
-> ProcessExprM GraphRefRelationalExpr
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (GraphRefRelationalExpr -> GraphRefRelationalExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RelationalExpr -> ProcessExprM GraphRefRelationalExpr
processRelationalExpr RelationalExpr
exprA ReaderT
  GraphRefTransactionMarker
  Identity
  (GraphRefRelationalExpr -> GraphRefRelationalExpr)
-> ProcessExprM GraphRefRelationalExpr
-> ProcessExprM GraphRefRelationalExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RelationalExpr -> ProcessExprM GraphRefRelationalExpr
processRelationalExpr RelationalExpr
exprB
processRelationalExpr (Join RelationalExpr
exprA RelationalExpr
exprB) = GraphRefRelationalExpr
-> GraphRefRelationalExpr -> GraphRefRelationalExpr
forall a.
RelationalExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Join (GraphRefRelationalExpr
 -> GraphRefRelationalExpr -> GraphRefRelationalExpr)
-> ProcessExprM GraphRefRelationalExpr
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (GraphRefRelationalExpr -> GraphRefRelationalExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RelationalExpr -> ProcessExprM GraphRefRelationalExpr
processRelationalExpr RelationalExpr
exprA ReaderT
  GraphRefTransactionMarker
  Identity
  (GraphRefRelationalExpr -> GraphRefRelationalExpr)
-> ProcessExprM GraphRefRelationalExpr
-> ProcessExprM GraphRefRelationalExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RelationalExpr -> ProcessExprM GraphRefRelationalExpr
processRelationalExpr RelationalExpr
exprB
processRelationalExpr (Rename RelVarName
attrA RelVarName
attrB RelationalExpr
expr) =
  RelVarName
-> RelVarName -> GraphRefRelationalExpr -> GraphRefRelationalExpr
forall a.
RelVarName
-> RelVarName -> RelationalExprBase a -> RelationalExprBase a
Rename RelVarName
attrA RelVarName
attrB (GraphRefRelationalExpr -> GraphRefRelationalExpr)
-> ProcessExprM GraphRefRelationalExpr
-> ProcessExprM GraphRefRelationalExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RelationalExpr -> ProcessExprM GraphRefRelationalExpr
processRelationalExpr RelationalExpr
expr
processRelationalExpr (Difference RelationalExpr
exprA RelationalExpr
exprB) = GraphRefRelationalExpr
-> GraphRefRelationalExpr -> GraphRefRelationalExpr
forall a.
RelationalExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Difference (GraphRefRelationalExpr
 -> GraphRefRelationalExpr -> GraphRefRelationalExpr)
-> ProcessExprM GraphRefRelationalExpr
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (GraphRefRelationalExpr -> GraphRefRelationalExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RelationalExpr -> ProcessExprM GraphRefRelationalExpr
processRelationalExpr RelationalExpr
exprA ReaderT
  GraphRefTransactionMarker
  Identity
  (GraphRefRelationalExpr -> GraphRefRelationalExpr)
-> ProcessExprM GraphRefRelationalExpr
-> ProcessExprM GraphRefRelationalExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RelationalExpr -> ProcessExprM GraphRefRelationalExpr
processRelationalExpr RelationalExpr
exprB
processRelationalExpr (Group AttributeNamesBase ()
attrNames RelVarName
attrName RelationalExpr
expr) = AttributeNamesBase GraphRefTransactionMarker
-> RelVarName -> GraphRefRelationalExpr -> GraphRefRelationalExpr
forall a.
AttributeNamesBase a
-> RelVarName -> RelationalExprBase a -> RelationalExprBase a
Group (AttributeNamesBase GraphRefTransactionMarker
 -> RelVarName -> GraphRefRelationalExpr -> GraphRefRelationalExpr)
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (AttributeNamesBase GraphRefTransactionMarker)
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (RelVarName -> GraphRefRelationalExpr -> GraphRefRelationalExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AttributeNamesBase ()
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (AttributeNamesBase GraphRefTransactionMarker)
processAttributeNames AttributeNamesBase ()
attrNames ReaderT
  GraphRefTransactionMarker
  Identity
  (RelVarName -> GraphRefRelationalExpr -> GraphRefRelationalExpr)
-> ReaderT GraphRefTransactionMarker Identity RelVarName
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (GraphRefRelationalExpr -> GraphRefRelationalExpr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RelVarName -> ReaderT GraphRefTransactionMarker Identity RelVarName
forall (f :: * -> *) a. Applicative f => a -> f a
pure RelVarName
attrName ReaderT
  GraphRefTransactionMarker
  Identity
  (GraphRefRelationalExpr -> GraphRefRelationalExpr)
-> ProcessExprM GraphRefRelationalExpr
-> ProcessExprM GraphRefRelationalExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RelationalExpr -> ProcessExprM GraphRefRelationalExpr
processRelationalExpr RelationalExpr
expr
processRelationalExpr (Ungroup RelVarName
attrName RelationalExpr
expr) = RelVarName -> GraphRefRelationalExpr -> GraphRefRelationalExpr
forall a.
RelVarName -> RelationalExprBase a -> RelationalExprBase a
Ungroup RelVarName
attrName (GraphRefRelationalExpr -> GraphRefRelationalExpr)
-> ProcessExprM GraphRefRelationalExpr
-> ProcessExprM GraphRefRelationalExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RelationalExpr -> ProcessExprM GraphRefRelationalExpr
processRelationalExpr RelationalExpr
expr
processRelationalExpr (Restrict RestrictionPredicateExprBase ()
pred' RelationalExpr
expr) = RestrictionPredicateExprBase GraphRefTransactionMarker
-> GraphRefRelationalExpr -> GraphRefRelationalExpr
forall a.
RestrictionPredicateExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Restrict (RestrictionPredicateExprBase GraphRefTransactionMarker
 -> GraphRefRelationalExpr -> GraphRefRelationalExpr)
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (RestrictionPredicateExprBase GraphRefTransactionMarker)
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (GraphRefRelationalExpr -> GraphRefRelationalExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RestrictionPredicateExprBase ()
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (RestrictionPredicateExprBase GraphRefTransactionMarker)
processRestrictionPredicateExpr RestrictionPredicateExprBase ()
pred' ReaderT
  GraphRefTransactionMarker
  Identity
  (GraphRefRelationalExpr -> GraphRefRelationalExpr)
-> ProcessExprM GraphRefRelationalExpr
-> ProcessExprM GraphRefRelationalExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RelationalExpr -> ProcessExprM GraphRefRelationalExpr
processRelationalExpr RelationalExpr
expr
processRelationalExpr (Equals RelationalExpr
exprA RelationalExpr
exprB) =
  GraphRefRelationalExpr
-> GraphRefRelationalExpr -> GraphRefRelationalExpr
forall a.
RelationalExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Equals (GraphRefRelationalExpr
 -> GraphRefRelationalExpr -> GraphRefRelationalExpr)
-> ProcessExprM GraphRefRelationalExpr
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (GraphRefRelationalExpr -> GraphRefRelationalExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RelationalExpr -> ProcessExprM GraphRefRelationalExpr
processRelationalExpr RelationalExpr
exprA ReaderT
  GraphRefTransactionMarker
  Identity
  (GraphRefRelationalExpr -> GraphRefRelationalExpr)
-> ProcessExprM GraphRefRelationalExpr
-> ProcessExprM GraphRefRelationalExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RelationalExpr -> ProcessExprM GraphRefRelationalExpr
processRelationalExpr RelationalExpr
exprB
processRelationalExpr (NotEquals RelationalExpr
exprA RelationalExpr
exprB) =   
  GraphRefRelationalExpr
-> GraphRefRelationalExpr -> GraphRefRelationalExpr
forall a.
RelationalExprBase a
-> RelationalExprBase a -> RelationalExprBase a
NotEquals (GraphRefRelationalExpr
 -> GraphRefRelationalExpr -> GraphRefRelationalExpr)
-> ProcessExprM GraphRefRelationalExpr
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (GraphRefRelationalExpr -> GraphRefRelationalExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RelationalExpr -> ProcessExprM GraphRefRelationalExpr
processRelationalExpr RelationalExpr
exprA ReaderT
  GraphRefTransactionMarker
  Identity
  (GraphRefRelationalExpr -> GraphRefRelationalExpr)
-> ProcessExprM GraphRefRelationalExpr
-> ProcessExprM GraphRefRelationalExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RelationalExpr -> ProcessExprM GraphRefRelationalExpr
processRelationalExpr RelationalExpr
exprB
processRelationalExpr (Extend ExtendTupleExprBase ()
extendExpr RelationalExpr
expr) =
  ExtendTupleExprBase GraphRefTransactionMarker
-> GraphRefRelationalExpr -> GraphRefRelationalExpr
forall a.
ExtendTupleExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Extend (ExtendTupleExprBase GraphRefTransactionMarker
 -> GraphRefRelationalExpr -> GraphRefRelationalExpr)
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (ExtendTupleExprBase GraphRefTransactionMarker)
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (GraphRefRelationalExpr -> GraphRefRelationalExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExtendTupleExprBase ()
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (ExtendTupleExprBase GraphRefTransactionMarker)
processExtendTupleExpr ExtendTupleExprBase ()
extendExpr ReaderT
  GraphRefTransactionMarker
  Identity
  (GraphRefRelationalExpr -> GraphRefRelationalExpr)
-> ProcessExprM GraphRefRelationalExpr
-> ProcessExprM GraphRefRelationalExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RelationalExpr -> ProcessExprM GraphRefRelationalExpr
processRelationalExpr RelationalExpr
expr
processRelationalExpr (With [(WithNameExprBase (), RelationalExpr)]
macros RelationalExpr
expr) =
  [(WithNameExprBase GraphRefTransactionMarker,
  GraphRefRelationalExpr)]
-> GraphRefRelationalExpr -> GraphRefRelationalExpr
forall a.
[(WithNameExprBase a, RelationalExprBase a)]
-> RelationalExprBase a -> RelationalExprBase a
With ([(WithNameExprBase GraphRefTransactionMarker,
   GraphRefRelationalExpr)]
 -> GraphRefRelationalExpr -> GraphRefRelationalExpr)
-> ReaderT
     GraphRefTransactionMarker
     Identity
     [(WithNameExprBase GraphRefTransactionMarker,
       GraphRefRelationalExpr)]
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (GraphRefRelationalExpr -> GraphRefRelationalExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((WithNameExprBase (), RelationalExpr)
 -> ReaderT
      GraphRefTransactionMarker
      Identity
      (WithNameExprBase GraphRefTransactionMarker,
       GraphRefRelationalExpr))
-> [(WithNameExprBase (), RelationalExpr)]
-> ReaderT
     GraphRefTransactionMarker
     Identity
     [(WithNameExprBase GraphRefTransactionMarker,
       GraphRefRelationalExpr)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(WithNameExprBase ()
wnexpr, RelationalExpr
macroExpr) -> (,) (WithNameExprBase GraphRefTransactionMarker
 -> GraphRefRelationalExpr
 -> (WithNameExprBase GraphRefTransactionMarker,
     GraphRefRelationalExpr))
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (WithNameExprBase GraphRefTransactionMarker)
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (GraphRefRelationalExpr
      -> (WithNameExprBase GraphRefTransactionMarker,
          GraphRefRelationalExpr))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WithNameExprBase ()
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (WithNameExprBase GraphRefTransactionMarker)
processWithNameExpr WithNameExprBase ()
wnexpr ReaderT
  GraphRefTransactionMarker
  Identity
  (GraphRefRelationalExpr
   -> (WithNameExprBase GraphRefTransactionMarker,
       GraphRefRelationalExpr))
-> ProcessExprM GraphRefRelationalExpr
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (WithNameExprBase GraphRefTransactionMarker,
      GraphRefRelationalExpr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RelationalExpr -> ProcessExprM GraphRefRelationalExpr
processRelationalExpr RelationalExpr
macroExpr) [(WithNameExprBase (), RelationalExpr)]
macros ReaderT
  GraphRefTransactionMarker
  Identity
  (GraphRefRelationalExpr -> GraphRefRelationalExpr)
-> ProcessExprM GraphRefRelationalExpr
-> ProcessExprM GraphRefRelationalExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RelationalExpr -> ProcessExprM GraphRefRelationalExpr
processRelationalExpr RelationalExpr
expr

processWithNameExpr :: WithNameExpr -> ProcessExprM GraphRefWithNameExpr
processWithNameExpr :: WithNameExprBase ()
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (WithNameExprBase GraphRefTransactionMarker)
processWithNameExpr (WithNameExpr RelVarName
rvname ()) =
  RelVarName
-> GraphRefTransactionMarker
-> WithNameExprBase GraphRefTransactionMarker
forall a. RelVarName -> a -> WithNameExprBase a
WithNameExpr RelVarName
rvname (GraphRefTransactionMarker
 -> WithNameExprBase GraphRefTransactionMarker)
-> ProcessExprM GraphRefTransactionMarker
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (WithNameExprBase GraphRefTransactionMarker)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProcessExprM GraphRefTransactionMarker
askMarker

processAttributeNames :: AttributeNames -> ProcessExprM GraphRefAttributeNames
processAttributeNames :: AttributeNamesBase ()
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (AttributeNamesBase GraphRefTransactionMarker)
processAttributeNames (AttributeNames Set RelVarName
nameSet) = AttributeNamesBase GraphRefTransactionMarker
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (AttributeNamesBase GraphRefTransactionMarker)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AttributeNamesBase GraphRefTransactionMarker
 -> ReaderT
      GraphRefTransactionMarker
      Identity
      (AttributeNamesBase GraphRefTransactionMarker))
-> AttributeNamesBase GraphRefTransactionMarker
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (AttributeNamesBase GraphRefTransactionMarker)
forall a b. (a -> b) -> a -> b
$ Set RelVarName -> AttributeNamesBase GraphRefTransactionMarker
forall a. Set RelVarName -> AttributeNamesBase a
AttributeNames Set RelVarName
nameSet
processAttributeNames (InvertedAttributeNames Set RelVarName
attrNameSet) =
  AttributeNamesBase GraphRefTransactionMarker
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (AttributeNamesBase GraphRefTransactionMarker)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AttributeNamesBase GraphRefTransactionMarker
 -> ReaderT
      GraphRefTransactionMarker
      Identity
      (AttributeNamesBase GraphRefTransactionMarker))
-> AttributeNamesBase GraphRefTransactionMarker
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (AttributeNamesBase GraphRefTransactionMarker)
forall a b. (a -> b) -> a -> b
$ Set RelVarName -> AttributeNamesBase GraphRefTransactionMarker
forall a. Set RelVarName -> AttributeNamesBase a
InvertedAttributeNames Set RelVarName
attrNameSet
processAttributeNames (UnionAttributeNames AttributeNamesBase ()
attrNamesA AttributeNamesBase ()
attrNamesB) = AttributeNamesBase GraphRefTransactionMarker
-> AttributeNamesBase GraphRefTransactionMarker
-> AttributeNamesBase GraphRefTransactionMarker
forall a.
AttributeNamesBase a
-> AttributeNamesBase a -> AttributeNamesBase a
UnionAttributeNames (AttributeNamesBase GraphRefTransactionMarker
 -> AttributeNamesBase GraphRefTransactionMarker
 -> AttributeNamesBase GraphRefTransactionMarker)
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (AttributeNamesBase GraphRefTransactionMarker)
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (AttributeNamesBase GraphRefTransactionMarker
      -> AttributeNamesBase GraphRefTransactionMarker)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AttributeNamesBase ()
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (AttributeNamesBase GraphRefTransactionMarker)
processAttributeNames AttributeNamesBase ()
attrNamesA ReaderT
  GraphRefTransactionMarker
  Identity
  (AttributeNamesBase GraphRefTransactionMarker
   -> AttributeNamesBase GraphRefTransactionMarker)
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (AttributeNamesBase GraphRefTransactionMarker)
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (AttributeNamesBase GraphRefTransactionMarker)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AttributeNamesBase ()
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (AttributeNamesBase GraphRefTransactionMarker)
processAttributeNames AttributeNamesBase ()
attrNamesB
processAttributeNames (IntersectAttributeNames AttributeNamesBase ()
attrNamesA AttributeNamesBase ()
attrNamesB) = AttributeNamesBase GraphRefTransactionMarker
-> AttributeNamesBase GraphRefTransactionMarker
-> AttributeNamesBase GraphRefTransactionMarker
forall a.
AttributeNamesBase a
-> AttributeNamesBase a -> AttributeNamesBase a
IntersectAttributeNames (AttributeNamesBase GraphRefTransactionMarker
 -> AttributeNamesBase GraphRefTransactionMarker
 -> AttributeNamesBase GraphRefTransactionMarker)
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (AttributeNamesBase GraphRefTransactionMarker)
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (AttributeNamesBase GraphRefTransactionMarker
      -> AttributeNamesBase GraphRefTransactionMarker)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AttributeNamesBase ()
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (AttributeNamesBase GraphRefTransactionMarker)
processAttributeNames AttributeNamesBase ()
attrNamesA ReaderT
  GraphRefTransactionMarker
  Identity
  (AttributeNamesBase GraphRefTransactionMarker
   -> AttributeNamesBase GraphRefTransactionMarker)
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (AttributeNamesBase GraphRefTransactionMarker)
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (AttributeNamesBase GraphRefTransactionMarker)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AttributeNamesBase ()
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (AttributeNamesBase GraphRefTransactionMarker)
processAttributeNames AttributeNamesBase ()
attrNamesB
processAttributeNames (RelationalExprAttributeNames RelationalExpr
expr) = GraphRefRelationalExpr
-> AttributeNamesBase GraphRefTransactionMarker
forall a. RelationalExprBase a -> AttributeNamesBase a
RelationalExprAttributeNames (GraphRefRelationalExpr
 -> AttributeNamesBase GraphRefTransactionMarker)
-> ProcessExprM GraphRefRelationalExpr
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (AttributeNamesBase GraphRefTransactionMarker)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RelationalExpr -> ProcessExprM GraphRefRelationalExpr
processRelationalExpr RelationalExpr
expr

processDatabaseContextExpr :: DatabaseContextExpr -> ProcessExprM GraphRefDatabaseContextExpr
processDatabaseContextExpr :: DatabaseContextExpr -> ProcessExprM GraphRefDatabaseContextExpr
processDatabaseContextExpr DatabaseContextExpr
expr =
  case DatabaseContextExpr
expr of
    DatabaseContextExpr
NoOperation -> GraphRefDatabaseContextExpr
-> ProcessExprM GraphRefDatabaseContextExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure GraphRefDatabaseContextExpr
forall a. DatabaseContextExprBase a
NoOperation
    Define RelVarName
nam [AttributeExprBase ()]
attrExprs -> RelVarName
-> [GraphRefAttributeExpr] -> GraphRefDatabaseContextExpr
forall a.
RelVarName -> [AttributeExprBase a] -> DatabaseContextExprBase a
Define RelVarName
nam ([GraphRefAttributeExpr] -> GraphRefDatabaseContextExpr)
-> ReaderT
     GraphRefTransactionMarker Identity [GraphRefAttributeExpr]
-> ProcessExprM GraphRefDatabaseContextExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AttributeExprBase ()
 -> ReaderT
      GraphRefTransactionMarker Identity GraphRefAttributeExpr)
-> [AttributeExprBase ()]
-> ReaderT
     GraphRefTransactionMarker Identity [GraphRefAttributeExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM AttributeExprBase ()
-> ReaderT GraphRefTransactionMarker Identity GraphRefAttributeExpr
processAttributeExpr [AttributeExprBase ()]
attrExprs
    Undefine RelVarName
nam -> GraphRefDatabaseContextExpr
-> ProcessExprM GraphRefDatabaseContextExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelVarName -> GraphRefDatabaseContextExpr
forall a. RelVarName -> DatabaseContextExprBase a
Undefine RelVarName
nam)
    Assign RelVarName
nam RelationalExpr
rexpr -> RelVarName -> GraphRefRelationalExpr -> GraphRefDatabaseContextExpr
forall a.
RelVarName -> RelationalExprBase a -> DatabaseContextExprBase a
Assign RelVarName
nam (GraphRefRelationalExpr -> GraphRefDatabaseContextExpr)
-> ProcessExprM GraphRefRelationalExpr
-> ProcessExprM GraphRefDatabaseContextExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RelationalExpr -> ProcessExprM GraphRefRelationalExpr
processRelationalExpr RelationalExpr
rexpr
    Insert RelVarName
nam RelationalExpr
rexpr -> RelVarName -> GraphRefRelationalExpr -> GraphRefDatabaseContextExpr
forall a.
RelVarName -> RelationalExprBase a -> DatabaseContextExprBase a
Insert RelVarName
nam (GraphRefRelationalExpr -> GraphRefDatabaseContextExpr)
-> ProcessExprM GraphRefRelationalExpr
-> ProcessExprM GraphRefDatabaseContextExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RelationalExpr -> ProcessExprM GraphRefRelationalExpr
processRelationalExpr RelationalExpr
rexpr
    Delete RelVarName
nam RestrictionPredicateExprBase ()
pred' -> RelVarName
-> RestrictionPredicateExprBase GraphRefTransactionMarker
-> GraphRefDatabaseContextExpr
forall a.
RelVarName
-> RestrictionPredicateExprBase a -> DatabaseContextExprBase a
Delete RelVarName
nam (RestrictionPredicateExprBase GraphRefTransactionMarker
 -> GraphRefDatabaseContextExpr)
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (RestrictionPredicateExprBase GraphRefTransactionMarker)
-> ProcessExprM GraphRefDatabaseContextExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RestrictionPredicateExprBase ()
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (RestrictionPredicateExprBase GraphRefTransactionMarker)
processRestrictionPredicateExpr RestrictionPredicateExprBase ()
pred'
    Update RelVarName
nam AttributeNameAtomExprMap
attrMap RestrictionPredicateExprBase ()
pred' -> RelVarName
-> AttributeNameAtomExprMap
-> RestrictionPredicateExprBase GraphRefTransactionMarker
-> GraphRefDatabaseContextExpr
forall a.
RelVarName
-> AttributeNameAtomExprMap
-> RestrictionPredicateExprBase a
-> DatabaseContextExprBase a
Update RelVarName
nam AttributeNameAtomExprMap
attrMap (RestrictionPredicateExprBase GraphRefTransactionMarker
 -> GraphRefDatabaseContextExpr)
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (RestrictionPredicateExprBase GraphRefTransactionMarker)
-> ProcessExprM GraphRefDatabaseContextExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RestrictionPredicateExprBase ()
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (RestrictionPredicateExprBase GraphRefTransactionMarker)
processRestrictionPredicateExpr RestrictionPredicateExprBase ()
pred'

    AddInclusionDependency RelVarName
nam InclusionDependency
dep -> GraphRefDatabaseContextExpr
-> ProcessExprM GraphRefDatabaseContextExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelVarName -> InclusionDependency -> GraphRefDatabaseContextExpr
forall a.
RelVarName -> InclusionDependency -> DatabaseContextExprBase a
AddInclusionDependency RelVarName
nam InclusionDependency
dep)
    RemoveInclusionDependency RelVarName
nam -> GraphRefDatabaseContextExpr
-> ProcessExprM GraphRefDatabaseContextExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelVarName -> GraphRefDatabaseContextExpr
forall a. RelVarName -> DatabaseContextExprBase a
RemoveInclusionDependency RelVarName
nam)
    AddNotification RelVarName
nam RelationalExpr
exprA RelationalExpr
exprB RelationalExpr
exprC -> GraphRefDatabaseContextExpr
-> ProcessExprM GraphRefDatabaseContextExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelVarName
-> RelationalExpr
-> RelationalExpr
-> RelationalExpr
-> GraphRefDatabaseContextExpr
forall a.
RelVarName
-> RelationalExpr
-> RelationalExpr
-> RelationalExpr
-> DatabaseContextExprBase a
AddNotification RelVarName
nam RelationalExpr
exprA RelationalExpr
exprB RelationalExpr
exprC)
    RemoveNotification RelVarName
nam -> GraphRefDatabaseContextExpr
-> ProcessExprM GraphRefDatabaseContextExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelVarName -> GraphRefDatabaseContextExpr
forall a. RelVarName -> DatabaseContextExprBase a
RemoveNotification RelVarName
nam)
    AddTypeConstructor TypeConstructorDef
tyDef [DataConstructorDef]
consDefs -> GraphRefDatabaseContextExpr
-> ProcessExprM GraphRefDatabaseContextExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TypeConstructorDef
-> [DataConstructorDef] -> GraphRefDatabaseContextExpr
forall a.
TypeConstructorDef
-> [DataConstructorDef] -> DatabaseContextExprBase a
AddTypeConstructor TypeConstructorDef
tyDef [DataConstructorDef]
consDefs)
    RemoveTypeConstructor RelVarName
tyName -> GraphRefDatabaseContextExpr
-> ProcessExprM GraphRefDatabaseContextExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelVarName -> GraphRefDatabaseContextExpr
forall a. RelVarName -> DatabaseContextExprBase a
RemoveTypeConstructor RelVarName
tyName)

    RemoveAtomFunction RelVarName
aFuncName -> GraphRefDatabaseContextExpr
-> ProcessExprM GraphRefDatabaseContextExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelVarName -> GraphRefDatabaseContextExpr
forall a. RelVarName -> DatabaseContextExprBase a
RemoveAtomFunction RelVarName
aFuncName)
    RemoveDatabaseContextFunction RelVarName
funcName' -> GraphRefDatabaseContextExpr
-> ProcessExprM GraphRefDatabaseContextExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelVarName -> GraphRefDatabaseContextExpr
forall a. RelVarName -> DatabaseContextExprBase a
RemoveDatabaseContextFunction RelVarName
funcName')
    ExecuteDatabaseContextFunction RelVarName
funcName' [AtomExprBase ()]
atomExprs -> RelVarName
-> [AtomExprBase GraphRefTransactionMarker]
-> GraphRefDatabaseContextExpr
forall a.
RelVarName -> [AtomExprBase a] -> DatabaseContextExprBase a
ExecuteDatabaseContextFunction RelVarName
funcName' ([AtomExprBase GraphRefTransactionMarker]
 -> GraphRefDatabaseContextExpr)
-> ReaderT
     GraphRefTransactionMarker
     Identity
     [AtomExprBase GraphRefTransactionMarker]
-> ProcessExprM GraphRefDatabaseContextExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AtomExprBase ()
 -> ReaderT
      GraphRefTransactionMarker
      Identity
      (AtomExprBase GraphRefTransactionMarker))
-> [AtomExprBase ()]
-> ReaderT
     GraphRefTransactionMarker
     Identity
     [AtomExprBase GraphRefTransactionMarker]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM AtomExprBase ()
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (AtomExprBase GraphRefTransactionMarker)
processAtomExpr [AtomExprBase ()]
atomExprs
    MultipleExpr [DatabaseContextExpr]
exprs -> [GraphRefDatabaseContextExpr] -> GraphRefDatabaseContextExpr
forall a. [DatabaseContextExprBase a] -> DatabaseContextExprBase a
MultipleExpr ([GraphRefDatabaseContextExpr] -> GraphRefDatabaseContextExpr)
-> ReaderT
     GraphRefTransactionMarker Identity [GraphRefDatabaseContextExpr]
-> ProcessExprM GraphRefDatabaseContextExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DatabaseContextExpr -> ProcessExprM GraphRefDatabaseContextExpr)
-> [DatabaseContextExpr]
-> ReaderT
     GraphRefTransactionMarker Identity [GraphRefDatabaseContextExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM DatabaseContextExpr -> ProcessExprM GraphRefDatabaseContextExpr
processDatabaseContextExpr [DatabaseContextExpr]
exprs

processDatabaseContextIOExpr :: DatabaseContextIOExpr -> ProcessExprM GraphRefDatabaseContextIOExpr
processDatabaseContextIOExpr :: DatabaseContextIOExpr -> ProcessExprM GraphRefDatabaseContextIOExpr
processDatabaseContextIOExpr (AddAtomFunction RelVarName
f [TypeConstructor]
tcs RelVarName
sc) =
  GraphRefDatabaseContextIOExpr
-> ProcessExprM GraphRefDatabaseContextIOExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelVarName
-> [TypeConstructor] -> RelVarName -> GraphRefDatabaseContextIOExpr
forall a.
RelVarName
-> [TypeConstructor] -> RelVarName -> DatabaseContextIOExprBase a
AddAtomFunction RelVarName
f [TypeConstructor]
tcs RelVarName
sc)
processDatabaseContextIOExpr (LoadAtomFunctions RelVarName
mod' RelVarName
fun FilePath
file) =
  GraphRefDatabaseContextIOExpr
-> ProcessExprM GraphRefDatabaseContextIOExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelVarName
-> RelVarName -> FilePath -> GraphRefDatabaseContextIOExpr
forall a.
RelVarName -> RelVarName -> FilePath -> DatabaseContextIOExprBase a
LoadAtomFunctions RelVarName
mod' RelVarName
fun FilePath
file)
processDatabaseContextIOExpr (AddDatabaseContextFunction RelVarName
mod' [TypeConstructor]
fun RelVarName
path) =
  GraphRefDatabaseContextIOExpr
-> ProcessExprM GraphRefDatabaseContextIOExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelVarName
-> [TypeConstructor] -> RelVarName -> GraphRefDatabaseContextIOExpr
forall a.
RelVarName
-> [TypeConstructor] -> RelVarName -> DatabaseContextIOExprBase a
AddDatabaseContextFunction RelVarName
mod' [TypeConstructor]
fun RelVarName
path)
processDatabaseContextIOExpr (LoadDatabaseContextFunctions RelVarName
mod' RelVarName
fun FilePath
path) =
  GraphRefDatabaseContextIOExpr
-> ProcessExprM GraphRefDatabaseContextIOExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelVarName
-> RelVarName -> FilePath -> GraphRefDatabaseContextIOExpr
forall a.
RelVarName -> RelVarName -> FilePath -> DatabaseContextIOExprBase a
LoadDatabaseContextFunctions RelVarName
mod' RelVarName
fun FilePath
path)
processDatabaseContextIOExpr (CreateArbitraryRelation RelVarName
rvName [AttributeExprBase ()]
attrExprs Range
range) =
  RelVarName
-> [GraphRefAttributeExpr]
-> Range
-> GraphRefDatabaseContextIOExpr
forall a.
RelVarName
-> [AttributeExprBase a] -> Range -> DatabaseContextIOExprBase a
CreateArbitraryRelation RelVarName
rvName ([GraphRefAttributeExpr] -> Range -> GraphRefDatabaseContextIOExpr)
-> ReaderT
     GraphRefTransactionMarker Identity [GraphRefAttributeExpr]
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (Range -> GraphRefDatabaseContextIOExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AttributeExprBase ()
 -> ReaderT
      GraphRefTransactionMarker Identity GraphRefAttributeExpr)
-> [AttributeExprBase ()]
-> ReaderT
     GraphRefTransactionMarker Identity [GraphRefAttributeExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM AttributeExprBase ()
-> ReaderT GraphRefTransactionMarker Identity GraphRefAttributeExpr
processAttributeExpr [AttributeExprBase ()]
attrExprs ReaderT
  GraphRefTransactionMarker
  Identity
  (Range -> GraphRefDatabaseContextIOExpr)
-> ReaderT GraphRefTransactionMarker Identity Range
-> ProcessExprM GraphRefDatabaseContextIOExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Range -> ReaderT GraphRefTransactionMarker Identity Range
forall (f :: * -> *) a. Applicative f => a -> f a
pure Range
range
  
processRestrictionPredicateExpr :: RestrictionPredicateExpr -> ProcessExprM GraphRefRestrictionPredicateExpr
processRestrictionPredicateExpr :: RestrictionPredicateExprBase ()
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (RestrictionPredicateExprBase GraphRefTransactionMarker)
processRestrictionPredicateExpr RestrictionPredicateExprBase ()
TruePredicate = RestrictionPredicateExprBase GraphRefTransactionMarker
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (RestrictionPredicateExprBase GraphRefTransactionMarker)
forall (f :: * -> *) a. Applicative f => a -> f a
pure RestrictionPredicateExprBase GraphRefTransactionMarker
forall a. RestrictionPredicateExprBase a
TruePredicate
processRestrictionPredicateExpr (AndPredicate RestrictionPredicateExprBase ()
a RestrictionPredicateExprBase ()
b) = RestrictionPredicateExprBase GraphRefTransactionMarker
-> RestrictionPredicateExprBase GraphRefTransactionMarker
-> RestrictionPredicateExprBase GraphRefTransactionMarker
forall a.
RestrictionPredicateExprBase a
-> RestrictionPredicateExprBase a -> RestrictionPredicateExprBase a
AndPredicate (RestrictionPredicateExprBase GraphRefTransactionMarker
 -> RestrictionPredicateExprBase GraphRefTransactionMarker
 -> RestrictionPredicateExprBase GraphRefTransactionMarker)
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (RestrictionPredicateExprBase GraphRefTransactionMarker)
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (RestrictionPredicateExprBase GraphRefTransactionMarker
      -> RestrictionPredicateExprBase GraphRefTransactionMarker)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RestrictionPredicateExprBase ()
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (RestrictionPredicateExprBase GraphRefTransactionMarker)
processRestrictionPredicateExpr RestrictionPredicateExprBase ()
a ReaderT
  GraphRefTransactionMarker
  Identity
  (RestrictionPredicateExprBase GraphRefTransactionMarker
   -> RestrictionPredicateExprBase GraphRefTransactionMarker)
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (RestrictionPredicateExprBase GraphRefTransactionMarker)
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (RestrictionPredicateExprBase GraphRefTransactionMarker)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RestrictionPredicateExprBase ()
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (RestrictionPredicateExprBase GraphRefTransactionMarker)
processRestrictionPredicateExpr RestrictionPredicateExprBase ()
b
processRestrictionPredicateExpr (OrPredicate RestrictionPredicateExprBase ()
a RestrictionPredicateExprBase ()
b) = RestrictionPredicateExprBase GraphRefTransactionMarker
-> RestrictionPredicateExprBase GraphRefTransactionMarker
-> RestrictionPredicateExprBase GraphRefTransactionMarker
forall a.
RestrictionPredicateExprBase a
-> RestrictionPredicateExprBase a -> RestrictionPredicateExprBase a
OrPredicate (RestrictionPredicateExprBase GraphRefTransactionMarker
 -> RestrictionPredicateExprBase GraphRefTransactionMarker
 -> RestrictionPredicateExprBase GraphRefTransactionMarker)
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (RestrictionPredicateExprBase GraphRefTransactionMarker)
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (RestrictionPredicateExprBase GraphRefTransactionMarker
      -> RestrictionPredicateExprBase GraphRefTransactionMarker)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RestrictionPredicateExprBase ()
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (RestrictionPredicateExprBase GraphRefTransactionMarker)
processRestrictionPredicateExpr RestrictionPredicateExprBase ()
a ReaderT
  GraphRefTransactionMarker
  Identity
  (RestrictionPredicateExprBase GraphRefTransactionMarker
   -> RestrictionPredicateExprBase GraphRefTransactionMarker)
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (RestrictionPredicateExprBase GraphRefTransactionMarker)
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (RestrictionPredicateExprBase GraphRefTransactionMarker)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RestrictionPredicateExprBase ()
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (RestrictionPredicateExprBase GraphRefTransactionMarker)
processRestrictionPredicateExpr RestrictionPredicateExprBase ()
b
processRestrictionPredicateExpr (NotPredicate RestrictionPredicateExprBase ()
a) = RestrictionPredicateExprBase GraphRefTransactionMarker
-> RestrictionPredicateExprBase GraphRefTransactionMarker
forall a.
RestrictionPredicateExprBase a -> RestrictionPredicateExprBase a
NotPredicate (RestrictionPredicateExprBase GraphRefTransactionMarker
 -> RestrictionPredicateExprBase GraphRefTransactionMarker)
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (RestrictionPredicateExprBase GraphRefTransactionMarker)
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (RestrictionPredicateExprBase GraphRefTransactionMarker)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RestrictionPredicateExprBase ()
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (RestrictionPredicateExprBase GraphRefTransactionMarker)
processRestrictionPredicateExpr RestrictionPredicateExprBase ()
a
processRestrictionPredicateExpr (RelationalExprPredicate RelationalExpr
expr) =
  GraphRefRelationalExpr
-> RestrictionPredicateExprBase GraphRefTransactionMarker
forall a. RelationalExprBase a -> RestrictionPredicateExprBase a
RelationalExprPredicate (GraphRefRelationalExpr
 -> RestrictionPredicateExprBase GraphRefTransactionMarker)
-> ProcessExprM GraphRefRelationalExpr
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (RestrictionPredicateExprBase GraphRefTransactionMarker)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RelationalExpr -> ProcessExprM GraphRefRelationalExpr
processRelationalExpr RelationalExpr
expr
processRestrictionPredicateExpr (AtomExprPredicate AtomExprBase ()
expr) =
  AtomExprBase GraphRefTransactionMarker
-> RestrictionPredicateExprBase GraphRefTransactionMarker
forall a. AtomExprBase a -> RestrictionPredicateExprBase a
AtomExprPredicate (AtomExprBase GraphRefTransactionMarker
 -> RestrictionPredicateExprBase GraphRefTransactionMarker)
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (AtomExprBase GraphRefTransactionMarker)
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (RestrictionPredicateExprBase GraphRefTransactionMarker)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AtomExprBase ()
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (AtomExprBase GraphRefTransactionMarker)
processAtomExpr AtomExprBase ()
expr
processRestrictionPredicateExpr (AttributeEqualityPredicate RelVarName
nam AtomExprBase ()
expr) =
  RelVarName
-> AtomExprBase GraphRefTransactionMarker
-> RestrictionPredicateExprBase GraphRefTransactionMarker
forall a.
RelVarName -> AtomExprBase a -> RestrictionPredicateExprBase a
AttributeEqualityPredicate RelVarName
nam (AtomExprBase GraphRefTransactionMarker
 -> RestrictionPredicateExprBase GraphRefTransactionMarker)
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (AtomExprBase GraphRefTransactionMarker)
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (RestrictionPredicateExprBase GraphRefTransactionMarker)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AtomExprBase ()
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (AtomExprBase GraphRefTransactionMarker)
processAtomExpr AtomExprBase ()
expr

processExtendTupleExpr :: ExtendTupleExpr -> ProcessExprM GraphRefExtendTupleExpr
processExtendTupleExpr :: ExtendTupleExprBase ()
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (ExtendTupleExprBase GraphRefTransactionMarker)
processExtendTupleExpr (AttributeExtendTupleExpr RelVarName
nam AtomExprBase ()
atomExpr) =
  RelVarName
-> AtomExprBase GraphRefTransactionMarker
-> ExtendTupleExprBase GraphRefTransactionMarker
forall a. RelVarName -> AtomExprBase a -> ExtendTupleExprBase a
AttributeExtendTupleExpr RelVarName
nam (AtomExprBase GraphRefTransactionMarker
 -> ExtendTupleExprBase GraphRefTransactionMarker)
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (AtomExprBase GraphRefTransactionMarker)
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (ExtendTupleExprBase GraphRefTransactionMarker)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AtomExprBase ()
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (AtomExprBase GraphRefTransactionMarker)
processAtomExpr AtomExprBase ()
atomExpr

processAtomExpr :: AtomExpr -> ProcessExprM GraphRefAtomExpr
processAtomExpr :: AtomExprBase ()
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (AtomExprBase GraphRefTransactionMarker)
processAtomExpr (AttributeAtomExpr RelVarName
nam) = AtomExprBase GraphRefTransactionMarker
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (AtomExprBase GraphRefTransactionMarker)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AtomExprBase GraphRefTransactionMarker
 -> ReaderT
      GraphRefTransactionMarker
      Identity
      (AtomExprBase GraphRefTransactionMarker))
-> AtomExprBase GraphRefTransactionMarker
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (AtomExprBase GraphRefTransactionMarker)
forall a b. (a -> b) -> a -> b
$ RelVarName -> AtomExprBase GraphRefTransactionMarker
forall a. RelVarName -> AtomExprBase a
AttributeAtomExpr RelVarName
nam
processAtomExpr (NakedAtomExpr Atom
atom) = AtomExprBase GraphRefTransactionMarker
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (AtomExprBase GraphRefTransactionMarker)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AtomExprBase GraphRefTransactionMarker
 -> ReaderT
      GraphRefTransactionMarker
      Identity
      (AtomExprBase GraphRefTransactionMarker))
-> AtomExprBase GraphRefTransactionMarker
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (AtomExprBase GraphRefTransactionMarker)
forall a b. (a -> b) -> a -> b
$ Atom -> AtomExprBase GraphRefTransactionMarker
forall a. Atom -> AtomExprBase a
NakedAtomExpr Atom
atom
processAtomExpr (FunctionAtomExpr RelVarName
fName [AtomExprBase ()]
atomExprs ()) =
  RelVarName
-> [AtomExprBase GraphRefTransactionMarker]
-> GraphRefTransactionMarker
-> AtomExprBase GraphRefTransactionMarker
forall a. RelVarName -> [AtomExprBase a] -> a -> AtomExprBase a
FunctionAtomExpr RelVarName
fName ([AtomExprBase GraphRefTransactionMarker]
 -> GraphRefTransactionMarker
 -> AtomExprBase GraphRefTransactionMarker)
-> ReaderT
     GraphRefTransactionMarker
     Identity
     [AtomExprBase GraphRefTransactionMarker]
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (GraphRefTransactionMarker
      -> AtomExprBase GraphRefTransactionMarker)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AtomExprBase ()
 -> ReaderT
      GraphRefTransactionMarker
      Identity
      (AtomExprBase GraphRefTransactionMarker))
-> [AtomExprBase ()]
-> ReaderT
     GraphRefTransactionMarker
     Identity
     [AtomExprBase GraphRefTransactionMarker]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM AtomExprBase ()
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (AtomExprBase GraphRefTransactionMarker)
processAtomExpr [AtomExprBase ()]
atomExprs  ReaderT
  GraphRefTransactionMarker
  Identity
  (GraphRefTransactionMarker
   -> AtomExprBase GraphRefTransactionMarker)
-> ProcessExprM GraphRefTransactionMarker
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (AtomExprBase GraphRefTransactionMarker)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ProcessExprM GraphRefTransactionMarker
askMarker
processAtomExpr (RelationAtomExpr RelationalExpr
expr) = GraphRefRelationalExpr -> AtomExprBase GraphRefTransactionMarker
forall a. RelationalExprBase a -> AtomExprBase a
RelationAtomExpr (GraphRefRelationalExpr -> AtomExprBase GraphRefTransactionMarker)
-> ProcessExprM GraphRefRelationalExpr
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (AtomExprBase GraphRefTransactionMarker)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RelationalExpr -> ProcessExprM GraphRefRelationalExpr
processRelationalExpr RelationalExpr
expr
processAtomExpr (ConstructedAtomExpr RelVarName
dConsName [AtomExprBase ()]
atomExprs ()) = RelVarName
-> [AtomExprBase GraphRefTransactionMarker]
-> GraphRefTransactionMarker
-> AtomExprBase GraphRefTransactionMarker
forall a. RelVarName -> [AtomExprBase a] -> a -> AtomExprBase a
ConstructedAtomExpr RelVarName
dConsName ([AtomExprBase GraphRefTransactionMarker]
 -> GraphRefTransactionMarker
 -> AtomExprBase GraphRefTransactionMarker)
-> ReaderT
     GraphRefTransactionMarker
     Identity
     [AtomExprBase GraphRefTransactionMarker]
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (GraphRefTransactionMarker
      -> AtomExprBase GraphRefTransactionMarker)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AtomExprBase ()
 -> ReaderT
      GraphRefTransactionMarker
      Identity
      (AtomExprBase GraphRefTransactionMarker))
-> [AtomExprBase ()]
-> ReaderT
     GraphRefTransactionMarker
     Identity
     [AtomExprBase GraphRefTransactionMarker]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM AtomExprBase ()
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (AtomExprBase GraphRefTransactionMarker)
processAtomExpr [AtomExprBase ()]
atomExprs ReaderT
  GraphRefTransactionMarker
  Identity
  (GraphRefTransactionMarker
   -> AtomExprBase GraphRefTransactionMarker)
-> ProcessExprM GraphRefTransactionMarker
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (AtomExprBase GraphRefTransactionMarker)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ProcessExprM GraphRefTransactionMarker
askMarker

processTupleExprs :: TupleExprs -> ProcessExprM GraphRefTupleExprs
processTupleExprs :: TupleExprsBase ()
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (TupleExprsBase GraphRefTransactionMarker)
processTupleExprs (TupleExprs () [TupleExprBase ()]
tupleExprs) = do
  GraphRefTransactionMarker
marker <- ProcessExprM GraphRefTransactionMarker
askMarker
  GraphRefTransactionMarker
-> [TupleExprBase GraphRefTransactionMarker]
-> TupleExprsBase GraphRefTransactionMarker
forall a. a -> [TupleExprBase a] -> TupleExprsBase a
TupleExprs GraphRefTransactionMarker
marker ([TupleExprBase GraphRefTransactionMarker]
 -> TupleExprsBase GraphRefTransactionMarker)
-> ReaderT
     GraphRefTransactionMarker
     Identity
     [TupleExprBase GraphRefTransactionMarker]
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (TupleExprsBase GraphRefTransactionMarker)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TupleExprBase ()
 -> ReaderT
      GraphRefTransactionMarker
      Identity
      (TupleExprBase GraphRefTransactionMarker))
-> [TupleExprBase ()]
-> ReaderT
     GraphRefTransactionMarker
     Identity
     [TupleExprBase GraphRefTransactionMarker]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM TupleExprBase ()
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (TupleExprBase GraphRefTransactionMarker)
processTupleExpr [TupleExprBase ()]
tupleExprs
  
processTupleExpr :: TupleExpr -> ProcessExprM GraphRefTupleExpr
processTupleExpr :: TupleExprBase ()
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (TupleExprBase GraphRefTransactionMarker)
processTupleExpr (TupleExpr AttributeNameAtomExprMap
tMap) =
  Map RelVarName (AtomExprBase GraphRefTransactionMarker)
-> TupleExprBase GraphRefTransactionMarker
forall a. Map RelVarName (AtomExprBase a) -> TupleExprBase a
TupleExpr (Map RelVarName (AtomExprBase GraphRefTransactionMarker)
 -> TupleExprBase GraphRefTransactionMarker)
-> ([(RelVarName, AtomExprBase GraphRefTransactionMarker)]
    -> Map RelVarName (AtomExprBase GraphRefTransactionMarker))
-> [(RelVarName, AtomExprBase GraphRefTransactionMarker)]
-> TupleExprBase GraphRefTransactionMarker
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(RelVarName, AtomExprBase GraphRefTransactionMarker)]
-> Map RelVarName (AtomExprBase GraphRefTransactionMarker)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(RelVarName, AtomExprBase GraphRefTransactionMarker)]
 -> TupleExprBase GraphRefTransactionMarker)
-> ReaderT
     GraphRefTransactionMarker
     Identity
     [(RelVarName, AtomExprBase GraphRefTransactionMarker)]
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (TupleExprBase GraphRefTransactionMarker)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((RelVarName, AtomExprBase ())
 -> ReaderT
      GraphRefTransactionMarker
      Identity
      (RelVarName, AtomExprBase GraphRefTransactionMarker))
-> [(RelVarName, AtomExprBase ())]
-> ReaderT
     GraphRefTransactionMarker
     Identity
     [(RelVarName, AtomExprBase GraphRefTransactionMarker)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(RelVarName
k,AtomExprBase ()
v) -> (,) RelVarName
k (AtomExprBase GraphRefTransactionMarker
 -> (RelVarName, AtomExprBase GraphRefTransactionMarker))
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (AtomExprBase GraphRefTransactionMarker)
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (RelVarName, AtomExprBase GraphRefTransactionMarker)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AtomExprBase ()
-> ReaderT
     GraphRefTransactionMarker
     Identity
     (AtomExprBase GraphRefTransactionMarker)
processAtomExpr AtomExprBase ()
v) (AttributeNameAtomExprMap -> [(RelVarName, AtomExprBase ())]
forall k a. Map k a -> [(k, a)]
M.toList AttributeNameAtomExprMap
tMap)

--convert AttributeExpr to GraphRefAttributeExpr
processAttributeExpr :: AttributeExpr -> ProcessExprM GraphRefAttributeExpr
processAttributeExpr :: AttributeExprBase ()
-> ReaderT GraphRefTransactionMarker Identity GraphRefAttributeExpr
processAttributeExpr (AttributeAndTypeNameExpr RelVarName
nam TypeConstructor
tCons ()) =
  RelVarName
-> TypeConstructor
-> GraphRefTransactionMarker
-> GraphRefAttributeExpr
forall a. RelVarName -> TypeConstructor -> a -> AttributeExprBase a
AttributeAndTypeNameExpr RelVarName
nam TypeConstructor
tCons (GraphRefTransactionMarker -> GraphRefAttributeExpr)
-> ProcessExprM GraphRefTransactionMarker
-> ReaderT GraphRefTransactionMarker Identity GraphRefAttributeExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProcessExprM GraphRefTransactionMarker
askMarker
processAttributeExpr (NakedAttributeExpr Attribute
attr) = GraphRefAttributeExpr
-> ReaderT GraphRefTransactionMarker Identity GraphRefAttributeExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GraphRefAttributeExpr
 -> ReaderT
      GraphRefTransactionMarker Identity GraphRefAttributeExpr)
-> GraphRefAttributeExpr
-> ReaderT GraphRefTransactionMarker Identity GraphRefAttributeExpr
forall a b. (a -> b) -> a -> b
$ Attribute -> GraphRefAttributeExpr
forall a. Attribute -> AttributeExprBase a
NakedAttributeExpr Attribute
attr