-- | 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 :: forall a. GraphRefTransactionMarker -> ProcessExprM a -> a
runProcessExprM GraphRefTransactionMarker
mtid ProcessExprM a
m = forall r a. Reader r a -> r -> a
runReader ProcessExprM a
m GraphRefTransactionMarker
mtid

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

processAttributeNames :: AttributeNames -> ProcessExprM GraphRefAttributeNames
processAttributeNames :: AttributeNamesBase () -> ProcessExprM GraphRefAttributeNames
processAttributeNames (AttributeNames Set AttributeName
nameSet) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Set AttributeName -> AttributeNamesBase a
AttributeNames Set AttributeName
nameSet
processAttributeNames (InvertedAttributeNames Set AttributeName
attrNameSet) =
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Set AttributeName -> AttributeNamesBase a
InvertedAttributeNames Set AttributeName
attrNameSet
processAttributeNames (UnionAttributeNames AttributeNamesBase ()
attrNamesA AttributeNamesBase ()
attrNamesB) = forall a.
AttributeNamesBase a
-> AttributeNamesBase a -> AttributeNamesBase a
UnionAttributeNames forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AttributeNamesBase () -> ProcessExprM GraphRefAttributeNames
processAttributeNames AttributeNamesBase ()
attrNamesA forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AttributeNamesBase () -> ProcessExprM GraphRefAttributeNames
processAttributeNames AttributeNamesBase ()
attrNamesB
processAttributeNames (IntersectAttributeNames AttributeNamesBase ()
attrNamesA AttributeNamesBase ()
attrNamesB) = forall a.
AttributeNamesBase a
-> AttributeNamesBase a -> AttributeNamesBase a
IntersectAttributeNames forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AttributeNamesBase () -> ProcessExprM GraphRefAttributeNames
processAttributeNames AttributeNamesBase ()
attrNamesA forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AttributeNamesBase () -> ProcessExprM GraphRefAttributeNames
processAttributeNames AttributeNamesBase ()
attrNamesB
processAttributeNames (RelationalExprAttributeNames RelationalExpr
expr) = forall a. RelationalExprBase a -> AttributeNamesBase a
RelationalExprAttributeNames 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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. DatabaseContextExprBase a
NoOperation
    Define AttributeName
nam [AttributeExprBase ()]
attrExprs -> forall a.
AttributeName -> [AttributeExprBase a] -> DatabaseContextExprBase a
Define AttributeName
nam forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM AttributeExprBase () -> ProcessExprM GraphRefAttributeExpr
processAttributeExpr [AttributeExprBase ()]
attrExprs
    Undefine AttributeName
nam -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. AttributeName -> DatabaseContextExprBase a
Undefine AttributeName
nam)
    Assign AttributeName
nam RelationalExpr
rexpr -> forall a.
AttributeName -> RelationalExprBase a -> DatabaseContextExprBase a
Assign AttributeName
nam forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RelationalExpr -> ProcessExprM GraphRefRelationalExpr
processRelationalExpr RelationalExpr
rexpr
    Insert AttributeName
nam RelationalExpr
rexpr -> forall a.
AttributeName -> RelationalExprBase a -> DatabaseContextExprBase a
Insert AttributeName
nam forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RelationalExpr -> ProcessExprM GraphRefRelationalExpr
processRelationalExpr RelationalExpr
rexpr
    Delete AttributeName
nam RestrictionPredicateExprBase ()
pred' -> forall a.
AttributeName
-> RestrictionPredicateExprBase a -> DatabaseContextExprBase a
Delete AttributeName
nam forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RestrictionPredicateExprBase ()
-> ProcessExprM GraphRefRestrictionPredicateExpr
processRestrictionPredicateExpr RestrictionPredicateExprBase ()
pred'
    Update AttributeName
nam AttributeNameAtomExprMap
attrMap RestrictionPredicateExprBase ()
pred' -> forall a.
AttributeName
-> AttributeNameAtomExprMap
-> RestrictionPredicateExprBase a
-> DatabaseContextExprBase a
Update AttributeName
nam AttributeNameAtomExprMap
attrMap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RestrictionPredicateExprBase ()
-> ProcessExprM GraphRefRestrictionPredicateExpr
processRestrictionPredicateExpr RestrictionPredicateExprBase ()
pred'

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

    RemoveAtomFunction AttributeName
aFuncName -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. AttributeName -> DatabaseContextExprBase a
RemoveAtomFunction AttributeName
aFuncName)
    RemoveDatabaseContextFunction AttributeName
funcName' -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. AttributeName -> DatabaseContextExprBase a
RemoveDatabaseContextFunction AttributeName
funcName')
    ExecuteDatabaseContextFunction AttributeName
funcName' [AtomExprBase ()]
atomExprs -> forall a.
AttributeName -> [AtomExprBase a] -> DatabaseContextExprBase a
ExecuteDatabaseContextFunction AttributeName
funcName' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM AtomExprBase () -> ProcessExprM GraphRefAtomExpr
processAtomExpr [AtomExprBase ()]
atomExprs
    AddRegisteredQuery AttributeName
n RelationalExpr
q -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a.
AttributeName -> RelationalExpr -> DatabaseContextExprBase a
AddRegisteredQuery AttributeName
n RelationalExpr
q)
    RemoveRegisteredQuery AttributeName
