content: {-# LANGUAGE FlexibleInstances #-}
  {-# LANGUAGE FlexibleContexts #-}
  module ProjectM36.StaticOptimizer where
  import ProjectM36.Base
  import ProjectM36.GraphRefRelationalExpr
  import ProjectM36.Relation
  import ProjectM36.RelationalExpression
  import ProjectM36.TransGraphRelationalExpression as TGRE hiding (askGraph)
  import ProjectM36.Error
  import ProjectM36.Transaction
  import ProjectM36.NormalizeExpr
  import qualified ProjectM36.Attribute as A
  import qualified ProjectM36.AttributeNames as AS
  import ProjectM36.TupleSet
  #if MIN_VERSION_base(4,18,0)
  import Control.Monad (foldM)
  #endif
  import Control.Monad.State
  import Control.Monad.Reader
  import Control.Monad.Except
  import Control.Monad.Trans.Except
  import Data.Functor.Identity
  import Data.List.NonEmpty (NonEmpty(..))
  import qualified Data.List.NonEmpty as NE
  import qualified Data.Map as M
  import qualified Data.Set as S
  import Data.Functor.Foldable as Fold
  --import Debug.Trace
  
  -- the static optimizer performs optimizations which need not take any specific-relation statistics into account
  
  data GraphRefSOptRelationalExprEnv =
    GraphRefSOptRelationalExprEnv
    {
      ore_graph :: TransactionGraph,
      ore_mcontext :: Maybe DatabaseContext
    }
    
  type GraphRefSOptRelationalExprM a = ReaderT GraphRefSOptRelationalExprEnv (ExceptT RelationalError Identity) a
  
  data GraphRefSOptDatabaseContextExprEnv =
    GraphRefSOptDatabaseContextExprEnv
    {
      odce_graph :: TransactionGraph,
      odce_context :: DatabaseContext, --not optional for DatabaseContextExpr evaluation
      odce_transId :: TransactionId -- parent if context is committed- needed because MultipleExpr optimization requires running the DatabaseContextExprs (with empty relvars)
      }
  
  type GraphRefSOptDatabaseContextExprM a = ReaderT GraphRefSOptDatabaseContextExprEnv (ExceptT RelationalError Identity) a
  
  -- | A temporary function to be replaced by IO-based implementation.
  optimizeAndEvalRelationalExpr :: RelationalExprEnv -> RelationalExpr -> Either RelationalError Relation
  optimizeAndEvalRelationalExpr env expr = do
    let graph = re_graph env
        ctx = re_context env
        gfEnv = freshGraphRefRelationalExprEnv (Just ctx) graph
    optExpr <- optimizeRelationalExpr env expr
    runGraphRefRelationalExprM gfEnv (evalGraphRefRelationalExpr optExpr)
  
  optimizeRelationalExpr :: RelationalExprEnv -> RelationalExpr -> Either RelationalError GraphRefRelationalExpr
  optimizeRelationalExpr env expr = do
    let gfExpr = runProcessExprM UncommittedContextMarker (processRelationalExpr expr) -- references parent tid instead of context! options- I could add the context to the graph with a new transid or implement an evalRelationalExpr in RE.hs to use the context (which is what I had previously)
        ctx = re_context env
    runGraphRefSOptRelationalExprM (Just ctx) (re_graph env) (fullOptimizeGraphRefRelationalExpr gfExpr)
  
  class Monad m => AskGraphContext m where
    askGraph :: m TransactionGraph
    askContext :: m DatabaseContext
  
  instance AskGraphContext (ReaderT GraphRefSOptDatabaseContextExprEnv (ExceptT RelationalError Identity)) where
    askGraph = asks odce_graph
    askContext = asks odce_context 
  
  instance AskGraphContext (ReaderT GraphRefSOptRelationalExprEnv (ExceptT RelationalError Identity)) where
    askGraph = asks ore_graph
    askContext = do
      mctx <- asks ore_mcontext
      case mctx of
        Nothing -> throwError NoUncommittedContextInEvalError
        Just ctx -> pure ctx
  
  askTransId :: GraphRefSOptDatabaseContextExprM TransactionId
  askTransId = asks odce_transId
  
  askMaybeContext :: GraphRefSOptRelationalExprM (Maybe DatabaseContext)
  askMaybeContext = asks ore_mcontext
  
  optimizeDatabaseContextExpr :: DatabaseContextExpr -> GraphRefSOptDatabaseContextExprM GraphRefDatabaseContextExpr
  optimizeDatabaseContextExpr expr = do
    let gfExpr = runProcessExprM UncommittedContextMarker (processDatabaseContextExpr expr)
    optimizeGraphRefDatabaseContextExpr gfExpr
    
  optimizeAndEvalDatabaseContextExpr :: Bool -> DatabaseContextExpr -> DatabaseContextEvalMonad ()
  optimizeAndEvalDatabaseContextExpr optimize expr = do
    graph <- asks dce_graph
    transId <- asks dce_transId
    context <- getStateContext
    let gfExpr = runProcessExprM UncommittedContextMarker (processDatabaseContextExpr expr)
        eOptExpr = if optimize then
                     runGraphRefSOptDatabaseContextExprM transId context graph (optimizeGraphRefDatabaseContextExpr gfExpr)
                     else
                     pure gfExpr
    case eOptExpr of
      Left err -> throwError err
      Right optExpr -> evalGraphRefDatabaseContextExpr optExpr
  
  
  optimizeAndEvalTransGraphRelationalExpr :: TransactionGraph -> TransGraphRelationalExpr -> Either RelationalError Relation
  optimizeAndEvalTransGraphRelationalExpr graph tgExpr = do
    gfExpr <- TGRE.process (TransGraphEvalEnv graph) tgExpr
    optExpr <- runGraphRefSOptRelationalExprM Nothing graph (fullOptimizeGraphRefRelationalExpr gfExpr)
    let gfEnv = freshGraphRefRelationalExprEnv Nothing graph
    runGraphRefRelationalExprM gfEnv (evalGraphRefRelationalExpr optExpr)
  
  optimizeAndEvalDatabaseContextIOExpr :: DatabaseContextIOExpr -> DatabaseContextIOEvalMonad (Either RelationalError ())
  optimizeAndEvalDatabaseContextIOExpr expr = do
    transId <- asks dbcio_transId
    ctx <- getDBCIOContext
    graph <- asks dbcio_graph
    let gfExpr = runProcessExprM UncommittedContextMarker (processDatabaseContextIOExpr expr)
        eOptExpr = runGraphRefSOptDatabaseContextExprM transId ctx graph (optimizeDatabaseContextIOExpr gfExpr)
    case eOptExpr of
      Left err -> pure (Left err)
      Right optExpr ->
        evalGraphRefDatabaseContextIOExpr optExpr
  
  {-  
  runStaticOptimizerMonad :: RelationalExprEnv -> StaticOptimizerMonad a -> Either RelationalError a
  runStaticOptimizerMonad env m = runIdentity (runExceptT (runReaderT m env))
  -}
  
  runGraphRefSOptRelationalExprM ::
    Maybe DatabaseContext ->  
    TransactionGraph ->
    GraphRefSOptRelationalExprM a ->
    Either RelationalError a
  runGraphRefSOptRelationalExprM mctx graph m = runIdentity (runExceptT (runReaderT m env))
    where
      env = GraphRefSOptRelationalExprEnv {
        ore_graph = graph,
        ore_mcontext = mctx
        }
    
  
  runGraphRefSOptDatabaseContextExprM ::
    TransactionId ->
    DatabaseContext ->
    TransactionGraph ->
    GraphRefSOptDatabaseContextExprM a ->
    Either RelationalError a
  runGraphRefSOptDatabaseContextExprM tid ctx graph m =
    runIdentity (runExceptT (runReaderT m env))
    where
      env = GraphRefSOptDatabaseContextExprEnv {
        odce_graph = graph,
        odce_context = ctx,
        odce_transId = tid
        }
  
  optimizeGraphRefRelationalExpr' ::
    Maybe DatabaseContext ->
    TransactionGraph ->
    GraphRefRelationalExpr ->
    Either RelationalError GraphRefRelationalExpr
  optimizeGraphRefRelationalExpr' mctx graph expr =
    runIdentity (runExceptT (runReaderT (optimizeGraphRefRelationalExpr expr) env))
    where
      env = GraphRefSOptRelationalExprEnv {
        ore_graph = graph,
        ore_mcontext = mctx
        }
  
  -- | optimize relational expression within database context expr monad
  liftGraphRefRelExpr :: GraphRefSOptRelationalExprM a -> GraphRefSOptDatabaseContextExprM a
  liftGraphRefRelExpr m = do
    context <- asks odce_context
    graph <- asks odce_graph
    lift $ except $ runGraphRefSOptRelationalExprM (Just context) graph m
    
  fullOptimizeGraphRefRelationalExpr :: GraphRefRelationalExpr -> GraphRefSOptRelationalExprM GraphRefRelationalExpr
  fullOptimizeGraphRefRelationalExpr expr = do
    optExpr <- optimizeGraphRefRelationalExpr expr
    let optExpr' = applyStaticRestrictionPushdown (applyStaticRestrictionCollapse optExpr)
    applyStaticJoinElimination optExpr'
  
  -- apply optimizations which merely remove steps to become no-ops: example: projection of a relation across all of its attributes => original relation
  
  --should optimizations offer the possibility to pure errors? If they perform the up-front type-checking, maybe so
  optimizeGraphRefRelationalExpr :: GraphRefRelationalExpr -> GraphRefSOptRelationalExprM GraphRefRelationalExpr
  optimizeGraphRefRelationalExpr e@(MakeStaticRelation _ _) = pure e
  
  optimizeGraphRefRelationalExpr e@MakeRelationFromExprs{} = pure e
  
  optimizeGraphRefRelationalExpr e@(ExistingRelation _) = pure e
  
  optimizeGraphRefRelationalExpr e@(RelationValuedAttribute{}) = pure e
  
  optimizeGraphRefRelationalExpr e@(RelationVariable _ _) = pure e
    
  --remove project of attributes which removes no attributes
  optimizeGraphRefRelationalExpr (Project attrNameSet expr) = do
    graph <- askGraph
    mctx <- askMaybeContext
    let relType = runGraphRefRelationalExprM gfEnv (typeForGraphRefRelationalExpr expr)
        gfEnv = freshGraphRefRelationalExprEnv mctx graph
    case relType of
      Left err -> throwError err
      Right relType2 
        | AS.all == attrNameSet ->        
          optimizeGraphRefRelationalExpr expr
        | AttributeNames (attributeNames relType2) == attrNameSet ->
          optimizeGraphRefRelationalExpr expr
        | otherwise -> do
          optSubExpr <- optimizeGraphRefRelationalExpr expr 
          pure (Project attrNameSet optSubExpr)
                             
  optimizeGraphRefRelationalExpr (Union exprA exprB) = do
    optExprA <- optimizeGraphRefRelationalExpr exprA
    optExprB <- optimizeGraphRefRelationalExpr exprB
    -- (x where pred1) union (x where pred2) -> (x where pred1 or pred2)
    case (optExprA, optExprB) of 
            (Restrict predA (RelationVariable nameA sA),
             Restrict predB (RelationVariable nameB sB)) | nameA == nameB && sA == sB -> pure (Restrict (AndPredicate predA predB) (RelationVariable nameA sA))
            (exprA', exprB') | isEmptyRelationExpr exprA' -> pure exprB'
                             | isEmptyRelationExpr exprB' -> pure exprA'
            _ -> if optExprA == optExprB then           
              pure optExprA
              else
              pure $ Union optExprA optExprB
                              
  optimizeGraphRefRelationalExpr (Join exprA exprB) = do
    optExprA <- optimizeGraphRefRelationalExpr exprA
    optExprB <- optimizeGraphRefRelationalExpr exprB
    -- if the relvars to join are the same but with predicates, then just AndPredicate the predicates
    case (optExprA, optExprB) of
            (Restrict predA (RelationVariable nameA sA),
             Restrict predB (RelationVariable nameB sB)) | nameA == nameB && sA == sB -> pure (Restrict  (AndPredicate predA predB) (RelationVariable nameA sA))
            _ -> if optExprA == optExprB then --A join A == A
                             pure optExprA
                           else
                             pure (Join optExprA optExprB)
                             
  optimizeGraphRefRelationalExpr (Difference exprA exprB) = do
    graph <- askGraph
    context <- askMaybeContext
    optExprA <- optimizeGraphRefRelationalExpr exprA
    optExprB <- optimizeGraphRefRelationalExpr exprB
    if optExprA == optExprB then do --A difference A == A where false
      let eEmptyRel = runGraphRefRelationalExprM gfEnv (typeForGraphRefRelationalExpr optExprA)
          gfEnv = freshGraphRefRelationalExprEnv context graph
      case eEmptyRel of
        Left err -> throwError err
        Right emptyRel -> pure (ExistingRelation emptyRel)
      else
      pure (Difference optExprA optExprB)
                             
  optimizeGraphRefRelationalExpr e@Rename{} = pure e
  
  optimizeGraphRefRelationalExpr (Group oldAttrNames newAttrName expr) =
    pure $ Group oldAttrNames newAttrName expr
    
  optimizeGraphRefRelationalExpr (Ungroup attrName expr) =
    pure $ Ungroup attrName expr
    
  --remove restriction of nothing
  optimizeGraphRefRelationalExpr (Restrict predicate expr) = do
    graph <- askGraph
    mctx <- askMaybeContext
    optimizedPredicate <- applyStaticPredicateOptimization predicate
    case optimizedPredicate of
      optimizedPredicate' | isTrueExpr optimizedPredicate' -> optimizeGraphRefRelationalExpr expr -- remove predicate entirely
      optimizedPredicate' | isFalseExpr optimizedPredicate' -> do -- replace where false predicate with empty relation with attributes from relexpr
          let attributesRel = runGraphRefRelationalExprM gfEnv (typeForGraphRefRelationalExpr expr)
              gfEnv = freshGraphRefRelationalExprEnv mctx graph
          case attributesRel of 
            Left err -> throwError err
            Right attributesRelA -> pure $ MakeStaticRelation (attributes attributesRelA) emptyTupleSet
        | otherwise -> do
          optSubExpr <- optimizeGraphRefRelationalExpr expr
          pure $ Restrict optimizedPredicate' optSubExpr
    
  optimizeGraphRefRelationalExpr e@(Equals _ _) = pure e 
  
  optimizeGraphRefRelationalExpr e@(NotEquals _ _) = pure e 
    
  optimizeGraphRefRelationalExpr e@(Extend _ _) = pure e  
  
  optimizeGraphRefRelationalExpr e@(With _ _) = pure e  
  
  -- database context expr
  optimizeGraphRefDatabaseContextExpr :: GraphRefDatabaseContextExpr -> GraphRefSOptDatabaseContextExprM GraphRefDatabaseContextExpr
  optimizeGraphRefDatabaseContextExpr x@NoOperation = pure x
  optimizeGraphRefDatabaseContextExpr x@(Define _ _) = pure x
  
  optimizeGraphRefDatabaseContextExpr x@(Undefine _) = pure x
  
  optimizeGraphRefDatabaseContextExpr (Assign name expr) = do
    optExpr <- liftGraphRefRelExpr (fullOptimizeGraphRefRelationalExpr expr)
    pure $ Assign name optExpr
      
  optimizeGraphRefDatabaseContextExpr (Insert targetName expr) = do
    optimizedExpr <- liftGraphRefRelExpr (fullOptimizeGraphRefRelationalExpr expr)
    if isEmptyRelationExpr optimizedExpr then -- if we are trying to insert an empty relation, do nothing
      pure NoOperation
      else 
      case optimizedExpr of 
        -- if the target relvar and the insert relvar are the same, there is nothing to do
        -- insert s s -> NoOperation
        RelationVariable insName _ | insName == targetName -> pure NoOperation
        _ -> pure (Insert targetName optimizedExpr)
    
  optimizeGraphRefDatabaseContextExpr (Delete name predicate) =
    Delete name <$> liftGraphRefRelExpr (applyStaticPredicateOptimization predicate)
  
  optimizeGraphRefDatabaseContextExpr (Update name upmap predicate) =
    Update name upmap <$> liftGraphRefRelExpr (applyStaticPredicateOptimization predicate)
        
  optimizeGraphRefDatabaseContextExpr dep@(AddInclusionDependency _ _) = pure dep
  
  optimizeGraphRefDatabaseContextExpr (RemoveInclusionDependency name) = pure (RemoveInclusionDependency name)
  
  optimizeGraphRefDatabaseContextExpr (AddNotification name triggerExpr resultOldExpr resultNewExpr) = 
    --we can't optimize these expressions until they run
    pure (AddNotification name triggerExpr resultOldExpr resultNewExpr)
  
  optimizeGraphRefDatabaseContextExpr notif@(RemoveNotification _) = pure notif
  
  optimizeGraphRefDatabaseContextExpr c@(AddTypeConstructor _ _) = pure c
  optimizeGraphRefDatabaseContextExpr c@(RemoveTypeConstructor _) = pure c
  optimizeGraphRefDatabaseContextExpr c@(RemoveAtomFunction _) = pure c
  optimizeGraphRefDatabaseContextExpr c@(RemoveDatabaseContextFunction _) = pure c
  optimizeGraphRefDatabaseContextExpr c@(ExecuteDatabaseContextFunction _ _) = pure c
  optimizeGraphRefDatabaseContextExpr c@AddRegisteredQuery{} = pure c
  optimizeGraphRefDatabaseContextExpr c@RemoveRegisteredQuery{} = pure c
  --optimization: from pgsql lists- check for join condition referencing foreign key- if join projection project away the referenced table, then it does not need to be scanned
  
  --applyStaticDatabaseOptimization (MultipleExpr exprs) = pure $ Right $ MultipleExpr exprs
  --for multiple expressions, we must evaluate
  optimizeGraphRefDatabaseContextExpr (MultipleExpr exprs) = do
    --a previous expression in the exprs list could create a relvar; we don't want to miss it, so we clear the tuples and execute the expression to get an empty relation in the relvar
    context <- askContext
    graph <- askGraph
    parentId <- askTransId
    
    let emptyRvs ctx = ctx { relationVariables = mkEmptyRelVars (relationVariables ctx) }
        dbcEnv = mkDatabaseContextEvalEnv parentId graph
        folder (ctx, expracc) expr = do
          --optimize the expr and run it against empty relvars to add it to the context
          case runGraphRefSOptDatabaseContextExprM parentId ctx graph (optimizeGraphRefDatabaseContextExpr expr) of
            Left err -> throwError err
            Right optExpr ->
              case runDatabaseContextEvalMonad ctx dbcEnv (evalGraphRefDatabaseContextExpr optExpr) of
                Left err -> throwError err
                Right dbcState ->
                  pure (emptyRvs $ dbc_context dbcState, expracc ++ [optExpr])
  
    (_, exprs') <- foldM folder (context,[]) exprs
    pure (MultipleExpr exprs')
  
  applyStaticPredicateOptimization :: GraphRefRestrictionPredicateExpr -> GraphRefSOptRelationalExprM GraphRefRestrictionPredicateExpr
  applyStaticPredicateOptimization predi = do
    optPred <- case predi of 
  -- where x and x => where x
      AndPredicate pred1 pred2 -> do
        optPredA <- applyStaticPredicateOptimization pred1
        optPredB <- applyStaticPredicateOptimization pred2
        if optPredA == optPredB then
          pure optPredA
          else
          pure (AndPredicate optPredA optPredB)
  -- where x or x => where x    
      OrPredicate pred1 pred2 -> do
        optPredA <- applyStaticPredicateOptimization pred1
        optPredB <- applyStaticPredicateOptimization pred2
        if (optPredA == optPredB) || isTrueExpr optPredA then
          pure optPredA
          else if isTrueExpr optPredB then
                 pure optPredB
               else
                 pure (OrPredicate optPredA optPredB)
      AttributeEqualityPredicate attrNameA (AttributeAtomExpr attrNameB) ->
        if attrNameA == attrNameB then
          pure TruePredicate
        else
          pure predi
      AttributeEqualityPredicate{} -> pure predi
      TruePredicate -> pure predi
      NotPredicate{} -> pure predi
      RelationalExprPredicate{} -> pure predi
      AtomExprPredicate{} -> pure predi
    let attrMap = findStaticRestrictionPredicates optPred
    pure (replaceStaticAtomExprs optPred attrMap)
  
  --determines if an atom expression is tautologically true
  isTrueExpr :: RestrictionPredicateExprBase a -> Bool
  isTrueExpr TruePredicate = True
  isTrueExpr (AtomExprPredicate (NakedAtomExpr (BoolAtom True))) = True
  isTrueExpr _ = False
  
  --determines if an atom expression is tautologically false
  isFalseExpr :: RestrictionPredicateExprBase a -> Bool
  isFalseExpr (NotPredicate expr) = isTrueExpr expr
  isFalseExpr (AtomExprPredicate (NakedAtomExpr (BoolAtom False))) = True
  isFalseExpr _ = False
  
  -- determine if the created relation can statically be determined to be empty
  isEmptyRelationExpr :: RelationalExprBase a -> Bool    
  isEmptyRelationExpr (MakeRelationFromExprs _ (TupleExprs _ [])) = True
  isEmptyRelationExpr (MakeStaticRelation _ tupSet) = null (asList tupSet)
  isEmptyRelationExpr (ExistingRelation rel) = rel == emptyRelationWithAttrs (attributes rel)
  isEmptyRelationExpr _ = False
      
  --transitive static variable optimization                        
  replaceStaticAtomExprs :: GraphRefRestrictionPredicateExpr -> M.Map AttributeName GraphRefAtomExpr -> GraphRefRestrictionPredicateExpr
  replaceStaticAtomExprs predIn replaceMap = case predIn of
    AttributeEqualityPredicate newAttrName (AttributeAtomExpr matchName) -> case M.lookup matchName replaceMap of
      Nothing -> predIn
      Just newVal -> AttributeEqualityPredicate newAttrName newVal
    AttributeEqualityPredicate{} -> predIn
    AndPredicate pred1 pred2 -> AndPredicate (replaceStaticAtomExprs pred1 replaceMap) (replaceStaticAtomExprs pred2 replaceMap)
    OrPredicate pred1 pred2 -> OrPredicate (replaceStaticAtomExprs pred1 replaceMap) (replaceStaticAtomExprs pred2 replaceMap)
    NotPredicate pred1 -> NotPredicate (replaceStaticAtomExprs pred1 replaceMap)
    TruePredicate -> predIn
    RelationalExprPredicate{} -> predIn
    AtomExprPredicate{} -> predIn
  -- used for transitive attribute optimization- only works on statically-determined atoms for now- in the future, this could work for all AtomExprs which don't reference attributes
  findStaticRestrictionPredicates :: GraphRefRestrictionPredicateExpr -> M.Map AttributeName GraphRefAtomExpr
  findStaticRestrictionPredicates (AttributeEqualityPredicate attrName atomExpr) = 
    case atomExpr of
      val@NakedAtomExpr{} -> M.singleton attrName val
      val@ConstructedAtomExpr{} -> M.singleton attrName val
      _ -> M.empty
  
  findStaticRestrictionPredicates (AndPredicate pred1 pred2) = 
    M.union (findStaticRestrictionPredicates pred1) (findStaticRestrictionPredicates pred2) 
  findStaticRestrictionPredicates (OrPredicate pred1 pred2) =
    M.union (findStaticRestrictionPredicates pred1) (findStaticRestrictionPredicates pred2)
  findStaticRestrictionPredicates (NotPredicate predi) = findStaticRestrictionPredicates predi
  findStaticRestrictionPredicates TruePredicate = M.empty
  findStaticRestrictionPredicates RelationalExprPredicate{} = M.empty
  findStaticRestrictionPredicates AtomExprPredicate{} = M.empty
  
  isStaticAtomExpr :: AtomExpr -> Bool
  isStaticAtomExpr NakedAtomExpr{} = True
  isStaticAtomExpr SubrelationAttributeAtomExpr{} = False
  isStaticAtomExpr ConstructedAtomExpr{} = True
  isStaticAtomExpr AttributeAtomExpr{} = False
  isStaticAtomExpr FunctionAtomExpr{} = False
  isStaticAtomExpr IfThenAtomExpr{} = False
  isStaticAtomExpr RelationAtomExpr{} = False
  
  --if the projection of a join only uses the attributes from one of the expressions and there is a foreign key relationship between the expressions, we know that the join is inconsequential and can be removed
  applyStaticJoinElimination :: GraphRefRelationalExpr -> GraphRefSOptRelationalExprM GraphRefRelationalExpr
  applyStaticJoinElimination expr@(Project attrNameSet (Join exprA exprB)) = do
    graph <- askGraph
    case inSameTransaction exprA exprB of
      -- the sub exprs are in different transactions or none at all, so we cannot extract inclusion dependencies across transaction boundaries
      Nothing -> pure expr
      Just marker -> do
        commonContext <- case marker of
                           UncommittedContextMarker -> askContext
                           TransactionMarker tid -> concreteDatabaseContext <$> lift (except (transactionForId tid graph))
        let typeForExpr e = lift $ except $ runGraphRefRelationalExprM gfEnv (typeForGraphRefRelationalExpr e)
            gfEnv = freshGraphRefRelationalExprEnv (Just commonContext) graph
          
        projType <- typeForExpr expr
        typeA <- typeForExpr exprA
        typeB <- typeForExpr exprB
        let matchesProjectionAttributes 
              | attrNames projType `S.isSubsetOf` attrNames typeA =
                  Just ((exprA, typeA), (exprB, typeB))
              | attrNames projType `S.isSubsetOf` attrNames typeB =
                  Just ((exprB, typeB), (exprA, typeA))
              | otherwise =
                  Nothing
            attrNames = A.attributeNameSet . attributes
        case matchesProjectionAttributes of
          Nothing ->  -- this optimization does not apply
            pure expr
          Just ((joinedExpr, joinedType), (unjoinedExpr, _)) -> do
          --lookup transaction
          --scan inclusion dependencies for a foreign key relationship
           let incDeps = inclusionDependencies commonContext
               fkConstraint = foldM isFkConstraint False incDeps
              --search for matching fk constraint
               isFkConstraint acc (InclusionDependency (Project subAttrNames subrv) (Project _ superrv)) = do
                 let gfSubAttrNames = processM (processAttributeNames subAttrNames)
                     gfSubRv = processM (processRelationalExpr subrv)
                     gfSuperRv = processM (processRelationalExpr superrv)
                     processM = runProcessExprM marker
                 case runGraphRefRelationalExprM gfEnv (evalGraphRefAttributeNames gfSubAttrNames expr) of
                   Left _ -> pure acc
                   Right subAttrNameSet -> 
                     pure (acc || (joinedExpr == gfSubRv &&
                                   unjoinedExpr == gfSuperRv && 
                                   -- the fk attribute is one of the projection attributes
                                   A.attributeNamesContained subAttrNameSet (A.attributeNameSet (attributes joinedType))
                                  ))
               isFkConstraint acc _ = pure acc
           case fkConstraint of
             Right True -> --join elimination optimization applies
               optimizeGraphRefRelationalExpr (Project attrNameSet joinedExpr)
             Right False -> --join elimination optimization does not apply
               pure expr
             Left err -> throwError err
            
  applyStaticJoinElimination expr = pure expr
                                                                                
  --restriction collapse converts chained restrictions into (Restrict (And pred1 pred2 pred3...))
    --this optimization should be fairly uncontroversial- performing a tuple scan once is cheaper than twice- parallelization can still take place
  applyStaticRestrictionCollapse :: GraphRefRelationalExpr -> GraphRefRelationalExpr
  applyStaticRestrictionCollapse expr = 
    case expr of
      MakeRelationFromExprs _ _ -> expr
      MakeStaticRelation _ _ -> expr
      ExistingRelation _ -> expr
      RelationValuedAttribute{} -> expr
      RelationVariable _ _ -> expr
      With _ _ -> expr
      Project attrs subexpr -> 
        Project attrs (applyStaticRestrictionCollapse subexpr)
      Union sub1 sub2 ->
        Union (applyStaticRestrictionCollapse sub1) (applyStaticRestrictionCollapse sub2)    
      Join sub1 sub2 ->
        Join (applyStaticRestrictionCollapse sub1) (applyStaticRestrictionCollapse sub2)
      Rename attrs sub -> 
        Rename attrs (applyStaticRestrictionCollapse sub)
      Difference sub1 sub2 -> 
        Difference (applyStaticRestrictionCollapse sub1) (applyStaticRestrictionCollapse sub2)
      Group n1 n2 sub ->
        Group n1 n2 (applyStaticRestrictionCollapse sub)
      Ungroup n1 sub ->
        Ungroup n1 (applyStaticRestrictionCollapse sub)
      Equals sub1 sub2 -> 
        Equals (applyStaticRestrictionCollapse sub1) (applyStaticRestrictionCollapse sub2)
      NotEquals sub1 sub2 ->
        NotEquals (applyStaticRestrictionCollapse sub1) (applyStaticRestrictionCollapse sub2)
      Extend n sub ->
        Extend n (applyStaticRestrictionCollapse sub)
      Restrict firstPred _ ->
        let (finalExpr, restrictions) = case sequentialRestrictions expr of
              [] -> (undefined, [])
              x : xs -> (NE.last $ x :| xs, xs)
  
            optFinalExpr = case finalExpr of
                                Restrict _ subexpr -> applyStaticRestrictionCollapse subexpr
                                otherExpr -> otherExpr
            andPreds = foldr folder firstPred restrictions
            folder (Restrict subpred _) acc = AndPredicate acc subpred
            folder _ _ = error "unexpected restriction expression in optimization phase"
        in
        Restrict andPreds optFinalExpr
        
  sequentialRestrictions :: RelationalExprBase a -> [RelationalExprBase a]
  sequentialRestrictions expr@(Restrict _ subexpr) = expr:sequentialRestrictions subexpr
  sequentialRestrictions _ = []
  
  --restriction pushdown only really makes sense for tuple-oriented storage schemes where performing a restriction before projection can cut down on the intermediate storage needed to store the data before the projection
  -- x{proj} where c1 -> (x where c1){proj} #project on fewer tuples
  -- (x union y) where c -> (x where c) union (y where c) #with a selective restriction, fewer tuples will need to be joined
  applyStaticRestrictionPushdown :: GraphRefRelationalExpr -> GraphRefRelationalExpr
  applyStaticRestrictionPushdown expr = case expr of
    MakeRelationFromExprs _ _ -> expr
    MakeStaticRelation _ _ -> expr
    ExistingRelation _ -> expr
    RelationValuedAttribute{} -> expr
    RelationVariable _ _ -> expr
    With _ _ -> expr
    Project _ _ -> expr
    --this transformation cannot be inverted because the projection attributes might not exist in the inverted version
    Restrict restrictAttrs (Project projAttrs subexpr) -> 
      Project projAttrs (Restrict restrictAttrs (applyStaticRestrictionPushdown subexpr))
    Restrict restrictAttrs (Union subexpr1 subexpr2) ->
      let optSub1 = applyStaticRestrictionPushdown subexpr1
          optSub2 = applyStaticRestrictionPushdown subexpr2 in
      Union (Restrict restrictAttrs optSub1) (Restrict restrictAttrs optSub2)
    Restrict attrs subexpr -> 
      Restrict attrs (applyStaticRestrictionPushdown subexpr)
      
    Union sub1 sub2 -> 
      Union (applyStaticRestrictionPushdown sub1) (applyStaticRestrictionPushdown sub2)
    Join sub1 sub2 ->
      Join (applyStaticRestrictionPushdown sub1) (applyStaticRestrictionPushdown sub2)
    Rename attrs sub ->
      Rename attrs (applyStaticRestrictionPushdown sub)
    Difference sub1 sub2 -> 
      Difference (applyStaticRestrictionPushdown sub1) (applyStaticRestrictionPushdown sub2)
    Group n1 n2 sub ->
      Group n1 n2 (applyStaticRestrictionPushdown sub)
    Ungroup n1 sub ->
      Ungroup n1 (applyStaticRestrictionPushdown sub)
    Equals sub1 sub2 -> 
      Equals (applyStaticRestrictionPushdown sub1) (applyStaticRestrictionPushdown sub2)
    NotEquals sub1 sub2 ->
      NotEquals (applyStaticRestrictionPushdown sub1) (applyStaticRestrictionPushdown sub2)
    Extend n sub ->
      Extend n (applyStaticRestrictionPushdown sub)
  
  -- if the rename is completely redundant because it renames an attribute name to the same attribute name, remove it
  -- Rename [(x,x)] == Rename []
  applyRedundantRenameCleanup :: GraphRefRelationalExpr -> GraphRefRelationalExpr
  applyRedundantRenameCleanup = Fold.cata folder
    where
      folder (RenameF renameSet e) =
        if S.null renameSet then
          e
        else
          Rename (S.filter (uncurry (/=)) renameSet) e
      folder e = Fold.embed e
  
  -- if the destination name in the rename is unused, we can remove it- does not detect errors if an a Rename is missing
  -- Project ["x"] (Rename [("y","z"),("w","x")] (RelationVariable "rv" ())) == Project ["x"] (Rename [("w","x")] (RelationVariable "rv" ()))
  {-
  applyUnusedRenameCleanup :: Show a => RelationalExprBase a -> RelationalExprBase a
  applyUnusedRenameCleanup expr = Fold.para folder expr
    where
      folder :: Show a => RelationalExprBaseF a (RelationalExprBase a, RelationalExprBase a) -> RelationalExprBase a
      folder (RenameF renameSet (expr', acc)) = traceShow ("para", expr', acc) (Rename renameSet expr')
      folder e = traceShow ("para2", Fold.embed $ fst <$> e) $ Fold.embed $ fst <$> e
  -}    
  -- no optimizations available  
  optimizeDatabaseContextIOExpr :: GraphRefDatabaseContextIOExpr -> GraphRefSOptDatabaseContextExprM GraphRefDatabaseContextIOExpr
  optimizeDatabaseContextIOExpr = pure
  
  