n -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. AttributeName -> DatabaseContextExprBase a
RemoveRegisteredQuery AttributeName
n)
    MultipleExpr [DatabaseContextExpr]
exprs -> forall a. [DatabaseContextExprBase a] -> DatabaseContextExprBase a
MultipleExpr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 AttributeName
f [TypeConstructor]
tcs AttributeName
sc) =
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a.
AttributeName
-> [TypeConstructor]
-> AttributeName
-> DatabaseContextIOExprBase a
AddAtomFunction AttributeName
f [TypeConstructor]
tcs AttributeName
sc)
processDatabaseContextIOExpr (LoadAtomFunctions AttributeName
mod' AttributeName
fun FilePath
file) =
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a.
AttributeName
-> AttributeName -> FilePath -> DatabaseContextIOExprBase a
LoadAtomFunctions AttributeName
mod' AttributeName
fun FilePath
file)
processDatabaseContextIOExpr (AddDatabaseContextFunction AttributeName
mod' [TypeConstructor]
fun AttributeName
path) =
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a.
AttributeName
-> [TypeConstructor]
-> AttributeName
-> DatabaseContextIOExprBase a
AddDatabaseContextFunction AttributeName
mod' [TypeConstructor]
fun AttributeName
path)
processDatabaseContextIOExpr (LoadDatabaseContextFunctions AttributeName
mod' AttributeName
fun FilePath
path) =
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a.
AttributeName
-> AttributeName -> FilePath -> DatabaseContextIOExprBase a
LoadDatabaseContextFunctions AttributeName
mod' AttributeName
fun FilePath
path)
processDatabaseContextIOExpr (CreateArbitraryRelation AttributeName
rvName [AttributeExprBase ()]
attrExprs Range
range) =
  forall a.
AttributeName
-> [AttributeExprBase a] -> Range -> DatabaseContextIOExprBase a
CreateArbitraryRelation AttributeName
rvName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM AttributeExprBase () -> ProcessExprM GraphRefAttributeExpr
processAttributeExpr [AttributeExprBase ()]
attrExprs forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Range
range
  
processRestrictionPredicateExpr :: RestrictionPredicateExpr -> ProcessExprM GraphRefRestrictionPredicateExpr
processRestrictionPredicateExpr :: RestrictionPredicateExprBase ()
-> ProcessExprM GraphRefRestrictionPredicateExpr
processRestrictionPredicateExpr RestrictionPredicateExprBase ()
TruePredicate = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. RestrictionPredicateExprBase a
TruePredicate
processRestrictionPredicateExpr (AndPredicate RestrictionPredicateExprBase ()
a RestrictionPredicateExprBase ()
b) = forall a.
RestrictionPredicateExprBase a
-> RestrictionPredicateExprBase a -> RestrictionPredicateExprBase a
AndPredicate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RestrictionPredicateExprBase ()
-> ProcessExprM GraphRefRestrictionPredicateExpr
processRestrictionPredicateExpr RestrictionPredicateExprBase ()
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RestrictionPredicateExprBase ()
-> ProcessExprM GraphRefRestrictionPredicateExpr
processRestrictionPredicateExpr RestrictionPredicateExprBase ()
b
processRestrictionPredicateExpr (OrPredicate RestrictionPredicateExprBase ()
a RestrictionPredicateExprBase ()
b) = forall a.
RestrictionPredicateExprBase a
-> RestrictionPredicateExprBase a -> RestrictionPredicateExprBase a
OrPredicate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RestrictionPredicateExprBase ()
-> ProcessExprM GraphRefRestrictionPredicateExpr
processRestrictionPredicateExpr RestrictionPredicateExprBase ()
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RestrictionPredicateExprBase ()
-> ProcessExprM GraphRefRestrictionPredicateExpr
processRestrictionPredicateExpr RestrictionPredicateExprBase ()
b
processRestrictionPredicateExpr (NotPredicate RestrictionPredicateExprBase ()
a) = forall a.
RestrictionPredicateExprBase a -> RestrictionPredicateExprBase a
NotPredicate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RestrictionPredicateExprBase ()
-> ProcessExprM GraphRefRestrictionPredicateExpr
processRestrictionPredicateExpr RestrictionPredicateExprBase ()
a
processRestrictionPredicateExpr (RelationalExprPredicate RelationalExpr
expr) =
  forall a. RelationalExprBase a -> RestrictionPredicateExprBase a
RelationalExprPredicate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RelationalExpr -> ProcessExprM GraphRefRelationalExpr
processRelationalExpr RelationalExpr
expr
processRestrictionPredicateExpr (AtomExprPredicate AtomExprBase ()
expr) =
  forall a. AtomExprBase a -> RestrictionPredicateExprBase a
AtomExprPredicate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AtomExprBase () -> ProcessExprM GraphRefAtomExpr
processAtomExpr AtomExprBase ()
expr
processRestrictionPredicateExpr (AttributeEqualityPredicate AttributeName
nam AtomExprBase ()
expr) =
  forall a.
AttributeName -> AtomExprBase a -> RestrictionPredicateExprBase a
AttributeEqualityPredicate AttributeName
nam forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AtomExprBase () -> ProcessExprM GraphRefAtomExpr
processAtomExpr AtomExprBase ()
expr

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

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

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

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