{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleInstances  #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE OverloadedStrings  #-}
module ProjectM36.RelationalExpression where
import ProjectM36.Relation
import ProjectM36.Tuple
import ProjectM36.TupleSet
import ProjectM36.Base
import qualified Data.UUID as U
import ProjectM36.Error
import ProjectM36.AtomType
import ProjectM36.Attribute (emptyAttributes, attributesFromList)
import ProjectM36.ScriptSession
import ProjectM36.DataTypes.Primitive
import ProjectM36.AtomFunction
import ProjectM36.DatabaseContextFunction
import ProjectM36.Arbitrary
import ProjectM36.GraphRefRelationalExpr
import ProjectM36.Transaction
import qualified ProjectM36.Attribute as A
import qualified Data.Map as M
import qualified Data.HashSet as HS
import qualified Data.Set as S
import Control.Monad.State hiding (join)
import Data.Bifunctor (second)
import Data.Maybe
import Data.Either
import Data.Char (isUpper)
import Data.Time
import qualified Data.List.NonEmpty as NE
import Data.Functor.Identity
import qualified Data.Text as T
import qualified Data.Vector as V
import qualified ProjectM36.TypeConstructorDef as TCD
import qualified Control.Monad.RWS.Strict as RWS
import Control.Monad.RWS.Strict (RWST, execRWST, runRWST)
import Control.Monad.Except hiding (join)
import Control.Monad.Trans.Except (except)
import Control.Monad.Reader as R hiding (join)
import ProjectM36.NormalizeExpr
import ProjectM36.WithNameExpr
import ProjectM36.Function
import Test.QuickCheck
import qualified Data.Functor.Foldable as Fold
import Control.Applicative
#ifdef PM36_HASKELL_SCRIPTING
import GHC hiding (getContext)
import Control.Exception
import GHC.Paths
#endif

data DatabaseContextExprDetails = CountUpdatedTuples

databaseContextExprDetailsFunc :: DatabaseContextExprDetails -> ResultAccumFunc
databaseContextExprDetailsFunc :: DatabaseContextExprDetails -> ResultAccumFunc
databaseContextExprDetailsFunc DatabaseContextExprDetails
CountUpdatedTuples RelationTuple -> Relation -> Relation
_ Relation
relIn = Attributes -> RelationTupleSet -> Relation
Relation Attributes
attrs RelationTupleSet
newTups
  where
    attrs :: Attributes
attrs = [Attribute] -> Attributes
A.attributesFromList [AttributeName -> AtomType -> Attribute
Attribute AttributeName
"count" AtomType
IntAtomType]
    existingTuple :: RelationTuple
existingTuple = RelationTuple -> Maybe RelationTuple -> RelationTuple
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> RelationTuple
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible counting error in singletonTuple") (Relation -> Maybe RelationTuple
singletonTuple Relation
relIn)
    existingCount :: Int
existingCount = case Vector Atom -> Atom
forall a. Vector a -> a
V.head (RelationTuple -> Vector Atom
tupleAtoms RelationTuple
existingTuple) of
      IntAtom Int
v -> Int
v
      Atom
_ -> [Char] -> Int
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible counting error in tupleAtoms"
    newTups :: RelationTupleSet
newTups = case Attributes -> [[Atom]] -> Either RelationalError RelationTupleSet
mkTupleSetFromList Attributes
attrs [[Int -> Atom
IntAtom (Int
existingCount Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)]] of
      Left RelationalError
err -> [Char] -> RelationTupleSet
forall a. HasCallStack => [Char] -> a
error ([Char]
"impossible counting error in " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ RelationalError -> [Char]
forall a. Show a => a -> [Char]
show RelationalError
err)
      Right RelationTupleSet
ts -> RelationTupleSet
ts
      
-- | Used to start a fresh database state for a new database context expression.
mkDatabaseContextEvalState :: DatabaseContext -> DatabaseContextEvalState
mkDatabaseContextEvalState :: DatabaseContext -> DatabaseContextEvalState
mkDatabaseContextEvalState DatabaseContext
context = DatabaseContextEvalState :: DatabaseContext
-> Map AttributeName ResultAccum
-> DirtyFlag
-> DatabaseContextEvalState
DatabaseContextEvalState {
  dbc_context :: DatabaseContext
dbc_context = DatabaseContext
context,
  dbc_accum :: Map AttributeName ResultAccum
dbc_accum = Map AttributeName ResultAccum
forall k a. Map k a
M.empty,
  dbc_dirty :: DirtyFlag
dbc_dirty = DirtyFlag
False
  } --future work: propagate return accumulator

-- we need to pass around a higher level RelationTuple and Attributes in order to solve #52
data RelationalExprEnv = RelationalExprEnv {
  RelationalExprEnv -> DatabaseContext
re_context :: DatabaseContext, 
  RelationalExprEnv -> TransactionGraph
re_graph :: TransactionGraph,
  RelationalExprEnv -> Maybe (Either RelationTuple Attributes)
re_extra :: Maybe (Either RelationTuple Attributes)
  }

envTuple :: GraphRefRelationalExprEnv -> RelationTuple
envTuple :: GraphRefRelationalExprEnv -> RelationTuple
envTuple GraphRefRelationalExprEnv
e = RelationTuple -> Either RelationTuple Attributes -> RelationTuple
forall a b. a -> Either a b -> a
fromLeft RelationTuple
emptyTuple (Either RelationTuple Attributes
-> Maybe (Either RelationTuple Attributes)
-> Either RelationTuple Attributes
forall a. a -> Maybe a -> a
fromMaybe (RelationTuple -> Either RelationTuple Attributes
forall a b. a -> Either a b
Left RelationTuple
emptyTuple) (GraphRefRelationalExprEnv
-> Maybe (Either RelationTuple Attributes)
gre_extra GraphRefRelationalExprEnv
e))

envAttributes :: GraphRefRelationalExprEnv -> Attributes
envAttributes :: GraphRefRelationalExprEnv -> Attributes
envAttributes GraphRefRelationalExprEnv
e = Attributes -> Either RelationTuple Attributes -> Attributes
forall b a. b -> Either a b -> b
fromRight Attributes
emptyAttributes (Either RelationTuple Attributes
-> Maybe (Either RelationTuple Attributes)
-> Either RelationTuple Attributes
forall a. a -> Maybe a -> a
fromMaybe (Attributes -> Either RelationTuple Attributes
forall a b. b -> Either a b
Right Attributes
emptyAttributes) (GraphRefRelationalExprEnv
-> Maybe (Either RelationTuple Attributes)
gre_extra GraphRefRelationalExprEnv
e))
  
instance Show RelationalExprEnv where
  show :: RelationalExprEnv -> [Char]
show e :: RelationalExprEnv
e@RelationalExprEnv{} = [Char]
"RelationalExprEnv " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Maybe (Either RelationTuple Attributes) -> [Char]
forall a. Show a => a -> [Char]
show (RelationalExprEnv -> Maybe (Either RelationTuple Attributes)
re_extra RelationalExprEnv
e)

--used to eval relationalexpr
type RelationalExprM a = ReaderT RelationalExprEnv (ExceptT RelationalError Identity) a

runRelationalExprM :: RelationalExprEnv -> RelationalExprM a -> Either RelationalError a
runRelationalExprM :: RelationalExprEnv -> RelationalExprM a -> Either RelationalError a
runRelationalExprM RelationalExprEnv
env RelationalExprM a
m = Identity (Either RelationalError a) -> Either RelationalError a
forall a. Identity a -> a
runIdentity (ExceptT RelationalError Identity a
-> Identity (Either RelationalError a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (RelationalExprM a
-> RelationalExprEnv -> ExceptT RelationalError Identity a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT RelationalExprM a
m RelationalExprEnv
env))

reGraph :: RelationalExprM TransactionGraph
reGraph :: RelationalExprM TransactionGraph
reGraph = (RelationalExprEnv -> TransactionGraph)
-> RelationalExprM TransactionGraph
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks RelationalExprEnv -> TransactionGraph
re_graph

reContext :: RelationalExprM DatabaseContext
reContext :: RelationalExprM DatabaseContext
reContext = (RelationalExprEnv -> DatabaseContext)
-> RelationalExprM DatabaseContext
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks RelationalExprEnv -> DatabaseContext
re_context

mkRelationalExprEnv :: DatabaseContext -> TransactionGraph -> RelationalExprEnv
mkRelationalExprEnv :: DatabaseContext -> TransactionGraph -> RelationalExprEnv
mkRelationalExprEnv DatabaseContext
ctx TransactionGraph
graph =
  RelationalExprEnv :: DatabaseContext
-> TransactionGraph
-> Maybe (Either RelationTuple Attributes)
-> RelationalExprEnv
RelationalExprEnv
  { re_context :: DatabaseContext
re_context = DatabaseContext
ctx,
    re_graph :: TransactionGraph
re_graph = TransactionGraph
graph,
    re_extra :: Maybe (Either RelationTuple Attributes)
re_extra = Maybe (Either RelationTuple Attributes)
forall a. Maybe a
Nothing }

askEnv :: GraphRefRelationalExprM GraphRefRelationalExprEnv
askEnv :: GraphRefRelationalExprM GraphRefRelationalExprEnv
askEnv = GraphRefRelationalExprM GraphRefRelationalExprEnv
forall r (m :: * -> *). MonadReader r m => m r
R.ask

mergeTuplesIntoGraphRefRelationalExprEnv :: RelationTuple -> GraphRefRelationalExprEnv -> GraphRefRelationalExprEnv
mergeTuplesIntoGraphRefRelationalExprEnv :: RelationTuple
-> GraphRefRelationalExprEnv -> GraphRefRelationalExprEnv
mergeTuplesIntoGraphRefRelationalExprEnv RelationTuple
tupIn GraphRefRelationalExprEnv
env =
  GraphRefRelationalExprEnv
env { gre_extra :: Maybe (Either RelationTuple Attributes)
gre_extra = Maybe (Either RelationTuple Attributes)
forall b. Maybe (Either RelationTuple b)
new_elems }
  where
    new_elems :: Maybe (Either RelationTuple b)
new_elems = Either RelationTuple b -> Maybe (Either RelationTuple b)
forall a. a -> Maybe a
Just (RelationTuple -> Either RelationTuple b
forall a b. a -> Either a b
Left RelationTuple
newTuple)
    mergedTupMap :: Map AttributeName Atom
mergedTupMap = Map AttributeName Atom
-> Map AttributeName Atom -> Map AttributeName Atom
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union (RelationTuple -> Map AttributeName Atom
tupleToMap RelationTuple
tupIn) (RelationTuple -> Map AttributeName Atom
tupleToMap (GraphRefRelationalExprEnv -> RelationTuple
envTuple GraphRefRelationalExprEnv
env))
    newTuple :: RelationTuple
newTuple = Map AttributeName Atom -> RelationTuple
mkRelationTupleFromMap Map AttributeName Atom
mergedTupMap

mergeAttributesIntoGraphRefRelationalExprEnv :: Attributes -> GraphRefRelationalExprEnv -> GraphRefRelationalExprEnv
mergeAttributesIntoGraphRefRelationalExprEnv :: Attributes
-> GraphRefRelationalExprEnv -> GraphRefRelationalExprEnv
mergeAttributesIntoGraphRefRelationalExprEnv Attributes
attrsIn GraphRefRelationalExprEnv
e = GraphRefRelationalExprEnv
e { gre_extra :: Maybe (Either RelationTuple Attributes)
gre_extra = Maybe (Either RelationTuple Attributes)
forall a. Maybe (Either a Attributes)
newattrs }
  where
    newattrs :: Maybe (Either a Attributes)
newattrs = Either a Attributes -> Maybe (Either a Attributes)
forall a. a -> Maybe a
Just (Attributes -> Either a Attributes
forall a b. b -> Either a b
Right (Attributes -> Attributes -> Attributes
A.union Attributes
attrsIn (GraphRefRelationalExprEnv -> Attributes
envAttributes GraphRefRelationalExprEnv
e)))

type ResultAccumName = StringType

type ResultAccumFunc = (RelationTuple -> Relation -> Relation) -> Relation -> Relation

data ResultAccum = ResultAccum { ResultAccum -> ResultAccumFunc
resultAccumFunc :: ResultAccumFunc,
                                 ResultAccum -> Relation
resultAccumResult :: Relation
                                 }

data DatabaseContextEvalState = DatabaseContextEvalState {
  DatabaseContextEvalState -> DatabaseContext
dbc_context :: DatabaseContext, --new, alterable context for a new transaction
  DatabaseContextEvalState -> Map AttributeName ResultAccum
dbc_accum :: M.Map ResultAccumName ResultAccum,
  DatabaseContextEvalState -> DirtyFlag
dbc_dirty :: DirtyFlag
  }

data DatabaseContextEvalEnv = DatabaseContextEvalEnv
  { DatabaseContextEvalEnv -> TransactionId
dce_transId :: TransactionId,
    DatabaseContextEvalEnv -> TransactionGraph
dce_graph :: TransactionGraph
  }

mkDatabaseContextEvalEnv :: TransactionId -> TransactionGraph -> DatabaseContextEvalEnv
mkDatabaseContextEvalEnv :: TransactionId -> TransactionGraph -> DatabaseContextEvalEnv
mkDatabaseContextEvalEnv = TransactionId -> TransactionGraph -> DatabaseContextEvalEnv
DatabaseContextEvalEnv

type DatabaseContextEvalMonad a = RWST DatabaseContextEvalEnv () DatabaseContextEvalState (ExceptT RelationalError Identity) a

runDatabaseContextEvalMonad :: DatabaseContext -> DatabaseContextEvalEnv -> DatabaseContextEvalMonad () -> Either RelationalError DatabaseContextEvalState
runDatabaseContextEvalMonad :: DatabaseContext
-> DatabaseContextEvalEnv
-> DatabaseContextEvalMonad ()
-> Either RelationalError DatabaseContextEvalState
runDatabaseContextEvalMonad DatabaseContext
ctx DatabaseContextEvalEnv
env DatabaseContextEvalMonad ()
m = Identity (Either RelationalError DatabaseContextEvalState)
-> Either RelationalError DatabaseContextEvalState
forall a. Identity a -> a
runIdentity (ExceptT RelationalError Identity DatabaseContextEvalState
-> Identity (Either RelationalError DatabaseContextEvalState)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ((DatabaseContextEvalState, ()) -> DatabaseContextEvalState
forall a b. (a, b) -> a
fst ((DatabaseContextEvalState, ()) -> DatabaseContextEvalState)
-> ExceptT RelationalError Identity (DatabaseContextEvalState, ())
-> ExceptT RelationalError Identity DatabaseContextEvalState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DatabaseContextEvalMonad ()
-> DatabaseContextEvalEnv
-> DatabaseContextEvalState
-> ExceptT RelationalError Identity (DatabaseContextEvalState, ())
forall (m :: * -> *) r w s a.
Monad m =>
RWST r w s m a -> r -> s -> m (s, w)
execRWST DatabaseContextEvalMonad ()
m DatabaseContextEvalEnv
env DatabaseContextEvalState
freshEnv))
  where
    freshEnv :: DatabaseContextEvalState
freshEnv = DatabaseContext -> DatabaseContextEvalState
mkDatabaseContextEvalState DatabaseContext
ctx
    

dbcTransId :: DatabaseContextEvalMonad TransactionId
dbcTransId :: DatabaseContextEvalMonad TransactionId
dbcTransId = DatabaseContextEvalEnv -> TransactionId
dce_transId (DatabaseContextEvalEnv -> TransactionId)
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     DatabaseContextEvalEnv
-> DatabaseContextEvalMonad TransactionId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST
  DatabaseContextEvalEnv
  ()
  DatabaseContextEvalState
  (ExceptT RelationalError Identity)
  DatabaseContextEvalEnv
forall r (m :: * -> *). MonadReader r m => m r
RWS.ask

dbcGraph :: DatabaseContextEvalMonad TransactionGraph
dbcGraph :: DatabaseContextEvalMonad TransactionGraph
dbcGraph = DatabaseContextEvalEnv -> TransactionGraph
dce_graph (DatabaseContextEvalEnv -> TransactionGraph)
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     DatabaseContextEvalEnv
-> DatabaseContextEvalMonad TransactionGraph
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST
  DatabaseContextEvalEnv
  ()
  DatabaseContextEvalState
  (ExceptT RelationalError Identity)
  DatabaseContextEvalEnv
forall r (m :: * -> *). MonadReader r m => m r
RWS.ask

dbcRelationalExprEnv :: DatabaseContextEvalMonad RelationalExprEnv
dbcRelationalExprEnv :: DatabaseContextEvalMonad RelationalExprEnv
dbcRelationalExprEnv = 
  DatabaseContext -> TransactionGraph -> RelationalExprEnv
mkRelationalExprEnv (DatabaseContext -> TransactionGraph -> RelationalExprEnv)
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     DatabaseContext
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (TransactionGraph -> RelationalExprEnv)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST
  DatabaseContextEvalEnv
  ()
  DatabaseContextEvalState
  (ExceptT RelationalError Identity)
  DatabaseContext
getStateContext RWST
  DatabaseContextEvalEnv
  ()
  DatabaseContextEvalState
  (ExceptT RelationalError Identity)
  (TransactionGraph -> RelationalExprEnv)
-> DatabaseContextEvalMonad TransactionGraph
-> DatabaseContextEvalMonad RelationalExprEnv
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DatabaseContextEvalMonad TransactionGraph
dbcGraph

getStateContext :: DatabaseContextEvalMonad DatabaseContext
getStateContext :: RWST
  DatabaseContextEvalEnv
  ()
  DatabaseContextEvalState
  (ExceptT RelationalError Identity)
  DatabaseContext
getStateContext = (DatabaseContextEvalState -> DatabaseContext)
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     DatabaseContext
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DatabaseContextEvalState -> DatabaseContext
dbc_context

putStateContext :: DatabaseContext -> DatabaseContextEvalMonad () 
putStateContext :: DatabaseContext -> DatabaseContextEvalMonad ()
putStateContext DatabaseContext
ctx' = do
  DatabaseContextEvalState
s <- RWST
  DatabaseContextEvalEnv
  ()
  DatabaseContextEvalState
  (ExceptT RelationalError Identity)
  DatabaseContextEvalState
forall s (m :: * -> *). MonadState s m => m s
get
  DatabaseContextEvalState -> DatabaseContextEvalMonad ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (DatabaseContextEvalState
s {dbc_context :: DatabaseContext
dbc_context = DatabaseContext
ctx', dbc_dirty :: DirtyFlag
dbc_dirty = DirtyFlag
True}) 

-- | The context is optionally passed down along in cases where the current context is uncommitted.
data GraphRefRelationalExprEnv =
  GraphRefRelationalExprEnv {
  GraphRefRelationalExprEnv -> Maybe DatabaseContext
gre_context :: Maybe DatabaseContext,
  GraphRefRelationalExprEnv -> TransactionGraph
gre_graph :: TransactionGraph,
  GraphRefRelationalExprEnv
-> Maybe (Either RelationTuple Attributes)
gre_extra :: Maybe (Either RelationTuple Attributes)
  }
  
type GraphRefRelationalExprM a = ReaderT GraphRefRelationalExprEnv (ExceptT RelationalError Identity) a

gfTransForId :: TransactionId -> GraphRefRelationalExprM Transaction
gfTransForId :: TransactionId -> GraphRefRelationalExprM Transaction
gfTransForId TransactionId
tid = do
  TransactionGraph
graph <- GraphRefRelationalExprM TransactionGraph
gfGraph
  ExceptT RelationalError Identity Transaction
-> GraphRefRelationalExprM Transaction
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT RelationalError Identity Transaction
 -> GraphRefRelationalExprM Transaction)
-> ExceptT RelationalError Identity Transaction
-> GraphRefRelationalExprM Transaction
forall a b. (a -> b) -> a -> b
$ Either RelationalError Transaction
-> ExceptT RelationalError Identity Transaction
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either RelationalError Transaction
 -> ExceptT RelationalError Identity Transaction)
-> Either RelationalError Transaction
-> ExceptT RelationalError Identity Transaction
forall a b. (a -> b) -> a -> b
$ TransactionId
-> TransactionGraph -> Either RelationalError Transaction
transactionForId TransactionId
tid TransactionGraph
graph

gfDatabaseContextForMarker :: GraphRefTransactionMarker -> GraphRefRelationalExprM DatabaseContext
gfDatabaseContextForMarker :: GraphRefTransactionMarker
-> GraphRefRelationalExprM DatabaseContext
gfDatabaseContextForMarker (TransactionMarker TransactionId
transId) = Transaction -> DatabaseContext
concreteDatabaseContext (Transaction -> DatabaseContext)
-> GraphRefRelationalExprM Transaction
-> GraphRefRelationalExprM DatabaseContext
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TransactionId -> GraphRefRelationalExprM Transaction
gfTransForId TransactionId
transId
gfDatabaseContextForMarker GraphRefTransactionMarker
UncommittedContextMarker = do
  Maybe DatabaseContext
mctx <- GraphRefRelationalExprEnv -> Maybe DatabaseContext
gre_context (GraphRefRelationalExprEnv -> Maybe DatabaseContext)
-> GraphRefRelationalExprM GraphRefRelationalExprEnv
-> ReaderT
     GraphRefRelationalExprEnv
     (ExceptT RelationalError Identity)
     (Maybe DatabaseContext)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GraphRefRelationalExprM GraphRefRelationalExprEnv
askEnv
  case Maybe DatabaseContext
mctx of
    Maybe DatabaseContext
Nothing -> RelationalError -> GraphRefRelationalExprM DatabaseContext
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError RelationalError
NoUncommittedContextInEvalError
    Just DatabaseContext
ctx -> DatabaseContext -> GraphRefRelationalExprM DatabaseContext
forall (f :: * -> *) a. Applicative f => a -> f a
pure DatabaseContext
ctx

runGraphRefRelationalExprM :: GraphRefRelationalExprEnv -> GraphRefRelationalExprM a -> Either RelationalError a
runGraphRefRelationalExprM :: GraphRefRelationalExprEnv
-> GraphRefRelationalExprM a -> Either RelationalError a
runGraphRefRelationalExprM GraphRefRelationalExprEnv
env GraphRefRelationalExprM a
m = Identity (Either RelationalError a) -> Either RelationalError a
forall a. Identity a -> a
runIdentity (ExceptT RelationalError Identity a
-> Identity (Either RelationalError a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (GraphRefRelationalExprM a
-> GraphRefRelationalExprEnv -> ExceptT RelationalError Identity a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT GraphRefRelationalExprM a
m GraphRefRelationalExprEnv
env))

freshGraphRefRelationalExprEnv :: Maybe DatabaseContext -> TransactionGraph -> GraphRefRelationalExprEnv
freshGraphRefRelationalExprEnv :: Maybe DatabaseContext
-> TransactionGraph -> GraphRefRelationalExprEnv
freshGraphRefRelationalExprEnv Maybe DatabaseContext
mctx TransactionGraph
graph = GraphRefRelationalExprEnv :: Maybe DatabaseContext
-> TransactionGraph
-> Maybe (Either RelationTuple Attributes)
-> GraphRefRelationalExprEnv
GraphRefRelationalExprEnv {
  gre_context :: Maybe DatabaseContext
gre_context = Maybe DatabaseContext
mctx,
  gre_graph :: TransactionGraph
gre_graph = TransactionGraph
graph,
  gre_extra :: Maybe (Either RelationTuple Attributes)
gre_extra = Maybe (Either RelationTuple Attributes)
forall a. Maybe a
Nothing
  }

gfGraph :: GraphRefRelationalExprM TransactionGraph
gfGraph :: GraphRefRelationalExprM TransactionGraph
gfGraph = (GraphRefRelationalExprEnv -> TransactionGraph)
-> GraphRefRelationalExprM TransactionGraph
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks GraphRefRelationalExprEnv -> TransactionGraph
gre_graph

envContext :: RelationalExprEnv -> DatabaseContext
envContext :: RelationalExprEnv -> DatabaseContext
envContext = RelationalExprEnv -> DatabaseContext
re_context

setEnvContext :: RelationalExprEnv -> DatabaseContext -> RelationalExprEnv
setEnvContext :: RelationalExprEnv -> DatabaseContext -> RelationalExprEnv
setEnvContext RelationalExprEnv
e DatabaseContext
ctx = RelationalExprEnv
e { re_context :: DatabaseContext
re_context = DatabaseContext
ctx }

--helper function to process relation variable creation/assignment
setRelVar :: RelVarName -> GraphRefRelationalExpr -> DatabaseContextEvalMonad ()
setRelVar :: AttributeName
-> GraphRefRelationalExpr -> DatabaseContextEvalMonad ()
setRelVar AttributeName
relVarName GraphRefRelationalExpr
relExpr = do
  DatabaseContext
currentContext <- RWST
  DatabaseContextEvalEnv
  ()
  DatabaseContextEvalState
  (ExceptT RelationalError Identity)
  DatabaseContext
getStateContext
  --prevent recursive relvar definition by resolving references to relvars in previous states
  GraphRefRelationalExpr
relExpr' <- GraphRefRelationalExpr
-> DatabaseContextEvalMonad GraphRefRelationalExpr
forall a.
ResolveGraphRefTransactionMarker a =>
a -> DatabaseContextEvalMonad a
resolve GraphRefRelationalExpr
relExpr
  let newRelVars :: Map AttributeName GraphRefRelationalExpr
newRelVars = AttributeName
-> GraphRefRelationalExpr
-> Map AttributeName GraphRefRelationalExpr
-> Map AttributeName GraphRefRelationalExpr
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert AttributeName
relVarName GraphRefRelationalExpr
relExpr' (Map AttributeName GraphRefRelationalExpr
 -> Map AttributeName GraphRefRelationalExpr)
-> Map AttributeName GraphRefRelationalExpr
-> Map AttributeName GraphRefRelationalExpr
forall a b. (a -> b) -> a -> b
$ DatabaseContext -> Map AttributeName GraphRefRelationalExpr
relationVariables DatabaseContext
currentContext
      potentialContext :: DatabaseContext
potentialContext = DatabaseContext
currentContext { relationVariables :: Map AttributeName GraphRefRelationalExpr
relationVariables = Map AttributeName GraphRefRelationalExpr
newRelVars }
  --optimization: if the relexpr is unchanged, skip the update      
  if AttributeName
-> Map AttributeName GraphRefRelationalExpr
-> Maybe GraphRefRelationalExpr
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup AttributeName
relVarName (DatabaseContext -> Map AttributeName GraphRefRelationalExpr
relationVariables DatabaseContext
currentContext) Maybe GraphRefRelationalExpr
-> Maybe GraphRefRelationalExpr -> DirtyFlag
forall a. Eq a => a -> a -> DirtyFlag
== GraphRefRelationalExpr -> Maybe GraphRefRelationalExpr
forall a. a -> Maybe a
Just GraphRefRelationalExpr
relExpr then
    () -> DatabaseContextEvalMonad ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    else do
    --determine when to check constraints
    TransactionGraph
graph <- DatabaseContextEvalMonad TransactionGraph
dbcGraph
    TransactionId
tid <- DatabaseContextEvalMonad TransactionId
dbcTransId
    case DatabaseContext
-> TransactionId -> TransactionGraph -> Either RelationalError ()
checkConstraints DatabaseContext
potentialContext TransactionId
tid TransactionGraph
graph of
      Left RelationalError
err -> RelationalError -> DatabaseContextEvalMonad ()
dbErr RelationalError
err
      Right ()
_ -> DatabaseContext -> DatabaseContextEvalMonad ()
putStateContext DatabaseContext
potentialContext

--fast-path insertion- we already know that the previous relvar validated correctly, so we can validate just the relation that is being inserted for attribute matches- without this, even a single tuple relation inserted causes the entire relation to be re-validated unnecessarily
--insertIntoRelVar :: RelVarName -> GraphRefRelationalExpr -> DatabaseContextEvalMonad ()

-- it is not an error to delete a relvar which does not exist, just like it is not an error to insert a pre-existing tuple into a relation
deleteRelVar :: RelVarName -> DatabaseContextEvalMonad ()
deleteRelVar :: AttributeName -> DatabaseContextEvalMonad ()
deleteRelVar AttributeName
relVarName = do
  DatabaseContext
currContext <- RWST
  DatabaseContextEvalEnv
  ()
  DatabaseContextEvalState
  (ExceptT RelationalError Identity)
  DatabaseContext
getStateContext
  let relVars :: Map AttributeName GraphRefRelationalExpr
relVars = DatabaseContext -> Map AttributeName GraphRefRelationalExpr
relationVariables DatabaseContext
currContext
  if AttributeName
-> Map AttributeName GraphRefRelationalExpr -> DirtyFlag
forall k a. Ord k => k -> Map k a -> DirtyFlag
M.notMember AttributeName
relVarName Map AttributeName GraphRefRelationalExpr
relVars then
    () -> DatabaseContextEvalMonad ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    else do
    let newRelVars :: Map AttributeName GraphRefRelationalExpr
newRelVars = AttributeName
-> Map AttributeName GraphRefRelationalExpr
-> Map AttributeName GraphRefRelationalExpr
forall k a. Ord k => k -> Map k a -> Map k a
M.delete AttributeName
relVarName Map AttributeName GraphRefRelationalExpr
relVars
        newContext :: DatabaseContext
newContext = DatabaseContext
currContext { relationVariables :: Map AttributeName GraphRefRelationalExpr
relationVariables = Map AttributeName GraphRefRelationalExpr
newRelVars }
    TransactionGraph
graph <- DatabaseContextEvalMonad TransactionGraph
dbcGraph
    TransactionId
tid <- DatabaseContextEvalMonad TransactionId
dbcTransId
    case DatabaseContext
-> TransactionId -> TransactionGraph -> Either RelationalError ()
checkConstraints DatabaseContext
newContext TransactionId
tid TransactionGraph
graph of
      Left RelationalError
err -> RelationalError -> DatabaseContextEvalMonad ()
dbErr RelationalError
err
      Right ()
_ ->
        DatabaseContext -> DatabaseContextEvalMonad ()
putStateContext DatabaseContext
newContext

evalGraphRefDatabaseContextExpr :: GraphRefDatabaseContextExpr -> DatabaseContextEvalMonad ()
evalGraphRefDatabaseContextExpr :: GraphRefDatabaseContextExpr -> DatabaseContextEvalMonad ()
evalGraphRefDatabaseContextExpr GraphRefDatabaseContextExpr
NoOperation = () -> DatabaseContextEvalMonad ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  
evalGraphRefDatabaseContextExpr (Define AttributeName
relVarName [AttributeExprBase GraphRefTransactionMarker]
attrExprs) = do
  DatabaseContext
context <- RWST
  DatabaseContextEvalEnv
  ()
  DatabaseContextEvalState
  (ExceptT RelationalError Identity)
  DatabaseContext
getStateContext
  Map AttributeName GraphRefRelationalExpr
relvars <- (DatabaseContext -> Map AttributeName GraphRefRelationalExpr)
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     DatabaseContext
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (Map AttributeName GraphRefRelationalExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DatabaseContext -> Map AttributeName GraphRefRelationalExpr
relationVariables RWST
  DatabaseContextEvalEnv
  ()
  DatabaseContextEvalState
  (ExceptT RelationalError Identity)
  DatabaseContext
getStateContext
  TypeConstructorMapping
tConss <- (DatabaseContext -> TypeConstructorMapping)
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     DatabaseContext
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     TypeConstructorMapping
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DatabaseContext -> TypeConstructorMapping
typeConstructorMapping RWST
  DatabaseContextEvalEnv
  ()
  DatabaseContextEvalState
  (ExceptT RelationalError Identity)
  DatabaseContext
getStateContext
  TransactionGraph
graph <- DatabaseContextEvalMonad TransactionGraph
dbcGraph
  let eAttrs :: Either RelationalError [Attribute]
eAttrs = GraphRefRelationalExprEnv
-> GraphRefRelationalExprM [Attribute]
-> Either RelationalError [Attribute]
forall a.
GraphRefRelationalExprEnv
-> GraphRefRelationalExprM a -> Either RelationalError a
runGraphRefRelationalExprM GraphRefRelationalExprEnv
gfEnv ((AttributeExprBase GraphRefTransactionMarker
 -> ReaderT
      GraphRefRelationalExprEnv
      (ExceptT RelationalError Identity)
      Attribute)
-> [AttributeExprBase GraphRefTransactionMarker]
-> GraphRefRelationalExprM [Attribute]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM AttributeExprBase GraphRefTransactionMarker
-> ReaderT
     GraphRefRelationalExprEnv
     (ExceptT RelationalError Identity)
     Attribute
evalGraphRefAttrExpr [AttributeExprBase GraphRefTransactionMarker]
attrExprs)
      gfEnv :: GraphRefRelationalExprEnv
gfEnv = Maybe DatabaseContext
-> TransactionGraph -> GraphRefRelationalExprEnv
freshGraphRefRelationalExprEnv (DatabaseContext -> Maybe DatabaseContext
forall a. a -> Maybe a
Just DatabaseContext
context) TransactionGraph
graph
  case Either RelationalError [Attribute]
eAttrs of
    Left RelationalError
err -> RelationalError -> DatabaseContextEvalMonad ()
dbErr RelationalError
err
    Right [Attribute]
attrsList -> do
      ExceptT RelationalError Identity () -> DatabaseContextEvalMonad ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT RelationalError Identity ()
 -> DatabaseContextEvalMonad ())
-> ExceptT RelationalError Identity ()
-> DatabaseContextEvalMonad ()
forall a b. (a -> b) -> a -> b
$ Either RelationalError () -> ExceptT RelationalError Identity ()
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either RelationalError () -> ExceptT RelationalError Identity ())
-> Either RelationalError () -> ExceptT RelationalError Identity ()
forall a b. (a -> b) -> a -> b
$ TypeConstructorMapping -> Attributes -> Either RelationalError ()
validateAttributes TypeConstructorMapping
tConss ([Attribute] -> Attributes
A.attributesFromList [Attribute]
attrsList)
      case AttributeName
-> Map AttributeName GraphRefRelationalExpr -> DirtyFlag
forall k a. Ord k => k -> Map k a -> DirtyFlag
M.member AttributeName
relVarName Map AttributeName GraphRefRelationalExpr
relvars of
          DirtyFlag
True -> RelationalError -> DatabaseContextEvalMonad ()
dbErr (AttributeName -> RelationalError
RelVarAlreadyDefinedError AttributeName
relVarName)
          DirtyFlag
False -> AttributeName
-> GraphRefRelationalExpr -> DatabaseContextEvalMonad ()
setRelVar AttributeName
relVarName (Relation -> GraphRefRelationalExpr
forall a. Relation -> RelationalExprBase a
ExistingRelation Relation
emptyRelation)
            where
              attrs :: Attributes
attrs = [Attribute] -> Attributes
A.attributesFromList [Attribute]
attrsList
              emptyRelation :: Relation
emptyRelation = Attributes -> RelationTupleSet -> Relation
Relation Attributes
attrs RelationTupleSet
emptyTupleSet

evalGraphRefDatabaseContextExpr (Undefine AttributeName
relVarName) = AttributeName -> DatabaseContextEvalMonad ()
deleteRelVar AttributeName
relVarName

evalGraphRefDatabaseContextExpr (Assign AttributeName
relVarName GraphRefRelationalExpr
expr) = do
  TransactionGraph
graph <- RelationalExprEnv -> TransactionGraph
re_graph (RelationalExprEnv -> TransactionGraph)
-> DatabaseContextEvalMonad RelationalExprEnv
-> DatabaseContextEvalMonad TransactionGraph
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DatabaseContextEvalMonad RelationalExprEnv
dbcRelationalExprEnv
  DatabaseContext
context <- RWST
  DatabaseContextEvalEnv
  ()
  DatabaseContextEvalState
  (ExceptT RelationalError Identity)
  DatabaseContext
getStateContext
  let existingRelVar :: Maybe GraphRefRelationalExpr
existingRelVar = AttributeName
-> Map AttributeName GraphRefRelationalExpr
-> Maybe GraphRefRelationalExpr
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup AttributeName
relVarName (DatabaseContext -> Map AttributeName GraphRefRelationalExpr
relationVariables DatabaseContext
context)
      reEnv :: GraphRefRelationalExprEnv
reEnv = Maybe DatabaseContext
-> TransactionGraph -> GraphRefRelationalExprEnv
freshGraphRefRelationalExprEnv (DatabaseContext -> Maybe DatabaseContext
forall a. a -> Maybe a
Just DatabaseContext
context) TransactionGraph
graph
      eNewExprType :: Either RelationalError Relation
eNewExprType = GraphRefRelationalExprEnv
-> GraphRefRelationalExprM Relation
-> Either RelationalError Relation
forall a.
GraphRefRelationalExprEnv
-> GraphRefRelationalExprM a -> Either RelationalError a
runGraphRefRelationalExprM GraphRefRelationalExprEnv
reEnv (GraphRefRelationalExpr -> GraphRefRelationalExprM Relation
typeForGraphRefRelationalExpr GraphRefRelationalExpr
expr)      
  case Maybe GraphRefRelationalExpr
existingRelVar of
    Maybe GraphRefRelationalExpr
Nothing -> do
      case GraphRefRelationalExprEnv
-> GraphRefRelationalExprM Relation
-> Either RelationalError Relation
forall a.
GraphRefRelationalExprEnv
-> GraphRefRelationalExprM a -> Either RelationalError a
runGraphRefRelationalExprM GraphRefRelationalExprEnv
reEnv (GraphRefRelationalExpr -> GraphRefRelationalExprM Relation
typeForGraphRefRelationalExpr GraphRefRelationalExpr
expr) of
        Left RelationalError
err -> RelationalError -> DatabaseContextEvalMonad ()
dbErr RelationalError
err
        Right Relation
reltype -> do
          ExceptT RelationalError Identity () -> DatabaseContextEvalMonad ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT RelationalError Identity ()
 -> DatabaseContextEvalMonad ())
-> ExceptT RelationalError Identity ()
-> DatabaseContextEvalMonad ()
forall a b. (a -> b) -> a -> b
$ Either RelationalError () -> ExceptT RelationalError Identity ()
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either RelationalError () -> ExceptT RelationalError Identity ())
-> Either RelationalError () -> ExceptT RelationalError Identity ()
forall a b. (a -> b) -> a -> b
$ TypeConstructorMapping -> Attributes -> Either RelationalError ()
validateAttributes (DatabaseContext -> TypeConstructorMapping
typeConstructorMapping DatabaseContext
context) (Relation -> Attributes
attributes Relation
reltype)
          AttributeName
-> GraphRefRelationalExpr -> DatabaseContextEvalMonad ()
setRelVar AttributeName
relVarName GraphRefRelationalExpr
expr
    Just GraphRefRelationalExpr
existingRel -> do
      let eExpectedType :: Either RelationalError Relation
eExpectedType = GraphRefRelationalExprEnv
-> GraphRefRelationalExprM Relation
-> Either RelationalError Relation
forall a.
GraphRefRelationalExprEnv
-> GraphRefRelationalExprM a -> Either RelationalError a
runGraphRefRelationalExprM GraphRefRelationalExprEnv
reEnv (GraphRefRelationalExpr -> GraphRefRelationalExprM Relation
typeForGraphRefRelationalExpr GraphRefRelationalExpr
existingRel)
      case Either RelationalError Relation
eExpectedType of
        Left RelationalError
err -> RelationalError -> DatabaseContextEvalMonad ()
dbErr RelationalError
err
        Right Relation
expectedType ->
          case Either RelationalError Relation
eNewExprType of
            Left RelationalError
err -> RelationalError -> DatabaseContextEvalMonad ()
dbErr RelationalError
err
            Right Relation
newExprType -> do
              if Relation
newExprType Relation -> Relation -> DirtyFlag
forall a. Eq a => a -> a -> DirtyFlag
== Relation
expectedType then do
                ExceptT RelationalError Identity () -> DatabaseContextEvalMonad ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT RelationalError Identity ()
 -> DatabaseContextEvalMonad ())
-> ExceptT RelationalError Identity ()
-> DatabaseContextEvalMonad ()
forall a b. (a -> b) -> a -> b
$ Either RelationalError () -> ExceptT RelationalError Identity ()
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either RelationalError () -> ExceptT RelationalError Identity ())
-> Either RelationalError () -> ExceptT RelationalError Identity ()
forall a b. (a -> b) -> a -> b
$ TypeConstructorMapping -> Attributes -> Either RelationalError ()
validateAttributes (DatabaseContext -> TypeConstructorMapping
typeConstructorMapping DatabaseContext
context) (Relation -> Attributes
attributes Relation
newExprType)
                AttributeName
-> GraphRefRelationalExpr -> DatabaseContextEvalMonad ()
setRelVar AttributeName
relVarName GraphRefRelationalExpr
expr 
              else
                RelationalError -> DatabaseContextEvalMonad ()
dbErr (Attributes -> Attributes -> RelationalError
RelationTypeMismatchError (Relation -> Attributes
attributes Relation
expectedType) (Relation -> Attributes
attributes Relation
newExprType))

evalGraphRefDatabaseContextExpr (Insert AttributeName
relVarName GraphRefRelationalExpr
relExpr) = do
  GraphRefRelationalExpr
gfExpr <- AttributeName -> DatabaseContextEvalMonad GraphRefRelationalExpr
forall (m :: * -> *).
DatabaseContextM m =>
AttributeName -> m GraphRefRelationalExpr
relVarByName AttributeName
relVarName
  let optExpr :: GraphRefRelationalExpr
optExpr = GraphRefRelationalExpr -> GraphRefRelationalExpr
applyUnionCollapse (GraphRefRelationalExpr
-> GraphRefRelationalExpr -> GraphRefRelationalExpr
forall a.
RelationalExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Union
                                    GraphRefRelationalExpr
relExpr
                                     GraphRefRelationalExpr
gfExpr)
  GraphRefDatabaseContextExpr -> DatabaseContextEvalMonad ()
evalGraphRefDatabaseContextExpr (AttributeName
-> GraphRefRelationalExpr -> GraphRefDatabaseContextExpr
forall a.
AttributeName -> RelationalExprBase a -> DatabaseContextExprBase a
Assign AttributeName
relVarName GraphRefRelationalExpr
optExpr)

evalGraphRefDatabaseContextExpr (Delete AttributeName
relVarName RestrictionPredicateExprBase GraphRefTransactionMarker
predicate) = do
  GraphRefRelationalExpr
gfExpr <- AttributeName -> DatabaseContextEvalMonad GraphRefRelationalExpr
forall (m :: * -> *).
DatabaseContextM m =>
AttributeName -> m GraphRefRelationalExpr
relVarByName AttributeName
relVarName
  let optExpr :: GraphRefRelationalExpr
optExpr = GraphRefRelationalExpr -> GraphRefRelationalExpr
applyRestrictionCollapse (RestrictionPredicateExprBase GraphRefTransactionMarker
-> GraphRefRelationalExpr -> GraphRefRelationalExpr
forall a.
RestrictionPredicateExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Restrict (RestrictionPredicateExprBase GraphRefTransactionMarker
-> RestrictionPredicateExprBase GraphRefTransactionMarker
forall a.
RestrictionPredicateExprBase a -> RestrictionPredicateExprBase a
NotPredicate RestrictionPredicateExprBase GraphRefTransactionMarker
predicate) GraphRefRelationalExpr
gfExpr)
  AttributeName
-> GraphRefRelationalExpr -> DatabaseContextEvalMonad ()
setRelVar AttributeName
relVarName GraphRefRelationalExpr
optExpr
  
--union of restricted+updated portion and the unrestricted+unupdated portion
evalGraphRefDatabaseContextExpr (Update AttributeName
relVarName AttributeNameAtomExprMap
atomExprMap RestrictionPredicateExprBase GraphRefTransactionMarker
pred') = do
  GraphRefRelationalExpr
rvExpr <- AttributeName -> DatabaseContextEvalMonad GraphRefRelationalExpr
forall (m :: * -> *).
DatabaseContextM m =>
AttributeName -> m GraphRefRelationalExpr
relVarByName AttributeName
relVarName
  TransactionGraph
graph <- RelationalExprEnv -> TransactionGraph
re_graph (RelationalExprEnv -> TransactionGraph)
-> DatabaseContextEvalMonad RelationalExprEnv
-> DatabaseContextEvalMonad TransactionGraph
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DatabaseContextEvalMonad RelationalExprEnv
dbcRelationalExprEnv  
  DatabaseContext
context <- RWST
  DatabaseContextEvalEnv
  ()
  DatabaseContextEvalState
  (ExceptT RelationalError Identity)
  DatabaseContext
getStateContext
  let reEnv :: GraphRefRelationalExprEnv
reEnv = Maybe DatabaseContext
-> TransactionGraph -> GraphRefRelationalExprEnv
freshGraphRefRelationalExprEnv (DatabaseContext -> Maybe DatabaseContext
forall a. a -> Maybe a
Just DatabaseContext
context) TransactionGraph
graph
  --get the current attributes name in the relvar to ensure that we don't conflict when renaming
      eExprType :: Either RelationalError Relation
eExprType = GraphRefRelationalExprEnv
-> GraphRefRelationalExprM Relation
-> Either RelationalError Relation
forall a.
GraphRefRelationalExprEnv
-> GraphRefRelationalExprM a -> Either RelationalError a
runGraphRefRelationalExprM GraphRefRelationalExprEnv
reEnv (GraphRefRelationalExpr -> GraphRefRelationalExprM Relation
typeForGraphRefRelationalExpr GraphRefRelationalExpr
rvExpr)
  Relation
exprType' <- case Either RelationalError Relation
eExprType of
    Left RelationalError
err -> RelationalError
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     Relation
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError RelationalError
err
    Right Relation
t -> Relation
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     Relation
forall (f :: * -> *) a. Applicative f => a -> f a
pure Relation
t
  let unrestrictedPortion :: GraphRefRelationalExpr
unrestrictedPortion = RestrictionPredicateExprBase GraphRefTransactionMarker
-> GraphRefRelationalExpr -> GraphRefRelationalExpr
forall a.
RestrictionPredicateExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Restrict (RestrictionPredicateExprBase GraphRefTransactionMarker
-> RestrictionPredicateExprBase GraphRefTransactionMarker
forall a.
RestrictionPredicateExprBase a -> RestrictionPredicateExprBase a
NotPredicate RestrictionPredicateExprBase GraphRefTransactionMarker
pred') GraphRefRelationalExpr
rvExpr
      tmpAttr :: AttributeName -> AttributeName
tmpAttr = Int -> AttributeName -> AttributeName
tmpAttrC Int
1
      tmpAttrC :: Int -> AttributeName -> AttributeName
      tmpAttrC :: Int -> AttributeName -> AttributeName
tmpAttrC Int
c AttributeName
attr =
        let tmpAttrName :: AttributeName
tmpAttrName = AttributeName
"_tmp_" AttributeName -> AttributeName -> AttributeName
forall a. Semigroup a => a -> a -> a
<> [Char] -> AttributeName
T.pack (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
c) AttributeName -> AttributeName -> AttributeName
forall a. Semigroup a => a -> a -> a
<> AttributeName
attr in
          if AttributeName
tmpAttrName AttributeName -> Set AttributeName -> DirtyFlag
forall a. Ord a => a -> Set a -> DirtyFlag
`S.member` Attributes -> Set AttributeName
A.attributeNameSet (Relation -> Attributes
attributes Relation
exprType') then
            Int -> AttributeName -> AttributeName
tmpAttrC (Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) AttributeName
attr
          else 
            AttributeName
tmpAttrName
      updateAttr :: AttributeName
-> AtomExprBase a -> RelationalExprBase a -> RelationalExprBase a
updateAttr AttributeName
nam AtomExprBase a
atomExpr = ExtendTupleExprBase a
-> RelationalExprBase a -> RelationalExprBase a
forall a.
ExtendTupleExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Extend (AttributeName -> AtomExprBase a -> ExtendTupleExprBase a
forall a. AttributeName -> AtomExprBase a -> ExtendTupleExprBase a
AttributeExtendTupleExpr (AttributeName -> AttributeName
tmpAttr AttributeName
nam) AtomExprBase a
atomExpr)
      projectAndRename :: AttributeName -> RelationalExprBase a -> RelationalExprBase a
projectAndRename AttributeName
attr RelationalExprBase a
expr = AttributeName
-> AttributeName -> RelationalExprBase a -> RelationalExprBase a
forall a.
AttributeName
-> AttributeName -> RelationalExprBase a -> RelationalExprBase a
Rename (AttributeName -> AttributeName
tmpAttr AttributeName
attr) AttributeName
attr (AttributeNamesBase a
-> RelationalExprBase a -> RelationalExprBase a
forall a.
AttributeNamesBase a
-> RelationalExprBase a -> RelationalExprBase a
Project (Set AttributeName -> AttributeNamesBase a
forall a. Set AttributeName -> AttributeNamesBase a
InvertedAttributeNames (AttributeName -> Set AttributeName
forall a. a -> Set a
S.singleton AttributeName
attr)) RelationalExprBase a
expr)
      restrictedPortion :: GraphRefRelationalExpr
restrictedPortion = RestrictionPredicateExprBase GraphRefTransactionMarker
-> GraphRefRelationalExpr -> GraphRefRelationalExpr
forall a.
RestrictionPredicateExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Restrict RestrictionPredicateExprBase GraphRefTransactionMarker
pred' GraphRefRelationalExpr
rvExpr
      updated :: GraphRefRelationalExpr
updated = ((AttributeName, AtomExpr)
 -> GraphRefRelationalExpr -> GraphRefRelationalExpr)
-> GraphRefRelationalExpr
-> [(AttributeName, AtomExpr)]
-> GraphRefRelationalExpr
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(AttributeName
oldname, AtomExpr
atomExpr) GraphRefRelationalExpr
accum ->
                                 let procAtomExpr :: GraphRefAtomExpr
procAtomExpr = GraphRefTransactionMarker
-> ProcessExprM GraphRefAtomExpr -> GraphRefAtomExpr
forall a. GraphRefTransactionMarker -> ProcessExprM a -> a
runProcessExprM GraphRefTransactionMarker
UncommittedContextMarker (AtomExpr -> ProcessExprM GraphRefAtomExpr
processAtomExpr AtomExpr
atomExpr) in
                                  AttributeName
-> GraphRefAtomExpr
-> GraphRefRelationalExpr
-> GraphRefRelationalExpr
forall a.
AttributeName
-> AtomExprBase a -> RelationalExprBase a -> RelationalExprBase a
updateAttr AttributeName
oldname GraphRefAtomExpr
procAtomExpr GraphRefRelationalExpr
accum
                              ) GraphRefRelationalExpr
restrictedPortion (AttributeNameAtomExprMap -> [(AttributeName, AtomExpr)]
forall k a. Map k a -> [(k, a)]
M.toList AttributeNameAtomExprMap
atomExprMap)
              -- the atomExprMap could reference other attributes, so we must perform multi-pass folds
      updatedPortion :: GraphRefRelationalExpr
updatedPortion = (AttributeName -> GraphRefRelationalExpr -> GraphRefRelationalExpr)
-> GraphRefRelationalExpr
-> [AttributeName]
-> GraphRefRelationalExpr
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr AttributeName -> GraphRefRelationalExpr -> GraphRefRelationalExpr
forall a.
AttributeName -> RelationalExprBase a -> RelationalExprBase a
projectAndRename GraphRefRelationalExpr
updated (AttributeNameAtomExprMap -> [AttributeName]
forall k a. Map k a -> [k]
M.keys AttributeNameAtomExprMap
atomExprMap)
  AttributeName
-> GraphRefRelationalExpr -> DatabaseContextEvalMonad ()
setRelVar AttributeName
relVarName (GraphRefRelationalExpr
-> GraphRefRelationalExpr -> GraphRefRelationalExpr
forall a.
RelationalExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Union GraphRefRelationalExpr
unrestrictedPortion GraphRefRelationalExpr
updatedPortion)

evalGraphRefDatabaseContextExpr (AddInclusionDependency AttributeName
newDepName InclusionDependency
newDep) = do
  DatabaseContext
currContext <- RWST
  DatabaseContextEvalEnv
  ()
  DatabaseContextEvalState
  (ExceptT RelationalError Identity)
  DatabaseContext
getStateContext
  TransactionId
transId <- DatabaseContextEvalMonad TransactionId
dbcTransId
  TransactionGraph
graph <- DatabaseContextEvalMonad TransactionGraph
dbcGraph
  let currDeps :: InclusionDependencies
currDeps = DatabaseContext -> InclusionDependencies
inclusionDependencies DatabaseContext
currContext
      newDeps :: InclusionDependencies
newDeps = AttributeName
-> InclusionDependency
-> InclusionDependencies
-> InclusionDependencies
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert AttributeName
newDepName InclusionDependency
newDep InclusionDependencies
currDeps
  if AttributeName -> InclusionDependencies -> DirtyFlag
forall k a. Ord k => k -> Map k a -> DirtyFlag
M.member AttributeName
newDepName InclusionDependencies
currDeps then
    RelationalError -> DatabaseContextEvalMonad ()
dbErr (AttributeName -> RelationalError
InclusionDependencyNameInUseError AttributeName
newDepName)
    else do
      let potentialContext :: DatabaseContext
potentialContext = DatabaseContext
currContext { inclusionDependencies :: InclusionDependencies
inclusionDependencies = InclusionDependencies
newDeps }
      -- if the potential context passes all constraints, then save it
      -- potential optimization: validate only the new constraint- all old constraints must already hold
      case DatabaseContext
-> TransactionId -> TransactionGraph -> Either RelationalError ()
checkConstraints DatabaseContext
potentialContext TransactionId
transId TransactionGraph
graph of
        Left RelationalError
err -> RelationalError -> DatabaseContextEvalMonad ()
dbErr RelationalError
err
        Right ()
_ -> 
          DatabaseContext -> DatabaseContextEvalMonad ()
putStateContext DatabaseContext
potentialContext

evalGraphRefDatabaseContextExpr (RemoveInclusionDependency AttributeName
depName) = do
  DatabaseContext
currContext <- RWST
  DatabaseContextEvalEnv
  ()
  DatabaseContextEvalState
  (ExceptT RelationalError Identity)
  DatabaseContext
getStateContext
  let currDeps :: InclusionDependencies
currDeps = DatabaseContext -> InclusionDependencies
inclusionDependencies DatabaseContext
currContext
      newDeps :: InclusionDependencies
newDeps = AttributeName -> InclusionDependencies -> InclusionDependencies
forall k a. Ord k => k -> Map k a -> Map k a
M.delete AttributeName
depName InclusionDependencies
currDeps
  if AttributeName -> InclusionDependencies -> DirtyFlag
forall k a. Ord k => k -> Map k a -> DirtyFlag
M.notMember AttributeName
depName InclusionDependencies
currDeps then
    RelationalError -> DatabaseContextEvalMonad ()
dbErr (AttributeName -> RelationalError
InclusionDependencyNameNotInUseError AttributeName
depName)
    else 
    DatabaseContext -> DatabaseContextEvalMonad ()
putStateContext (DatabaseContext -> DatabaseContextEvalMonad ())
-> DatabaseContext -> DatabaseContextEvalMonad ()
forall a b. (a -> b) -> a -> b
$ DatabaseContext
currContext {inclusionDependencies :: InclusionDependencies
inclusionDependencies = InclusionDependencies
newDeps }
    
-- | Add a notification which will send the resultExpr when triggerExpr changes between commits.
evalGraphRefDatabaseContextExpr (AddNotification AttributeName
notName RelationalExpr
triggerExpr RelationalExpr
resultOldExpr RelationalExpr
resultNewExpr) = do
  DatabaseContext
currentContext <- RWST
  DatabaseContextEvalEnv
  ()
  DatabaseContextEvalState
  (ExceptT RelationalError Identity)
  DatabaseContext
getStateContext
  let nots :: Notifications
nots = DatabaseContext -> Notifications
notifications DatabaseContext
currentContext
  if AttributeName -> Notifications -> DirtyFlag
forall k a. Ord k => k -> Map k a -> DirtyFlag
M.member AttributeName
notName Notifications
nots then
    RelationalError -> DatabaseContextEvalMonad ()
dbErr (AttributeName -> RelationalError
NotificationNameInUseError AttributeName
notName)
    else do
      let newNotifications :: Notifications
newNotifications = AttributeName -> Notification -> Notifications -> Notifications
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert AttributeName
notName Notification
newNotification Notifications
nots
          newNotification :: Notification
newNotification = Notification :: RelationalExpr -> RelationalExpr -> RelationalExpr -> Notification
Notification { changeExpr :: RelationalExpr
changeExpr = RelationalExpr
triggerExpr,
                                           reportOldExpr :: RelationalExpr
reportOldExpr = RelationalExpr
resultOldExpr, 
                                           reportNewExpr :: RelationalExpr
reportNewExpr = RelationalExpr
resultNewExpr}
      DatabaseContext -> DatabaseContextEvalMonad ()
putStateContext (DatabaseContext -> DatabaseContextEvalMonad ())
-> DatabaseContext -> DatabaseContextEvalMonad ()
forall a b. (a -> b) -> a -> b
$ DatabaseContext
currentContext { notifications :: Notifications
notifications = Notifications
newNotifications }
  
evalGraphRefDatabaseContextExpr (RemoveNotification AttributeName
notName) = do
  DatabaseContext
currentContext <- RWST
  DatabaseContextEvalEnv
  ()
  DatabaseContextEvalState
  (ExceptT RelationalError Identity)
  DatabaseContext
getStateContext
  let nots :: Notifications
nots = DatabaseContext -> Notifications
notifications DatabaseContext
currentContext
  if AttributeName -> Notifications -> DirtyFlag
forall k a. Ord k => k -> Map k a -> DirtyFlag
M.notMember AttributeName
notName Notifications
nots then
    RelationalError -> DatabaseContextEvalMonad ()
dbErr (AttributeName -> RelationalError
NotificationNameNotInUseError AttributeName
notName)
    else do
    let newNotifications :: Notifications
newNotifications = AttributeName -> Notifications -> Notifications
forall k a. Ord k => k -> Map k a -> Map k a
M.delete AttributeName
notName Notifications
nots
    DatabaseContext -> DatabaseContextEvalMonad ()
putStateContext (DatabaseContext -> DatabaseContextEvalMonad ())
-> DatabaseContext -> DatabaseContextEvalMonad ()
forall a b. (a -> b) -> a -> b
$ DatabaseContext
currentContext { notifications :: Notifications
notifications = Notifications
newNotifications }


-- | Adds type and data constructors to the database context.
-- validate that the type *and* constructor names are unique! not yet implemented!
evalGraphRefDatabaseContextExpr (AddTypeConstructor TypeConstructorDef
tConsDef [DataConstructorDef]
dConsDefList) = do
  DatabaseContext
currentContext <- RWST
  DatabaseContextEvalEnv
  ()
  DatabaseContextEvalState
  (ExceptT RelationalError Identity)
  DatabaseContext
getStateContext
  let oldTypes :: TypeConstructorMapping
oldTypes = DatabaseContext -> TypeConstructorMapping
typeConstructorMapping DatabaseContext
currentContext
      tConsName :: AttributeName
tConsName = TypeConstructorDef -> AttributeName
TCD.name TypeConstructorDef
tConsDef
  -- validate that the constructor's types exist
  case TypeConstructorDef
-> [DataConstructorDef]
-> TypeConstructorMapping
-> Either RelationalError ()
validateTypeConstructorDef TypeConstructorDef
tConsDef [DataConstructorDef]
dConsDefList TypeConstructorMapping
oldTypes of
    Left RelationalError
err -> RelationalError -> DatabaseContextEvalMonad ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError RelationalError
err
    Right () | AttributeName -> DirtyFlag
T.null AttributeName
tConsName DirtyFlag -> DirtyFlag -> DirtyFlag
|| DirtyFlag -> DirtyFlag
not (Char -> DirtyFlag
isUpper (AttributeName -> Char
T.head AttributeName
tConsName)) -> RelationalError -> DatabaseContextEvalMonad ()
dbErr (AttributeName -> RelationalError
InvalidAtomTypeName AttributeName
tConsName)
       | Maybe (TypeConstructorDef, [DataConstructorDef]) -> DirtyFlag
forall a. Maybe a -> DirtyFlag
isJust (AttributeName
-> TypeConstructorMapping
-> Maybe (TypeConstructorDef, [DataConstructorDef])
findTypeConstructor AttributeName
tConsName TypeConstructorMapping
oldTypes) -> RelationalError -> DatabaseContextEvalMonad ()
dbErr (AttributeName -> RelationalError
AtomTypeNameInUseError AttributeName
tConsName)
       | DirtyFlag
otherwise -> do
      let newTypes :: TypeConstructorMapping
newTypes = TypeConstructorMapping
oldTypes TypeConstructorMapping
-> TypeConstructorMapping -> TypeConstructorMapping
forall a. [a] -> [a] -> [a]
++ [(TypeConstructorDef
tConsDef, [DataConstructorDef]
dConsDefList)]
      DatabaseContext -> DatabaseContextEvalMonad ()
putStateContext (DatabaseContext -> DatabaseContextEvalMonad ())
-> DatabaseContext -> DatabaseContextEvalMonad ()
forall a b. (a -> b) -> a -> b
$ DatabaseContext
currentContext { typeConstructorMapping :: TypeConstructorMapping
typeConstructorMapping = TypeConstructorMapping
newTypes }

-- | Removing the atom constructor prevents new atoms of the type from being created. Existing atoms of the type remain. Thus, the atomTypes list in the DatabaseContext need not be all-inclusive.
evalGraphRefDatabaseContextExpr (RemoveTypeConstructor AttributeName
tConsName) = do
  DatabaseContext
currentContext <- RWST
  DatabaseContextEvalEnv
  ()
  DatabaseContextEvalState
  (ExceptT RelationalError Identity)
  DatabaseContext
getStateContext
  let oldTypes :: TypeConstructorMapping
oldTypes = DatabaseContext -> TypeConstructorMapping
typeConstructorMapping DatabaseContext
currentContext
  if Maybe (TypeConstructorDef, [DataConstructorDef]) -> DirtyFlag
forall a. Maybe a -> DirtyFlag
isNothing (AttributeName
-> TypeConstructorMapping
-> Maybe (TypeConstructorDef, [DataConstructorDef])
findTypeConstructor AttributeName
tConsName TypeConstructorMapping
oldTypes) then
    RelationalError -> DatabaseContextEvalMonad ()
dbErr (AttributeName -> RelationalError
AtomTypeNameNotInUseError AttributeName
tConsName)
    else do
      let newTypes :: TypeConstructorMapping
newTypes = ((TypeConstructorDef, [DataConstructorDef]) -> DirtyFlag)
-> TypeConstructorMapping -> TypeConstructorMapping
forall a. (a -> DirtyFlag) -> [a] -> [a]
filter (\(TypeConstructorDef
tCons, [DataConstructorDef]
_) -> TypeConstructorDef -> AttributeName
TCD.name TypeConstructorDef
tCons AttributeName -> AttributeName -> DirtyFlag
forall a. Eq a => a -> a -> DirtyFlag
/= AttributeName
tConsName) TypeConstructorMapping
oldTypes
      DatabaseContext -> DatabaseContextEvalMonad ()
putStateContext (DatabaseContext -> DatabaseContextEvalMonad ())
-> DatabaseContext -> DatabaseContextEvalMonad ()
forall a b. (a -> b) -> a -> b
$ DatabaseContext
currentContext { typeConstructorMapping :: TypeConstructorMapping
typeConstructorMapping = TypeConstructorMapping
newTypes }

evalGraphRefDatabaseContextExpr (MultipleExpr [GraphRefDatabaseContextExpr]
exprs) =
  --the multiple expressions must pass the same context around- not the old unmodified context
  (GraphRefDatabaseContextExpr -> DatabaseContextEvalMonad ())
-> [GraphRefDatabaseContextExpr] -> DatabaseContextEvalMonad ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ GraphRefDatabaseContextExpr -> DatabaseContextEvalMonad ()
evalGraphRefDatabaseContextExpr [GraphRefDatabaseContextExpr]
exprs

evalGraphRefDatabaseContextExpr (RemoveAtomFunction AttributeName
funcName') = do
  DatabaseContext
currentContext <- RWST
  DatabaseContextEvalEnv
  ()
  DatabaseContextEvalState
  (ExceptT RelationalError Identity)
  DatabaseContext
getStateContext
  let atomFuncs :: AtomFunctions
atomFuncs = DatabaseContext -> AtomFunctions
atomFunctions DatabaseContext
currentContext
  case AttributeName
-> AtomFunctions -> Either RelationalError AtomFunction
atomFunctionForName AttributeName
funcName' AtomFunctions
atomFuncs of
    Left RelationalError
err -> RelationalError -> DatabaseContextEvalMonad ()
dbErr RelationalError
err
    Right AtomFunction
realFunc ->
      if AtomFunction -> DirtyFlag
isScriptedAtomFunction AtomFunction
realFunc then do
        let updatedFuncs :: AtomFunctions
updatedFuncs = AtomFunction -> AtomFunctions -> AtomFunctions
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HS.delete AtomFunction
realFunc AtomFunctions
atomFuncs
        DatabaseContext -> DatabaseContextEvalMonad ()
putStateContext (DatabaseContext
currentContext {atomFunctions :: AtomFunctions
atomFunctions = AtomFunctions
updatedFuncs })
      else
        RelationalError -> DatabaseContextEvalMonad ()
dbErr (AttributeName -> RelationalError
PrecompiledFunctionRemoveError AttributeName
funcName')
      
evalGraphRefDatabaseContextExpr (RemoveDatabaseContextFunction AttributeName
funcName') = do      
  DatabaseContext
context <- RWST
  DatabaseContextEvalEnv
  ()
  DatabaseContextEvalState
  (ExceptT RelationalError Identity)
  DatabaseContext
getStateContext
  let dbcFuncs :: DatabaseContextFunctions
dbcFuncs = DatabaseContext -> DatabaseContextFunctions
dbcFunctions DatabaseContext
context
  case AttributeName
-> DatabaseContextFunctions
-> Either RelationalError DatabaseContextFunction
databaseContextFunctionForName AttributeName
funcName' DatabaseContextFunctions
dbcFuncs of
    Left RelationalError
err -> RelationalError -> DatabaseContextEvalMonad ()
dbErr RelationalError
err
    Right DatabaseContextFunction
realFunc ->
      if DatabaseContextFunction -> DirtyFlag
isScriptedDatabaseContextFunction DatabaseContextFunction
realFunc then do
        let updatedFuncs :: DatabaseContextFunctions
updatedFuncs = DatabaseContextFunction
-> DatabaseContextFunctions -> DatabaseContextFunctions
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HS.delete DatabaseContextFunction
realFunc DatabaseContextFunctions
dbcFuncs
        DatabaseContext -> DatabaseContextEvalMonad ()
putStateContext (DatabaseContext
context { dbcFunctions :: DatabaseContextFunctions
dbcFunctions = DatabaseContextFunctions
updatedFuncs })
      else
        RelationalError -> DatabaseContextEvalMonad ()
dbErr (AttributeName -> RelationalError
PrecompiledFunctionRemoveError AttributeName
funcName')
      
evalGraphRefDatabaseContextExpr (ExecuteDatabaseContextFunction AttributeName
funcName' [GraphRefAtomExpr]
atomArgExprs) = do
  DatabaseContext
context <- RWST
  DatabaseContextEvalEnv
  ()
  DatabaseContextEvalState
  (ExceptT RelationalError Identity)
  DatabaseContext
getStateContext
  TransactionGraph
graph <- DatabaseContextEvalMonad TransactionGraph
dbcGraph
  --resolve atom arguments
  let eAtomTypes :: Either RelationalError [AtomType]
eAtomTypes = (GraphRefAtomExpr -> Either RelationalError AtomType)
-> [GraphRefAtomExpr] -> Either RelationalError [AtomType]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (GraphRefRelationalExprEnv
-> GraphRefRelationalExprM AtomType
-> Either RelationalError AtomType
forall a.
GraphRefRelationalExprEnv
-> GraphRefRelationalExprM a -> Either RelationalError a
runGraphRefRelationalExprM GraphRefRelationalExprEnv
gfEnv (GraphRefRelationalExprM AtomType
 -> Either RelationalError AtomType)
-> (GraphRefAtomExpr -> GraphRefRelationalExprM AtomType)
-> GraphRefAtomExpr
-> Either RelationalError AtomType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attributes -> GraphRefAtomExpr -> GraphRefRelationalExprM AtomType
typeForGraphRefAtomExpr Attributes
emptyAttributes) [GraphRefAtomExpr]
atomArgExprs
      eFunc :: Either RelationalError DatabaseContextFunction
eFunc = AttributeName
-> DatabaseContextFunctions
-> Either RelationalError DatabaseContextFunction
databaseContextFunctionForName AttributeName
funcName' (DatabaseContext -> DatabaseContextFunctions
dbcFunctions DatabaseContext
context)
      gfEnv :: GraphRefRelationalExprEnv
gfEnv = Maybe DatabaseContext
-> TransactionGraph -> GraphRefRelationalExprEnv
freshGraphRefRelationalExprEnv (DatabaseContext -> Maybe DatabaseContext
forall a. a -> Maybe a
Just DatabaseContext
context) TransactionGraph
graph
  case Either RelationalError DatabaseContextFunction
eFunc of
      Left RelationalError
err -> RelationalError -> DatabaseContextEvalMonad ()
dbErr RelationalError
err
      Right DatabaseContextFunction
func -> do
        let expectedArgCount :: Int
expectedArgCount = [AtomType] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (DatabaseContextFunction -> [AtomType]
forall a. Function a -> [AtomType]
funcType DatabaseContextFunction
func)
            actualArgCount :: Int
actualArgCount = [GraphRefAtomExpr] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [GraphRefAtomExpr]
atomArgExprs
        if Int
expectedArgCount Int -> Int -> DirtyFlag
forall a. Eq a => a -> a -> DirtyFlag
/= Int
actualArgCount then
          RelationalError -> DatabaseContextEvalMonad ()
dbErr (Int -> Int -> RelationalError
FunctionArgumentCountMismatchError Int
expectedArgCount Int
actualArgCount)
          else 
          --check that the atom types are valid
          case Either RelationalError [AtomType]
eAtomTypes of
            Left RelationalError
err -> RelationalError -> DatabaseContextEvalMonad ()
dbErr RelationalError
err
            Right [AtomType]
atomTypes -> do
              let mValidTypes :: [Maybe RelationalError]
mValidTypes = (AtomType -> AtomType -> Maybe RelationalError)
-> [AtomType] -> [AtomType] -> [Maybe RelationalError]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\ AtomType
expType AtomType
actType
                                           -> case AtomType -> AtomType -> Either RelationalError AtomType
atomTypeVerify AtomType
expType AtomType
actType of
                                                Left RelationalError
err -> RelationalError -> Maybe RelationalError
forall a. a -> Maybe a
Just RelationalError
err
                                                Right AtomType
_ -> Maybe RelationalError
forall a. Maybe a
Nothing)
                                (DatabaseContextFunction -> [AtomType]
forall a. Function a -> [AtomType]
funcType DatabaseContextFunction
func) [AtomType]
atomTypes
                  typeErrors :: [RelationalError]
typeErrors = [Maybe RelationalError] -> [RelationalError]
forall a. [Maybe a] -> [a]
catMaybes [Maybe RelationalError]
mValidTypes
                  eAtomArgs :: [Either RelationalError Atom]
eAtomArgs = (GraphRefAtomExpr -> Either RelationalError Atom)
-> [GraphRefAtomExpr] -> [Either RelationalError Atom]
forall a b. (a -> b) -> [a] -> [b]
map (GraphRefRelationalExprEnv
-> GraphRefRelationalExprM Atom -> Either RelationalError Atom
forall a.
GraphRefRelationalExprEnv
-> GraphRefRelationalExprM a -> Either RelationalError a
runGraphRefRelationalExprM GraphRefRelationalExprEnv
gfEnv (GraphRefRelationalExprM Atom -> Either RelationalError Atom)
-> (GraphRefAtomExpr -> GraphRefRelationalExprM Atom)
-> GraphRefAtomExpr
-> Either RelationalError Atom
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelationTuple -> GraphRefAtomExpr -> GraphRefRelationalExprM Atom
evalGraphRefAtomExpr RelationTuple
emptyTuple) [GraphRefAtomExpr]
atomArgExprs
              if [RelationalError] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Either RelationalError Atom] -> [RelationalError]
forall a b. [Either a b] -> [a]
lefts [Either RelationalError Atom]
eAtomArgs) Int -> Int -> DirtyFlag
forall a. Ord a => a -> a -> DirtyFlag
> Int
1 then
                RelationalError -> DatabaseContextEvalMonad ()
dbErr ([RelationalError] -> RelationalError
someErrors ([Either RelationalError Atom] -> [RelationalError]
forall a b. [Either a b] -> [a]
lefts [Either RelationalError Atom]
eAtomArgs))
                else if DirtyFlag -> DirtyFlag
not ([RelationalError] -> DirtyFlag
forall (t :: * -> *) a. Foldable t => t a -> DirtyFlag
null [RelationalError]
typeErrors) then
                     RelationalError -> DatabaseContextEvalMonad ()
dbErr ([RelationalError] -> RelationalError
someErrors [RelationalError]
typeErrors)
                   else
                     case DatabaseContextFunction
-> [Atom]
-> DatabaseContext
-> Either RelationalError DatabaseContext
evalDatabaseContextFunction DatabaseContextFunction
func ([Either RelationalError Atom] -> [Atom]
forall a b. [Either a b] -> [b]
rights [Either RelationalError Atom]
eAtomArgs) DatabaseContext
context of
                       Left RelationalError
err -> RelationalError -> DatabaseContextEvalMonad ()
dbErr RelationalError
err
                       Right DatabaseContext
newContext -> DatabaseContext -> DatabaseContextEvalMonad ()
putStateContext DatabaseContext
newContext

evalGraphRefDatabaseContextExpr (AddRegisteredQuery AttributeName
regName RelationalExpr
regExpr) = do
  DatabaseContext
context <- RWST
  DatabaseContextEvalEnv
  ()
  DatabaseContextEvalState
  (ExceptT RelationalError Identity)
  DatabaseContext
getStateContext
  TransactionGraph
tgraph <- DatabaseContextEvalMonad TransactionGraph
dbcGraph
  TransactionId
tid <- DatabaseContextEvalMonad TransactionId
dbcTransId
  case AttributeName
-> Map AttributeName RelationalExpr -> Maybe RelationalExpr
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup AttributeName
regName (DatabaseContext -> Map AttributeName RelationalExpr
registeredQueries DatabaseContext
context) of
    Just RelationalExpr
_ -> RelationalError -> DatabaseContextEvalMonad ()
dbErr (AttributeName -> RelationalError
RegisteredQueryNameInUseError AttributeName
regName)
    Maybe RelationalExpr
Nothing -> do
      let context' :: DatabaseContext
context' = DatabaseContext
context { registeredQueries :: Map AttributeName RelationalExpr
registeredQueries = AttributeName
-> RelationalExpr
-> Map AttributeName RelationalExpr
-> Map AttributeName RelationalExpr
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert AttributeName
regName RelationalExpr
regExpr (DatabaseContext -> Map AttributeName RelationalExpr
registeredQueries DatabaseContext
context) }
      case DatabaseContext
-> TransactionId -> TransactionGraph -> Either RelationalError ()
checkConstraints DatabaseContext
context' TransactionId
tid TransactionGraph
tgraph of
        Left RelationalError
err -> RelationalError -> DatabaseContextEvalMonad ()
dbErr RelationalError
err
        Right ()
_ -> DatabaseContext -> DatabaseContextEvalMonad ()
putStateContext DatabaseContext
context'
evalGraphRefDatabaseContextExpr (RemoveRegisteredQuery AttributeName
regName) = do
  DatabaseContext
context <- RWST
  DatabaseContextEvalEnv
  ()
  DatabaseContextEvalState
  (ExceptT RelationalError Identity)
  DatabaseContext
getStateContext  
  case AttributeName
-> Map AttributeName RelationalExpr -> Maybe RelationalExpr
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup AttributeName
regName (DatabaseContext -> Map AttributeName RelationalExpr
registeredQueries DatabaseContext
context) of
    Maybe RelationalExpr
Nothing -> RelationalError -> DatabaseContextEvalMonad ()
dbErr (AttributeName -> RelationalError
RegisteredQueryNameNotInUseError AttributeName
regName)
    Just RelationalExpr
_ -> DatabaseContext -> DatabaseContextEvalMonad ()
putStateContext (DatabaseContext
context { registeredQueries :: Map AttributeName RelationalExpr
registeredQueries = AttributeName
-> Map AttributeName RelationalExpr
-> Map AttributeName RelationalExpr
forall k a. Ord k => k -> Map k a -> Map k a
M.delete AttributeName
regName (DatabaseContext -> Map AttributeName RelationalExpr
registeredQueries DatabaseContext
context) })
  

data DatabaseContextIOEvalEnv = DatabaseContextIOEvalEnv
  { DatabaseContextIOEvalEnv -> TransactionId
dbcio_transId :: TransactionId,
    DatabaseContextIOEvalEnv -> TransactionGraph
dbcio_graph :: TransactionGraph,
    DatabaseContextIOEvalEnv -> Maybe ScriptSession
dbcio_mScriptSession :: Maybe ScriptSession,
    DatabaseContextIOEvalEnv -> Maybe [Char]
dbcio_mModulesDirectory :: Maybe FilePath -- ^ when running in persistent mode, this must be a Just value to a directory containing .o/.so/.dynlib files which the user has placed there for access to compiled functions
  }

type DatabaseContextIOEvalMonad a = RWST DatabaseContextIOEvalEnv () DatabaseContextEvalState IO a

runDatabaseContextIOEvalMonad :: DatabaseContextIOEvalEnv -> DatabaseContext -> DatabaseContextIOEvalMonad (Either RelationalError ()) -> IO (Either RelationalError DatabaseContextEvalState)
runDatabaseContextIOEvalMonad :: DatabaseContextIOEvalEnv
-> DatabaseContext
-> DatabaseContextIOEvalMonad (Either RelationalError ())
-> IO (Either RelationalError DatabaseContextEvalState)
runDatabaseContextIOEvalMonad DatabaseContextIOEvalEnv
env DatabaseContext
ctx DatabaseContextIOEvalMonad (Either RelationalError ())
m = do
  (Either RelationalError (), DatabaseContextEvalState, ())
res <- DatabaseContextIOEvalMonad (Either RelationalError ())
-> DatabaseContextIOEvalEnv
-> DatabaseContextEvalState
-> IO (Either RelationalError (), DatabaseContextEvalState, ())
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
runRWST DatabaseContextIOEvalMonad (Either RelationalError ())
m DatabaseContextIOEvalEnv
env DatabaseContextEvalState
freshState
  case (Either RelationalError (), DatabaseContextEvalState, ())
res of
    (Left RelationalError
err,DatabaseContextEvalState
_,()
_) -> Either RelationalError DatabaseContextEvalState
-> IO (Either RelationalError DatabaseContextEvalState)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError -> Either RelationalError DatabaseContextEvalState
forall a b. a -> Either a b
Left RelationalError
err)
    (Right (),DatabaseContextEvalState
s,()
_) -> Either RelationalError DatabaseContextEvalState
-> IO (Either RelationalError DatabaseContextEvalState)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DatabaseContextEvalState
-> Either RelationalError DatabaseContextEvalState
forall a b. b -> Either a b
Right DatabaseContextEvalState
s)
  where
    freshState :: DatabaseContextEvalState
freshState = DatabaseContext -> DatabaseContextEvalState
mkDatabaseContextEvalState DatabaseContext
ctx

requireScriptSession :: DatabaseContextIOEvalMonad (Either RelationalError ScriptSession)
requireScriptSession :: DatabaseContextIOEvalMonad (Either RelationalError ScriptSession)
requireScriptSession = do
  DatabaseContextIOEvalEnv
env <- RWST
  DatabaseContextIOEvalEnv
  ()
  DatabaseContextEvalState
  IO
  DatabaseContextIOEvalEnv
forall r (m :: * -> *). MonadReader r m => m r
RWS.ask
  case DatabaseContextIOEvalEnv -> Maybe ScriptSession
dbcio_mScriptSession DatabaseContextIOEvalEnv
env of
    Maybe ScriptSession
Nothing -> Either RelationalError ScriptSession
-> DatabaseContextIOEvalMonad
     (Either RelationalError ScriptSession)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RelationalError ScriptSession
 -> DatabaseContextIOEvalMonad
      (Either RelationalError ScriptSession))
-> Either RelationalError ScriptSession
-> DatabaseContextIOEvalMonad
     (Either RelationalError ScriptSession)
forall a b. (a -> b) -> a -> b
$ RelationalError -> Either RelationalError ScriptSession
forall a b. a -> Either a b
Left (RelationalError -> Either RelationalError ScriptSession)
-> RelationalError -> Either RelationalError ScriptSession
forall a b. (a -> b) -> a -> b
$ ScriptCompilationError -> RelationalError
ScriptError ScriptCompilationError
ScriptCompilationDisabledError
    Just ScriptSession
ss -> Either RelationalError ScriptSession
-> DatabaseContextIOEvalMonad
     (Either RelationalError ScriptSession)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ScriptSession -> Either RelationalError ScriptSession
forall a b. b -> Either a b
Right ScriptSession
ss)

putDBCIOContext :: DatabaseContext -> DatabaseContextIOEvalMonad (Either RelationalError ())
putDBCIOContext :: DatabaseContext
-> DatabaseContextIOEvalMonad (Either RelationalError ())
putDBCIOContext DatabaseContext
ctx = do
  (DatabaseContextEvalState -> DatabaseContextEvalState)
-> RWST DatabaseContextIOEvalEnv () DatabaseContextEvalState IO ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
RWS.modify (\DatabaseContextEvalState
dbstate -> DatabaseContextEvalState
dbstate { dbc_context :: DatabaseContext
dbc_context = DatabaseContext
ctx})
  Either RelationalError ()
-> DatabaseContextIOEvalMonad (Either RelationalError ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> Either RelationalError ()
forall a b. b -> Either a b
Right ())

getDBCIOContext :: DatabaseContextIOEvalMonad DatabaseContext
getDBCIOContext :: DatabaseContextIOEvalMonad DatabaseContext
getDBCIOContext = DatabaseContextEvalState -> DatabaseContext
dbc_context (DatabaseContextEvalState -> DatabaseContext)
-> RWST
     DatabaseContextIOEvalEnv
     ()
     DatabaseContextEvalState
     IO
     DatabaseContextEvalState
-> DatabaseContextIOEvalMonad DatabaseContext
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST
  DatabaseContextIOEvalEnv
  ()
  DatabaseContextEvalState
  IO
  DatabaseContextEvalState
forall s (m :: * -> *). MonadState s m => m s
RWS.get

getDBCIORelationalExprEnv :: DatabaseContextIOEvalMonad RelationalExprEnv
getDBCIORelationalExprEnv :: DatabaseContextIOEvalMonad RelationalExprEnv
getDBCIORelationalExprEnv = do
  DatabaseContext
context <- DatabaseContextIOEvalMonad DatabaseContext
getDBCIOContext
  DatabaseContext -> TransactionGraph -> RelationalExprEnv
mkRelationalExprEnv DatabaseContext
context (TransactionGraph -> RelationalExprEnv)
-> (DatabaseContextIOEvalEnv -> TransactionGraph)
-> DatabaseContextIOEvalEnv
-> RelationalExprEnv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DatabaseContextIOEvalEnv -> TransactionGraph
dbcio_graph (DatabaseContextIOEvalEnv -> RelationalExprEnv)
-> RWST
     DatabaseContextIOEvalEnv
     ()
     DatabaseContextEvalState
     IO
     DatabaseContextIOEvalEnv
-> DatabaseContextIOEvalMonad RelationalExprEnv
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST
  DatabaseContextIOEvalEnv
  ()
  DatabaseContextEvalState
  IO
  DatabaseContextIOEvalEnv
forall r (m :: * -> *). MonadReader r m => m r
RWS.ask

evalGraphRefDatabaseContextIOExpr :: GraphRefDatabaseContextIOExpr -> DatabaseContextIOEvalMonad (Either RelationalError ())
#if !defined(PM36_HASKELL_SCRIPTING)
evalGraphRefDatabaseContextIOExpr AddAtomFunction{} = pure (Left (ScriptError ScriptCompilationDisabledError))
evalGraphRefDatabaseContextIOExpr AddDatabaseContextFunction{} = pure (Left (ScriptError ScriptCompilationDisabledError))
evalGraphRefDatabaseContextIOExpr LoadAtomFunctions{} = pure (Left (ScriptError ScriptCompilationDisabledError))
evalGraphRefDatabaseContextIOExpr LoadDatabaseContextFunctions{} = pure (Left (ScriptError ScriptCompilationDisabledError))
#else
evalGraphRefDatabaseContextIOExpr :: GraphRefDatabaseContextIOExpr
-> DatabaseContextIOEvalMonad (Either RelationalError ())
evalGraphRefDatabaseContextIOExpr (AddAtomFunction AttributeName
funcName' [TypeConstructor]
funcType' AttributeName
script) = do
  Either RelationalError ScriptSession
eScriptSession <- DatabaseContextIOEvalMonad (Either RelationalError ScriptSession)
requireScriptSession
  DatabaseContext
currentContext <- DatabaseContextIOEvalMonad DatabaseContext
getDBCIOContext
  case Either RelationalError ScriptSession
eScriptSession of
    Left RelationalError
err -> Either RelationalError ()
-> DatabaseContextIOEvalMonad (Either RelationalError ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError -> Either RelationalError ()
forall a b. a -> Either a b
Left RelationalError
err)
    Right ScriptSession
scriptSession -> do
      Either SomeException (Either RelationalError DatabaseContext)
res <- IO (Either SomeException (Either RelationalError DatabaseContext))
-> RWST
     DatabaseContextIOEvalEnv
     ()
     DatabaseContextEvalState
     IO
     (Either SomeException (Either RelationalError DatabaseContext))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either SomeException (Either RelationalError DatabaseContext))
 -> RWST
      DatabaseContextIOEvalEnv
      ()
      DatabaseContextEvalState
      IO
      (Either SomeException (Either RelationalError DatabaseContext)))
-> IO
     (Either SomeException (Either RelationalError DatabaseContext))
-> RWST
     DatabaseContextIOEvalEnv
     ()
     DatabaseContextEvalState
     IO
     (Either SomeException (Either RelationalError DatabaseContext))
forall a b. (a -> b) -> a -> b
$ IO (Either RelationalError DatabaseContext)
-> IO
     (Either SomeException (Either RelationalError DatabaseContext))
forall e a. Exception e => IO a -> IO (Either e a)
try (IO (Either RelationalError DatabaseContext)
 -> IO
      (Either SomeException (Either RelationalError DatabaseContext)))
-> IO (Either RelationalError DatabaseContext)
-> IO
     (Either SomeException (Either RelationalError DatabaseContext))
forall a b. (a -> b) -> a -> b
$ Maybe [Char]
-> Ghc (Either RelationalError DatabaseContext)
-> IO (Either RelationalError DatabaseContext)
forall a. Maybe [Char] -> Ghc a -> IO a
runGhc ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
libdir) (Ghc (Either RelationalError DatabaseContext)
 -> IO (Either RelationalError DatabaseContext))
-> Ghc (Either RelationalError DatabaseContext)
-> IO (Either RelationalError DatabaseContext)
forall a b. (a -> b) -> a -> b
$ do
        HscEnv -> Ghc ()
forall (m :: * -> *). GhcMonad m => HscEnv -> m ()
setSession (ScriptSession -> HscEnv
hscEnv ScriptSession
scriptSession)
        let atomFuncs :: AtomFunctions
atomFuncs = DatabaseContext -> AtomFunctions
atomFunctions DatabaseContext
currentContext
        case [TypeConstructor] -> Either RelationalError [TypeConstructor]
extractAtomFunctionType [TypeConstructor]
funcType' of
          Left RelationalError
err -> Either RelationalError DatabaseContext
-> Ghc (Either RelationalError DatabaseContext)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError -> Either RelationalError DatabaseContext
forall a b. a -> Either a b
Left RelationalError
err)
          Right [TypeConstructor]
adjustedAtomTypeCons -> do
            --compile the function
            Either ScriptCompilationError AtomFunctionBodyType
eCompiledFunc  <- Type
-> AttributeName
-> Ghc (Either ScriptCompilationError AtomFunctionBodyType)
forall a.
Type -> AttributeName -> Ghc (Either ScriptCompilationError a)
compileScript (ScriptSession -> Type
atomFunctionBodyType ScriptSession
scriptSession) AttributeName
script
            Either RelationalError DatabaseContext
-> Ghc (Either RelationalError DatabaseContext)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RelationalError DatabaseContext
 -> Ghc (Either RelationalError DatabaseContext))
-> Either RelationalError DatabaseContext
-> Ghc (Either RelationalError DatabaseContext)
forall a b. (a -> b) -> a -> b
$ case Either ScriptCompilationError AtomFunctionBodyType
eCompiledFunc of
              Left ScriptCompilationError
err -> RelationalError -> Either RelationalError DatabaseContext
forall a b. a -> Either a b
Left (ScriptCompilationError -> RelationalError
ScriptError ScriptCompilationError
err)
              Right AtomFunctionBodyType
compiledFunc -> do
                [AtomType]
funcAtomType <- (TypeConstructor -> Either RelationalError AtomType)
-> [TypeConstructor] -> Either RelationalError [AtomType]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\TypeConstructor
funcTypeArg -> DirtyFlag
-> TypeConstructor
-> TypeConstructorMapping
-> TypeVarMap
-> Either RelationalError AtomType
atomTypeForTypeConstructorValidate DirtyFlag
False TypeConstructor
funcTypeArg (DatabaseContext -> TypeConstructorMapping
typeConstructorMapping DatabaseContext
currentContext) TypeVarMap
forall k a. Map k a
M.empty) [TypeConstructor]
adjustedAtomTypeCons
                let updatedFuncs :: AtomFunctions
updatedFuncs = AtomFunction -> AtomFunctions -> AtomFunctions
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HS.insert AtomFunction
newAtomFunc AtomFunctions
atomFuncs
                    newContext :: DatabaseContext
newContext = DatabaseContext
currentContext { atomFunctions :: AtomFunctions
atomFunctions = AtomFunctions
updatedFuncs }
                    newAtomFunc :: AtomFunction
newAtomFunc = Function :: forall a.
AttributeName -> [AtomType] -> FunctionBody a -> Function a
Function { funcName :: AttributeName
funcName = AttributeName
funcName',
                                             funcType :: [AtomType]
funcType = [AtomType]
funcAtomType,
                                             funcBody :: FunctionBody AtomFunctionBodyType
funcBody = AttributeName
-> AtomFunctionBodyType -> FunctionBody AtomFunctionBodyType
forall a. AttributeName -> a -> FunctionBody a
FunctionScriptBody AttributeName
script AtomFunctionBodyType
compiledFunc }
               -- check if the name is already in use
                if AttributeName -> HashSet AttributeName -> DirtyFlag
forall a. (Eq a, Hashable a) => a -> HashSet a -> DirtyFlag
HS.member AttributeName
funcName' ((AtomFunction -> AttributeName)
-> AtomFunctions -> HashSet AttributeName
forall b a.
(Hashable b, Eq b) =>
(a -> b) -> HashSet a -> HashSet b
HS.map AtomFunction -> AttributeName
forall a. Function a -> AttributeName
funcName AtomFunctions
atomFuncs) then
                  RelationalError -> Either RelationalError DatabaseContext
forall a b. a -> Either a b
Left (AttributeName -> RelationalError
FunctionNameInUseError AttributeName
funcName')
                  else 
                  DatabaseContext -> Either RelationalError DatabaseContext
forall a b. b -> Either a b
Right DatabaseContext
newContext
      case Either SomeException (Either RelationalError DatabaseContext)
res of
        Left (SomeException
exc :: SomeException) -> Either RelationalError ()
-> DatabaseContextIOEvalMonad (Either RelationalError ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RelationalError ()
 -> DatabaseContextIOEvalMonad (Either RelationalError ()))
-> Either RelationalError ()
-> DatabaseContextIOEvalMonad (Either RelationalError ())
forall a b. (a -> b) -> a -> b
$ RelationalError -> Either RelationalError ()
forall a b. a -> Either a b
Left (ScriptCompilationError -> RelationalError
ScriptError ([Char] -> ScriptCompilationError
OtherScriptCompilationError (SomeException -> [Char]
forall a. Show a => a -> [Char]
show SomeException
exc)))
        Right Either RelationalError DatabaseContext
eContext -> case Either RelationalError DatabaseContext
eContext of
          Left RelationalError
err -> Either RelationalError ()
-> DatabaseContextIOEvalMonad (Either RelationalError ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError -> Either RelationalError ()
forall a b. a -> Either a b
Left RelationalError
err)
          Right DatabaseContext
context' -> DatabaseContext
-> DatabaseContextIOEvalMonad (Either RelationalError ())
putDBCIOContext DatabaseContext
context'
evalGraphRefDatabaseContextIOExpr (AddDatabaseContextFunction AttributeName
funcName' [TypeConstructor]
funcType' AttributeName
script) = do
  Either RelationalError ScriptSession
eScriptSession <- DatabaseContextIOEvalMonad (Either RelationalError ScriptSession)
requireScriptSession
  DatabaseContext
currentContext <- DatabaseContextIOEvalMonad DatabaseContext
getDBCIOContext
  case Either RelationalError ScriptSession
eScriptSession of
    Left RelationalError
err -> Either RelationalError ()
-> DatabaseContextIOEvalMonad (Either RelationalError ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError -> Either RelationalError ()
forall a b. a -> Either a b
Left RelationalError
err)
    Right ScriptSession
scriptSession -> do
      --validate that the function signature is of the form x -> y -> ... -> DatabaseContext -> DatabaseContext
      let last2Args :: [TypeConstructor]
last2Args = [TypeConstructor] -> [TypeConstructor]
forall a. [a] -> [a]
reverse (Int -> [TypeConstructor] -> [TypeConstructor]
forall a. Int -> [a] -> [a]
take Int
2 ([TypeConstructor] -> [TypeConstructor]
forall a. [a] -> [a]
reverse [TypeConstructor]
funcType'))
          atomArgs :: [TypeConstructor]
atomArgs = Int -> [TypeConstructor] -> [TypeConstructor]
forall a. Int -> [a] -> [a]
take ([TypeConstructor] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TypeConstructor]
funcType' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) [TypeConstructor]
funcType'
          dbContextTypeCons :: TypeConstructorBase a
dbContextTypeCons = AttributeName -> [TypeConstructor] -> TypeConstructorBase a
forall a.
AttributeName -> [TypeConstructor] -> TypeConstructorBase a
ADTypeConstructor AttributeName
"Either" [AttributeName -> [TypeConstructor] -> TypeConstructor
forall a.
AttributeName -> [TypeConstructor] -> TypeConstructorBase a
ADTypeConstructor AttributeName
"DatabaseContextFunctionError" [], AttributeName -> [TypeConstructor] -> TypeConstructor
forall a.
AttributeName -> [TypeConstructor] -> TypeConstructorBase a
ADTypeConstructor AttributeName
"DatabaseContext" []]
          expectedType :: [Char]
expectedType = [Char]
"DatabaseContext -> Either DatabaseContextFunctionError DatabaseContext"
          actualType :: [Char]
actualType = [TypeConstructor] -> [Char]
forall a. Show a => a -> [Char]
show [TypeConstructor]
funcType'
      if [TypeConstructor]
last2Args [TypeConstructor] -> [TypeConstructor] -> DirtyFlag
forall a. Eq a => a -> a -> DirtyFlag
/= [AttributeName -> [TypeConstructor] -> TypeConstructor
forall a.
AttributeName -> [TypeConstructor] -> TypeConstructorBase a
ADTypeConstructor AttributeName
"DatabaseContext" [], TypeConstructor
forall a. TypeConstructorBase a
dbContextTypeCons] then 
        Either RelationalError ()
-> DatabaseContextIOEvalMonad (Either RelationalError ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError -> Either RelationalError ()
forall a b. a -> Either a b
Left (ScriptCompilationError -> RelationalError
ScriptError ([Char] -> [Char] -> ScriptCompilationError
TypeCheckCompilationError [Char]
expectedType [Char]
actualType)))
        else do
        Either SomeException (Either RelationalError DatabaseContext)
res <- IO (Either SomeException (Either RelationalError DatabaseContext))
-> RWST
     DatabaseContextIOEvalEnv
     ()
     DatabaseContextEvalState
     IO
     (Either SomeException (Either RelationalError DatabaseContext))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either SomeException (Either RelationalError DatabaseContext))
 -> RWST
      DatabaseContextIOEvalEnv
      ()
      DatabaseContextEvalState
      IO
      (Either SomeException (Either RelationalError DatabaseContext)))
-> IO
     (Either SomeException (Either RelationalError DatabaseContext))
-> RWST
     DatabaseContextIOEvalEnv
     ()
     DatabaseContextEvalState
     IO
     (Either SomeException (Either RelationalError DatabaseContext))
forall a b. (a -> b) -> a -> b
$ IO (Either RelationalError DatabaseContext)
-> IO
     (Either SomeException (Either RelationalError DatabaseContext))
forall e a. Exception e => IO a -> IO (Either e a)
try (IO (Either RelationalError DatabaseContext)
 -> IO
      (Either SomeException (Either RelationalError DatabaseContext)))
-> IO (Either RelationalError DatabaseContext)
-> IO
     (Either SomeException (Either RelationalError DatabaseContext))
forall a b. (a -> b) -> a -> b
$ Maybe [Char]
-> Ghc (Either RelationalError DatabaseContext)
-> IO (Either RelationalError DatabaseContext)
forall a. Maybe [Char] -> Ghc a -> IO a
runGhc ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
libdir) (Ghc (Either RelationalError DatabaseContext)
 -> IO (Either RelationalError DatabaseContext))
-> Ghc (Either RelationalError DatabaseContext)
-> IO (Either RelationalError DatabaseContext)
forall a b. (a -> b) -> a -> b
$ do
          HscEnv -> Ghc ()
forall (m :: * -> *). GhcMonad m => HscEnv -> m ()
setSession (ScriptSession -> HscEnv
hscEnv ScriptSession
scriptSession)
          Either ScriptCompilationError DatabaseContextFunctionBodyType
eCompiledFunc  <- Type
-> AttributeName
-> Ghc
     (Either ScriptCompilationError DatabaseContextFunctionBodyType)
forall a.
Type -> AttributeName -> Ghc (Either ScriptCompilationError a)
compileScript (ScriptSession -> Type
dbcFunctionBodyType ScriptSession
scriptSession) AttributeName
script
          Either RelationalError DatabaseContext
-> Ghc (Either RelationalError DatabaseContext)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RelationalError DatabaseContext
 -> Ghc (Either RelationalError DatabaseContext))
-> Either RelationalError DatabaseContext
-> Ghc (Either RelationalError DatabaseContext)
forall a b. (a -> b) -> a -> b
$ case Either ScriptCompilationError DatabaseContextFunctionBodyType
eCompiledFunc of        
            Left ScriptCompilationError
err -> RelationalError -> Either RelationalError DatabaseContext
forall a b. a -> Either a b
Left (ScriptCompilationError -> RelationalError
ScriptError ScriptCompilationError
err)
            Right DatabaseContextFunctionBodyType
compiledFunc -> do
              --if we are here, we have validated that the written function type is X -> DatabaseContext -> DatabaseContext, so we need to munge the first elements into an array
              [AtomType]
funcAtomType <- (TypeConstructor -> Either RelationalError AtomType)
-> [TypeConstructor] -> Either RelationalError [AtomType]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\TypeConstructor
funcTypeArg -> TypeConstructor
-> TypeConstructorMapping
-> TypeVarMap
-> Either RelationalError AtomType
atomTypeForTypeConstructor TypeConstructor
funcTypeArg (DatabaseContext -> TypeConstructorMapping
typeConstructorMapping DatabaseContext
currentContext) TypeVarMap
forall k a. Map k a
M.empty) [TypeConstructor]
atomArgs
              let updatedDBCFuncs :: DatabaseContextFunctions
updatedDBCFuncs = DatabaseContextFunction
-> DatabaseContextFunctions -> DatabaseContextFunctions
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HS.insert DatabaseContextFunction
newDBCFunc (DatabaseContext -> DatabaseContextFunctions
dbcFunctions DatabaseContext
currentContext)
                  newContext :: DatabaseContext
newContext = DatabaseContext
currentContext { dbcFunctions :: DatabaseContextFunctions
dbcFunctions = DatabaseContextFunctions
updatedDBCFuncs }
                  dbcFuncs :: DatabaseContextFunctions
dbcFuncs = DatabaseContext -> DatabaseContextFunctions
dbcFunctions DatabaseContext
currentContext
                  newDBCFunc :: DatabaseContextFunction
newDBCFunc = Function :: forall a.
AttributeName -> [AtomType] -> FunctionBody a -> Function a
Function {
                    funcName :: AttributeName
funcName = AttributeName
funcName',
                    funcType :: [AtomType]
funcType = [AtomType]
funcAtomType,
                    funcBody :: FunctionBody DatabaseContextFunctionBodyType
funcBody = AttributeName
-> DatabaseContextFunctionBodyType
-> FunctionBody DatabaseContextFunctionBodyType
forall a. AttributeName -> a -> FunctionBody a
FunctionScriptBody AttributeName
script DatabaseContextFunctionBodyType
compiledFunc
                    }
                -- check if the name is already in use
              if AttributeName -> HashSet AttributeName -> DirtyFlag
forall a. (Eq a, Hashable a) => a -> HashSet a -> DirtyFlag
HS.member AttributeName
funcName' ((DatabaseContextFunction -> AttributeName)
-> DatabaseContextFunctions -> HashSet AttributeName
forall b a.
(Hashable b, Eq b) =>
(a -> b) -> HashSet a -> HashSet b
HS.map DatabaseContextFunction -> AttributeName
forall a. Function a -> AttributeName
funcName DatabaseContextFunctions
dbcFuncs) then
                RelationalError -> Either RelationalError DatabaseContext
forall a b. a -> Either a b
Left (AttributeName -> RelationalError
FunctionNameInUseError AttributeName
funcName')
                else 
                DatabaseContext -> Either RelationalError DatabaseContext
forall a b. b -> Either a b
Right DatabaseContext
newContext
        case Either SomeException (Either RelationalError DatabaseContext)
res of
          Left (SomeException
exc :: SomeException) -> Either RelationalError ()
-> DatabaseContextIOEvalMonad (Either RelationalError ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RelationalError ()
 -> DatabaseContextIOEvalMonad (Either RelationalError ()))
-> Either RelationalError ()
-> DatabaseContextIOEvalMonad (Either RelationalError ())
forall a b. (a -> b) -> a -> b
$ RelationalError -> Either RelationalError ()
forall a b. a -> Either a b
Left (ScriptCompilationError -> RelationalError
ScriptError ([Char] -> ScriptCompilationError
OtherScriptCompilationError (SomeException -> [Char]
forall a. Show a => a -> [Char]
show SomeException
exc)))
          Right Either RelationalError DatabaseContext
eContext -> case Either RelationalError DatabaseContext
eContext of
            Left RelationalError
err -> Either RelationalError ()
-> DatabaseContextIOEvalMonad (Either RelationalError ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError -> Either RelationalError ()
forall a b. a -> Either a b
Left RelationalError
err)
            Right DatabaseContext
context' -> DatabaseContext
-> DatabaseContextIOEvalMonad (Either RelationalError ())
putDBCIOContext DatabaseContext
context'
evalGraphRefDatabaseContextIOExpr (LoadAtomFunctions AttributeName
modName AttributeName
entrypointName [Char]
modPath) = do

  -- when running an in-memory database, we are willing to load object files from any path- when running in persistent mode, we load modules only from the modules directory so that we can be reasonbly sure that these same modules will exist when the database is restarted from the same directory
  Maybe [Char]
mModDir <- DatabaseContextIOEvalEnv -> Maybe [Char]
dbcio_mModulesDirectory (DatabaseContextIOEvalEnv -> Maybe [Char])
-> RWST
     DatabaseContextIOEvalEnv
     ()
     DatabaseContextEvalState
     IO
     DatabaseContextIOEvalEnv
-> RWST
     DatabaseContextIOEvalEnv
     ()
     DatabaseContextEvalState
     IO
     (Maybe [Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST
  DatabaseContextIOEvalEnv
  ()
  DatabaseContextEvalState
  IO
  DatabaseContextIOEvalEnv
forall r (m :: * -> *). MonadReader r m => m r
ask
  DatabaseContext
currentContext <- DatabaseContextIOEvalMonad DatabaseContext
getDBCIOContext
  let sModName :: [Char]
sModName = AttributeName -> [Char]
T.unpack AttributeName
modName
      sEntrypointName :: [Char]
sEntrypointName = AttributeName -> [Char]
T.unpack AttributeName
entrypointName
  Either LoadSymbolError [AtomFunction]
eLoadFunc <- IO (Either LoadSymbolError [AtomFunction])
-> RWST
     DatabaseContextIOEvalEnv
     ()
     DatabaseContextEvalState
     IO
     (Either LoadSymbolError [AtomFunction])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either LoadSymbolError [AtomFunction])
 -> RWST
      DatabaseContextIOEvalEnv
      ()
      DatabaseContextEvalState
      IO
      (Either LoadSymbolError [AtomFunction]))
-> IO (Either LoadSymbolError [AtomFunction])
-> RWST
     DatabaseContextIOEvalEnv
     ()
     DatabaseContextEvalState
     IO
     (Either LoadSymbolError [AtomFunction])
forall a b. (a -> b) -> a -> b
$ [Char]
-> [Char]
-> Maybe [Char]
-> [Char]
-> IO (Either LoadSymbolError [AtomFunction])
forall a.
[Char]
-> [Char]
-> Maybe [Char]
-> [Char]
-> IO (Either LoadSymbolError [Function a])
loadFunctions [Char]
sModName [Char]
sEntrypointName Maybe [Char]
mModDir [Char]
modPath
  case Either LoadSymbolError [AtomFunction]
eLoadFunc of
    Left LoadSymbolError
LoadSymbolError -> Either RelationalError ()
-> DatabaseContextIOEvalMonad (Either RelationalError ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError -> Either RelationalError ()
forall a b. a -> Either a b
Left RelationalError
LoadFunctionError)
    Left LoadSymbolError
SecurityLoadSymbolError -> Either RelationalError ()
-> DatabaseContextIOEvalMonad (Either RelationalError ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError -> Either RelationalError ()
forall a b. a -> Either a b
Left RelationalError
SecurityLoadFunctionError)
    Right [AtomFunction]
atomFunctionListFunc -> do
      let newContext :: DatabaseContext
newContext = DatabaseContext
currentContext { atomFunctions :: AtomFunctions
atomFunctions = AtomFunctions
mergedFuncs }
          processedAtomFunctions :: [AtomFunction]
processedAtomFunctions = [Char] -> [Char] -> [Char] -> [AtomFunction] -> [AtomFunction]
forall (f :: * -> *) a.
Functor f =>
[Char] -> [Char] -> [Char] -> f (Function a) -> f (Function a)
processObjectLoadedFunctions [Char]
sModName [Char]
sEntrypointName [Char]
modPath [AtomFunction]
atomFunctionListFunc
          mergedFuncs :: AtomFunctions
mergedFuncs = AtomFunctions -> AtomFunctions -> AtomFunctions
forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
HS.union (DatabaseContext -> AtomFunctions
atomFunctions DatabaseContext
currentContext) ([AtomFunction] -> AtomFunctions
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList [AtomFunction]
processedAtomFunctions)
      DatabaseContext
-> DatabaseContextIOEvalMonad (Either RelationalError ())
putDBCIOContext DatabaseContext
newContext
evalGraphRefDatabaseContextIOExpr (LoadDatabaseContextFunctions AttributeName
modName AttributeName
entrypointName [Char]
modPath) = do
  DatabaseContext
currentContext <- DatabaseContextIOEvalMonad DatabaseContext
getDBCIOContext
  let sModName :: [Char]
sModName = AttributeName -> [Char]
T.unpack AttributeName
modName
      sEntrypointName :: [Char]
sEntrypointName = AttributeName -> [Char]
T.unpack AttributeName
entrypointName
  Maybe [Char]
mModDir <- DatabaseContextIOEvalEnv -> Maybe [Char]
dbcio_mModulesDirectory (DatabaseContextIOEvalEnv -> Maybe [Char])
-> RWST
     DatabaseContextIOEvalEnv
     ()
     DatabaseContextEvalState
     IO
     DatabaseContextIOEvalEnv
-> RWST
     DatabaseContextIOEvalEnv
     ()
     DatabaseContextEvalState
     IO
     (Maybe [Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST
  DatabaseContextIOEvalEnv
  ()
  DatabaseContextEvalState
  IO
  DatabaseContextIOEvalEnv
forall r (m :: * -> *). MonadReader r m => m r
ask      
  Either LoadSymbolError [DatabaseContextFunction]
eLoadFunc <- IO (Either LoadSymbolError [DatabaseContextFunction])
-> RWST
     DatabaseContextIOEvalEnv
     ()
     DatabaseContextEvalState
     IO
     (Either LoadSymbolError [DatabaseContextFunction])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either LoadSymbolError [DatabaseContextFunction])
 -> RWST
      DatabaseContextIOEvalEnv
      ()
      DatabaseContextEvalState
      IO
      (Either LoadSymbolError [DatabaseContextFunction]))
-> IO (Either LoadSymbolError [DatabaseContextFunction])
-> RWST
     DatabaseContextIOEvalEnv
     ()
     DatabaseContextEvalState
     IO
     (Either LoadSymbolError [DatabaseContextFunction])
forall a b. (a -> b) -> a -> b
$ [Char]
-> [Char]
-> Maybe [Char]
-> [Char]
-> IO (Either LoadSymbolError [DatabaseContextFunction])
forall a.
[Char]
-> [Char]
-> Maybe [Char]
-> [Char]
-> IO (Either LoadSymbolError [Function a])
loadFunctions [Char]
sModName [Char]
sEntrypointName Maybe [Char]
mModDir [Char]
modPath
  case Either LoadSymbolError [DatabaseContextFunction]
eLoadFunc of
    Left LoadSymbolError
LoadSymbolError -> Either RelationalError ()
-> DatabaseContextIOEvalMonad (Either RelationalError ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError -> Either RelationalError ()
forall a b. a -> Either a b
Left RelationalError
LoadFunctionError)
    Left LoadSymbolError
SecurityLoadSymbolError -> Either RelationalError ()
-> DatabaseContextIOEvalMonad (Either RelationalError ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError -> Either RelationalError ()
forall a b. a -> Either a b
Left RelationalError
SecurityLoadFunctionError)
    Right [DatabaseContextFunction]
dbcListFunc -> let newContext :: DatabaseContext
newContext = DatabaseContext
currentContext { dbcFunctions :: DatabaseContextFunctions
dbcFunctions = DatabaseContextFunctions
mergedFuncs }
                             mergedFuncs :: DatabaseContextFunctions
mergedFuncs = DatabaseContextFunctions
-> DatabaseContextFunctions -> DatabaseContextFunctions
forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
HS.union (DatabaseContext -> DatabaseContextFunctions
dbcFunctions DatabaseContext
currentContext) ([DatabaseContextFunction] -> DatabaseContextFunctions
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList [DatabaseContextFunction]
processedDBCFuncs)
                             processedDBCFuncs :: [DatabaseContextFunction]
processedDBCFuncs = [Char]
-> [Char]
-> [Char]
-> [DatabaseContextFunction]
-> [DatabaseContextFunction]
forall (f :: * -> *) a.
Functor f =>
[Char] -> [Char] -> [Char] -> f (Function a) -> f (Function a)
processObjectLoadedFunctions [Char]
sModName [Char]
sEntrypointName [Char]
modPath [DatabaseContextFunction]
dbcListFunc
                                  in DatabaseContext
-> DatabaseContextIOEvalMonad (Either RelationalError ())
putDBCIOContext DatabaseContext
newContext
#endif
evalGraphRefDatabaseContextIOExpr (CreateArbitraryRelation AttributeName
relVarName [AttributeExprBase GraphRefTransactionMarker]
attrExprs Range
range) = do
  --Define
  DatabaseContext
currentContext <- DatabaseContextIOEvalMonad DatabaseContext
getDBCIOContext
  DatabaseContextIOEvalEnv
env <- RWST
  DatabaseContextIOEvalEnv
  ()
  DatabaseContextEvalState
  IO
  DatabaseContextIOEvalEnv
forall r (m :: * -> *). MonadReader r m => m r
RWS.ask
  --create graph ref expr
  let gfExpr :: GraphRefDatabaseContextExpr
gfExpr = AttributeName
-> [AttributeExprBase GraphRefTransactionMarker]
-> GraphRefDatabaseContextExpr
forall a.
AttributeName -> [AttributeExprBase a] -> DatabaseContextExprBase a
Define AttributeName
relVarName [AttributeExprBase GraphRefTransactionMarker]
attrExprs
      evalEnv :: DatabaseContextEvalEnv
evalEnv = TransactionId -> TransactionGraph -> DatabaseContextEvalEnv
mkDatabaseContextEvalEnv (DatabaseContextIOEvalEnv -> TransactionId
dbcio_transId DatabaseContextIOEvalEnv
env) (DatabaseContextIOEvalEnv -> TransactionGraph
dbcio_graph DatabaseContextIOEvalEnv
env)
      graph :: TransactionGraph
graph = DatabaseContextIOEvalEnv -> TransactionGraph
dbcio_graph DatabaseContextIOEvalEnv
env
  case DatabaseContext
-> DatabaseContextEvalEnv
-> DatabaseContextEvalMonad ()
-> Either RelationalError DatabaseContextEvalState
runDatabaseContextEvalMonad DatabaseContext
currentContext DatabaseContextEvalEnv
evalEnv (GraphRefDatabaseContextExpr -> DatabaseContextEvalMonad ()
evalGraphRefDatabaseContextExpr GraphRefDatabaseContextExpr
gfExpr) of
    Left RelationalError
err -> Either RelationalError ()
-> DatabaseContextIOEvalMonad (Either RelationalError ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError -> Either RelationalError ()
forall a b. a -> Either a b
Left RelationalError
err)
    Right DatabaseContextEvalState
dbstate -> do
         --Assign
           let existingRelVar :: Maybe GraphRefRelationalExpr
existingRelVar = AttributeName
-> Map AttributeName GraphRefRelationalExpr
-> Maybe GraphRefRelationalExpr
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup AttributeName
relVarName Map AttributeName GraphRefRelationalExpr
relVarTable
               relVarTable :: Map AttributeName GraphRefRelationalExpr
relVarTable = DatabaseContext -> Map AttributeName GraphRefRelationalExpr
relationVariables (DatabaseContextEvalState -> DatabaseContext
dbc_context DatabaseContextEvalState
dbstate)
           case Maybe GraphRefRelationalExpr
existingRelVar of
                Maybe GraphRefRelationalExpr
Nothing -> Either RelationalError ()
-> DatabaseContextIOEvalMonad (Either RelationalError ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RelationalError ()
 -> DatabaseContextIOEvalMonad (Either RelationalError ()))
-> Either RelationalError ()
-> DatabaseContextIOEvalMonad (Either RelationalError ())
forall a b. (a -> b) -> a -> b
$ RelationalError -> Either RelationalError ()
forall a b. a -> Either a b
Left (AttributeName -> RelationalError
RelVarNotDefinedError AttributeName
relVarName)
                Just GraphRefRelationalExpr
existingRel -> do
                  let gfEnv :: GraphRefRelationalExprEnv
gfEnv = Maybe DatabaseContext
-> TransactionGraph -> GraphRefRelationalExprEnv
freshGraphRefRelationalExprEnv (DatabaseContext -> Maybe DatabaseContext
forall a. a -> Maybe a
Just DatabaseContext
currentContext) TransactionGraph
graph
                  case GraphRefRelationalExprEnv
-> GraphRefRelationalExprM Relation
-> Either RelationalError Relation
forall a.
GraphRefRelationalExprEnv
-> GraphRefRelationalExprM a -> Either RelationalError a
runGraphRefRelationalExprM GraphRefRelationalExprEnv
gfEnv (GraphRefRelationalExpr -> GraphRefRelationalExprM Relation
typeForGraphRefRelationalExpr GraphRefRelationalExpr
existingRel) of
                    Left RelationalError
err -> Either RelationalError ()
-> DatabaseContextIOEvalMonad (Either RelationalError ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError -> Either RelationalError ()
forall a b. a -> Either a b
Left RelationalError
err)
                    Right Relation
relType -> do
                      let expectedAttributes :: Attributes
expectedAttributes = Relation -> Attributes
attributes Relation
relType
                          tcMap :: TypeConstructorMapping
tcMap = DatabaseContext -> TypeConstructorMapping
typeConstructorMapping (DatabaseContextEvalState -> DatabaseContext
dbc_context DatabaseContextEvalState
dbstate)
                      Either RelationalError Relation
eitherRel <- IO (Either RelationalError Relation)
-> RWST
     DatabaseContextIOEvalEnv
     ()
     DatabaseContextEvalState
     IO
     (Either RelationalError Relation)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either RelationalError Relation)
 -> RWST
      DatabaseContextIOEvalEnv
      ()
      DatabaseContextEvalState
      IO
      (Either RelationalError Relation))
-> IO (Either RelationalError Relation)
-> RWST
     DatabaseContextIOEvalEnv
     ()
     DatabaseContextEvalState
     IO
     (Either RelationalError Relation)
forall a b. (a -> b) -> a -> b
$ Gen (Either RelationalError Relation)
-> IO (Either RelationalError Relation)
forall a. Gen a -> IO a
generate (Gen (Either RelationalError Relation)
 -> IO (Either RelationalError Relation))
-> Gen (Either RelationalError Relation)
-> IO (Either RelationalError Relation)
forall a b. (a -> b) -> a -> b
$ ReaderT
  TypeConstructorMapping Gen (Either RelationalError Relation)
-> TypeConstructorMapping -> Gen (Either RelationalError Relation)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Attributes
-> Range
-> ReaderT
     TypeConstructorMapping Gen (Either RelationalError Relation)
arbitraryRelation Attributes
expectedAttributes Range
range) TypeConstructorMapping
tcMap
                      case Either RelationalError Relation
eitherRel of
                        Left RelationalError
err -> Either RelationalError ()
-> DatabaseContextIOEvalMonad (Either RelationalError ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RelationalError ()
 -> DatabaseContextIOEvalMonad (Either RelationalError ()))
-> Either RelationalError ()
-> DatabaseContextIOEvalMonad (Either RelationalError ())
forall a b. (a -> b) -> a -> b
$ RelationalError -> Either RelationalError ()
forall a b. a -> Either a b
Left RelationalError
err
                        Right Relation
rel ->
                          case DatabaseContext
-> DatabaseContextEvalEnv
-> DatabaseContextEvalMonad ()
-> Either RelationalError DatabaseContextEvalState
runDatabaseContextEvalMonad DatabaseContext
currentContext DatabaseContextEvalEnv
evalEnv (AttributeName
-> GraphRefRelationalExpr -> DatabaseContextEvalMonad ()
setRelVar AttributeName
relVarName (Relation -> GraphRefRelationalExpr
forall a. Relation -> RelationalExprBase a
ExistingRelation Relation
rel)) of
                            Left RelationalError
err -> Either RelationalError ()
-> DatabaseContextIOEvalMonad (Either RelationalError ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError -> Either RelationalError ()
forall a b. a -> Either a b
Left RelationalError
err)
                            Right DatabaseContextEvalState
dbstate' -> DatabaseContext
-> DatabaseContextIOEvalMonad (Either RelationalError ())
putDBCIOContext (DatabaseContextEvalState -> DatabaseContext
dbc_context DatabaseContextEvalState
dbstate')

--run verification on all constraints
checkConstraints :: DatabaseContext -> TransactionId -> TransactionGraph -> Either RelationalError ()
checkConstraints :: DatabaseContext
-> TransactionId -> TransactionGraph -> Either RelationalError ()
checkConstraints DatabaseContext
context TransactionId
transId graph :: TransactionGraph
graph@(TransactionGraph TransactionHeads
graphHeads Set Transaction
transSet) = do
  ((AttributeName, InclusionDependency) -> Either RelationalError ())
-> [(AttributeName, InclusionDependency)]
-> Either RelationalError ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((AttributeName -> InclusionDependency -> Either RelationalError ())
-> (AttributeName, InclusionDependency)
-> Either RelationalError ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry AttributeName -> InclusionDependency -> Either RelationalError ()
checkIncDep) (InclusionDependencies -> [(AttributeName, InclusionDependency)]
forall k a. Map k a -> [(k, a)]
M.toList InclusionDependencies
deps)
  ((AttributeName, RelationalExpr) -> Either RelationalError ())
-> [(AttributeName, RelationalExpr)] -> Either RelationalError ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (AttributeName, RelationalExpr) -> Either RelationalError ()
checkRegisteredQuery (Map AttributeName RelationalExpr
-> [(AttributeName, RelationalExpr)]
forall k a. Map k a -> [(k, a)]
M.toList (DatabaseContext -> Map AttributeName RelationalExpr
registeredQueries DatabaseContext
context))
  where
    potentialGraph :: TransactionGraph
potentialGraph = TransactionHeads -> Set Transaction -> TransactionGraph
TransactionGraph TransactionHeads
graphHeads (Transaction -> Set Transaction -> Set Transaction
forall a. Ord a => a -> Set a -> Set a
S.insert Transaction
tempTrans Set Transaction
transSet)
    tempStamp :: UTCTime
tempStamp = UTCTime :: Day -> DiffTime -> UTCTime
UTCTime { utctDay :: Day
utctDay = Integer -> Int -> Int -> Day
fromGregorian Integer
2000 Int
1 Int
1,
                          utctDayTime :: DiffTime
utctDayTime = Integer -> DiffTime
secondsToDiffTime Integer
0 }
    tempSchemas :: Schemas
tempSchemas = DatabaseContext -> Subschemas -> Schemas
Schemas DatabaseContext
context Subschemas
forall k a. Map k a
M.empty
    tempTrans :: Transaction
tempTrans = TransactionId -> TransactionInfo -> Schemas -> Transaction
Transaction TransactionId
U.nil  TransactionInfo
tempTransInfo Schemas
tempSchemas
    tempTransInfo :: TransactionInfo
tempTransInfo = TransactionInfo :: TransactionParents -> UTCTime -> MerkleHash -> TransactionInfo
TransactionInfo { parents :: TransactionParents
parents = TransactionId
transId TransactionId -> [TransactionId] -> TransactionParents
forall a. a -> [a] -> NonEmpty a
NE.:| [],
                                      stamp :: UTCTime
stamp = UTCTime
tempStamp,
                                      merkleHash :: MerkleHash
merkleHash = MerkleHash
forall a. Monoid a => a
mempty
                                      }
    
    deps :: InclusionDependencies
deps = DatabaseContext -> InclusionDependencies
inclusionDependencies DatabaseContext
context
    process :: ProcessExprM a -> a
process = GraphRefTransactionMarker -> ProcessExprM a -> a
forall a. GraphRefTransactionMarker -> ProcessExprM a -> a
runProcessExprM GraphRefTransactionMarker
UncommittedContextMarker
    gfEnv :: GraphRefRelationalExprEnv
gfEnv = Maybe DatabaseContext
-> TransactionGraph -> GraphRefRelationalExprEnv
freshGraphRefRelationalExprEnv (DatabaseContext -> Maybe DatabaseContext
forall a. a -> Maybe a
Just DatabaseContext
context) TransactionGraph
graph
      -- no optimization available here, really? perhaps the optimizer should be passed down to here or the eval function should be passed through the environment
    checkIncDep :: AttributeName -> InclusionDependency -> Either RelationalError ()
checkIncDep AttributeName
depName (InclusionDependency RelationalExpr
subsetExpr RelationalExpr
supersetExpr) = do
      let gfSubsetExpr :: GraphRefRelationalExpr
gfSubsetExpr = ProcessExprM GraphRefRelationalExpr -> GraphRefRelationalExpr
forall a. ProcessExprM a -> a
process (RelationalExpr -> ProcessExprM GraphRefRelationalExpr
processRelationalExpr RelationalExpr
subsetExpr)
          gfSupersetExpr :: GraphRefRelationalExpr
gfSupersetExpr = ProcessExprM GraphRefRelationalExpr -> GraphRefRelationalExpr
forall a. ProcessExprM a -> a
process (RelationalExpr -> ProcessExprM GraphRefRelationalExpr
processRelationalExpr RelationalExpr
supersetExpr)
      --if both expressions are of a single-attribute (such as with a simple foreign key), the names of the attributes are irrelevant (they need not match) because the expression is unambiguous, but special-casing this to rename the attribute automatically would not be orthogonal behavior and probably cause confusion. Instead, special case the error to make it clear.
          runGfRel :: GraphRefRelationalExprM b -> Either RelationalError b
runGfRel GraphRefRelationalExprM b
e = case GraphRefRelationalExprEnv
-> GraphRefRelationalExprM b -> Either RelationalError b
forall a.
GraphRefRelationalExprEnv
-> GraphRefRelationalExprM a -> Either RelationalError a
runGraphRefRelationalExprM GraphRefRelationalExprEnv
gfEnv GraphRefRelationalExprM b
e of
                         Left RelationalError
err -> RelationalError -> Either RelationalError b
forall a b. a -> Either a b
Left (Maybe RelationalError -> RelationalError
wrapIncDepErr (RelationalError -> Maybe RelationalError
forall a. a -> Maybe a
Just RelationalError
err))
                         Right b
v -> b -> Either RelationalError b
forall a b. b -> Either a b
Right b
v
          wrapIncDepErr :: Maybe RelationalError -> RelationalError
wrapIncDepErr = AttributeName -> Maybe RelationalError -> RelationalError
InclusionDependencyCheckError AttributeName
depName
      Relation
typeSub <- GraphRefRelationalExprM Relation -> Either RelationalError Relation
forall b. GraphRefRelationalExprM b -> Either RelationalError b
runGfRel (GraphRefRelationalExpr -> GraphRefRelationalExprM Relation
typeForGraphRefRelationalExpr GraphRefRelationalExpr
gfSubsetExpr)
      Relation
typeSuper <- GraphRefRelationalExprM Relation -> Either RelationalError Relation
forall b. GraphRefRelationalExprM b -> Either RelationalError b
runGfRel (GraphRefRelationalExpr -> GraphRefRelationalExprM Relation
typeForGraphRefRelationalExpr GraphRefRelationalExpr
gfSupersetExpr)
      DirtyFlag -> Either RelationalError () -> Either RelationalError ()
forall (f :: * -> *). Applicative f => DirtyFlag -> f () -> f ()
when (Relation
typeSub Relation -> Relation -> DirtyFlag
forall a. Eq a => a -> a -> DirtyFlag
/= Relation
typeSuper) (RelationalError -> Either RelationalError ()
forall a b. a -> Either a b
Left (Maybe RelationalError -> RelationalError
wrapIncDepErr (RelationalError -> Maybe RelationalError
forall a. a -> Maybe a
Just (Attributes -> Attributes -> RelationalError
RelationTypeMismatchError (Relation -> Attributes
attributes Relation
typeSub) (Relation -> Attributes
attributes Relation
typeSuper)))))
      let checkExpr :: GraphRefRelationalExpr
checkExpr = GraphRefRelationalExpr
-> GraphRefRelationalExpr -> GraphRefRelationalExpr
forall a.
RelationalExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Equals GraphRefRelationalExpr
gfSupersetExpr (GraphRefRelationalExpr
-> GraphRefRelationalExpr -> GraphRefRelationalExpr
forall a.
RelationalExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Union GraphRefRelationalExpr
gfSubsetExpr GraphRefRelationalExpr
gfSupersetExpr)
          gfEvald :: Either RelationalError Relation
gfEvald = GraphRefRelationalExprEnv
-> GraphRefRelationalExprM Relation
-> Either RelationalError Relation
forall a.
GraphRefRelationalExprEnv
-> GraphRefRelationalExprM a -> Either RelationalError a
runGraphRefRelationalExprM GraphRefRelationalExprEnv
gfEnv' (GraphRefRelationalExpr -> GraphRefRelationalExprM Relation
evalGraphRefRelationalExpr GraphRefRelationalExpr
checkExpr)
          gfEnv' :: GraphRefRelationalExprEnv
gfEnv' = Maybe DatabaseContext
-> TransactionGraph -> GraphRefRelationalExprEnv
freshGraphRefRelationalExprEnv (DatabaseContext -> Maybe DatabaseContext
forall a. a -> Maybe a
Just DatabaseContext
context) TransactionGraph
potentialGraph
      case Either RelationalError Relation
gfEvald of
        Left RelationalError
err -> RelationalError -> Either RelationalError ()
forall a b. a -> Either a b
Left (Maybe RelationalError -> RelationalError
wrapIncDepErr (RelationalError -> Maybe RelationalError
forall a. a -> Maybe a
Just RelationalError
err))
        Right Relation
resultRel -> if Relation
resultRel Relation -> Relation -> DirtyFlag
forall a. Eq a => a -> a -> DirtyFlag
== Relation
relationTrue then
                                   () -> Either RelationalError ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                                else 
                                  RelationalError -> Either RelationalError ()
forall a b. a -> Either a b
Left (Maybe RelationalError -> RelationalError
wrapIncDepErr Maybe RelationalError
forall a. Maybe a
Nothing)
    --registered queries just need to typecheck- think of them as a constraints on the schema/DDL
    checkRegisteredQuery :: (AttributeName, RelationalExpr) -> Either RelationalError ()
checkRegisteredQuery (AttributeName
qName, RelationalExpr
relExpr) = do
      let gfExpr :: GraphRefRelationalExpr
gfExpr = ProcessExprM GraphRefRelationalExpr -> GraphRefRelationalExpr
forall a. ProcessExprM a -> a
process (RelationalExpr -> ProcessExprM GraphRefRelationalExpr
processRelationalExpr RelationalExpr
relExpr)
      case GraphRefRelationalExprEnv
-> GraphRefRelationalExprM Relation
-> Either RelationalError Relation
forall a.
GraphRefRelationalExprEnv
-> GraphRefRelationalExprM a -> Either RelationalError a
runGraphRefRelationalExprM GraphRefRelationalExprEnv
gfEnv (GraphRefRelationalExpr -> GraphRefRelationalExprM Relation
typeForGraphRefRelationalExpr GraphRefRelationalExpr
gfExpr) of
        Left RelationalError
err -> RelationalError -> Either RelationalError ()
forall a b. a -> Either a b
Left (AttributeName -> RelationalError -> RelationalError
RegisteredQueryValidationError AttributeName
qName RelationalError
err)
        Right Relation
_ -> () -> Either RelationalError ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- the type of a relational expression is equal to the relation attribute set returned from executing the relational expression; therefore, the type can be cheaply derived by evaluating a relational expression and ignoring and tuple processing
-- furthermore, the type of a relational expression is the resultant header of the evaluated empty-tupled relation

typeForRelationalExpr :: RelationalExpr -> RelationalExprM Relation
typeForRelationalExpr :: RelationalExpr -> RelationalExprM Relation
typeForRelationalExpr RelationalExpr
expr = do
  --replace the relationVariables context element with a cloned set of relation devoid of tuples
  --evalRelationalExpr could still return an existing relation with tuples, so strip them
  TransactionGraph
graph <- RelationalExprM TransactionGraph
reGraph
  DatabaseContext
context <- RelationalExprM DatabaseContext
reContext
  let gfExpr :: GraphRefRelationalExpr
gfExpr = GraphRefTransactionMarker
-> ProcessExprM GraphRefRelationalExpr -> GraphRefRelationalExpr
forall a. GraphRefTransactionMarker -> ProcessExprM a -> a
runProcessExprM GraphRefTransactionMarker
UncommittedContextMarker (RelationalExpr -> ProcessExprM GraphRefRelationalExpr
processRelationalExpr RelationalExpr
expr)
      gfEnv :: GraphRefRelationalExprEnv
gfEnv = Maybe DatabaseContext
-> TransactionGraph -> GraphRefRelationalExprEnv
freshGraphRefRelationalExprEnv (DatabaseContext -> Maybe DatabaseContext
forall a. a -> Maybe a
Just DatabaseContext
context) TransactionGraph
graph
      runGf :: Either RelationalError Relation
runGf = GraphRefRelationalExprEnv
-> GraphRefRelationalExprM Relation
-> Either RelationalError Relation
forall a.
GraphRefRelationalExprEnv
-> GraphRefRelationalExprM a -> Either RelationalError a
runGraphRefRelationalExprM GraphRefRelationalExprEnv
gfEnv (GraphRefRelationalExpr -> GraphRefRelationalExprM Relation
typeForGraphRefRelationalExpr GraphRefRelationalExpr
gfExpr)
  ExceptT RelationalError Identity Relation
-> RelationalExprM Relation
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT RelationalError Identity Relation
 -> RelationalExprM Relation)
-> ExceptT RelationalError Identity Relation
-> RelationalExprM Relation
forall a b. (a -> b) -> a -> b
$ Either RelationalError Relation
-> ExceptT RelationalError Identity Relation
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except Either RelationalError Relation
runGf

liftE :: (Monad m) => m (Either a b) -> ExceptT a m b
liftE :: m (Either a b) -> ExceptT a m b
liftE m (Either a b)
v = do
  Either a b
y <- m (Either a b) -> ExceptT a m (Either a b)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Either a b)
v
  case Either a b
y of
    Left a
err -> a -> ExceptT a m b
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError a
err
    Right b
val -> b -> ExceptT a m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
val

{- used for restrictions- take the restrictionpredicate and return the corresponding filter function -}
predicateRestrictionFilter :: Attributes -> GraphRefRestrictionPredicateExpr -> GraphRefRelationalExprM RestrictionFilter
predicateRestrictionFilter :: Attributes
-> RestrictionPredicateExprBase GraphRefTransactionMarker
-> GraphRefRelationalExprM RestrictionFilter
predicateRestrictionFilter Attributes
attrs (AndPredicate RestrictionPredicateExprBase GraphRefTransactionMarker
expr1 RestrictionPredicateExprBase GraphRefTransactionMarker
expr2) = do
  RestrictionFilter
expr1v <- Attributes
-> RestrictionPredicateExprBase GraphRefTransactionMarker
-> GraphRefRelationalExprM RestrictionFilter
predicateRestrictionFilter Attributes
attrs RestrictionPredicateExprBase GraphRefTransactionMarker
expr1
  RestrictionFilter
expr2v <- Attributes
-> RestrictionPredicateExprBase GraphRefTransactionMarker
-> GraphRefRelationalExprM RestrictionFilter
predicateRestrictionFilter Attributes
attrs RestrictionPredicateExprBase GraphRefTransactionMarker
expr2
  RestrictionFilter -> GraphRefRelationalExprM RestrictionFilter
forall (f :: * -> *) a. Applicative f => a -> f a
pure (\RelationTuple
x -> do
           DirtyFlag
ev1 <- RestrictionFilter
expr1v RelationTuple
x 
           DirtyFlag
ev2 <- RestrictionFilter
expr2v RelationTuple
x
           DirtyFlag -> Either RelationalError DirtyFlag
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DirtyFlag
ev1 DirtyFlag -> DirtyFlag -> DirtyFlag
&& DirtyFlag
ev2))

predicateRestrictionFilter Attributes
attrs (OrPredicate RestrictionPredicateExprBase GraphRefTransactionMarker
expr1 RestrictionPredicateExprBase GraphRefTransactionMarker
expr2) = do
    RestrictionFilter
expr1v <- Attributes
-> RestrictionPredicateExprBase GraphRefTransactionMarker
-> GraphRefRelationalExprM RestrictionFilter
predicateRestrictionFilter Attributes
attrs RestrictionPredicateExprBase GraphRefTransactionMarker
expr1
    RestrictionFilter
expr2v <- Attributes
-> RestrictionPredicateExprBase GraphRefTransactionMarker
-> GraphRefRelationalExprM RestrictionFilter
predicateRestrictionFilter Attributes
attrs RestrictionPredicateExprBase GraphRefTransactionMarker
expr2
    RestrictionFilter -> GraphRefRelationalExprM RestrictionFilter
forall (f :: * -> *) a. Applicative f => a -> f a
pure (\RelationTuple
x -> do
                DirtyFlag
ev1 <- RestrictionFilter
expr1v RelationTuple
x 
                DirtyFlag
ev2 <- RestrictionFilter
expr2v RelationTuple
x
                DirtyFlag -> Either RelationalError DirtyFlag
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DirtyFlag
ev1 DirtyFlag -> DirtyFlag -> DirtyFlag
|| DirtyFlag
ev2))

predicateRestrictionFilter Attributes
_ RestrictionPredicateExprBase GraphRefTransactionMarker
TruePredicate = RestrictionFilter -> GraphRefRelationalExprM RestrictionFilter
forall (f :: * -> *) a. Applicative f => a -> f a
pure (\RelationTuple
_ -> DirtyFlag -> Either RelationalError DirtyFlag
forall (f :: * -> *) a. Applicative f => a -> f a
pure DirtyFlag
True)

predicateRestrictionFilter Attributes
attrs (NotPredicate RestrictionPredicateExprBase GraphRefTransactionMarker
expr) = do
  RestrictionFilter
exprv <- Attributes
-> RestrictionPredicateExprBase GraphRefTransactionMarker
-> GraphRefRelationalExprM RestrictionFilter
predicateRestrictionFilter Attributes
attrs RestrictionPredicateExprBase GraphRefTransactionMarker
expr
  RestrictionFilter -> GraphRefRelationalExprM RestrictionFilter
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((DirtyFlag -> DirtyFlag)
-> Either RelationalError DirtyFlag
-> Either RelationalError DirtyFlag
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DirtyFlag -> DirtyFlag
not (Either RelationalError DirtyFlag
 -> Either RelationalError DirtyFlag)
-> RestrictionFilter -> RestrictionFilter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RestrictionFilter
exprv)

--optimization opportunity: if the subexpression does not reference attributes in the top-level expression, then it need only be evaluated once, statically, outside the tuple filter- see historical implementation here
predicateRestrictionFilter Attributes
_ (RelationalExprPredicate GraphRefRelationalExpr
relExpr) = do
  GraphRefRelationalExprEnv
renv <- GraphRefRelationalExprM GraphRefRelationalExprEnv
askEnv
  let eval :: RelationTuple -> Either RelationalError Relation
      eval :: RelationTuple -> Either RelationalError Relation
eval RelationTuple
tup = 
        let gfEnv :: GraphRefRelationalExprEnv
gfEnv = RelationTuple
-> GraphRefRelationalExprEnv -> GraphRefRelationalExprEnv
mergeTuplesIntoGraphRefRelationalExprEnv RelationTuple
tup GraphRefRelationalExprEnv
renv in
        GraphRefRelationalExprEnv
-> GraphRefRelationalExprM Relation
-> Either RelationalError Relation
forall a.
GraphRefRelationalExprEnv
-> GraphRefRelationalExprM a -> Either RelationalError a
runGraphRefRelationalExprM GraphRefRelationalExprEnv
gfEnv (GraphRefRelationalExpr -> GraphRefRelationalExprM Relation
evalGraphRefRelationalExpr GraphRefRelationalExpr
relExpr)
  RestrictionFilter -> GraphRefRelationalExprM RestrictionFilter
forall (f :: * -> *) a. Applicative f => a -> f a
pure (\RelationTuple
tup -> case RelationTuple -> Either RelationalError Relation
eval RelationTuple
tup of
    Left RelationalError
err -> RelationalError -> Either RelationalError DirtyFlag
forall a b. a -> Either a b
Left RelationalError
err
    Right Relation
rel -> if Relation -> Int
arity Relation
rel Int -> Int -> DirtyFlag
forall a. Eq a => a -> a -> DirtyFlag
/= Int
0 then
                   RelationalError -> Either RelationalError DirtyFlag
forall a b. a -> Either a b
Left (AttributeName -> RelationalError
PredicateExpressionError AttributeName
"Relational restriction filter must evaluate to 'true' or 'false'")
                   else
                   DirtyFlag -> Either RelationalError DirtyFlag
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Relation
rel Relation -> Relation -> DirtyFlag
forall a. Eq a => a -> a -> DirtyFlag
== Relation
relationTrue))

predicateRestrictionFilter Attributes
attrs (AttributeEqualityPredicate AttributeName
attrName GraphRefAtomExpr
atomExpr) = do
  GraphRefRelationalExprEnv
env <- GraphRefRelationalExprM GraphRefRelationalExprEnv
askEnv
  let attrs' :: Attributes
attrs' = Attributes -> Attributes -> Attributes
A.union Attributes
attrs (GraphRefRelationalExprEnv -> Attributes
envAttributes GraphRefRelationalExprEnv
env)
      ctxtup' :: RelationTuple
ctxtup' = GraphRefRelationalExprEnv -> RelationTuple
envTuple GraphRefRelationalExprEnv
env
  AtomType
atomExprType <- Attributes -> GraphRefAtomExpr -> GraphRefRelationalExprM AtomType
typeForGraphRefAtomExpr Attributes
attrs' GraphRefAtomExpr
atomExpr
  Attribute
attr <- ExceptT RelationalError Identity Attribute
-> ReaderT
     GraphRefRelationalExprEnv
     (ExceptT RelationalError Identity)
     Attribute
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT RelationalError Identity Attribute
 -> ReaderT
      GraphRefRelationalExprEnv
      (ExceptT RelationalError Identity)
      Attribute)
-> ExceptT RelationalError Identity Attribute
-> ReaderT
     GraphRefRelationalExprEnv
     (ExceptT RelationalError Identity)
     Attribute
forall a b. (a -> b) -> a -> b
$ Either RelationalError Attribute
-> ExceptT RelationalError Identity Attribute
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either RelationalError Attribute
 -> ExceptT RelationalError Identity Attribute)
-> Either RelationalError Attribute
-> ExceptT RelationalError Identity Attribute
forall a b. (a -> b) -> a -> b
$ case AttributeName -> Attributes -> Either RelationalError Attribute
A.attributeForName AttributeName
attrName Attributes
attrs' of
      Right Attribute
attr -> Attribute -> Either RelationalError Attribute
forall a b. b -> Either a b
Right Attribute
attr
      Left (NoSuchAttributeNamesError Set AttributeName
_) -> case AttributeName -> Attributes -> Either RelationalError Attribute
A.attributeForName AttributeName
attrName (RelationTuple -> Attributes
tupleAttributes RelationTuple
ctxtup') of 
                                              Right Attribute
ctxattr -> Attribute -> Either RelationalError Attribute
forall a b. b -> Either a b
Right Attribute
ctxattr
                                              Left err2 :: RelationalError
err2@(NoSuchAttributeNamesError Set AttributeName
_) -> RelationalError -> Either RelationalError Attribute
forall a b. a -> Either a b
Left RelationalError
err2
                                              Left RelationalError
err -> RelationalError -> Either RelationalError Attribute
forall a b. a -> Either a b
Left RelationalError
err
      Left RelationalError
err -> RelationalError -> Either RelationalError Attribute
forall a b. a -> Either a b
Left RelationalError
err
  if AtomType
atomExprType AtomType -> AtomType -> DirtyFlag
forall a. Eq a => a -> a -> DirtyFlag
/= Attribute -> AtomType
A.atomType Attribute
attr then
      RelationalError -> GraphRefRelationalExprM RestrictionFilter
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Attributes -> RelationalError
TupleAttributeTypeMismatchError ([Attribute] -> Attributes
A.attributesFromList [Attribute
attr]))
    else
      RestrictionFilter -> GraphRefRelationalExprM RestrictionFilter
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RestrictionFilter -> GraphRefRelationalExprM RestrictionFilter)
-> RestrictionFilter -> GraphRefRelationalExprM RestrictionFilter
forall a b. (a -> b) -> a -> b
$ \RelationTuple
tupleIn -> let evalAndCmp :: Atom -> DirtyFlag
evalAndCmp Atom
atomIn = case Either RelationalError Atom
atomEvald of
                               Right Atom
atomCmp -> Atom
atomCmp Atom -> Atom -> DirtyFlag
forall a. Eq a => a -> a -> DirtyFlag
== Atom
atomIn
                               Left RelationalError
_ -> DirtyFlag
False
                             atomEvald :: Either RelationalError Atom
atomEvald = GraphRefRelationalExprEnv
-> GraphRefRelationalExprM Atom -> Either RelationalError Atom
forall a.
GraphRefRelationalExprEnv
-> GraphRefRelationalExprM a -> Either RelationalError a
runGraphRefRelationalExprM GraphRefRelationalExprEnv
env (RelationTuple -> GraphRefAtomExpr -> GraphRefRelationalExprM Atom
evalGraphRefAtomExpr RelationTuple
tupleIn GraphRefAtomExpr
atomExpr)
                         in
                          DirtyFlag -> Either RelationalError DirtyFlag
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DirtyFlag -> Either RelationalError DirtyFlag)
-> DirtyFlag -> Either RelationalError DirtyFlag
forall a b. (a -> b) -> a -> b
$ case AttributeName -> RelationTuple -> Either RelationalError Atom
atomForAttributeName AttributeName
attrName RelationTuple
tupleIn of
                            Left (NoSuchAttributeNamesError Set AttributeName
_) -> case AttributeName -> RelationTuple -> Either RelationalError Atom
atomForAttributeName AttributeName
attrName RelationTuple
ctxtup' of
                              Left RelationalError
_ -> DirtyFlag
False
                              Right Atom
ctxatom -> Atom -> DirtyFlag
evalAndCmp Atom
ctxatom
                            Left RelationalError
_ -> DirtyFlag
False
                            Right Atom
atomIn -> Atom -> DirtyFlag
evalAndCmp Atom
atomIn
-- in the future, it would be useful to do typechecking on the attribute and atom expr filters in advance
predicateRestrictionFilter Attributes
attrs (AtomExprPredicate GraphRefAtomExpr
atomExpr) = do
  --merge attrs into the state attributes
  GraphRefRelationalExprEnv
renv <- GraphRefRelationalExprM GraphRefRelationalExprEnv
askEnv
  AtomType
aType <- Attributes -> GraphRefAtomExpr -> GraphRefRelationalExprM AtomType
typeForGraphRefAtomExpr Attributes
attrs GraphRefAtomExpr
atomExpr
  if AtomType
aType AtomType -> AtomType -> DirtyFlag
forall a. Eq a => a -> a -> DirtyFlag
/= AtomType
BoolAtomType then
      RelationalError -> GraphRefRelationalExprM RestrictionFilter
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (AtomType -> AtomType -> RelationalError
AtomTypeMismatchError AtomType
aType AtomType
BoolAtomType)
    else
      RestrictionFilter -> GraphRefRelationalExprM RestrictionFilter
forall (f :: * -> *) a. Applicative f => a -> f a
pure (\RelationTuple
tupleIn ->
             case GraphRefRelationalExprEnv
-> GraphRefRelationalExprM Atom -> Either RelationalError Atom
forall a.
GraphRefRelationalExprEnv
-> GraphRefRelationalExprM a -> Either RelationalError a
runGraphRefRelationalExprM GraphRefRelationalExprEnv
renv (RelationTuple -> GraphRefAtomExpr -> GraphRefRelationalExprM Atom
evalGraphRefAtomExpr RelationTuple
tupleIn GraphRefAtomExpr
atomExpr) of
               Left RelationalError
err -> RelationalError -> Either RelationalError DirtyFlag
forall a b. a -> Either a b
Left RelationalError
err
               Right Atom
boolAtomValue -> DirtyFlag -> Either RelationalError DirtyFlag
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Atom
boolAtomValue Atom -> Atom -> DirtyFlag
forall a. Eq a => a -> a -> DirtyFlag
== DirtyFlag -> Atom
BoolAtom DirtyFlag
True))

tupleExprCheckNewAttrName :: AttributeName -> Relation -> Either RelationalError Relation
tupleExprCheckNewAttrName :: AttributeName -> Relation -> Either RelationalError Relation
tupleExprCheckNewAttrName AttributeName
attrName Relation
rel = if Either RelationalError Attribute -> DirtyFlag
forall a b. Either a b -> DirtyFlag
isRight (AttributeName -> Relation -> Either RelationalError Attribute
attributeForName AttributeName
attrName Relation
rel) then
                                           RelationalError -> Either RelationalError Relation
forall a b. a -> Either a b
Left (AttributeName -> RelationalError
AttributeNameInUseError AttributeName
attrName)
                                         else
                                           Relation -> Either RelationalError Relation
forall a b. b -> Either a b
Right Relation
rel

extendGraphRefTupleExpressionProcessor :: Relation -> GraphRefExtendTupleExpr -> GraphRefRelationalExprM (Attributes, RelationTuple -> Either RelationalError RelationTuple)
extendGraphRefTupleExpressionProcessor :: Relation
-> GraphRefExtendTupleExpr
-> GraphRefRelationalExprM
     (Attributes, RelationTuple -> Either RelationalError RelationTuple)
extendGraphRefTupleExpressionProcessor Relation
relIn (AttributeExtendTupleExpr AttributeName
newAttrName GraphRefAtomExpr
atomExpr) = 
--  renv <- askEnv
  -- check that the attribute name is not in use
  case AttributeName -> Relation -> Either RelationalError Relation
tupleExprCheckNewAttrName AttributeName
newAttrName Relation
relIn of
    Left RelationalError
err -> RelationalError
-> GraphRefRelationalExprM
     (Attributes, RelationTuple -> Either RelationalError RelationTuple)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError RelationalError
err
    Right Relation
_ -> do
      AtomType
atomExprType <- Attributes -> GraphRefAtomExpr -> GraphRefRelationalExprM AtomType
typeForGraphRefAtomExpr (Relation -> Attributes
attributes Relation
relIn) GraphRefAtomExpr
atomExpr
      AtomType
atomExprType' <- Relation
-> GraphRefAtomExpr -> AtomType -> GraphRefRelationalExprM AtomType
verifyGraphRefAtomExprTypes Relation
relIn GraphRefAtomExpr
atomExpr AtomType
atomExprType
      let newAttrs :: Attributes
newAttrs = [Attribute] -> Attributes
A.attributesFromList [AttributeName -> AtomType -> Attribute
Attribute AttributeName
newAttrName AtomType
atomExprType']
          newAndOldAttrs :: Attributes
newAndOldAttrs = Attributes -> Attributes -> Attributes
A.addAttributes (Relation -> Attributes
attributes Relation
relIn) Attributes
newAttrs
      GraphRefRelationalExprEnv
env <- GraphRefRelationalExprM GraphRefRelationalExprEnv
forall r (m :: * -> *). MonadReader r m => m r
ask
      (Attributes, RelationTuple -> Either RelationalError RelationTuple)
-> GraphRefRelationalExprM
     (Attributes, RelationTuple -> Either RelationalError RelationTuple)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Attributes
newAndOldAttrs, \RelationTuple
tup -> do
               let gfEnv :: GraphRefRelationalExprEnv
gfEnv = RelationTuple
-> GraphRefRelationalExprEnv -> GraphRefRelationalExprEnv
mergeTuplesIntoGraphRefRelationalExprEnv RelationTuple
tup GraphRefRelationalExprEnv
env
               Atom
atom <- GraphRefRelationalExprEnv
-> GraphRefRelationalExprM Atom -> Either RelationalError Atom
forall a.
GraphRefRelationalExprEnv
-> GraphRefRelationalExprM a -> Either RelationalError a
runGraphRefRelationalExprM GraphRefRelationalExprEnv
gfEnv (RelationTuple -> GraphRefAtomExpr -> GraphRefRelationalExprM Atom
evalGraphRefAtomExpr RelationTuple
tup GraphRefAtomExpr
atomExpr)
               RelationTuple -> Either RelationalError RelationTuple
forall a b. b -> Either a b
Right (AttributeName -> Atom -> RelationTuple -> RelationTuple
tupleAtomExtend AttributeName
newAttrName Atom
atom RelationTuple
tup)
               )

evalGraphRefAtomExpr :: RelationTuple -> GraphRefAtomExpr -> GraphRefRelationalExprM Atom
evalGraphRefAtomExpr :: RelationTuple -> GraphRefAtomExpr -> GraphRefRelationalExprM Atom
evalGraphRefAtomExpr RelationTuple
tupIn (AttributeAtomExpr AttributeName
attrName) =
  case AttributeName -> RelationTuple -> Either RelationalError Atom
atomForAttributeName AttributeName
attrName RelationTuple
tupIn of
    Right Atom
atom -> Atom -> GraphRefRelationalExprM Atom
forall (f :: * -> *) a. Applicative f => a -> f a
pure Atom
atom
    Left err :: RelationalError
err@(NoSuchAttributeNamesError Set AttributeName
_) -> do
      GraphRefRelationalExprEnv
env <- GraphRefRelationalExprM GraphRefRelationalExprEnv
askEnv
      case GraphRefRelationalExprEnv
-> Maybe (Either RelationTuple Attributes)
gre_extra GraphRefRelationalExprEnv
env of
        Maybe (Either RelationTuple Attributes)
Nothing -> RelationalError -> GraphRefRelationalExprM Atom
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError RelationalError
err
        Just (Left RelationTuple
ctxtup) -> ExceptT RelationalError Identity Atom
-> GraphRefRelationalExprM Atom
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT RelationalError Identity Atom
 -> GraphRefRelationalExprM Atom)
-> ExceptT RelationalError Identity Atom
-> GraphRefRelationalExprM Atom
forall a b. (a -> b) -> a -> b
$ Either RelationalError Atom
-> ExceptT RelationalError Identity Atom
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either RelationalError Atom
 -> ExceptT RelationalError Identity Atom)
-> Either RelationalError Atom
-> ExceptT RelationalError Identity Atom
forall a b. (a -> b) -> a -> b
$ AttributeName -> RelationTuple -> Either RelationalError Atom
atomForAttributeName AttributeName
attrName RelationTuple
ctxtup
        Just (Right Attributes
_) -> RelationalError -> GraphRefRelationalExprM Atom
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError RelationalError
err
    Left RelationalError
err -> RelationalError -> GraphRefRelationalExprM Atom
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError RelationalError
err
evalGraphRefAtomExpr RelationTuple
_ (NakedAtomExpr Atom
atom) = Atom -> GraphRefRelationalExprM Atom
forall (f :: * -> *) a. Applicative f => a -> f a
pure Atom
atom
evalGraphRefAtomExpr RelationTuple
tupIn (FunctionAtomExpr AttributeName
funcName' [GraphRefAtomExpr]
arguments GraphRefTransactionMarker
tid) = do
  [AtomType]
argTypes <- (GraphRefAtomExpr -> GraphRefRelationalExprM AtomType)
-> [GraphRefAtomExpr]
-> ReaderT
     GraphRefRelationalExprEnv
     (ExceptT RelationalError Identity)
     [AtomType]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Attributes -> GraphRefAtomExpr -> GraphRefRelationalExprM AtomType
typeForGraphRefAtomExpr (RelationTuple -> Attributes
tupleAttributes RelationTuple
tupIn)) [GraphRefAtomExpr]
arguments
  DatabaseContext
context <- GraphRefTransactionMarker
-> GraphRefRelationalExprM DatabaseContext
gfDatabaseContextForMarker GraphRefTransactionMarker
tid
  let functions :: AtomFunctions
functions = DatabaseContext -> AtomFunctions
atomFunctions DatabaseContext
context
  AtomFunction
func <- ExceptT RelationalError Identity AtomFunction
-> ReaderT
     GraphRefRelationalExprEnv
     (ExceptT RelationalError Identity)
     AtomFunction
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT RelationalError Identity AtomFunction
 -> ReaderT
      GraphRefRelationalExprEnv
      (ExceptT RelationalError Identity)
      AtomFunction)
-> ExceptT RelationalError Identity AtomFunction
-> ReaderT
     GraphRefRelationalExprEnv
     (ExceptT RelationalError Identity)
     AtomFunction
forall a b. (a -> b) -> a -> b
$ Either RelationalError AtomFunction
-> ExceptT RelationalError Identity AtomFunction
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (AttributeName
-> AtomFunctions -> Either RelationalError AtomFunction
atomFunctionForName AttributeName
funcName' AtomFunctions
functions)
  let expectedArgCount :: Int
expectedArgCount = [AtomType] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (AtomFunction -> [AtomType]
forall a. Function a -> [AtomType]
funcType AtomFunction
func) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
      actualArgCount :: Int
actualArgCount = [AtomType] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [AtomType]
argTypes
      safeInit :: [a] -> [a]
safeInit [] = [] -- different behavior from normal init
      safeInit [a]
xs = [a] -> [a]
forall a. [a] -> [a]
init [a]
xs
  if Int
expectedArgCount Int -> Int -> DirtyFlag
forall a. Eq a => a -> a -> DirtyFlag
/= Int
actualArgCount then
      RelationalError -> GraphRefRelationalExprM Atom
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Int -> Int -> RelationalError
FunctionArgumentCountMismatchError Int
expectedArgCount Int
actualArgCount)
    else do
      let zippedArgs :: [(AtomType, AtomType)]
zippedArgs = [AtomType] -> [AtomType] -> [(AtomType, AtomType)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([AtomType] -> [AtomType]
forall a. [a] -> [a]
safeInit (AtomFunction -> [AtomType]
forall a. Function a -> [AtomType]
funcType AtomFunction
func)) [AtomType]
argTypes
      ((AtomType, AtomType) -> GraphRefRelationalExprM AtomType)
-> [(AtomType, AtomType)]
-> ReaderT
     GraphRefRelationalExprEnv (ExceptT RelationalError Identity) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(AtomType
expType, AtomType
actType) -> 
                ExceptT RelationalError Identity AtomType
-> GraphRefRelationalExprM AtomType
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT RelationalError Identity AtomType
 -> GraphRefRelationalExprM AtomType)
-> ExceptT RelationalError Identity AtomType
-> GraphRefRelationalExprM AtomType
forall a b. (a -> b) -> a -> b
$ Either RelationalError AtomType
-> ExceptT RelationalError Identity AtomType
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (AtomType -> AtomType -> Either RelationalError AtomType
atomTypeVerify AtomType
expType AtomType
actType)) [(AtomType, AtomType)]
zippedArgs
      [Atom]
evaldArgs <- (GraphRefAtomExpr -> GraphRefRelationalExprM Atom)
-> [GraphRefAtomExpr]
-> ReaderT
     GraphRefRelationalExprEnv (ExceptT RelationalError Identity) [Atom]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (RelationTuple -> GraphRefAtomExpr -> GraphRefRelationalExprM Atom
evalGraphRefAtomExpr RelationTuple
tupIn) [GraphRefAtomExpr]
arguments
      case AtomFunction -> AtomFunctionBodyType
evalAtomFunction AtomFunction
func [Atom]
evaldArgs of
        Left AtomFunctionError
err -> RelationalError -> GraphRefRelationalExprM Atom
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (AtomFunctionError -> RelationalError
AtomFunctionUserError AtomFunctionError
err)
        Right Atom
result -> do
          --validate that the result matches the expected type
          AtomType
_ <- ExceptT RelationalError Identity AtomType
-> GraphRefRelationalExprM AtomType
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT RelationalError Identity AtomType
 -> GraphRefRelationalExprM AtomType)
-> ExceptT RelationalError Identity AtomType
-> GraphRefRelationalExprM AtomType
forall a b. (a -> b) -> a -> b
$ Either RelationalError AtomType
-> ExceptT RelationalError Identity AtomType
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (AtomType -> AtomType -> Either RelationalError AtomType
atomTypeVerify ([AtomType] -> AtomType
forall a. [a] -> a
last (AtomFunction -> [AtomType]
forall a. Function a -> [AtomType]
funcType AtomFunction
func)) (Atom -> AtomType
atomTypeForAtom Atom
result))
          Atom -> GraphRefRelationalExprM Atom
forall (f :: * -> *) a. Applicative f => a -> f a
pure Atom
result
evalGraphRefAtomExpr RelationTuple
tupIn (RelationAtomExpr GraphRefRelationalExpr
relExpr) = do
  --merge existing state tuple context into new state tuple context to support an arbitrary number of levels, but new attributes trounce old attributes
  GraphRefRelationalExprEnv
env <- GraphRefRelationalExprM GraphRefRelationalExprEnv
forall r (m :: * -> *). MonadReader r m => m r
ask
  let gfEnv :: GraphRefRelationalExprEnv
gfEnv = RelationTuple
-> GraphRefRelationalExprEnv -> GraphRefRelationalExprEnv
mergeTuplesIntoGraphRefRelationalExprEnv RelationTuple
tupIn GraphRefRelationalExprEnv
env
  Relation
relAtom <- ExceptT RelationalError Identity Relation
-> GraphRefRelationalExprM Relation
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT RelationalError Identity Relation
 -> GraphRefRelationalExprM Relation)
-> ExceptT RelationalError Identity Relation
-> GraphRefRelationalExprM Relation
forall a b. (a -> b) -> a -> b
$ Either RelationalError Relation
-> ExceptT RelationalError Identity Relation
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either RelationalError Relation
 -> ExceptT RelationalError Identity Relation)
-> Either RelationalError Relation
-> ExceptT RelationalError Identity Relation
forall a b. (a -> b) -> a -> b
$ GraphRefRelationalExprEnv
-> GraphRefRelationalExprM Relation
-> Either RelationalError Relation
forall a.
GraphRefRelationalExprEnv
-> GraphRefRelationalExprM a -> Either RelationalError a
runGraphRefRelationalExprM GraphRefRelationalExprEnv
gfEnv (GraphRefRelationalExpr -> GraphRefRelationalExprM Relation
evalGraphRefRelationalExpr GraphRefRelationalExpr
relExpr)
  Atom -> GraphRefRelationalExprM Atom
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Relation -> Atom
RelationAtom Relation
relAtom)
evalGraphRefAtomExpr RelationTuple
_ (ConstructedAtomExpr AttributeName
tOrF [] GraphRefTransactionMarker
_)
  | AttributeName
tOrF AttributeName -> AttributeName -> DirtyFlag
forall a. Eq a => a -> a -> DirtyFlag
== AttributeName
"True" = Atom -> GraphRefRelationalExprM Atom
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DirtyFlag -> Atom
BoolAtom DirtyFlag
True)
  | AttributeName
tOrF AttributeName -> AttributeName -> DirtyFlag
forall a. Eq a => a -> a -> DirtyFlag
== AttributeName
"False" = Atom -> GraphRefRelationalExprM Atom
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DirtyFlag -> Atom
BoolAtom DirtyFlag
False)
evalGraphRefAtomExpr RelationTuple
tupIn cons :: GraphRefAtomExpr
cons@(ConstructedAtomExpr AttributeName
dConsName [GraphRefAtomExpr]
dConsArgs GraphRefTransactionMarker
_) = do --why is the tid unused here? suspicious
  let mergeEnv :: GraphRefRelationalExprEnv -> GraphRefRelationalExprEnv
mergeEnv = RelationTuple
-> GraphRefRelationalExprEnv -> GraphRefRelationalExprEnv
mergeTuplesIntoGraphRefRelationalExprEnv RelationTuple
tupIn
  AtomType
aType <- (GraphRefRelationalExprEnv -> GraphRefRelationalExprEnv)
-> GraphRefRelationalExprM AtomType
-> GraphRefRelationalExprM AtomType
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local GraphRefRelationalExprEnv -> GraphRefRelationalExprEnv
mergeEnv (Attributes -> GraphRefAtomExpr -> GraphRefRelationalExprM AtomType
typeForGraphRefAtomExpr (RelationTuple -> Attributes
tupleAttributes RelationTuple
tupIn) GraphRefAtomExpr
cons)
  [Atom]
argAtoms <- (GraphRefRelationalExprEnv -> GraphRefRelationalExprEnv)
-> ReaderT
     GraphRefRelationalExprEnv (ExceptT RelationalError Identity) [Atom]
-> ReaderT
     GraphRefRelationalExprEnv (ExceptT RelationalError Identity) [Atom]
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local GraphRefRelationalExprEnv -> GraphRefRelationalExprEnv
mergeEnv (ReaderT
   GraphRefRelationalExprEnv (ExceptT RelationalError Identity) [Atom]
 -> ReaderT
      GraphRefRelationalExprEnv
      (ExceptT RelationalError Identity)
      [Atom])
-> ReaderT
     GraphRefRelationalExprEnv (ExceptT RelationalError Identity) [Atom]
-> ReaderT
     GraphRefRelationalExprEnv (ExceptT RelationalError Identity) [Atom]
forall a b. (a -> b) -> a -> b
$
    (GraphRefAtomExpr -> GraphRefRelationalExprM Atom)
-> [GraphRefAtomExpr]
-> ReaderT
     GraphRefRelationalExprEnv (ExceptT RelationalError Identity) [Atom]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (RelationTuple -> GraphRefAtomExpr -> GraphRefRelationalExprM Atom
evalGraphRefAtomExpr RelationTuple
tupIn) [GraphRefAtomExpr]
dConsArgs
  Atom -> GraphRefRelationalExprM Atom
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AttributeName -> AtomType -> [Atom] -> Atom
ConstructedAtom AttributeName
dConsName AtomType
aType [Atom]
argAtoms)

typeForGraphRefAtomExpr :: Attributes -> GraphRefAtomExpr -> GraphRefRelationalExprM AtomType
typeForGraphRefAtomExpr :: Attributes -> GraphRefAtomExpr -> GraphRefRelationalExprM AtomType
typeForGraphRefAtomExpr Attributes
attrs (AttributeAtomExpr AttributeName
attrName) = do
  GraphRefRelationalExprEnv
renv <- GraphRefRelationalExprM GraphRefRelationalExprEnv
askEnv
  case AttributeName -> Attributes -> Either RelationalError AtomType
A.atomTypeForAttributeName AttributeName
attrName Attributes
attrs of
    Right AtomType
aType -> AtomType -> GraphRefRelationalExprM AtomType
forall (f :: * -> *) a. Applicative f => a -> f a
pure AtomType
aType
    Left err :: RelationalError
err@(NoSuchAttributeNamesError Set AttributeName
_) ->
      let envTup :: RelationTuple
envTup = GraphRefRelationalExprEnv -> RelationTuple
envTuple GraphRefRelationalExprEnv
renv
          envAttrs :: Attributes
envAttrs = GraphRefRelationalExprEnv -> Attributes
envAttributes GraphRefRelationalExprEnv
renv in
      case AttributeName -> Attributes -> Either RelationalError Attribute
A.attributeForName AttributeName
attrName Attributes
envAttrs of
        Right Attribute
attr -> AtomType -> GraphRefRelationalExprM AtomType
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Attribute -> AtomType
A.atomType Attribute
attr)
        Left RelationalError
_ -> case AttributeName -> RelationTuple -> Either RelationalError Atom
atomForAttributeName AttributeName
attrName RelationTuple
envTup of
          Right Atom
atom -> AtomType -> GraphRefRelationalExprM AtomType
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Atom -> AtomType
atomTypeForAtom Atom
atom)
          Left RelationalError
_ -> --throwError (traceStack (show ("typeForGRAtomExpr", attrs, envTup)) err)
            RelationalError -> GraphRefRelationalExprM AtomType
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError RelationalError
err
    Left RelationalError
err -> RelationalError -> GraphRefRelationalExprM AtomType
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError RelationalError
err

typeForGraphRefAtomExpr Attributes
_ (NakedAtomExpr Atom
atom) = AtomType -> GraphRefRelationalExprM AtomType
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Atom -> AtomType
atomTypeForAtom Atom
atom)
typeForGraphRefAtomExpr Attributes
attrs (FunctionAtomExpr AttributeName
funcName' [GraphRefAtomExpr]
atomArgs GraphRefTransactionMarker
transId) = do
  AtomFunctions
funcs <- DatabaseContext -> AtomFunctions
atomFunctions (DatabaseContext -> AtomFunctions)
-> GraphRefRelationalExprM DatabaseContext
-> ReaderT
     GraphRefRelationalExprEnv
     (ExceptT RelationalError Identity)
     AtomFunctions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GraphRefTransactionMarker
-> GraphRefRelationalExprM DatabaseContext
gfDatabaseContextForMarker GraphRefTransactionMarker
transId
  case AttributeName
-> AtomFunctions -> Either RelationalError AtomFunction
atomFunctionForName AttributeName
funcName' AtomFunctions
funcs of
    Left RelationalError
err -> RelationalError -> GraphRefRelationalExprM AtomType
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError RelationalError
err
    Right AtomFunction
func -> do
      let funcRetType :: AtomType
funcRetType = [AtomType] -> AtomType
forall a. [a] -> a
last (AtomFunction -> [AtomType]
forall a. Function a -> [AtomType]
funcType AtomFunction
func)
          funcArgTypes :: [AtomType]
funcArgTypes = [AtomType] -> [AtomType]
forall a. [a] -> [a]
init (AtomFunction -> [AtomType]
forall a. Function a -> [AtomType]
funcType AtomFunction
func)
          funArgCount :: Int
funArgCount = [AtomType] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [AtomType]
funcArgTypes
          inArgCount :: Int
inArgCount = [GraphRefAtomExpr] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [GraphRefAtomExpr]
atomArgs
      DirtyFlag
-> ReaderT
     GraphRefRelationalExprEnv (ExceptT RelationalError Identity) ()
-> ReaderT
     GraphRefRelationalExprEnv (ExceptT RelationalError Identity) ()
forall (f :: * -> *). Applicative f => DirtyFlag -> f () -> f ()
when (Int
funArgCount Int -> Int -> DirtyFlag
forall a. Eq a => a -> a -> DirtyFlag
/= Int
inArgCount) (RelationalError
-> ReaderT
     GraphRefRelationalExprEnv (ExceptT RelationalError Identity) ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Int -> Int -> RelationalError
FunctionArgumentCountMismatchError Int
funArgCount Int
inArgCount))
      [AtomType]
argTypes <- (GraphRefAtomExpr -> GraphRefRelationalExprM AtomType)
-> [GraphRefAtomExpr]
-> ReaderT
     GraphRefRelationalExprEnv
     (ExceptT RelationalError Identity)
     [AtomType]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Attributes -> GraphRefAtomExpr -> GraphRefRelationalExprM AtomType
typeForGraphRefAtomExpr Attributes
attrs) [GraphRefAtomExpr]
atomArgs
      ((AtomType, AtomType, Int) -> GraphRefRelationalExprM AtomType)
-> [(AtomType, AtomType, Int)]
-> ReaderT
     GraphRefRelationalExprEnv (ExceptT RelationalError Identity) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(AtomType
fArg,AtomType
arg,Int
argCount) -> do
                let handler :: RelationalError -> GraphRefRelationalExprM AtomType
                    handler :: RelationalError -> GraphRefRelationalExprM AtomType
handler (AtomTypeMismatchError AtomType
expSubType AtomType
actSubType) = RelationalError -> GraphRefRelationalExprM AtomType
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (AttributeName -> Int -> AtomType -> AtomType -> RelationalError
AtomFunctionTypeError AttributeName
funcName' Int
argCount AtomType
expSubType AtomType
actSubType)
                    handler RelationalError
err = RelationalError -> GraphRefRelationalExprM AtomType
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError RelationalError
err
                ExceptT RelationalError Identity AtomType
-> GraphRefRelationalExprM AtomType
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either RelationalError AtomType
-> ExceptT RelationalError Identity AtomType
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either RelationalError AtomType
 -> ExceptT RelationalError Identity AtomType)
-> Either RelationalError AtomType
-> ExceptT RelationalError Identity AtomType
forall a b. (a -> b) -> a -> b
$ AtomType -> AtomType -> Either RelationalError AtomType
atomTypeVerify AtomType
fArg AtomType
arg) GraphRefRelationalExprM AtomType
-> (RelationalError -> GraphRefRelationalExprM AtomType)
-> GraphRefRelationalExprM AtomType
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` RelationalError -> GraphRefRelationalExprM AtomType
handler
            ) ([AtomType] -> [AtomType] -> [Int] -> [(AtomType, AtomType, Int)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [AtomType]
funcArgTypes [AtomType]
argTypes [Int
1..])
      let eTvMap :: Either RelationalError TypeVarMap
eTvMap = [AtomType] -> [AtomType] -> Either RelationalError TypeVarMap
resolveTypeVariables [AtomType]
funcArgTypes [AtomType]
argTypes
      case Either RelationalError TypeVarMap
eTvMap of
            Left RelationalError
err -> RelationalError -> GraphRefRelationalExprM AtomType
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError RelationalError
err
            Right TypeVarMap
tvMap ->
              ExceptT RelationalError Identity AtomType
-> GraphRefRelationalExprM AtomType
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT RelationalError Identity AtomType
 -> GraphRefRelationalExprM AtomType)
-> ExceptT RelationalError Identity AtomType
-> GraphRefRelationalExprM AtomType
forall a b. (a -> b) -> a -> b
$ Either RelationalError AtomType
-> ExceptT RelationalError Identity AtomType
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either RelationalError AtomType
 -> ExceptT RelationalError Identity AtomType)
-> Either RelationalError AtomType
-> ExceptT RelationalError Identity AtomType
forall a b. (a -> b) -> a -> b
$ AttributeName
-> TypeVarMap -> AtomType -> Either RelationalError AtomType
resolveFunctionReturnValue AttributeName
funcName' TypeVarMap
tvMap AtomType
funcRetType
typeForGraphRefAtomExpr Attributes
attrs (RelationAtomExpr GraphRefRelationalExpr
relExpr) = do
  Relation
relType <- (GraphRefRelationalExprEnv -> GraphRefRelationalExprEnv)
-> GraphRefRelationalExprM Relation
-> GraphRefRelationalExprM Relation
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
R.local (Attributes
-> GraphRefRelationalExprEnv -> GraphRefRelationalExprEnv
mergeAttributesIntoGraphRefRelationalExprEnv Attributes
attrs) (GraphRefRelationalExpr -> GraphRefRelationalExprM Relation
typeForGraphRefRelationalExpr GraphRefRelationalExpr
relExpr)  
  AtomType -> GraphRefRelationalExprM AtomType
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Attributes -> AtomType
RelationAtomType (Relation -> Attributes
attributes Relation
relType))
-- grab the type of the data constructor, then validate that the args match the expected types
typeForGraphRefAtomExpr Attributes
_ (ConstructedAtomExpr AttributeName
tOrF [] GraphRefTransactionMarker
_) | AttributeName
tOrF AttributeName -> [AttributeName] -> DirtyFlag
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> DirtyFlag
`elem` [AttributeName
"True", AttributeName
"False"] =
                                                            AtomType -> GraphRefRelationalExprM AtomType
forall (f :: * -> *) a. Applicative f => a -> f a
pure AtomType
BoolAtomType
typeForGraphRefAtomExpr Attributes
attrs (ConstructedAtomExpr AttributeName
dConsName [GraphRefAtomExpr]
dConsArgs GraphRefTransactionMarker
tid) =
  do
    [AtomType]
argsTypes <- (GraphRefAtomExpr -> GraphRefRelationalExprM AtomType)
-> [GraphRefAtomExpr]
-> ReaderT
     GraphRefRelationalExprEnv
     (ExceptT RelationalError Identity)
     [AtomType]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Attributes -> GraphRefAtomExpr -> GraphRefRelationalExprM AtomType
typeForGraphRefAtomExpr Attributes
attrs) [GraphRefAtomExpr]
dConsArgs
    TypeConstructorMapping
tConsMap <- DatabaseContext -> TypeConstructorMapping
typeConstructorMapping (DatabaseContext -> TypeConstructorMapping)
-> GraphRefRelationalExprM DatabaseContext
-> ReaderT
     GraphRefRelationalExprEnv
     (ExceptT RelationalError Identity)
     TypeConstructorMapping
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GraphRefTransactionMarker
-> GraphRefRelationalExprM DatabaseContext
gfDatabaseContextForMarker GraphRefTransactionMarker
tid
    ExceptT RelationalError Identity AtomType
-> GraphRefRelationalExprM AtomType
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT RelationalError Identity AtomType
 -> GraphRefRelationalExprM AtomType)
-> ExceptT RelationalError Identity AtomType
-> GraphRefRelationalExprM AtomType
forall a b. (a -> b) -> a -> b
$ Either RelationalError AtomType
-> ExceptT RelationalError Identity AtomType
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either RelationalError AtomType
 -> ExceptT RelationalError Identity AtomType)
-> Either RelationalError AtomType
-> ExceptT RelationalError Identity AtomType
forall a b. (a -> b) -> a -> b
$ TypeConstructorMapping
-> AttributeName -> [AtomType] -> Either RelationalError AtomType
atomTypeForDataConstructor TypeConstructorMapping
tConsMap AttributeName
dConsName [AtomType]
argsTypes

-- | Validate that the type of the AtomExpr matches the expected type.
verifyGraphRefAtomExprTypes :: Relation -> GraphRefAtomExpr -> AtomType -> GraphRefRelationalExprM AtomType
verifyGraphRefAtomExprTypes :: Relation
-> GraphRefAtomExpr -> AtomType -> GraphRefRelationalExprM AtomType
verifyGraphRefAtomExprTypes Relation
relIn (AttributeAtomExpr AttributeName
attrName) AtomType
expectedType = do
  GraphRefRelationalExprEnv
env <- GraphRefRelationalExprM GraphRefRelationalExprEnv
askEnv
  case AttributeName -> Attributes -> Either RelationalError AtomType
A.atomTypeForAttributeName AttributeName
attrName (Relation -> Attributes
attributes Relation
relIn) of
    Right AtomType
aType -> ExceptT RelationalError Identity AtomType
-> GraphRefRelationalExprM AtomType
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT RelationalError Identity AtomType
 -> GraphRefRelationalExprM AtomType)
-> ExceptT RelationalError Identity AtomType
-> GraphRefRelationalExprM AtomType
forall a b. (a -> b) -> a -> b
$ Either RelationalError AtomType
-> ExceptT RelationalError Identity AtomType
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either RelationalError AtomType
 -> ExceptT RelationalError Identity AtomType)
-> Either RelationalError AtomType
-> ExceptT RelationalError Identity AtomType
forall a b. (a -> b) -> a -> b
$ AtomType -> AtomType -> Either RelationalError AtomType
atomTypeVerify AtomType
expectedType AtomType
aType
    (Left err :: RelationalError
err@(NoSuchAttributeNamesError Set AttributeName
_)) ->
      let attrs' :: Attributes
attrs' = GraphRefRelationalExprEnv -> Attributes
envAttributes GraphRefRelationalExprEnv
env in
        if Attributes
attrs' Attributes -> Attributes -> DirtyFlag
forall a. Eq a => a -> a -> DirtyFlag
== Attributes
emptyAttributes then
          RelationalError -> GraphRefRelationalExprM AtomType
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError RelationalError
err
        else
          case AttributeName -> Attributes -> Either RelationalError Attribute
A.attributeForName AttributeName
attrName Attributes
attrs' of
            Left RelationalError
err' -> RelationalError -> GraphRefRelationalExprM AtomType
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError RelationalError
err'
            Right Attribute
attrType -> ExceptT RelationalError Identity AtomType
-> GraphRefRelationalExprM AtomType
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT RelationalError Identity AtomType
 -> GraphRefRelationalExprM AtomType)
-> ExceptT RelationalError Identity AtomType
-> GraphRefRelationalExprM AtomType
forall a b. (a -> b) -> a -> b
$ Either RelationalError AtomType
-> ExceptT RelationalError Identity AtomType
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either RelationalError AtomType
 -> ExceptT RelationalError Identity AtomType)
-> Either RelationalError AtomType
-> ExceptT RelationalError Identity AtomType
forall a b. (a -> b) -> a -> b
$ AtomType -> AtomType -> Either RelationalError AtomType
atomTypeVerify AtomType
expectedType (Attribute -> AtomType
A.atomType Attribute
attrType)
    Left RelationalError
err -> RelationalError -> GraphRefRelationalExprM AtomType
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError RelationalError
err

verifyGraphRefAtomExprTypes Relation
_ (NakedAtomExpr Atom
atom) AtomType
expectedType =
  ExceptT RelationalError Identity AtomType
-> GraphRefRelationalExprM AtomType
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT RelationalError Identity AtomType
 -> GraphRefRelationalExprM AtomType)
-> ExceptT RelationalError Identity AtomType
-> GraphRefRelationalExprM AtomType
forall a b. (a -> b) -> a -> b
$ Either RelationalError AtomType
-> ExceptT RelationalError Identity AtomType
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either RelationalError AtomType
 -> ExceptT RelationalError Identity AtomType)
-> Either RelationalError AtomType
-> ExceptT RelationalError Identity AtomType
forall a b. (a -> b) -> a -> b
$ AtomType -> AtomType -> Either RelationalError AtomType
atomTypeVerify AtomType
expectedType (Atom -> AtomType
atomTypeForAtom Atom
atom)
verifyGraphRefAtomExprTypes Relation
relIn (FunctionAtomExpr AttributeName
funcName' [GraphRefAtomExpr]
funcArgExprs GraphRefTransactionMarker
tid) AtomType
expectedType = do
  DatabaseContext
context <- GraphRefTransactionMarker
-> GraphRefRelationalExprM DatabaseContext
gfDatabaseContextForMarker GraphRefTransactionMarker
tid
  let functions :: AtomFunctions
functions = DatabaseContext -> AtomFunctions
atomFunctions DatabaseContext
context
  AtomFunction
func <- ExceptT RelationalError Identity AtomFunction
-> ReaderT
     GraphRefRelationalExprEnv
     (ExceptT RelationalError Identity)
     AtomFunction
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT RelationalError Identity AtomFunction
 -> ReaderT
      GraphRefRelationalExprEnv
      (ExceptT RelationalError Identity)
      AtomFunction)
-> ExceptT RelationalError Identity AtomFunction
-> ReaderT
     GraphRefRelationalExprEnv
     (ExceptT RelationalError Identity)
     AtomFunction
forall a b. (a -> b) -> a -> b
$ Either RelationalError AtomFunction
-> ExceptT RelationalError Identity AtomFunction
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either RelationalError AtomFunction
 -> ExceptT RelationalError Identity AtomFunction)
-> Either RelationalError AtomFunction
-> ExceptT RelationalError Identity AtomFunction
forall a b. (a -> b) -> a -> b
$ AttributeName
-> AtomFunctions -> Either RelationalError AtomFunction
atomFunctionForName AttributeName
funcName' AtomFunctions
functions
  let expectedArgTypes :: [AtomType]
expectedArgTypes = AtomFunction -> [AtomType]
forall a. Function a -> [AtomType]
funcType AtomFunction
func
      funcArgVerifier :: (GraphRefAtomExpr, AtomType, Int)
-> GraphRefRelationalExprM AtomType
funcArgVerifier (GraphRefAtomExpr
atomExpr, AtomType
expectedType2, Int
argCount) = do
        let handler :: RelationalError -> GraphRefRelationalExprM AtomType
            handler :: RelationalError -> GraphRefRelationalExprM AtomType
handler (AtomTypeMismatchError AtomType
expSubType AtomType
actSubType) = RelationalError -> GraphRefRelationalExprM AtomType
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (AttributeName -> Int -> AtomType -> AtomType -> RelationalError
AtomFunctionTypeError AttributeName
funcName' Int
argCount AtomType
expSubType AtomType
actSubType)
            handler RelationalError
err = RelationalError -> GraphRefRelationalExprM AtomType
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError RelationalError
err
        Relation
-> GraphRefAtomExpr -> AtomType -> GraphRefRelationalExprM AtomType
verifyGraphRefAtomExprTypes Relation
relIn GraphRefAtomExpr
atomExpr AtomType
expectedType2 GraphRefRelationalExprM AtomType
-> (RelationalError -> GraphRefRelationalExprM AtomType)
-> GraphRefRelationalExprM AtomType
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` RelationalError -> GraphRefRelationalExprM AtomType
handler   
  [AtomType]
funcArgTypes <- ((GraphRefAtomExpr, AtomType, Int)
 -> GraphRefRelationalExprM AtomType)
-> [(GraphRefAtomExpr, AtomType, Int)]
-> ReaderT
     GraphRefRelationalExprEnv
     (ExceptT RelationalError Identity)
     [AtomType]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (GraphRefAtomExpr, AtomType, Int)
-> GraphRefRelationalExprM AtomType
funcArgVerifier ([(GraphRefAtomExpr, AtomType, Int)]
 -> ReaderT
      GraphRefRelationalExprEnv
      (ExceptT RelationalError Identity)
      [AtomType])
-> [(GraphRefAtomExpr, AtomType, Int)]
-> ReaderT
     GraphRefRelationalExprEnv
     (ExceptT RelationalError Identity)
     [AtomType]
forall a b. (a -> b) -> a -> b
$ [GraphRefAtomExpr]
-> [AtomType] -> [Int] -> [(GraphRefAtomExpr, AtomType, Int)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [GraphRefAtomExpr]
funcArgExprs [AtomType]
expectedArgTypes [Int
1..]
  if [AtomType] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [AtomType]
funcArgTypes Int -> Int -> DirtyFlag
forall a. Eq a => a -> a -> DirtyFlag
/= [AtomType] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [AtomType]
expectedArgTypes Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 then
      RelationalError -> GraphRefRelationalExprM AtomType
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ([AtomType] -> [AtomType] -> RelationalError
AtomTypeCountError [AtomType]
funcArgTypes [AtomType]
expectedArgTypes)
      else 
      ExceptT RelationalError Identity AtomType
-> GraphRefRelationalExprM AtomType
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT RelationalError Identity AtomType
 -> GraphRefRelationalExprM AtomType)
-> ExceptT RelationalError Identity AtomType
-> GraphRefRelationalExprM AtomType
forall a b. (a -> b) -> a -> b
$ Either RelationalError AtomType
-> ExceptT RelationalError Identity AtomType
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either RelationalError AtomType
 -> ExceptT RelationalError Identity AtomType)
-> Either RelationalError AtomType
-> ExceptT RelationalError Identity AtomType
forall a b. (a -> b) -> a -> b
$ AtomType -> AtomType -> Either RelationalError AtomType
atomTypeVerify AtomType
expectedType ([AtomType] -> AtomType
forall a. [a] -> a
last [AtomType]
expectedArgTypes)
verifyGraphRefAtomExprTypes Relation
relIn (RelationAtomExpr GraphRefRelationalExpr
relationExpr) AtomType
expectedType =
  do
    let mergedAttrsEnv :: GraphRefRelationalExprEnv -> GraphRefRelationalExprEnv
mergedAttrsEnv = Attributes
-> GraphRefRelationalExprEnv -> GraphRefRelationalExprEnv
mergeAttributesIntoGraphRefRelationalExprEnv (Relation -> Attributes
attributes Relation
relIn)
    Relation
relType <- (GraphRefRelationalExprEnv -> GraphRefRelationalExprEnv)
-> GraphRefRelationalExprM Relation
-> GraphRefRelationalExprM Relation
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
R.local GraphRefRelationalExprEnv -> GraphRefRelationalExprEnv
mergedAttrsEnv (GraphRefRelationalExpr -> GraphRefRelationalExprM Relation
typeForGraphRefRelationalExpr GraphRefRelationalExpr
relationExpr)
    ExceptT RelationalError Identity AtomType
-> GraphRefRelationalExprM AtomType
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT RelationalError Identity AtomType
 -> GraphRefRelationalExprM AtomType)
-> ExceptT RelationalError Identity AtomType
-> GraphRefRelationalExprM AtomType
forall a b. (a -> b) -> a -> b
$ Either RelationalError AtomType
-> ExceptT RelationalError Identity AtomType
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either RelationalError AtomType
 -> ExceptT RelationalError Identity AtomType)
-> Either RelationalError AtomType
-> ExceptT RelationalError Identity AtomType
forall a b. (a -> b) -> a -> b
$ AtomType -> AtomType -> Either RelationalError AtomType
atomTypeVerify AtomType
expectedType (Attributes -> AtomType
RelationAtomType (Relation -> Attributes
attributes Relation
relType))
verifyGraphRefAtomExprTypes Relation
rel cons :: GraphRefAtomExpr
cons@ConstructedAtomExpr{} AtomType
expectedType = do
  AtomType
cType <- Attributes -> GraphRefAtomExpr -> GraphRefRelationalExprM AtomType
typeForGraphRefAtomExpr (Relation -> Attributes
attributes Relation
rel) GraphRefAtomExpr
cons
  ExceptT RelationalError Identity AtomType
-> GraphRefRelationalExprM AtomType
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT RelationalError Identity AtomType
 -> GraphRefRelationalExprM AtomType)
-> ExceptT RelationalError Identity AtomType
-> GraphRefRelationalExprM AtomType
forall a b. (a -> b) -> a -> b
$ Either RelationalError AtomType
-> ExceptT RelationalError Identity AtomType
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either RelationalError AtomType
 -> ExceptT RelationalError Identity AtomType)
-> Either RelationalError AtomType
-> ExceptT RelationalError Identity AtomType
forall a b. (a -> b) -> a -> b
$ AtomType -> AtomType -> Either RelationalError AtomType
atomTypeVerify AtomType
expectedType AtomType
cType

-- | Look up the type's name and create a new attribute.
evalGraphRefAttrExpr :: GraphRefAttributeExpr -> GraphRefRelationalExprM Attribute
evalGraphRefAttrExpr :: AttributeExprBase GraphRefTransactionMarker
-> ReaderT
     GraphRefRelationalExprEnv
     (ExceptT RelationalError Identity)
     Attribute
evalGraphRefAttrExpr (AttributeAndTypeNameExpr AttributeName
attrName TypeConstructor
tCons GraphRefTransactionMarker
transId) = do
  TypeConstructorMapping
tConsMap <- DatabaseContext -> TypeConstructorMapping
typeConstructorMapping (DatabaseContext -> TypeConstructorMapping)
-> GraphRefRelationalExprM DatabaseContext
-> ReaderT
     GraphRefRelationalExprEnv
     (ExceptT RelationalError Identity)
     TypeConstructorMapping
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GraphRefTransactionMarker
-> GraphRefRelationalExprM DatabaseContext
gfDatabaseContextForMarker GraphRefTransactionMarker
transId
  AtomType
aType <- ExceptT RelationalError Identity AtomType
-> GraphRefRelationalExprM AtomType
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT RelationalError Identity AtomType
 -> GraphRefRelationalExprM AtomType)
-> ExceptT RelationalError Identity AtomType
-> GraphRefRelationalExprM AtomType
forall a b. (a -> b) -> a -> b
$ Either RelationalError AtomType
-> ExceptT RelationalError Identity AtomType
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either RelationalError AtomType
 -> ExceptT RelationalError Identity AtomType)
-> Either RelationalError AtomType
-> ExceptT RelationalError Identity AtomType
forall a b. (a -> b) -> a -> b
$ DirtyFlag
-> TypeConstructor
-> TypeConstructorMapping
-> TypeVarMap
-> Either RelationalError AtomType
atomTypeForTypeConstructorValidate DirtyFlag
True TypeConstructor
tCons TypeConstructorMapping
tConsMap TypeVarMap
forall k a. Map k a
M.empty
  ExceptT RelationalError Identity ()
-> ReaderT
     GraphRefRelationalExprEnv (ExceptT RelationalError Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT RelationalError Identity ()
 -> ReaderT
      GraphRefRelationalExprEnv (ExceptT RelationalError Identity) ())
-> ExceptT RelationalError Identity ()
-> ReaderT
     GraphRefRelationalExprEnv (ExceptT RelationalError Identity) ()
forall a b. (a -> b) -> a -> b
$ Either RelationalError () -> ExceptT RelationalError Identity ()
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either RelationalError () -> ExceptT RelationalError Identity ())
-> Either RelationalError () -> ExceptT RelationalError Identity ()
forall a b. (a -> b) -> a -> b
$ AtomType -> TypeConstructorMapping -> Either RelationalError ()
validateAtomType AtomType
aType TypeConstructorMapping
tConsMap
  Attribute
-> ReaderT
     GraphRefRelationalExprEnv
     (ExceptT RelationalError Identity)
     Attribute
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Attribute
 -> ReaderT
      GraphRefRelationalExprEnv
      (ExceptT RelationalError Identity)
      Attribute)
-> Attribute
-> ReaderT
     GraphRefRelationalExprEnv
     (ExceptT RelationalError Identity)
     Attribute
forall a b. (a -> b) -> a -> b
$ AttributeName -> AtomType -> Attribute
Attribute AttributeName
attrName AtomType
aType
  
evalGraphRefAttrExpr (NakedAttributeExpr Attribute
attr) = Attribute
-> ReaderT
     GraphRefRelationalExprEnv
     (ExceptT RelationalError Identity)
     Attribute
forall (f :: * -> *) a. Applicative f => a -> f a
pure Attribute
attr

-- for tuple type concrete resolution (Nothing ==> Maybe Int) when the attributes hint is Nothing, we need to first process all the tuples, then extract the concrete types on a per-attribute basis, then reprocess the tuples to include the concrete types
evalGraphRefTupleExprs :: Maybe Attributes -> GraphRefTupleExprs -> GraphRefRelationalExprM [RelationTuple]
evalGraphRefTupleExprs :: Maybe Attributes
-> GraphRefTupleExprs -> GraphRefRelationalExprM [RelationTuple]
evalGraphRefTupleExprs Maybe Attributes
_ (TupleExprs GraphRefTransactionMarker
_ []) = [RelationTuple] -> GraphRefRelationalExprM [RelationTuple]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
evalGraphRefTupleExprs Maybe Attributes
mAttrs (TupleExprs GraphRefTransactionMarker
fixedMarker [TupleExprBase GraphRefTransactionMarker]
tupleExprL) = do
  [RelationTuple]
tuples <- (TupleExprBase GraphRefTransactionMarker
 -> ReaderT
      GraphRefRelationalExprEnv
      (ExceptT RelationalError Identity)
      RelationTuple)
-> [TupleExprBase GraphRefTransactionMarker]
-> GraphRefRelationalExprM [RelationTuple]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Maybe Attributes
-> TupleExprBase GraphRefTransactionMarker
-> ReaderT
     GraphRefRelationalExprEnv
     (ExceptT RelationalError Identity)
     RelationTuple
evalGraphRefTupleExpr Maybe Attributes
mAttrs) [TupleExprBase GraphRefTransactionMarker]
tupleExprL
  Attributes
finalAttrs <- case Maybe Attributes
mAttrs of
    Just Attributes
attrs -> Attributes
-> ReaderT
     GraphRefRelationalExprEnv
     (ExceptT RelationalError Identity)
     Attributes
forall (f :: * -> *) a. Applicative f => a -> f a
pure Attributes
attrs
    Maybe Attributes
Nothing ->
      case [RelationTuple]
tuples of
        [] -> Attributes
-> ReaderT
     GraphRefRelationalExprEnv
     (ExceptT RelationalError Identity)
     Attributes
forall (f :: * -> *) a. Applicative f => a -> f a
pure Attributes
emptyAttributes
        (RelationTuple
headTuple:[RelationTuple]
tailTuples) -> do
      --gather up resolved atom types or throw an error if an attribute cannot be made concrete from the inferred types- this could still fail if the type cannot be inferred (e.g. from [Nothing, Nothing])
          let 
              processTupleAttrs :: (Attribute, Attribute) -> t (ExceptT RelationalError m) Attribute
processTupleAttrs (Attribute
tupAttr, Attribute
accAttr) =
                --if the attribute is a constructedatomtype, we can recurse into it to potentially resolve type variables                
                if Attribute -> DirtyFlag
isResolvedAttribute Attribute
accAttr DirtyFlag -> DirtyFlag -> DirtyFlag
&& Attribute
tupAttr Attribute -> Attribute -> DirtyFlag
forall a. Eq a => a -> a -> DirtyFlag
== Attribute
accAttr then
                  Attribute -> t (ExceptT RelationalError m) Attribute
forall (f :: * -> *) a. Applicative f => a -> f a
pure Attribute
accAttr
                else
                  ExceptT RelationalError m Attribute
-> t (ExceptT RelationalError m) Attribute
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT RelationalError m Attribute
 -> t (ExceptT RelationalError m) Attribute)
-> ExceptT RelationalError m Attribute
-> t (ExceptT RelationalError m) Attribute
forall a b. (a -> b) -> a -> b
$ Either RelationalError Attribute
-> ExceptT RelationalError m Attribute
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either RelationalError Attribute
 -> ExceptT RelationalError m Attribute)
-> Either RelationalError Attribute
-> ExceptT RelationalError m Attribute
forall a b. (a -> b) -> a -> b
$ Attribute -> Attribute -> Either RelationalError Attribute
resolveAttributes Attribute
accAttr Attribute
tupAttr 
          [Attribute]
mostResolvedTypes <-
                ([Attribute]
 -> RelationTuple -> GraphRefRelationalExprM [Attribute])
-> [Attribute]
-> [RelationTuple]
-> GraphRefRelationalExprM [Attribute]
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\[Attribute]
acc RelationTuple
tup -> do
                         let zipped :: [(Attribute, Attribute)]
zipped = [Attribute] -> [Attribute] -> [(Attribute, Attribute)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Vector Attribute -> [Attribute]
forall a. Vector a -> [a]
V.toList (Vector Attribute -> [Attribute])
-> (Attributes -> Vector Attribute) -> Attributes -> [Attribute]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attributes -> Vector Attribute
attributesVec (Attributes -> [Attribute]) -> Attributes -> [Attribute]
forall a b. (a -> b) -> a -> b
$ RelationTuple -> Attributes
tupleAttributes RelationTuple
tup) [Attribute]
acc
                             accNames :: Set AttributeName
accNames = [AttributeName] -> Set AttributeName
forall a. Ord a => [a] -> Set a
S.fromList ([AttributeName] -> Set AttributeName)
-> [AttributeName] -> Set AttributeName
forall a b. (a -> b) -> a -> b
$ (Attribute -> AttributeName) -> [Attribute] -> [AttributeName]
forall a b. (a -> b) -> [a] -> [b]
map Attribute -> AttributeName
A.attributeName [Attribute]
acc
                             tupNames :: Set AttributeName
tupNames = Attributes -> Set AttributeName
A.attributeNameSet (RelationTuple -> Attributes
tupleAttributes RelationTuple
tup)
                             attrNamesDiff :: Set AttributeName
attrNamesDiff = Set AttributeName -> Set AttributeName -> Set AttributeName
forall a. Ord a => Set a -> Set a -> Set a
S.union (Set AttributeName -> Set AttributeName -> Set AttributeName
forall a. Ord a => Set a -> Set a -> Set a
S.difference Set AttributeName
accNames Set AttributeName
tupNames) (Set AttributeName -> Set AttributeName -> Set AttributeName
forall a. Ord a => Set a -> Set a -> Set a
S.difference Set AttributeName
tupNames Set AttributeName
accNames)
                         DirtyFlag
-> ReaderT
     GraphRefRelationalExprEnv (ExceptT RelationalError Identity) ()
-> ReaderT
     GraphRefRelationalExprEnv (ExceptT RelationalError Identity) ()
forall (f :: * -> *). Applicative f => DirtyFlag -> f () -> f ()
unless (Set AttributeName -> DirtyFlag
forall (t :: * -> *) a. Foldable t => t a -> DirtyFlag
null Set AttributeName
attrNamesDiff) (RelationalError
-> ReaderT
     GraphRefRelationalExprEnv (ExceptT RelationalError Identity) ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Set AttributeName -> RelationalError
AttributeNamesMismatchError Set AttributeName
attrNamesDiff))
                         [Attribute]
nextTupleAttrs <- ((Attribute, Attribute)
 -> ReaderT
      GraphRefRelationalExprEnv
      (ExceptT RelationalError Identity)
      Attribute)
-> [(Attribute, Attribute)] -> GraphRefRelationalExprM [Attribute]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Attribute, Attribute)
-> ReaderT
     GraphRefRelationalExprEnv
     (ExceptT RelationalError Identity)
     Attribute
forall (t :: (* -> *) -> * -> *) (m :: * -> *).
(MonadTrans t, Monad m,
 Applicative (t (ExceptT RelationalError m))) =>
(Attribute, Attribute) -> t (ExceptT RelationalError m) Attribute
processTupleAttrs [(Attribute, Attribute)]
zipped
                         let diff :: Attributes
diff = Attributes -> Attributes -> Attributes
A.attributesDifference ([Attribute] -> Attributes
A.attributesFromList [Attribute]
nextTupleAttrs) ([Attribute] -> Attributes
A.attributesFromList [Attribute]
acc)
                         if Attributes
diff Attributes -> Attributes -> DirtyFlag
forall a. Eq a => a -> a -> DirtyFlag
== Attributes
A.emptyAttributes then
                           [Attribute] -> GraphRefRelationalExprM [Attribute]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Attribute]
nextTupleAttrs
                           else
                           RelationalError -> GraphRefRelationalExprM [Attribute]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Attributes -> RelationalError
TupleAttributeTypeMismatchError Attributes
diff)
                      ) (Vector Attribute -> [Attribute]
forall a. Vector a -> [a]
V.toList (Vector Attribute -> [Attribute])
-> (Attributes -> Vector Attribute) -> Attributes -> [Attribute]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attributes -> Vector Attribute
attributesVec (Attributes -> [Attribute]) -> Attributes -> [Attribute]
forall a b. (a -> b) -> a -> b
$ RelationTuple -> Attributes
tupleAttributes RelationTuple
headTuple) [RelationTuple]
tailTuples
          Attributes
-> ReaderT
     GraphRefRelationalExprEnv
     (ExceptT RelationalError Identity)
     Attributes
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Attribute] -> Attributes
A.attributesFromList [Attribute]
mostResolvedTypes)
  --strategy: if all the tuple expr transaction markers refer to one location, then we can pass the type constructor mapping from that location, otherwise, we cannot assume that the types are the same
  TypeConstructorMapping
tConsMap <- case [TupleExprBase GraphRefTransactionMarker] -> SingularTransactionRef
forall (f :: * -> *) (t :: * -> *).
(Foldable f, Foldable t) =>
f (t GraphRefTransactionMarker) -> SingularTransactionRef
singularTransactions [TupleExprBase GraphRefTransactionMarker]
tupleExprL of
                   SingularTransactionRef GraphRefTransactionMarker
commonTransId -> 
                     DatabaseContext -> TypeConstructorMapping
typeConstructorMapping (DatabaseContext -> TypeConstructorMapping)
-> GraphRefRelationalExprM DatabaseContext
-> ReaderT
     GraphRefRelationalExprEnv
     (ExceptT RelationalError Identity)
     TypeConstructorMapping
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GraphRefTransactionMarker
-> GraphRefRelationalExprM DatabaseContext
gfDatabaseContextForMarker GraphRefTransactionMarker
commonTransId
                   SingularTransactionRef
NoTransactionsRef -> 
                     DatabaseContext -> TypeConstructorMapping
typeConstructorMapping (DatabaseContext -> TypeConstructorMapping)
-> GraphRefRelationalExprM DatabaseContext
-> ReaderT
     GraphRefRelationalExprEnv
     (ExceptT RelationalError Identity)
     TypeConstructorMapping
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GraphRefTransactionMarker
-> GraphRefRelationalExprM DatabaseContext
gfDatabaseContextForMarker GraphRefTransactionMarker
fixedMarker
  -- if there are multiple transaction markers in the TupleExprs, then we can't assume a single type constructor mapping- this could be improved in the future, but if all the tuples are fully resolved, then we don't need further resolution                     
                   SingularTransactionRef
_ -> RelationalError
-> ReaderT
     GraphRefRelationalExprEnv
     (ExceptT RelationalError Identity)
     TypeConstructorMapping
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError RelationalError
TupleExprsReferenceMultipleMarkersError
  ExceptT RelationalError Identity ()
-> ReaderT
     GraphRefRelationalExprEnv (ExceptT RelationalError Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT RelationalError Identity ()
 -> ReaderT
      GraphRefRelationalExprEnv (ExceptT RelationalError Identity) ())
-> ExceptT RelationalError Identity ()
-> ReaderT
     GraphRefRelationalExprEnv (ExceptT RelationalError Identity) ()
forall a b. (a -> b) -> a -> b
$ Either RelationalError () -> ExceptT RelationalError Identity ()
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either RelationalError () -> ExceptT RelationalError Identity ())
-> Either RelationalError () -> ExceptT RelationalError Identity ()
forall a b. (a -> b) -> a -> b
$ TypeConstructorMapping -> Attributes -> Either RelationalError ()
validateAttributes TypeConstructorMapping
tConsMap Attributes
finalAttrs
  (RelationTuple
 -> ReaderT
      GraphRefRelationalExprEnv
      (ExceptT RelationalError Identity)
      RelationTuple)
-> [RelationTuple] -> GraphRefRelationalExprM [RelationTuple]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ExceptT RelationalError Identity RelationTuple
-> ReaderT
     GraphRefRelationalExprEnv
     (ExceptT RelationalError Identity)
     RelationTuple
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT RelationalError Identity RelationTuple
 -> ReaderT
      GraphRefRelationalExprEnv
      (ExceptT RelationalError Identity)
      RelationTuple)
-> (RelationTuple
    -> ExceptT RelationalError Identity RelationTuple)
-> RelationTuple
-> ReaderT
     GraphRefRelationalExprEnv
     (ExceptT RelationalError Identity)
     RelationTuple
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either RelationalError RelationTuple
-> ExceptT RelationalError Identity RelationTuple
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either RelationalError RelationTuple
 -> ExceptT RelationalError Identity RelationTuple)
-> (RelationTuple -> Either RelationalError RelationTuple)
-> RelationTuple
-> ExceptT RelationalError Identity RelationTuple
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attributes
-> TypeConstructorMapping
-> RelationTuple
-> Either RelationalError RelationTuple
resolveTypesInTuple Attributes
finalAttrs TypeConstructorMapping
tConsMap) [RelationTuple]
tuples


--resolveAttributes (Attribute "gonk" (ConstructedAtomType "Either" (fromList [("a",IntegerAtomType),("b",TypeVariableType "b")]))) (Attribute "gonk" (ConstructedAtomType "Either" (fromList [("a",TypeVariableType "a"),("b",TextAtomType)])))
                                                                                                                                                 
evalGraphRefTupleExpr :: Maybe Attributes -> GraphRefTupleExpr -> GraphRefRelationalExprM RelationTuple
evalGraphRefTupleExpr :: Maybe Attributes
-> TupleExprBase GraphRefTransactionMarker
-> ReaderT
     GraphRefRelationalExprEnv
     (ExceptT RelationalError Identity)
     RelationTuple
evalGraphRefTupleExpr Maybe Attributes
mAttrs (TupleExpr Map AttributeName GraphRefAtomExpr
tupMap) = do
  -- it's not possible for AtomExprs in tuple constructors to reference other Attributes' atoms due to the necessary order-of-operations (need a tuple to pass to evalAtomExpr)- it may be possible with some refactoring of type usage or delayed evaluation- needs more thought, but not a priority
  -- I could adjust this logic so that when the attributes are not specified (Nothing), then I can attempt to extract the attributes from the tuple- the type resolution will blow up if an ambiguous data constructor is used (Left 4) and this should allow simple cases to "relation{tuple{a 4}}" to be processed
  let attrs :: Attributes
attrs = Attributes -> Maybe Attributes -> Attributes
forall a. a -> Maybe a -> a
fromMaybe Attributes
A.emptyAttributes Maybe Attributes
mAttrs
      resolveOneAtom :: (AttributeName, GraphRefAtomExpr)
-> ReaderT
     GraphRefRelationalExprEnv
     (ExceptT RelationalError Identity)
     (AttributeName, Atom, AtomType)
resolveOneAtom (AttributeName
attrName, GraphRefAtomExpr
aExpr) =
        do
          --provided when the relation header is available
          let eExpectedAtomType :: Either RelationalError AtomType
eExpectedAtomType = AttributeName -> Attributes -> Either RelationalError AtomType
A.atomTypeForAttributeName AttributeName
attrName Attributes
attrs
          AtomType
unresolvedType <- Attributes -> GraphRefAtomExpr -> GraphRefRelationalExprM AtomType
typeForGraphRefAtomExpr Attributes
attrs GraphRefAtomExpr
aExpr
          AtomType
resolvedType <- case Either RelationalError AtomType
eExpectedAtomType of
                            Left RelationalError
_ -> AtomType -> GraphRefRelationalExprM AtomType
forall (f :: * -> *) a. Applicative f => a -> f a
pure AtomType
unresolvedType
                            Right AtomType
typeHint -> ExceptT RelationalError Identity AtomType
-> GraphRefRelationalExprM AtomType
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT RelationalError Identity AtomType
 -> GraphRefRelationalExprM AtomType)
-> ExceptT RelationalError Identity AtomType
-> GraphRefRelationalExprM AtomType
forall a b. (a -> b) -> a -> b
$ Either RelationalError AtomType
-> ExceptT RelationalError Identity AtomType
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either RelationalError AtomType
 -> ExceptT RelationalError Identity AtomType)
-> Either RelationalError AtomType
-> ExceptT RelationalError Identity AtomType
forall a b. (a -> b) -> a -> b
$ AtomType -> AtomType -> Either RelationalError AtomType
resolveAtomType AtomType
typeHint AtomType
unresolvedType
                          --resolve atom typevars based on resolvedType?
          Atom
newAtom <- RelationTuple -> GraphRefAtomExpr -> GraphRefRelationalExprM Atom
evalGraphRefAtomExpr RelationTuple
emptyTuple GraphRefAtomExpr
aExpr
          (AttributeName, Atom, AtomType)
-> ReaderT
     GraphRefRelationalExprEnv
     (ExceptT RelationalError Identity)
     (AttributeName, Atom, AtomType)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AttributeName
attrName, Atom
newAtom, AtomType
resolvedType)
  [(AttributeName, Atom, AtomType)]
attrAtoms <- ((AttributeName, GraphRefAtomExpr)
 -> ReaderT
      GraphRefRelationalExprEnv
      (ExceptT RelationalError Identity)
      (AttributeName, Atom, AtomType))
-> [(AttributeName, GraphRefAtomExpr)]
-> ReaderT
     GraphRefRelationalExprEnv
     (ExceptT RelationalError Identity)
     [(AttributeName, Atom, AtomType)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (AttributeName, GraphRefAtomExpr)
-> ReaderT
     GraphRefRelationalExprEnv
     (ExceptT RelationalError Identity)
     (AttributeName, Atom, AtomType)
resolveOneAtom (Map AttributeName GraphRefAtomExpr
-> [(AttributeName, GraphRefAtomExpr)]
forall k a. Map k a -> [(k, a)]
M.toList Map AttributeName GraphRefAtomExpr
tupMap)
  let tupAttrs :: Attributes
tupAttrs = [Attribute] -> Attributes
A.attributesFromList ([Attribute] -> Attributes) -> [Attribute] -> Attributes
forall a b. (a -> b) -> a -> b
$ ((AttributeName, Atom, AtomType) -> Attribute)
-> [(AttributeName, Atom, AtomType)] -> [Attribute]
forall a b. (a -> b) -> [a] -> [b]
map (\(AttributeName
attrName, Atom
_, AtomType
aType) -> AttributeName -> AtomType -> Attribute
Attribute AttributeName
attrName AtomType
aType) [(AttributeName, Atom, AtomType)]
attrAtoms
      atoms :: Vector Atom
atoms = [Atom] -> Vector Atom
forall a. [a] -> Vector a
V.fromList ([Atom] -> Vector Atom) -> [Atom] -> Vector Atom
forall a b. (a -> b) -> a -> b
$ ((AttributeName, Atom, AtomType) -> Atom)
-> [(AttributeName, Atom, AtomType)] -> [Atom]
forall a b. (a -> b) -> [a] -> [b]
map (\(AttributeName
_, Atom
atom, AtomType
_) -> Atom
atom) [(AttributeName, Atom, AtomType)]
attrAtoms
      tup :: RelationTuple
tup = Attributes -> Vector Atom -> RelationTuple
mkRelationTuple Attributes
tupAttrs Vector Atom
atoms
      finalAttrs :: Attributes
finalAttrs = Attributes -> Maybe Attributes -> Attributes
forall a. a -> Maybe a -> a
fromMaybe Attributes
tupAttrs Maybe Attributes
mAttrs
    --verify that the attributes match
  DirtyFlag
-> ReaderT
     GraphRefRelationalExprEnv (ExceptT RelationalError Identity) ()
-> ReaderT
     GraphRefRelationalExprEnv (ExceptT RelationalError Identity) ()
forall (f :: * -> *). Applicative f => DirtyFlag -> f () -> f ()
when (Attributes -> Set AttributeName
A.attributeNameSet Attributes
finalAttrs Set AttributeName -> Set AttributeName -> DirtyFlag
forall a. Eq a => a -> a -> DirtyFlag
/= Attributes -> Set AttributeName
A.attributeNameSet Attributes
tupAttrs) (ReaderT
   GraphRefRelationalExprEnv (ExceptT RelationalError Identity) ()
 -> ReaderT
      GraphRefRelationalExprEnv (ExceptT RelationalError Identity) ())
-> ReaderT
     GraphRefRelationalExprEnv (ExceptT RelationalError Identity) ()
-> ReaderT
     GraphRefRelationalExprEnv (ExceptT RelationalError Identity) ()
forall a b. (a -> b) -> a -> b
$ RelationalError
-> ReaderT
     GraphRefRelationalExprEnv (ExceptT RelationalError Identity) ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Attributes -> RelationalError
TupleAttributeTypeMismatchError Attributes
tupAttrs)
  --we can't resolve types here- they have to be resolved at the atom level where the graph ref is held
  --tup' <- lift $ except (resolveTypesInTuple finalAttrs tConss (reorderTuple finalAttrs tup))
  let tup' :: RelationTuple
tup' = Attributes -> RelationTuple -> RelationTuple
reorderTuple Attributes
finalAttrs RelationTuple
tup
  --TODO: restore type resolution
--  _ <- lift $ except (validateTuple tup' tConss)
  RelationTuple
-> ReaderT
     GraphRefRelationalExprEnv
     (ExceptT RelationalError Identity)
     RelationTuple
forall (f :: * -> *) a. Applicative f => a -> f a
pure RelationTuple
tup'

--temporary implementation until we have a proper planner+executor
evalGraphRefRelationalExpr :: GraphRefRelationalExpr -> GraphRefRelationalExprM Relation
evalGraphRefRelationalExpr :: GraphRefRelationalExpr -> GraphRefRelationalExprM Relation
evalGraphRefRelationalExpr (MakeRelationFromExprs Maybe [AttributeExprBase GraphRefTransactionMarker]
mAttrExprs GraphRefTupleExprs
tupleExprs) = do
  Maybe Attributes
mAttrs <- case Maybe [AttributeExprBase GraphRefTransactionMarker]
mAttrExprs of
    Just [AttributeExprBase GraphRefTransactionMarker]
_ ->
        Attributes -> Maybe Attributes
forall a. a -> Maybe a
Just (Attributes -> Maybe Attributes)
-> ([Attribute] -> Attributes) -> [Attribute] -> Maybe Attributes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Attribute] -> Attributes
A.attributesFromList ([Attribute] -> Maybe Attributes)
-> GraphRefRelationalExprM [Attribute]
-> ReaderT
     GraphRefRelationalExprEnv
     (ExceptT RelationalError Identity)
     (Maybe Attributes)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AttributeExprBase GraphRefTransactionMarker
 -> ReaderT
      GraphRefRelationalExprEnv
      (ExceptT RelationalError Identity)
      Attribute)
-> [AttributeExprBase GraphRefTransactionMarker]
-> GraphRefRelationalExprM [Attribute]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM AttributeExprBase GraphRefTransactionMarker
-> ReaderT
     GraphRefRelationalExprEnv
     (ExceptT RelationalError Identity)
     Attribute
evalGraphRefAttrExpr ([AttributeExprBase GraphRefTransactionMarker]
-> Maybe [AttributeExprBase GraphRefTransactionMarker]
-> [AttributeExprBase GraphRefTransactionMarker]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [AttributeExprBase GraphRefTransactionMarker]
mAttrExprs)
    Maybe [AttributeExprBase GraphRefTransactionMarker]
Nothing -> Maybe Attributes
-> ReaderT
     GraphRefRelationalExprEnv
     (ExceptT RelationalError Identity)
     (Maybe Attributes)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Attributes
forall a. Maybe a
Nothing
  [RelationTuple]
tuples <- Maybe Attributes
-> GraphRefTupleExprs -> GraphRefRelationalExprM [RelationTuple]
evalGraphRefTupleExprs Maybe Attributes
mAttrs GraphRefTupleExprs
tupleExprs
  let attrs :: Attributes
attrs = Attributes -> Maybe Attributes -> Attributes
forall a. a -> Maybe a -> a
fromMaybe Attributes
firstTupleAttrs Maybe Attributes
mAttrs
      firstTupleAttrs :: Attributes
firstTupleAttrs = if [RelationTuple] -> DirtyFlag
forall (t :: * -> *) a. Foldable t => t a -> DirtyFlag
null [RelationTuple]
tuples then Attributes
A.emptyAttributes else RelationTuple -> Attributes
tupleAttributes ([RelationTuple] -> RelationTuple
forall a. [a] -> a
head [RelationTuple]
tuples)
  ExceptT RelationalError Identity Relation
-> GraphRefRelationalExprM Relation
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT RelationalError Identity Relation
 -> GraphRefRelationalExprM Relation)
-> ExceptT RelationalError Identity Relation
-> GraphRefRelationalExprM Relation
forall a b. (a -> b) -> a -> b
$ Either RelationalError Relation
-> ExceptT RelationalError Identity Relation
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either RelationalError Relation
 -> ExceptT RelationalError Identity Relation)
-> Either RelationalError Relation
-> ExceptT RelationalError Identity Relation
forall a b. (a -> b) -> a -> b
$ Attributes -> RelationTupleSet -> Either RelationalError Relation
mkRelation Attributes
attrs ([RelationTuple] -> RelationTupleSet
RelationTupleSet [RelationTuple]
tuples)
evalGraphRefRelationalExpr (MakeStaticRelation Attributes
attributeSet RelationTupleSet
tupleSet) = 
  ExceptT RelationalError Identity Relation
-> GraphRefRelationalExprM Relation
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT RelationalError Identity Relation
 -> GraphRefRelationalExprM Relation)
-> ExceptT RelationalError Identity Relation
-> GraphRefRelationalExprM Relation
forall a b. (a -> b) -> a -> b
$ Either RelationalError Relation
-> ExceptT RelationalError Identity Relation
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either RelationalError Relation
 -> ExceptT RelationalError Identity Relation)
-> Either RelationalError Relation
-> ExceptT RelationalError Identity Relation
forall a b. (a -> b) -> a -> b
$ Attributes -> RelationTupleSet -> Either RelationalError Relation
mkRelation Attributes
attributeSet RelationTupleSet
tupleSet
evalGraphRefRelationalExpr (ExistingRelation Relation
rel) = Relation -> GraphRefRelationalExprM Relation
forall (f :: * -> *) a. Applicative f => a -> f a
pure Relation
rel
evalGraphRefRelationalExpr (RelationVariable AttributeName
name GraphRefTransactionMarker
tid) = do
  DatabaseContext
ctx <- GraphRefTransactionMarker
-> GraphRefRelationalExprM DatabaseContext
gfDatabaseContextForMarker GraphRefTransactionMarker
tid
  case AttributeName
-> Map AttributeName GraphRefRelationalExpr
-> Maybe GraphRefRelationalExpr
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup AttributeName
name (DatabaseContext -> Map AttributeName GraphRefRelationalExpr
relationVariables DatabaseContext
ctx) of
    Maybe GraphRefRelationalExpr
Nothing -> RelationalError -> GraphRefRelationalExprM Relation
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (AttributeName -> RelationalError
RelVarNotDefinedError AttributeName
name)
    Just GraphRefRelationalExpr
rv -> GraphRefRelationalExpr -> GraphRefRelationalExprM Relation
evalGraphRefRelationalExpr GraphRefRelationalExpr
rv
evalGraphRefRelationalExpr (Project AttributeNamesBase GraphRefTransactionMarker
attrNames GraphRefRelationalExpr
expr) = do
  Set AttributeName
attrNameSet <- AttributeNamesBase GraphRefTransactionMarker
-> GraphRefRelationalExpr
-> GraphRefRelationalExprM (Set AttributeName)
evalGraphRefAttributeNames AttributeNamesBase GraphRefTransactionMarker
attrNames GraphRefRelationalExpr
expr
  Relation
rel <- GraphRefRelationalExpr -> GraphRefRelationalExprM Relation
evalGraphRefRelationalExpr GraphRefRelationalExpr
expr
  ExceptT RelationalError Identity Relation
-> GraphRefRelationalExprM Relation
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT RelationalError Identity Relation
 -> GraphRefRelationalExprM Relation)
-> ExceptT RelationalError Identity Relation
-> GraphRefRelationalExprM Relation
forall a b. (a -> b) -> a -> b
$ Either RelationalError Relation
-> ExceptT RelationalError Identity Relation
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either RelationalError Relation
 -> ExceptT RelationalError Identity Relation)
-> Either RelationalError Relation
-> ExceptT RelationalError Identity Relation
forall a b. (a -> b) -> a -> b
$ Set AttributeName -> Relation -> Either RelationalError Relation
project Set AttributeName
attrNameSet Relation
rel
evalGraphRefRelationalExpr (Union GraphRefRelationalExpr
exprA GraphRefRelationalExpr
exprB) = do
  Relation
relA <- GraphRefRelationalExpr -> GraphRefRelationalExprM Relation
evalGraphRefRelationalExpr GraphRefRelationalExpr
exprA
  Relation
relB <- GraphRefRelationalExpr -> GraphRefRelationalExprM Relation
evalGraphRefRelationalExpr GraphRefRelationalExpr
exprB
  ExceptT RelationalError Identity Relation
-> GraphRefRelationalExprM Relation
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT RelationalError Identity Relation
 -> GraphRefRelationalExprM Relation)
-> ExceptT RelationalError Identity Relation
-> GraphRefRelationalExprM Relation
forall a b. (a -> b) -> a -> b
$ Either RelationalError Relation
-> ExceptT RelationalError Identity Relation
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either RelationalError Relation
 -> ExceptT RelationalError Identity Relation)
-> Either RelationalError Relation
-> ExceptT RelationalError Identity Relation
forall a b. (a -> b) -> a -> b
$ Relation -> Relation -> Either RelationalError Relation
union Relation
relA Relation
relB
evalGraphRefRelationalExpr (Join GraphRefRelationalExpr
exprA GraphRefRelationalExpr
exprB) = do  
  Relation
relA <- GraphRefRelationalExpr -> GraphRefRelationalExprM Relation
evalGraphRefRelationalExpr GraphRefRelationalExpr
exprA
  Relation
relB <- GraphRefRelationalExpr -> GraphRefRelationalExprM Relation
evalGraphRefRelationalExpr GraphRefRelationalExpr
exprB
  ExceptT RelationalError Identity Relation
-> GraphRefRelationalExprM Relation
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT RelationalError Identity Relation
 -> GraphRefRelationalExprM Relation)
-> ExceptT RelationalError Identity Relation
-> GraphRefRelationalExprM Relation
forall a b. (a -> b) -> a -> b
$ Either RelationalError Relation
-> ExceptT RelationalError Identity Relation
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either RelationalError Relation
 -> ExceptT RelationalError Identity Relation)
-> Either RelationalError Relation
-> ExceptT RelationalError Identity Relation
forall a b. (a -> b) -> a -> b
$ Relation -> Relation -> Either RelationalError Relation
join Relation
relA Relation
relB
evalGraphRefRelationalExpr (Rename AttributeName
oldName AttributeName
newName GraphRefRelationalExpr
expr) = do
  Relation
rel <- GraphRefRelationalExpr -> GraphRefRelationalExprM Relation
evalGraphRefRelationalExpr GraphRefRelationalExpr
expr
  ExceptT RelationalError Identity Relation
-> GraphRefRelationalExprM Relation
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT RelationalError Identity Relation
 -> GraphRefRelationalExprM Relation)
-> ExceptT RelationalError Identity Relation
-> GraphRefRelationalExprM Relation
forall a b. (a -> b) -> a -> b
$ Either RelationalError Relation
-> ExceptT RelationalError Identity Relation
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either RelationalError Relation
 -> ExceptT RelationalError Identity Relation)
-> Either RelationalError Relation
-> ExceptT RelationalError Identity Relation
forall a b. (a -> b) -> a -> b
$ AttributeName
-> AttributeName -> Relation -> Either RelationalError Relation
rename AttributeName
oldName AttributeName
newName Relation
rel
evalGraphRefRelationalExpr (Difference GraphRefRelationalExpr
exprA GraphRefRelationalExpr
exprB) = do
  Relation
relA <- GraphRefRelationalExpr -> GraphRefRelationalExprM Relation
evalGraphRefRelationalExpr GraphRefRelationalExpr
exprA
  Relation
relB <- GraphRefRelationalExpr -> GraphRefRelationalExprM Relation
evalGraphRefRelationalExpr GraphRefRelationalExpr
exprB
  ExceptT RelationalError Identity Relation
-> GraphRefRelationalExprM Relation
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT RelationalError Identity Relation
 -> GraphRefRelationalExprM Relation)
-> ExceptT RelationalError Identity Relation
-> GraphRefRelationalExprM Relation
forall a b. (a -> b) -> a -> b
$ Either RelationalError Relation
-> ExceptT RelationalError Identity Relation
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either RelationalError Relation
 -> ExceptT RelationalError Identity Relation)
-> Either RelationalError Relation
-> ExceptT RelationalError Identity Relation
forall a b. (a -> b) -> a -> b
$ Relation -> Relation -> Either RelationalError Relation
difference Relation
relA Relation
relB
evalGraphRefRelationalExpr (Group AttributeNamesBase GraphRefTransactionMarker
groupAttrNames AttributeName
newAttrName GraphRefRelationalExpr
expr) = do
  Set AttributeName
groupNames <- AttributeNamesBase GraphRefTransactionMarker
-> GraphRefRelationalExpr
-> GraphRefRelationalExprM (Set AttributeName)
evalGraphRefAttributeNames AttributeNamesBase GraphRefTransactionMarker
groupAttrNames GraphRefRelationalExpr
expr
  Relation
rel <- GraphRefRelationalExpr -> GraphRefRelationalExprM Relation
evalGraphRefRelationalExpr GraphRefRelationalExpr
expr
  ExceptT RelationalError Identity Relation
-> GraphRefRelationalExprM Relation
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT RelationalError Identity Relation
 -> GraphRefRelationalExprM Relation)
-> ExceptT RelationalError Identity Relation
-> GraphRefRelationalExprM Relation
forall a b. (a -> b) -> a -> b
$ Either RelationalError Relation
-> ExceptT RelationalError Identity Relation
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either RelationalError Relation
 -> ExceptT RelationalError Identity Relation)
-> Either RelationalError Relation
-> ExceptT RelationalError Identity Relation
forall a b. (a -> b) -> a -> b
$ Set AttributeName
-> AttributeName -> Relation -> Either RelationalError Relation
group Set AttributeName
groupNames AttributeName
newAttrName Relation
rel
evalGraphRefRelationalExpr (Ungroup AttributeName
groupAttrName GraphRefRelationalExpr
expr) = do
  Relation
rel <- GraphRefRelationalExpr -> GraphRefRelationalExprM Relation
evalGraphRefRelationalExpr GraphRefRelationalExpr
expr
  ExceptT RelationalError Identity Relation
-> GraphRefRelationalExprM Relation
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT RelationalError Identity Relation
 -> GraphRefRelationalExprM Relation)
-> ExceptT RelationalError Identity Relation
-> GraphRefRelationalExprM Relation
forall a b. (a -> b) -> a -> b
$ Either RelationalError Relation
-> ExceptT RelationalError Identity Relation
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either RelationalError Relation
 -> ExceptT RelationalError Identity Relation)
-> Either RelationalError Relation
-> ExceptT RelationalError Identity Relation
forall a b. (a -> b) -> a -> b
$ AttributeName -> Relation -> Either RelationalError Relation
ungroup AttributeName
groupAttrName Relation
rel
evalGraphRefRelationalExpr (Restrict RestrictionPredicateExprBase GraphRefTransactionMarker
predExpr GraphRefRelationalExpr
expr) = do
  Relation
rel <- GraphRefRelationalExpr -> GraphRefRelationalExprM Relation
evalGraphRefRelationalExpr GraphRefRelationalExpr
expr
  RestrictionFilter
filt <- Attributes
-> RestrictionPredicateExprBase GraphRefTransactionMarker
-> GraphRefRelationalExprM RestrictionFilter
predicateRestrictionFilter (Relation -> Attributes
attributes Relation
rel) RestrictionPredicateExprBase GraphRefTransactionMarker
predExpr
  ExceptT RelationalError Identity Relation
-> GraphRefRelationalExprM Relation
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT RelationalError Identity Relation
 -> GraphRefRelationalExprM Relation)
-> ExceptT RelationalError Identity Relation
-> GraphRefRelationalExprM Relation
forall a b. (a -> b) -> a -> b
$ Either RelationalError Relation
-> ExceptT RelationalError Identity Relation
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either RelationalError Relation
 -> ExceptT RelationalError Identity Relation)
-> Either RelationalError Relation
-> ExceptT RelationalError Identity Relation
forall a b. (a -> b) -> a -> b
$ RestrictionFilter -> Relation -> Either RelationalError Relation
restrict RestrictionFilter
filt Relation
rel
evalGraphRefRelationalExpr (Equals GraphRefRelationalExpr
exprA GraphRefRelationalExpr
exprB) = do
  Relation
relA <- GraphRefRelationalExpr -> GraphRefRelationalExprM Relation
evalGraphRefRelationalExpr GraphRefRelationalExpr
exprA
  Relation
relB <- GraphRefRelationalExpr -> GraphRefRelationalExprM Relation
evalGraphRefRelationalExpr GraphRefRelationalExpr
exprB
  Relation -> GraphRefRelationalExprM Relation
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Relation -> GraphRefRelationalExprM Relation)
-> Relation -> GraphRefRelationalExprM Relation
forall a b. (a -> b) -> a -> b
$ if Relation
relA Relation -> Relation -> DirtyFlag
forall a. Eq a => a -> a -> DirtyFlag
== Relation
relB then Relation
relationTrue else Relation
relationFalse
evalGraphRefRelationalExpr (NotEquals GraphRefRelationalExpr
exprA GraphRefRelationalExpr
exprB) = do
  Relation
relA <- GraphRefRelationalExpr -> GraphRefRelationalExprM Relation
evalGraphRefRelationalExpr GraphRefRelationalExpr
exprA
  Relation
relB <- GraphRefRelationalExpr -> GraphRefRelationalExprM Relation
evalGraphRefRelationalExpr GraphRefRelationalExpr
exprB
  Relation -> GraphRefRelationalExprM Relation
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Relation -> GraphRefRelationalExprM Relation)
-> Relation -> GraphRefRelationalExprM Relation
forall a b. (a -> b) -> a -> b
$ if Relation
relA Relation -> Relation -> DirtyFlag
forall a. Eq a => a -> a -> DirtyFlag
== Relation
relB then Relation
relationFalse else Relation
relationTrue
evalGraphRefRelationalExpr (Extend GraphRefExtendTupleExpr
extendTupleExpr GraphRefRelationalExpr
expr) = do
  Relation
rel <- GraphRefRelationalExpr -> GraphRefRelationalExprM Relation
evalGraphRefRelationalExpr GraphRefRelationalExpr
expr
  (Attributes
newAttrs, RelationTuple -> Either RelationalError RelationTuple
tupProc) <- Relation
-> GraphRefExtendTupleExpr
-> GraphRefRelationalExprM
     (Attributes, RelationTuple -> Either RelationalError RelationTuple)
extendGraphRefTupleExpressionProcessor Relation
rel GraphRefExtendTupleExpr
extendTupleExpr
  ExceptT RelationalError Identity Relation
-> GraphRefRelationalExprM Relation
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT RelationalError Identity Relation
 -> GraphRefRelationalExprM Relation)
-> ExceptT RelationalError Identity Relation
-> GraphRefRelationalExprM Relation
forall a b. (a -> b) -> a -> b
$ Either RelationalError Relation
-> ExceptT RelationalError Identity Relation
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either RelationalError Relation
 -> ExceptT RelationalError Identity Relation)
-> Either RelationalError Relation
-> ExceptT RelationalError Identity Relation
forall a b. (a -> b) -> a -> b
$ (RelationTuple -> Either RelationalError RelationTuple)
-> Attributes -> Relation -> Either RelationalError Relation
relMogrify RelationTuple -> Either RelationalError RelationTuple
tupProc Attributes
newAttrs Relation
rel
evalGraphRefRelationalExpr expr :: GraphRefRelationalExpr
expr@With{} =
  --strategy A: add relation variables to the contexts in the graph
  --strategy B: drop in macros in place (easier programmatically)
  --strategy B implementation
  GraphRefRelationalExpr -> GraphRefRelationalExprM Relation
evalGraphRefRelationalExpr (WithNameAssocs -> GraphRefRelationalExpr -> GraphRefRelationalExpr
substituteWithNameMacros [] GraphRefRelationalExpr
expr)

dbContextForTransId :: TransactionId -> TransactionGraph -> Either RelationalError DatabaseContext
dbContextForTransId :: TransactionId
-> TransactionGraph -> Either RelationalError DatabaseContext
dbContextForTransId TransactionId
tid TransactionGraph
graph = do
  Transaction
trans <- TransactionId
-> TransactionGraph -> Either RelationalError Transaction
transactionForId TransactionId
tid TransactionGraph
graph
  DatabaseContext -> Either RelationalError DatabaseContext
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Transaction -> DatabaseContext
concreteDatabaseContext Transaction
trans)

transactionForId :: TransactionId -> TransactionGraph -> Either RelationalError Transaction
transactionForId :: TransactionId
-> TransactionGraph -> Either RelationalError Transaction
transactionForId TransactionId
tid TransactionGraph
graph 
  | TransactionId
tid TransactionId -> TransactionId -> DirtyFlag
forall a. Eq a => a -> a -> DirtyFlag
== TransactionId
U.nil =
    RelationalError -> Either RelationalError Transaction
forall a b. a -> Either a b
Left RelationalError
RootTransactionTraversalError
  | Set Transaction -> DirtyFlag
forall a. Set a -> DirtyFlag
S.null Set Transaction
matchingTrans =
    RelationalError -> Either RelationalError Transaction
forall a b. a -> Either a b
Left (RelationalError -> Either RelationalError Transaction)
-> RelationalError -> Either RelationalError Transaction
forall a b. (a -> b) -> a -> b
$ TransactionId -> RelationalError
NoSuchTransactionError TransactionId
tid
  | DirtyFlag
otherwise =
    Transaction -> Either RelationalError Transaction
forall a b. b -> Either a b
Right (Transaction -> Either RelationalError Transaction)
-> Transaction -> Either RelationalError Transaction
forall a b. (a -> b) -> a -> b
$ [Transaction] -> Transaction
forall a. [a] -> a
head (Set Transaction -> [Transaction]
forall a. Set a -> [a]
S.toList Set Transaction
matchingTrans)
  where
    matchingTrans :: Set Transaction
matchingTrans = (Transaction -> DirtyFlag) -> Set Transaction -> Set Transaction
forall a. (a -> DirtyFlag) -> Set a -> Set a
S.filter (\(Transaction TransactionId
idMatch TransactionInfo
_ Schemas
_) -> TransactionId
idMatch TransactionId -> TransactionId -> DirtyFlag
forall a. Eq a => a -> a -> DirtyFlag
== TransactionId
tid) (TransactionGraph -> Set Transaction
transactionsForGraph TransactionGraph
graph)

typeForGraphRefRelationalExpr :: GraphRefRelationalExpr -> GraphRefRelationalExprM Relation
typeForGraphRefRelationalExpr :: GraphRefRelationalExpr -> GraphRefRelationalExprM Relation
typeForGraphRefRelationalExpr (MakeStaticRelation Attributes
attrs RelationTupleSet
_) = ExceptT RelationalError Identity Relation
-> GraphRefRelationalExprM Relation
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT RelationalError Identity Relation
 -> GraphRefRelationalExprM Relation)
-> ExceptT RelationalError Identity Relation
-> GraphRefRelationalExprM Relation
forall a b. (a -> b) -> a -> b
$ Either RelationalError Relation
-> ExceptT RelationalError Identity Relation
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either RelationalError Relation
 -> ExceptT RelationalError Identity Relation)
-> Either RelationalError Relation
-> ExceptT RelationalError Identity Relation
forall a b. (a -> b) -> a -> b
$ Attributes -> RelationTupleSet -> Either RelationalError Relation
mkRelation Attributes
attrs RelationTupleSet
emptyTupleSet
typeForGraphRefRelationalExpr (ExistingRelation Relation
rel) = Relation -> GraphRefRelationalExprM Relation
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Attributes -> Relation
emptyRelationWithAttrs (Relation -> Attributes
attributes Relation
rel))
typeForGraphRefRelationalExpr (MakeRelationFromExprs Maybe [AttributeExprBase GraphRefTransactionMarker]
mAttrExprs GraphRefTupleExprs
tupleExprs) = do
  Maybe Attributes
mAttrs <- case Maybe [AttributeExprBase GraphRefTransactionMarker]
mAttrExprs of
              Just [AttributeExprBase GraphRefTransactionMarker]
attrExprs -> do
                [Attribute]
attrs <- (AttributeExprBase GraphRefTransactionMarker
 -> ReaderT
      GraphRefRelationalExprEnv
      (ExceptT RelationalError Identity)
      Attribute)
-> [AttributeExprBase GraphRefTransactionMarker]
-> GraphRefRelationalExprM [Attribute]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM AttributeExprBase GraphRefTransactionMarker
-> ReaderT
     GraphRefRelationalExprEnv
     (ExceptT RelationalError Identity)
     Attribute
evalGraphRefAttributeExpr [AttributeExprBase GraphRefTransactionMarker]
attrExprs
                Maybe Attributes
-> ReaderT
     GraphRefRelationalExprEnv
     (ExceptT RelationalError Identity)
     (Maybe Attributes)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Attributes -> Maybe Attributes
forall a. a -> Maybe a
Just ([Attribute] -> Attributes
attributesFromList [Attribute]
attrs))
              Maybe [AttributeExprBase GraphRefTransactionMarker]
Nothing -> Maybe Attributes
-> ReaderT
     GraphRefRelationalExprEnv
     (ExceptT RelationalError Identity)
     (Maybe Attributes)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Attributes
forall a. Maybe a
Nothing
  [RelationTuple]
tuples <- Maybe Attributes
-> GraphRefTupleExprs -> GraphRefRelationalExprM [RelationTuple]
evalGraphRefTupleExprs Maybe Attributes
mAttrs GraphRefTupleExprs
tupleExprs
  let retAttrs :: Attributes
retAttrs = case [RelationTuple]
tuples of
                (RelationTuple
tup:[RelationTuple]
_) -> RelationTuple -> Attributes
tupleAttributes RelationTuple
tup
                [] -> Attributes -> Maybe Attributes -> Attributes
forall a. a -> Maybe a -> a
fromMaybe Attributes
A.emptyAttributes Maybe Attributes
mAttrs
  Relation -> GraphRefRelationalExprM Relation
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Relation -> GraphRefRelationalExprM Relation)
-> Relation -> GraphRefRelationalExprM Relation
forall a b. (a -> b) -> a -> b
$ Attributes -> Relation
emptyRelationWithAttrs Attributes
retAttrs
  
typeForGraphRefRelationalExpr (RelationVariable AttributeName
rvName GraphRefTransactionMarker
tid) = do
  Map AttributeName GraphRefRelationalExpr
relVars <- DatabaseContext -> Map AttributeName GraphRefRelationalExpr
relationVariables (DatabaseContext -> Map AttributeName GraphRefRelationalExpr)
-> GraphRefRelationalExprM DatabaseContext
-> ReaderT
     GraphRefRelationalExprEnv
     (ExceptT RelationalError Identity)
     (Map AttributeName GraphRefRelationalExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GraphRefTransactionMarker
-> GraphRefRelationalExprM DatabaseContext
gfDatabaseContextForMarker GraphRefTransactionMarker
tid
  case AttributeName
-> Map AttributeName GraphRefRelationalExpr
-> Maybe GraphRefRelationalExpr
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup AttributeName
rvName Map AttributeName GraphRefRelationalExpr
relVars of
    Maybe GraphRefRelationalExpr
Nothing -> RelationalError -> GraphRefRelationalExprM Relation
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (AttributeName -> RelationalError
RelVarNotDefinedError AttributeName
rvName)
    Just GraphRefRelationalExpr
rvExpr -> 
      GraphRefRelationalExpr -> GraphRefRelationalExprM Relation
typeForGraphRefRelationalExpr GraphRefRelationalExpr
rvExpr
typeForGraphRefRelationalExpr (Project AttributeNamesBase GraphRefTransactionMarker
attrNames GraphRefRelationalExpr
expr) = do
  Relation
exprType' <- GraphRefRelationalExpr -> GraphRefRelationalExprM Relation
typeForGraphRefRelationalExpr GraphRefRelationalExpr
expr
  Set AttributeName
projectionAttrs <- AttributeNamesBase GraphRefTransactionMarker
-> GraphRefRelationalExpr
-> GraphRefRelationalExprM (Set AttributeName)
evalGraphRefAttributeNames AttributeNamesBase GraphRefTransactionMarker
attrNames GraphRefRelationalExpr
expr
  ExceptT RelationalError Identity Relation
-> GraphRefRelationalExprM Relation
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT RelationalError Identity Relation
 -> GraphRefRelationalExprM Relation)
-> ExceptT RelationalError Identity Relation
-> GraphRefRelationalExprM Relation
forall a b. (a -> b) -> a -> b
$ Either RelationalError Relation
-> ExceptT RelationalError Identity Relation
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either RelationalError Relation
 -> ExceptT RelationalError Identity Relation)
-> Either RelationalError Relation
-> ExceptT RelationalError Identity Relation
forall a b. (a -> b) -> a -> b
$ Set AttributeName -> Relation -> Either RelationalError Relation
project Set AttributeName
projectionAttrs Relation
exprType'
typeForGraphRefRelationalExpr (Union GraphRefRelationalExpr
exprA GraphRefRelationalExpr
exprB) = do
  Relation
exprA' <- GraphRefRelationalExpr -> GraphRefRelationalExprM Relation
typeForGraphRefRelationalExpr GraphRefRelationalExpr
exprA
  Relation
exprB' <- GraphRefRelationalExpr -> GraphRefRelationalExprM Relation
typeForGraphRefRelationalExpr GraphRefRelationalExpr
exprB
  ExceptT RelationalError Identity Relation
-> GraphRefRelationalExprM Relation
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT RelationalError Identity Relation
 -> GraphRefRelationalExprM Relation)
-> ExceptT RelationalError Identity Relation
-> GraphRefRelationalExprM Relation
forall a b. (a -> b) -> a -> b
$ Either RelationalError Relation
-> ExceptT RelationalError Identity Relation
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either RelationalError Relation
 -> ExceptT RelationalError Identity Relation)
-> Either RelationalError Relation
-> ExceptT RelationalError Identity Relation
forall a b. (a -> b) -> a -> b
$ Relation -> Relation -> Either RelationalError Relation
union Relation
exprA' Relation
exprB'
typeForGraphRefRelationalExpr (Join GraphRefRelationalExpr
exprA GraphRefRelationalExpr
exprB) = do
  Relation
exprA' <- GraphRefRelationalExpr -> GraphRefRelationalExprM Relation
typeForGraphRefRelationalExpr GraphRefRelationalExpr
exprA
  Relation
exprB' <- GraphRefRelationalExpr -> GraphRefRelationalExprM Relation
typeForGraphRefRelationalExpr GraphRefRelationalExpr
exprB
  ExceptT RelationalError Identity Relation
-> GraphRefRelationalExprM Relation
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT RelationalError Identity Relation
 -> GraphRefRelationalExprM Relation)
-> ExceptT RelationalError Identity Relation
-> GraphRefRelationalExprM Relation
forall a b. (a -> b) -> a -> b
$ Either RelationalError Relation
-> ExceptT RelationalError Identity Relation
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either RelationalError Relation
 -> ExceptT RelationalError Identity Relation)
-> Either RelationalError Relation
-> ExceptT RelationalError Identity Relation
forall a b. (a -> b) -> a -> b
$ Relation -> Relation -> Either RelationalError Relation
join Relation
exprA' Relation
exprB'
typeForGraphRefRelationalExpr (Rename AttributeName
oldAttr AttributeName
newAttr GraphRefRelationalExpr
expr) = do
  Relation
expr' <- GraphRefRelationalExpr -> GraphRefRelationalExprM Relation
typeForGraphRefRelationalExpr GraphRefRelationalExpr
expr
  ExceptT RelationalError Identity Relation
-> GraphRefRelationalExprM Relation
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT RelationalError Identity Relation
 -> GraphRefRelationalExprM Relation)
-> ExceptT RelationalError Identity Relation
-> GraphRefRelationalExprM Relation
forall a b. (a -> b) -> a -> b
$ Either RelationalError Relation
-> ExceptT RelationalError Identity Relation
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either RelationalError Relation
 -> ExceptT RelationalError Identity Relation)
-> Either RelationalError Relation
-> ExceptT RelationalError Identity Relation
forall a b. (a -> b) -> a -> b
$ AttributeName
-> AttributeName -> Relation -> Either RelationalError Relation
rename AttributeName
oldAttr AttributeName
newAttr Relation
expr'
typeForGraphRefRelationalExpr (Difference GraphRefRelationalExpr
exprA GraphRefRelationalExpr
exprB) = do  
  Relation
exprA' <- GraphRefRelationalExpr -> GraphRefRelationalExprM Relation
typeForGraphRefRelationalExpr GraphRefRelationalExpr
exprA
  Relation
exprB' <- GraphRefRelationalExpr -> GraphRefRelationalExprM Relation
typeForGraphRefRelationalExpr GraphRefRelationalExpr
exprB
  ExceptT RelationalError Identity Relation
-> GraphRefRelationalExprM Relation
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT RelationalError Identity Relation
 -> GraphRefRelationalExprM Relation)
-> ExceptT RelationalError Identity Relation
-> GraphRefRelationalExprM Relation
forall a b. (a -> b) -> a -> b
$ Either RelationalError Relation
-> ExceptT RelationalError Identity Relation
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either RelationalError Relation
 -> ExceptT RelationalError Identity Relation)
-> Either RelationalError Relation
-> ExceptT RelationalError Identity Relation
forall a b. (a -> b) -> a -> b
$ Relation -> Relation -> Either RelationalError Relation
difference Relation
exprA' Relation
exprB'
typeForGraphRefRelationalExpr (Group AttributeNamesBase GraphRefTransactionMarker
groupNames AttributeName
attrName GraphRefRelationalExpr
expr) = do
  Relation
expr' <- GraphRefRelationalExpr -> GraphRefRelationalExprM Relation
typeForGraphRefRelationalExpr GraphRefRelationalExpr
expr
  Set AttributeName
groupNames' <- AttributeNamesBase GraphRefTransactionMarker
-> GraphRefRelationalExpr
-> GraphRefRelationalExprM (Set AttributeName)
evalGraphRefAttributeNames AttributeNamesBase GraphRefTransactionMarker
groupNames GraphRefRelationalExpr
expr
  ExceptT RelationalError Identity Relation
-> GraphRefRelationalExprM Relation
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT RelationalError Identity Relation
 -> GraphRefRelationalExprM Relation)
-> ExceptT RelationalError Identity Relation
-> GraphRefRelationalExprM Relation
forall a b. (a -> b) -> a -> b
$ Either RelationalError Relation
-> ExceptT RelationalError Identity Relation
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either RelationalError Relation
 -> ExceptT RelationalError Identity Relation)
-> Either RelationalError Relation
-> ExceptT RelationalError Identity Relation
forall a b. (a -> b) -> a -> b
$ Set AttributeName
-> AttributeName -> Relation -> Either RelationalError Relation
group Set AttributeName
groupNames' AttributeName
attrName Relation
expr'
typeForGraphRefRelationalExpr (Ungroup AttributeName
groupAttrName GraphRefRelationalExpr
expr) = do
  Relation
expr' <- GraphRefRelationalExpr -> GraphRefRelationalExprM Relation
typeForGraphRefRelationalExpr GraphRefRelationalExpr
expr
  ExceptT RelationalError Identity Relation
-> GraphRefRelationalExprM Relation
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT RelationalError Identity Relation
 -> GraphRefRelationalExprM Relation)
-> ExceptT RelationalError Identity Relation
-> GraphRefRelationalExprM Relation
forall a b. (a -> b) -> a -> b
$ Either RelationalError Relation
-> ExceptT RelationalError Identity Relation
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either RelationalError Relation
 -> ExceptT RelationalError Identity Relation)
-> Either RelationalError Relation
-> ExceptT RelationalError Identity Relation
forall a b. (a -> b) -> a -> b
$ AttributeName -> Relation -> Either RelationalError Relation
ungroup AttributeName
groupAttrName Relation
expr'
typeForGraphRefRelationalExpr (Restrict RestrictionPredicateExprBase GraphRefTransactionMarker
pred' GraphRefRelationalExpr
expr) = do
  Relation
expr' <- GraphRefRelationalExpr -> GraphRefRelationalExprM Relation
typeForGraphRefRelationalExpr GraphRefRelationalExpr
expr
  RestrictionFilter
filt <- Attributes
-> RestrictionPredicateExprBase GraphRefTransactionMarker
-> GraphRefRelationalExprM RestrictionFilter
predicateRestrictionFilter (Relation -> Attributes
attributes Relation
expr') RestrictionPredicateExprBase GraphRefTransactionMarker
pred'
  ExceptT RelationalError Identity Relation
-> GraphRefRelationalExprM Relation
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT RelationalError Identity Relation
 -> GraphRefRelationalExprM Relation)
-> ExceptT RelationalError Identity Relation
-> GraphRefRelationalExprM Relation
forall a b. (a -> b) -> a -> b
$ Either RelationalError Relation
-> ExceptT RelationalError Identity Relation
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either RelationalError Relation
 -> ExceptT RelationalError Identity Relation)
-> Either RelationalError Relation
-> ExceptT RelationalError Identity Relation
forall a b. (a -> b) -> a -> b
$ RestrictionFilter -> Relation -> Either RelationalError Relation
restrict RestrictionFilter
filt Relation
expr'
typeForGraphRefRelationalExpr Equals{} = 
  Relation -> GraphRefRelationalExprM Relation
forall (f :: * -> *) a. Applicative f => a -> f a
pure Relation
relationFalse
typeForGraphRefRelationalExpr NotEquals{} = 
  Relation -> GraphRefRelationalExprM Relation
forall (f :: * -> *) a. Applicative f => a -> f a
pure Relation
relationFalse
typeForGraphRefRelationalExpr (Extend GraphRefExtendTupleExpr
extendTupleExpr GraphRefRelationalExpr
expr) = do
  Relation
rel <- GraphRefRelationalExpr -> GraphRefRelationalExprM Relation
typeForGraphRefRelationalExpr GraphRefRelationalExpr
expr
  GraphRefRelationalExpr -> GraphRefRelationalExprM Relation
evalGraphRefRelationalExpr (GraphRefExtendTupleExpr
-> GraphRefRelationalExpr -> GraphRefRelationalExpr
forall a.
ExtendTupleExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Extend GraphRefExtendTupleExpr
extendTupleExpr (Relation -> GraphRefRelationalExpr
forall a. Relation -> RelationalExprBase a
ExistingRelation Relation
rel))
typeForGraphRefRelationalExpr expr :: GraphRefRelationalExpr
expr@(With WithNameAssocs
withs GraphRefRelationalExpr
_) = do
  let expr' :: GraphRefRelationalExpr
expr' = WithNameAssocs -> GraphRefRelationalExpr -> GraphRefRelationalExpr
substituteWithNameMacros [] GraphRefRelationalExpr
expr
      checkMacroName :: WithNameExprBase GraphRefTransactionMarker
-> ReaderT
     GraphRefRelationalExprEnv (ExceptT RelationalError Identity) ()
checkMacroName (WithNameExpr AttributeName
macroName GraphRefTransactionMarker
tid) = do
        Map AttributeName GraphRefRelationalExpr
rvs <- DatabaseContext -> Map AttributeName GraphRefRelationalExpr
relationVariables (DatabaseContext -> Map AttributeName GraphRefRelationalExpr)
-> GraphRefRelationalExprM DatabaseContext
-> ReaderT
     GraphRefRelationalExprEnv
     (ExceptT RelationalError Identity)
     (Map AttributeName GraphRefRelationalExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GraphRefTransactionMarker
-> GraphRefRelationalExprM DatabaseContext
gfDatabaseContextForMarker GraphRefTransactionMarker
tid
        case AttributeName
-> Map AttributeName GraphRefRelationalExpr
-> Maybe GraphRefRelationalExpr
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup AttributeName
macroName Map AttributeName GraphRefRelationalExpr
rvs of
          Just GraphRefRelationalExpr
_ -> ExceptT RelationalError Identity ()
-> ReaderT
     GraphRefRelationalExprEnv (ExceptT RelationalError Identity) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT RelationalError Identity ()
 -> ReaderT
      GraphRefRelationalExprEnv (ExceptT RelationalError Identity) ())
-> ExceptT RelationalError Identity ()
-> ReaderT
     GraphRefRelationalExprEnv (ExceptT RelationalError Identity) ()
forall a b. (a -> b) -> a -> b
$ Either RelationalError () -> ExceptT RelationalError Identity ()
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either RelationalError () -> ExceptT RelationalError Identity ())
-> Either RelationalError () -> ExceptT RelationalError Identity ()
forall a b. (a -> b) -> a -> b
$ RelationalError -> Either RelationalError ()
forall a b. a -> Either a b
Left (AttributeName -> RelationalError
RelVarAlreadyDefinedError AttributeName
macroName) --this error does not include the transaction marker, but should be good enough to identify the cause
          Maybe GraphRefRelationalExpr
Nothing -> ()
-> ReaderT
     GraphRefRelationalExprEnv (ExceptT RelationalError Identity) ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  ((WithNameExprBase GraphRefTransactionMarker,
  GraphRefRelationalExpr)
 -> ReaderT
      GraphRefRelationalExprEnv (ExceptT RelationalError Identity) ())
-> WithNameAssocs
-> ReaderT
     GraphRefRelationalExprEnv (ExceptT RelationalError Identity) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (WithNameExprBase GraphRefTransactionMarker
-> ReaderT
     GraphRefRelationalExprEnv (ExceptT RelationalError Identity) ()
checkMacroName (WithNameExprBase GraphRefTransactionMarker
 -> ReaderT
      GraphRefRelationalExprEnv (ExceptT RelationalError Identity) ())
-> ((WithNameExprBase GraphRefTransactionMarker,
     GraphRefRelationalExpr)
    -> WithNameExprBase GraphRefTransactionMarker)
-> (WithNameExprBase GraphRefTransactionMarker,
    GraphRefRelationalExpr)
-> ReaderT
     GraphRefRelationalExprEnv (ExceptT RelationalError Identity) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithNameExprBase GraphRefTransactionMarker,
 GraphRefRelationalExpr)
-> WithNameExprBase GraphRefTransactionMarker
forall a b. (a, b) -> a
fst) WithNameAssocs
withs
  GraphRefRelationalExpr -> GraphRefRelationalExprM Relation
typeForGraphRefRelationalExpr GraphRefRelationalExpr
expr'
  
evalGraphRefAttributeNames :: GraphRefAttributeNames -> GraphRefRelationalExpr -> GraphRefRelationalExprM (S.Set AttributeName)
evalGraphRefAttributeNames :: AttributeNamesBase GraphRefTransactionMarker
-> GraphRefRelationalExpr
-> GraphRefRelationalExprM (Set AttributeName)
evalGraphRefAttributeNames AttributeNamesBase GraphRefTransactionMarker
attrNames GraphRefRelationalExpr
expr = do
  Relation
exprType' <- GraphRefRelationalExpr -> GraphRefRelationalExprM Relation
typeForGraphRefRelationalExpr GraphRefRelationalExpr
expr
  let typeNameSet :: Set AttributeName
typeNameSet = [AttributeName] -> Set AttributeName
forall a. Ord a => [a] -> Set a
S.fromList (Vector AttributeName -> [AttributeName]
forall a. Vector a -> [a]
V.toList (Attributes -> Vector AttributeName
A.attributeNames (Relation -> Attributes
attributes Relation
exprType')))
  case AttributeNamesBase GraphRefTransactionMarker
attrNames of
    AttributeNames Set AttributeName
names ->
      case Set AttributeName
-> Attributes -> Either RelationalError Attributes
A.projectionAttributesForNames Set AttributeName
names (Relation -> Attributes
attributes Relation
exprType') of
        Left RelationalError
err -> RelationalError -> GraphRefRelationalExprM (Set AttributeName)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError RelationalError
err
        Right Attributes
attrs -> Set AttributeName -> GraphRefRelationalExprM (Set AttributeName)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([AttributeName] -> Set AttributeName
forall a. Ord a => [a] -> Set a
S.fromList (Vector AttributeName -> [AttributeName]
forall a. Vector a -> [a]
V.toList (Attributes -> Vector AttributeName
A.attributeNames Attributes
attrs)))
          
    InvertedAttributeNames Set AttributeName
names -> do
          let nonExistentAttributeNames :: Set AttributeName
nonExistentAttributeNames = Set AttributeName -> Set AttributeName -> Set AttributeName
A.attributeNamesNotContained Set AttributeName
names Set AttributeName
typeNameSet
          if DirtyFlag -> DirtyFlag
not (Set AttributeName -> DirtyFlag
forall a. Set a -> DirtyFlag
S.null Set AttributeName
nonExistentAttributeNames) then
            RelationalError -> GraphRefRelationalExprM (Set AttributeName)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (RelationalError -> GraphRefRelationalExprM (Set AttributeName))
-> RelationalError -> GraphRefRelationalExprM (Set AttributeName)
forall a b. (a -> b) -> a -> b
$ Set AttributeName -> RelationalError
AttributeNamesMismatchError Set AttributeName
nonExistentAttributeNames
            else
            Set AttributeName -> GraphRefRelationalExprM (Set AttributeName)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set AttributeName -> Set AttributeName -> Set AttributeName
A.nonMatchingAttributeNameSet Set AttributeName
names Set AttributeName
typeNameSet)
        
    UnionAttributeNames AttributeNamesBase GraphRefTransactionMarker
namesA AttributeNamesBase GraphRefTransactionMarker
namesB -> do
      Set AttributeName
nameSetA <- AttributeNamesBase GraphRefTransactionMarker
-> GraphRefRelationalExpr
-> GraphRefRelationalExprM (Set AttributeName)
evalGraphRefAttributeNames AttributeNamesBase GraphRefTransactionMarker
namesA GraphRefRelationalExpr
expr
      Set AttributeName
nameSetB <- AttributeNamesBase GraphRefTransactionMarker
-> GraphRefRelationalExpr
-> GraphRefRelationalExprM (Set AttributeName)
evalGraphRefAttributeNames AttributeNamesBase GraphRefTransactionMarker
namesB GraphRefRelationalExpr
expr
      Set AttributeName -> GraphRefRelationalExprM (Set AttributeName)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set AttributeName -> Set AttributeName -> Set AttributeName
forall a. Ord a => Set a -> Set a -> Set a
S.union Set AttributeName
nameSetA Set AttributeName
nameSetB)
        
    IntersectAttributeNames AttributeNamesBase GraphRefTransactionMarker
namesA AttributeNamesBase GraphRefTransactionMarker
namesB -> do
      Set AttributeName
nameSetA <- AttributeNamesBase GraphRefTransactionMarker
-> GraphRefRelationalExpr
-> GraphRefRelationalExprM (Set AttributeName)
evalGraphRefAttributeNames AttributeNamesBase GraphRefTransactionMarker
namesA GraphRefRelationalExpr
expr
      Set AttributeName
nameSetB <- AttributeNamesBase GraphRefTransactionMarker
-> GraphRefRelationalExpr
-> GraphRefRelationalExprM (Set AttributeName)
evalGraphRefAttributeNames AttributeNamesBase GraphRefTransactionMarker
namesB GraphRefRelationalExpr
expr
      Set AttributeName -> GraphRefRelationalExprM (Set AttributeName)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set AttributeName -> Set AttributeName -> Set AttributeName
forall a. Ord a => Set a -> Set a -> Set a
S.intersection Set AttributeName
nameSetA Set AttributeName
nameSetB)
        
    RelationalExprAttributeNames GraphRefRelationalExpr
attrExpr -> do
      Relation
attrExprType <- GraphRefRelationalExpr -> GraphRefRelationalExprM Relation
typeForGraphRefRelationalExpr GraphRefRelationalExpr
attrExpr
      Set AttributeName -> GraphRefRelationalExprM (Set AttributeName)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Attributes -> Set AttributeName
A.attributeNameSet (Relation -> Attributes
attributes Relation
attrExprType))

evalGraphRefAttributeExpr :: GraphRefAttributeExpr -> GraphRefRelationalExprM Attribute
evalGraphRefAttributeExpr :: AttributeExprBase GraphRefTransactionMarker
-> ReaderT
     GraphRefRelationalExprEnv
     (ExceptT RelationalError Identity)
     Attribute
evalGraphRefAttributeExpr (AttributeAndTypeNameExpr AttributeName
attrName TypeConstructor
tCons GraphRefTransactionMarker
tid) = do
  TypeConstructorMapping
tConsMap <- DatabaseContext -> TypeConstructorMapping
typeConstructorMapping (DatabaseContext -> TypeConstructorMapping)
-> GraphRefRelationalExprM DatabaseContext
-> ReaderT
     GraphRefRelationalExprEnv
     (ExceptT RelationalError Identity)
     TypeConstructorMapping
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GraphRefTransactionMarker
-> GraphRefRelationalExprM DatabaseContext
gfDatabaseContextForMarker GraphRefTransactionMarker
tid
  case DirtyFlag
-> TypeConstructor
-> TypeConstructorMapping
-> TypeVarMap
-> Either RelationalError AtomType
atomTypeForTypeConstructorValidate DirtyFlag
True TypeConstructor
tCons TypeConstructorMapping
tConsMap TypeVarMap
forall k a. Map k a
M.empty of
    Left RelationalError
err -> RelationalError
-> ReaderT
     GraphRefRelationalExprEnv
     (ExceptT RelationalError Identity)
     Attribute
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError RelationalError
err
    Right AtomType
aType -> do
      case AtomType -> TypeConstructorMapping -> Either RelationalError ()
validateAtomType AtomType
aType TypeConstructorMapping
tConsMap of
        Left RelationalError
err -> RelationalError
-> ReaderT
     GraphRefRelationalExprEnv
     (ExceptT RelationalError Identity)
     Attribute
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError RelationalError
err
        Right ()
_ -> Attribute
-> ReaderT
     GraphRefRelationalExprEnv
     (ExceptT RelationalError Identity)
     Attribute
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AttributeName -> AtomType -> Attribute
Attribute AttributeName
attrName AtomType
aType)
evalGraphRefAttributeExpr (NakedAttributeExpr Attribute
attr) = Attribute
-> ReaderT
     GraphRefRelationalExprEnv
     (ExceptT RelationalError Identity)
     Attribute
forall (f :: * -> *) a. Applicative f => a -> f a
pure Attribute
attr        

mkEmptyRelVars :: RelationVariables -> RelationVariables
mkEmptyRelVars :: Map AttributeName GraphRefRelationalExpr
-> Map AttributeName GraphRefRelationalExpr
mkEmptyRelVars = (GraphRefRelationalExpr -> GraphRefRelationalExpr)
-> Map AttributeName GraphRefRelationalExpr
-> Map AttributeName GraphRefRelationalExpr
forall a b k. (a -> b) -> Map k a -> Map k b
M.map GraphRefRelationalExpr -> GraphRefRelationalExpr
forall a. RelationalExprBase a -> RelationalExprBase a
mkEmptyRelVar
  where
    mkEmptyRelVar :: RelationalExprBase a -> RelationalExprBase a
mkEmptyRelVar expr :: RelationalExprBase a
expr@MakeRelationFromExprs{} = RelationalExprBase a
expr --do not truncate here because we might lose essential type information in emptying the tuples
    mkEmptyRelVar (MakeStaticRelation Attributes
attrs RelationTupleSet
_) = Attributes -> RelationTupleSet -> RelationalExprBase a
forall a. Attributes -> RelationTupleSet -> RelationalExprBase a
MakeStaticRelation Attributes
attrs RelationTupleSet
emptyTupleSet
    mkEmptyRelVar (ExistingRelation Relation
rel) = Relation -> RelationalExprBase a
forall a. Relation -> RelationalExprBase a
ExistingRelation (Attributes -> Relation
emptyRelationWithAttrs (Relation -> Attributes
attributes Relation
rel))
    mkEmptyRelVar rv :: RelationalExprBase a
rv@RelationVariable{} = RestrictionPredicateExprBase a
-> RelationalExprBase a -> RelationalExprBase a
forall a.
RestrictionPredicateExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Restrict (RestrictionPredicateExprBase a -> RestrictionPredicateExprBase a
forall a.
RestrictionPredicateExprBase a -> RestrictionPredicateExprBase a
NotPredicate RestrictionPredicateExprBase a
forall a. RestrictionPredicateExprBase a
TruePredicate) RelationalExprBase a
rv
    mkEmptyRelVar (Project AttributeNamesBase a
attrNames RelationalExprBase a
expr) = AttributeNamesBase a
-> RelationalExprBase a -> RelationalExprBase a
forall a.
AttributeNamesBase a
-> RelationalExprBase a -> RelationalExprBase a
Project AttributeNamesBase a
attrNames (RelationalExprBase a -> RelationalExprBase a
mkEmptyRelVar RelationalExprBase a
expr)
    mkEmptyRelVar (Union RelationalExprBase a
exprA RelationalExprBase a
exprB) = RelationalExprBase a
-> RelationalExprBase a -> RelationalExprBase a
forall a.
RelationalExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Union (RelationalExprBase a -> RelationalExprBase a
mkEmptyRelVar RelationalExprBase a
exprA) (RelationalExprBase a -> RelationalExprBase a
mkEmptyRelVar RelationalExprBase a
exprB)
    mkEmptyRelVar (Join RelationalExprBase a
exprA RelationalExprBase a
exprB) = RelationalExprBase a
-> RelationalExprBase a -> RelationalExprBase a
forall a.
RelationalExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Join (RelationalExprBase a -> RelationalExprBase a
mkEmptyRelVar RelationalExprBase a
exprA) (RelationalExprBase a -> RelationalExprBase a
mkEmptyRelVar RelationalExprBase a
exprB)
    mkEmptyRelVar (Rename AttributeName
nameA AttributeName
nameB RelationalExprBase a
expr) = AttributeName
-> AttributeName -> RelationalExprBase a -> RelationalExprBase a
forall a.
AttributeName
-> AttributeName -> RelationalExprBase a -> RelationalExprBase a
Rename AttributeName
nameA AttributeName
nameB (RelationalExprBase a -> RelationalExprBase a
mkEmptyRelVar RelationalExprBase a
expr)
    mkEmptyRelVar (Difference RelationalExprBase a
exprA RelationalExprBase a
exprB) = RelationalExprBase a
-> RelationalExprBase a -> RelationalExprBase a
forall a.
RelationalExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Difference (RelationalExprBase a -> RelationalExprBase a
mkEmptyRelVar RelationalExprBase a
exprA) (RelationalExprBase a -> RelationalExprBase a
mkEmptyRelVar RelationalExprBase a
exprB)
    mkEmptyRelVar (Group AttributeNamesBase a
attrNames AttributeName
attrName RelationalExprBase a
expr) = AttributeNamesBase a
-> AttributeName -> RelationalExprBase a -> RelationalExprBase a
forall a.
AttributeNamesBase a
-> AttributeName -> RelationalExprBase a -> RelationalExprBase a
Group AttributeNamesBase a
attrNames AttributeName
attrName (RelationalExprBase a -> RelationalExprBase a
mkEmptyRelVar RelationalExprBase a
expr)
    mkEmptyRelVar (Ungroup AttributeName
attrName RelationalExprBase a
expr) = AttributeName -> RelationalExprBase a -> RelationalExprBase a
forall a.
AttributeName -> RelationalExprBase a -> RelationalExprBase a
Ungroup AttributeName
attrName (RelationalExprBase a -> RelationalExprBase a
mkEmptyRelVar RelationalExprBase a
expr)
    mkEmptyRelVar (Restrict RestrictionPredicateExprBase a
pred' RelationalExprBase a
expr) = RestrictionPredicateExprBase a
-> RelationalExprBase a -> RelationalExprBase a
forall a.
RestrictionPredicateExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Restrict RestrictionPredicateExprBase a
pred' (RelationalExprBase a -> RelationalExprBase a
mkEmptyRelVar RelationalExprBase a
expr)
    mkEmptyRelVar (Equals RelationalExprBase a
exprA RelationalExprBase a
exprB) = RelationalExprBase a
-> RelationalExprBase a -> RelationalExprBase a
forall a.
RelationalExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Equals (RelationalExprBase a -> RelationalExprBase a
mkEmptyRelVar RelationalExprBase a
exprA) (RelationalExprBase a -> RelationalExprBase a
mkEmptyRelVar RelationalExprBase a
exprB)
    mkEmptyRelVar (NotEquals RelationalExprBase a
exprA RelationalExprBase a
exprB) = RelationalExprBase a
-> RelationalExprBase a -> RelationalExprBase a
forall a.
RelationalExprBase a
-> RelationalExprBase a -> RelationalExprBase a
NotEquals (RelationalExprBase a -> RelationalExprBase a
mkEmptyRelVar RelationalExprBase a
exprA) (RelationalExprBase a -> RelationalExprBase a
mkEmptyRelVar RelationalExprBase a
exprB)
    mkEmptyRelVar (Extend ExtendTupleExprBase a
extTuple RelationalExprBase a
expr) = ExtendTupleExprBase a
-> RelationalExprBase a -> RelationalExprBase a
forall a.
ExtendTupleExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Extend ExtendTupleExprBase a
extTuple (RelationalExprBase a -> RelationalExprBase a
mkEmptyRelVar RelationalExprBase a
expr)
    mkEmptyRelVar (With [(WithNameExprBase a, RelationalExprBase a)]
macros RelationalExprBase a
expr) = [(WithNameExprBase a, RelationalExprBase a)]
-> RelationalExprBase a -> RelationalExprBase a
forall a.
[(WithNameExprBase a, RelationalExprBase a)]
-> RelationalExprBase a -> RelationalExprBase a
With (((WithNameExprBase a, RelationalExprBase a)
 -> (WithNameExprBase a, RelationalExprBase a))
-> [(WithNameExprBase a, RelationalExprBase a)]
-> [(WithNameExprBase a, RelationalExprBase a)]
forall a b. (a -> b) -> [a] -> [b]
map ((RelationalExprBase a -> RelationalExprBase a)
-> (WithNameExprBase a, RelationalExprBase a)
-> (WithNameExprBase a, RelationalExprBase a)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second RelationalExprBase a -> RelationalExprBase a
mkEmptyRelVar) [(WithNameExprBase a, RelationalExprBase a)]
macros) (RelationalExprBase a -> RelationalExprBase a
mkEmptyRelVar RelationalExprBase a
expr)


dbErr :: RelationalError -> DatabaseContextEvalMonad ()
dbErr :: RelationalError -> DatabaseContextEvalMonad ()
dbErr RelationalError
err = ExceptT RelationalError Identity () -> DatabaseContextEvalMonad ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either RelationalError () -> ExceptT RelationalError Identity ()
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (RelationalError -> Either RelationalError ()
forall a b. a -> Either a b
Left RelationalError
err))
      
-- | Return a Relation describing the relation variables.
relationVariablesAsRelation :: DatabaseContext -> TransactionGraph -> Either RelationalError Relation
relationVariablesAsRelation :: DatabaseContext
-> TransactionGraph -> Either RelationalError Relation
relationVariablesAsRelation DatabaseContext
ctx TransactionGraph
graph = do
  let subrelAttrs :: Attributes
subrelAttrs = [Attribute] -> Attributes
A.attributesFromList [AttributeName -> AtomType -> Attribute
Attribute AttributeName
"attribute" AtomType
TextAtomType, AttributeName -> AtomType -> Attribute
Attribute AttributeName
"type" AtomType
TextAtomType]
      attrs :: Attributes
attrs = [Attribute] -> Attributes
A.attributesFromList [AttributeName -> AtomType -> Attribute
Attribute AttributeName
"name" AtomType
TextAtomType,
                                  AttributeName -> AtomType -> Attribute
Attribute AttributeName
"attributes" (Attributes -> AtomType
RelationAtomType Attributes
subrelAttrs)]
      relVars :: Map AttributeName GraphRefRelationalExpr
relVars = DatabaseContext -> Map AttributeName GraphRefRelationalExpr
relationVariables DatabaseContext
ctx
      mkRvDesc :: (a, GraphRefRelationalExpr) -> Either RelationalError (a, Relation)
mkRvDesc (a
rvName, GraphRefRelationalExpr
gfExpr) = do
        let gfEnv :: GraphRefRelationalExprEnv
gfEnv = Maybe DatabaseContext
-> TransactionGraph -> GraphRefRelationalExprEnv
freshGraphRefRelationalExprEnv (DatabaseContext -> Maybe DatabaseContext
forall a. a -> Maybe a
Just DatabaseContext
ctx) TransactionGraph
graph
        Relation
gfType <- GraphRefRelationalExprEnv
-> GraphRefRelationalExprM Relation
-> Either RelationalError Relation
forall a.
GraphRefRelationalExprEnv
-> GraphRefRelationalExprM a -> Either RelationalError a
runGraphRefRelationalExprM GraphRefRelationalExprEnv
gfEnv (GraphRefRelationalExpr -> GraphRefRelationalExprM Relation
typeForGraphRefRelationalExpr GraphRefRelationalExpr
gfExpr)
        (a, Relation) -> Either RelationalError (a, Relation)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
rvName, Relation
gfType)
      relVarToAtomList :: (AttributeName, Relation) -> [Atom]
relVarToAtomList (AttributeName
rvName, Relation
rel) = [AttributeName -> Atom
TextAtom AttributeName
rvName, Vector Attribute -> Atom
attributesToRel (Attributes -> Vector Attribute
attributesVec (Relation -> Attributes
attributes Relation
rel))]
      attrAtoms :: Attribute -> [Atom]
attrAtoms Attribute
a = [AttributeName -> Atom
TextAtom (Attribute -> AttributeName
A.attributeName Attribute
a), AttributeName -> Atom
TextAtom (AtomType -> AttributeName
prettyAtomType (Attribute -> AtomType
A.atomType Attribute
a))]
      attributesToRel :: Vector Attribute -> Atom
attributesToRel Vector Attribute
attrl = case Attributes -> [[Atom]] -> Either RelationalError Relation
mkRelationFromList Attributes
subrelAttrs ((Attribute -> [Atom]) -> [Attribute] -> [[Atom]]
forall a b. (a -> b) -> [a] -> [b]
map Attribute -> [Atom]
attrAtoms (Vector Attribute -> [Attribute]
forall a. Vector a -> [a]
V.toList Vector Attribute
attrl)) of
        Left RelationalError
err -> [Char] -> Atom
forall a. HasCallStack => [Char] -> a
error ([Char]
"relationVariablesAsRelation pooped " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ RelationalError -> [Char]
forall a. Show a => a -> [Char]
show RelationalError
err)
        Right Relation
rel -> Relation -> Atom
RelationAtom Relation
rel
  [(AttributeName, Relation)]
rvs <- ((AttributeName, GraphRefRelationalExpr)
 -> Either RelationalError (AttributeName, Relation))
-> [(AttributeName, GraphRefRelationalExpr)]
-> Either RelationalError [(AttributeName, Relation)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (AttributeName, GraphRefRelationalExpr)
-> Either RelationalError (AttributeName, Relation)
forall a.
(a, GraphRefRelationalExpr) -> Either RelationalError (a, Relation)
mkRvDesc (Map AttributeName GraphRefRelationalExpr
-> [(AttributeName, GraphRefRelationalExpr)]
forall k a. Map k a -> [(k, a)]
M.toList Map AttributeName GraphRefRelationalExpr
relVars)
  let tups :: [[Atom]]
tups = ((AttributeName, Relation) -> [Atom])
-> [(AttributeName, Relation)] -> [[Atom]]
forall a b. (a -> b) -> [a] -> [b]
map (AttributeName, Relation) -> [Atom]
relVarToAtomList [(AttributeName, Relation)]
rvs
  Attributes -> [[Atom]] -> Either RelationalError Relation
mkRelationFromList Attributes
attrs [[Atom]]
tups

-- | An unoptimized variant of evalGraphRefRelationalExpr for testing.
evalRelationalExpr :: RelationalExpr -> RelationalExprM Relation
evalRelationalExpr :: RelationalExpr -> RelationalExprM Relation
evalRelationalExpr RelationalExpr
expr = do
  TransactionGraph
graph <- RelationalExprM TransactionGraph
reGraph
  DatabaseContext
context <- RelationalExprM DatabaseContext
reContext
  let expr' :: GraphRefRelationalExpr
expr' = GraphRefTransactionMarker
-> ProcessExprM GraphRefRelationalExpr -> GraphRefRelationalExpr
forall a. GraphRefTransactionMarker -> ProcessExprM a -> a
runProcessExprM GraphRefTransactionMarker
UncommittedContextMarker (RelationalExpr -> ProcessExprM GraphRefRelationalExpr
processRelationalExpr RelationalExpr
expr)
      gfEnv :: GraphRefRelationalExprEnv
gfEnv = Maybe DatabaseContext
-> TransactionGraph -> GraphRefRelationalExprEnv
freshGraphRefRelationalExprEnv (DatabaseContext -> Maybe DatabaseContext
forall a. a -> Maybe a
Just DatabaseContext
context) TransactionGraph
graph
  case GraphRefRelationalExprEnv
-> GraphRefRelationalExprM Relation
-> Either RelationalError Relation
forall a.
GraphRefRelationalExprEnv
-> GraphRefRelationalExprM a -> Either RelationalError a
runGraphRefRelationalExprM GraphRefRelationalExprEnv
gfEnv (GraphRefRelationalExpr -> GraphRefRelationalExprM Relation
evalGraphRefRelationalExpr GraphRefRelationalExpr
expr') of
    Left RelationalError
err -> RelationalError -> RelationalExprM Relation
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError RelationalError
err
    Right Relation
rel -> Relation -> RelationalExprM Relation
forall (f :: * -> *) a. Applicative f => a -> f a
pure Relation
rel

class (MonadError RelationalError m, Monad m) => DatabaseContextM m where
  getContext :: m DatabaseContext
  
instance DatabaseContextM (ReaderT GraphRefRelationalExprEnv (ExceptT RelationalError Identity)) where
  getContext :: GraphRefRelationalExprM DatabaseContext
getContext = GraphRefTransactionMarker
-> GraphRefRelationalExprM DatabaseContext
gfDatabaseContextForMarker GraphRefTransactionMarker
UncommittedContextMarker

instance DatabaseContextM (RWST DatabaseContextEvalEnv () DatabaseContextEvalState (ExceptT RelationalError Identity)) where
  getContext :: RWST
  DatabaseContextEvalEnv
  ()
  DatabaseContextEvalState
  (ExceptT RelationalError Identity)
  DatabaseContext
getContext = RWST
  DatabaseContextEvalEnv
  ()
  DatabaseContextEvalState
  (ExceptT RelationalError Identity)
  DatabaseContext
getStateContext
    
relVarByName :: DatabaseContextM m => RelVarName -> m GraphRefRelationalExpr
relVarByName :: AttributeName -> m GraphRefRelationalExpr
relVarByName AttributeName
rvName = do
  Map AttributeName GraphRefRelationalExpr
relvars <- DatabaseContext -> Map AttributeName GraphRefRelationalExpr
relationVariables (DatabaseContext -> Map AttributeName GraphRefRelationalExpr)
-> m DatabaseContext
-> m (Map AttributeName GraphRefRelationalExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m DatabaseContext
forall (m :: * -> *). DatabaseContextM m => m DatabaseContext
getContext  
  case AttributeName
-> Map AttributeName GraphRefRelationalExpr
-> Maybe GraphRefRelationalExpr
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup AttributeName
rvName Map AttributeName GraphRefRelationalExpr
relvars of
    Maybe GraphRefRelationalExpr
Nothing -> RelationalError -> m GraphRefRelationalExpr
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (AttributeName -> RelationalError
RelVarNotDefinedError AttributeName
rvName)
    Just GraphRefRelationalExpr
gfexpr -> GraphRefRelationalExpr -> m GraphRefRelationalExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure GraphRefRelationalExpr
gfexpr
  
-- | resolve UncommittedTransactionMarker whenever possible- this is important in the DatabaseContext in order to mitigate self-referencing loops for updates
class ResolveGraphRefTransactionMarker a where
  resolve :: a -> DatabaseContextEvalMonad a

-- s := s union t
instance ResolveGraphRefTransactionMarker GraphRefRelationalExpr where
  resolve :: GraphRefRelationalExpr
-> DatabaseContextEvalMonad GraphRefRelationalExpr
resolve (MakeRelationFromExprs Maybe [AttributeExprBase GraphRefTransactionMarker]
mAttrs GraphRefTupleExprs
tupleExprs) =
    Maybe [AttributeExprBase GraphRefTransactionMarker]
-> GraphRefTupleExprs -> GraphRefRelationalExpr
forall a.
Maybe [AttributeExprBase a]
-> TupleExprsBase a -> RelationalExprBase a
MakeRelationFromExprs Maybe [AttributeExprBase GraphRefTransactionMarker]
mAttrs (GraphRefTupleExprs -> GraphRefRelationalExpr)
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     GraphRefTupleExprs
-> DatabaseContextEvalMonad GraphRefRelationalExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GraphRefTupleExprs
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     GraphRefTupleExprs
forall a.
ResolveGraphRefTransactionMarker a =>
a -> DatabaseContextEvalMonad a
resolve GraphRefTupleExprs
tupleExprs
  resolve orig :: GraphRefRelationalExpr
orig@MakeStaticRelation{} = GraphRefRelationalExpr
-> DatabaseContextEvalMonad GraphRefRelationalExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure GraphRefRelationalExpr
orig
  resolve orig :: GraphRefRelationalExpr
orig@ExistingRelation{} = GraphRefRelationalExpr
-> DatabaseContextEvalMonad GraphRefRelationalExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure GraphRefRelationalExpr
orig
  resolve orig :: GraphRefRelationalExpr
orig@(RelationVariable AttributeName
rvName GraphRefTransactionMarker
UncommittedContextMarker) = do
    Map AttributeName GraphRefRelationalExpr
rvMap <- DatabaseContext -> Map AttributeName GraphRefRelationalExpr
relationVariables (DatabaseContext -> Map AttributeName GraphRefRelationalExpr)
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     DatabaseContext
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (Map AttributeName GraphRefRelationalExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST
  DatabaseContextEvalEnv
  ()
  DatabaseContextEvalState
  (ExceptT RelationalError Identity)
  DatabaseContext
getStateContext
    case AttributeName
-> Map AttributeName GraphRefRelationalExpr
-> Maybe GraphRefRelationalExpr
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup AttributeName
rvName Map AttributeName GraphRefRelationalExpr
rvMap of
      Maybe GraphRefRelationalExpr
Nothing -> GraphRefRelationalExpr
-> DatabaseContextEvalMonad GraphRefRelationalExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure GraphRefRelationalExpr
orig
      Just GraphRefRelationalExpr
resolvedRv -> GraphRefRelationalExpr
-> DatabaseContextEvalMonad GraphRefRelationalExpr
forall a.
ResolveGraphRefTransactionMarker a =>
a -> DatabaseContextEvalMonad a
resolve GraphRefRelationalExpr
resolvedRv
  resolve orig :: GraphRefRelationalExpr
orig@RelationVariable{} = GraphRefRelationalExpr
-> DatabaseContextEvalMonad GraphRefRelationalExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure GraphRefRelationalExpr
orig
  resolve (Project AttributeNamesBase GraphRefTransactionMarker
attrNames GraphRefRelationalExpr
relExpr) = AttributeNamesBase GraphRefTransactionMarker
-> GraphRefRelationalExpr -> GraphRefRelationalExpr
forall a.
AttributeNamesBase a
-> RelationalExprBase a -> RelationalExprBase a
Project (AttributeNamesBase GraphRefTransactionMarker
 -> GraphRefRelationalExpr -> GraphRefRelationalExpr)
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (AttributeNamesBase GraphRefTransactionMarker)
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (GraphRefRelationalExpr -> GraphRefRelationalExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AttributeNamesBase GraphRefTransactionMarker
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (AttributeNamesBase GraphRefTransactionMarker)
forall a.
ResolveGraphRefTransactionMarker a =>
a -> DatabaseContextEvalMonad a
resolve AttributeNamesBase GraphRefTransactionMarker
attrNames RWST
  DatabaseContextEvalEnv
  ()
  DatabaseContextEvalState
  (ExceptT RelationalError Identity)
  (GraphRefRelationalExpr -> GraphRefRelationalExpr)
-> DatabaseContextEvalMonad GraphRefRelationalExpr
-> DatabaseContextEvalMonad GraphRefRelationalExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GraphRefRelationalExpr
-> DatabaseContextEvalMonad GraphRefRelationalExpr
forall a.
ResolveGraphRefTransactionMarker a =>
a -> DatabaseContextEvalMonad a
resolve GraphRefRelationalExpr
relExpr
  resolve (Union GraphRefRelationalExpr
exprA GraphRefRelationalExpr
exprB) = GraphRefRelationalExpr
-> GraphRefRelationalExpr -> GraphRefRelationalExpr
forall a.
RelationalExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Union (GraphRefRelationalExpr
 -> GraphRefRelationalExpr -> GraphRefRelationalExpr)
-> DatabaseContextEvalMonad GraphRefRelationalExpr
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (GraphRefRelationalExpr -> GraphRefRelationalExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GraphRefRelationalExpr
-> DatabaseContextEvalMonad GraphRefRelationalExpr
forall a.
ResolveGraphRefTransactionMarker a =>
a -> DatabaseContextEvalMonad a
resolve GraphRefRelationalExpr
exprA RWST
  DatabaseContextEvalEnv
  ()
  DatabaseContextEvalState
  (ExceptT RelationalError Identity)
  (GraphRefRelationalExpr -> GraphRefRelationalExpr)
-> DatabaseContextEvalMonad GraphRefRelationalExpr
-> DatabaseContextEvalMonad GraphRefRelationalExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GraphRefRelationalExpr
-> DatabaseContextEvalMonad GraphRefRelationalExpr
forall a.
ResolveGraphRefTransactionMarker a =>
a -> DatabaseContextEvalMonad a
resolve GraphRefRelationalExpr
exprB
  resolve (Join GraphRefRelationalExpr
exprA GraphRefRelationalExpr
exprB) = GraphRefRelationalExpr
-> GraphRefRelationalExpr -> GraphRefRelationalExpr
forall a.
RelationalExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Join (GraphRefRelationalExpr
 -> GraphRefRelationalExpr -> GraphRefRelationalExpr)
-> DatabaseContextEvalMonad GraphRefRelationalExpr
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (GraphRefRelationalExpr -> GraphRefRelationalExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GraphRefRelationalExpr
-> DatabaseContextEvalMonad GraphRefRelationalExpr
forall a.
ResolveGraphRefTransactionMarker a =>
a -> DatabaseContextEvalMonad a
resolve GraphRefRelationalExpr
exprA RWST
  DatabaseContextEvalEnv
  ()
  DatabaseContextEvalState
  (ExceptT RelationalError Identity)
  (GraphRefRelationalExpr -> GraphRefRelationalExpr)
-> DatabaseContextEvalMonad GraphRefRelationalExpr
-> DatabaseContextEvalMonad GraphRefRelationalExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GraphRefRelationalExpr
-> DatabaseContextEvalMonad GraphRefRelationalExpr
forall a.
ResolveGraphRefTransactionMarker a =>
a -> DatabaseContextEvalMonad a
resolve GraphRefRelationalExpr
exprB
  resolve (Rename AttributeName
attrA AttributeName
attrB GraphRefRelationalExpr
expr) = AttributeName
-> AttributeName
-> GraphRefRelationalExpr
-> GraphRefRelationalExpr
forall a.
AttributeName
-> AttributeName -> RelationalExprBase a -> RelationalExprBase a
Rename AttributeName
attrA AttributeName
attrB (GraphRefRelationalExpr -> GraphRefRelationalExpr)
-> DatabaseContextEvalMonad GraphRefRelationalExpr
-> DatabaseContextEvalMonad GraphRefRelationalExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GraphRefRelationalExpr
-> DatabaseContextEvalMonad GraphRefRelationalExpr
forall a.
ResolveGraphRefTransactionMarker a =>
a -> DatabaseContextEvalMonad a
resolve GraphRefRelationalExpr
expr
  resolve (Difference GraphRefRelationalExpr
exprA GraphRefRelationalExpr
exprB) = GraphRefRelationalExpr
-> GraphRefRelationalExpr -> GraphRefRelationalExpr
forall a.
RelationalExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Difference (GraphRefRelationalExpr
 -> GraphRefRelationalExpr -> GraphRefRelationalExpr)
-> DatabaseContextEvalMonad GraphRefRelationalExpr
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (GraphRefRelationalExpr -> GraphRefRelationalExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GraphRefRelationalExpr
-> DatabaseContextEvalMonad GraphRefRelationalExpr
forall a.
ResolveGraphRefTransactionMarker a =>
a -> DatabaseContextEvalMonad a
resolve GraphRefRelationalExpr
exprA RWST
  DatabaseContextEvalEnv
  ()
  DatabaseContextEvalState
  (ExceptT RelationalError Identity)
  (GraphRefRelationalExpr -> GraphRefRelationalExpr)
-> DatabaseContextEvalMonad GraphRefRelationalExpr
-> DatabaseContextEvalMonad GraphRefRelationalExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GraphRefRelationalExpr
-> DatabaseContextEvalMonad GraphRefRelationalExpr
forall a.
ResolveGraphRefTransactionMarker a =>
a -> DatabaseContextEvalMonad a
resolve GraphRefRelationalExpr
exprB
  resolve (Group AttributeNamesBase GraphRefTransactionMarker
namesA AttributeName
nameB GraphRefRelationalExpr
expr) = AttributeNamesBase GraphRefTransactionMarker
-> AttributeName
-> GraphRefRelationalExpr
-> GraphRefRelationalExpr
forall a.
AttributeNamesBase a
-> AttributeName -> RelationalExprBase a -> RelationalExprBase a
Group (AttributeNamesBase GraphRefTransactionMarker
 -> AttributeName
 -> GraphRefRelationalExpr
 -> GraphRefRelationalExpr)
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (AttributeNamesBase GraphRefTransactionMarker)
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (AttributeName -> GraphRefRelationalExpr -> GraphRefRelationalExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AttributeNamesBase GraphRefTransactionMarker
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (AttributeNamesBase GraphRefTransactionMarker)
forall a.
ResolveGraphRefTransactionMarker a =>
a -> DatabaseContextEvalMonad a
resolve AttributeNamesBase GraphRefTransactionMarker
namesA RWST
  DatabaseContextEvalEnv
  ()
  DatabaseContextEvalState
  (ExceptT RelationalError Identity)
  (AttributeName -> GraphRefRelationalExpr -> GraphRefRelationalExpr)
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     AttributeName
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (GraphRefRelationalExpr -> GraphRefRelationalExpr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AttributeName
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     AttributeName
forall (f :: * -> *) a. Applicative f => a -> f a
pure AttributeName
nameB RWST
  DatabaseContextEvalEnv
  ()
  DatabaseContextEvalState
  (ExceptT RelationalError Identity)
  (GraphRefRelationalExpr -> GraphRefRelationalExpr)
-> DatabaseContextEvalMonad GraphRefRelationalExpr
-> DatabaseContextEvalMonad GraphRefRelationalExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GraphRefRelationalExpr
-> DatabaseContextEvalMonad GraphRefRelationalExpr
forall a.
ResolveGraphRefTransactionMarker a =>
a -> DatabaseContextEvalMonad a
resolve GraphRefRelationalExpr
expr
  resolve (Ungroup AttributeName
nameA GraphRefRelationalExpr
expr) = AttributeName -> GraphRefRelationalExpr -> GraphRefRelationalExpr
forall a.
AttributeName -> RelationalExprBase a -> RelationalExprBase a
Ungroup AttributeName
nameA (GraphRefRelationalExpr -> GraphRefRelationalExpr)
-> DatabaseContextEvalMonad GraphRefRelationalExpr
-> DatabaseContextEvalMonad GraphRefRelationalExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GraphRefRelationalExpr
-> DatabaseContextEvalMonad GraphRefRelationalExpr
forall a.
ResolveGraphRefTransactionMarker a =>
a -> DatabaseContextEvalMonad a
resolve GraphRefRelationalExpr
expr
  resolve (Restrict RestrictionPredicateExprBase GraphRefTransactionMarker
restrictExpr GraphRefRelationalExpr
relExpr) = RestrictionPredicateExprBase GraphRefTransactionMarker
-> GraphRefRelationalExpr -> GraphRefRelationalExpr
forall a.
RestrictionPredicateExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Restrict (RestrictionPredicateExprBase GraphRefTransactionMarker
 -> GraphRefRelationalExpr -> GraphRefRelationalExpr)
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (RestrictionPredicateExprBase GraphRefTransactionMarker)
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (GraphRefRelationalExpr -> GraphRefRelationalExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RestrictionPredicateExprBase GraphRefTransactionMarker
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (RestrictionPredicateExprBase GraphRefTransactionMarker)
forall a.
ResolveGraphRefTransactionMarker a =>
a -> DatabaseContextEvalMonad a
resolve RestrictionPredicateExprBase GraphRefTransactionMarker
restrictExpr RWST
  DatabaseContextEvalEnv
  ()
  DatabaseContextEvalState
  (ExceptT RelationalError Identity)
  (GraphRefRelationalExpr -> GraphRefRelationalExpr)
-> DatabaseContextEvalMonad GraphRefRelationalExpr
-> DatabaseContextEvalMonad GraphRefRelationalExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GraphRefRelationalExpr
-> DatabaseContextEvalMonad GraphRefRelationalExpr
forall a.
ResolveGraphRefTransactionMarker a =>
a -> DatabaseContextEvalMonad a
resolve GraphRefRelationalExpr
relExpr
  resolve (Equals GraphRefRelationalExpr
exprA GraphRefRelationalExpr
exprB) = GraphRefRelationalExpr
-> GraphRefRelationalExpr -> GraphRefRelationalExpr
forall a.
RelationalExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Equals (GraphRefRelationalExpr
 -> GraphRefRelationalExpr -> GraphRefRelationalExpr)
-> DatabaseContextEvalMonad GraphRefRelationalExpr
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (GraphRefRelationalExpr -> GraphRefRelationalExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GraphRefRelationalExpr
-> DatabaseContextEvalMonad GraphRefRelationalExpr
forall a.
ResolveGraphRefTransactionMarker a =>
a -> DatabaseContextEvalMonad a
resolve GraphRefRelationalExpr
exprA RWST
  DatabaseContextEvalEnv
  ()
  DatabaseContextEvalState
  (ExceptT RelationalError Identity)
  (GraphRefRelationalExpr -> GraphRefRelationalExpr)
-> DatabaseContextEvalMonad GraphRefRelationalExpr
-> DatabaseContextEvalMonad GraphRefRelationalExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GraphRefRelationalExpr
-> DatabaseContextEvalMonad GraphRefRelationalExpr
forall a.
ResolveGraphRefTransactionMarker a =>
a -> DatabaseContextEvalMonad a
resolve GraphRefRelationalExpr
exprB
  resolve (NotEquals GraphRefRelationalExpr
exprA GraphRefRelationalExpr
exprB) = GraphRefRelationalExpr
-> GraphRefRelationalExpr -> GraphRefRelationalExpr
forall a.
RelationalExprBase a
-> RelationalExprBase a -> RelationalExprBase a
NotEquals (GraphRefRelationalExpr
 -> GraphRefRelationalExpr -> GraphRefRelationalExpr)
-> DatabaseContextEvalMonad GraphRefRelationalExpr
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (GraphRefRelationalExpr -> GraphRefRelationalExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GraphRefRelationalExpr
-> DatabaseContextEvalMonad GraphRefRelationalExpr
forall a.
ResolveGraphRefTransactionMarker a =>
a -> DatabaseContextEvalMonad a
resolve GraphRefRelationalExpr
exprA RWST
  DatabaseContextEvalEnv
  ()
  DatabaseContextEvalState
  (ExceptT RelationalError Identity)
  (GraphRefRelationalExpr -> GraphRefRelationalExpr)
-> DatabaseContextEvalMonad GraphRefRelationalExpr
-> DatabaseContextEvalMonad GraphRefRelationalExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GraphRefRelationalExpr
-> DatabaseContextEvalMonad GraphRefRelationalExpr
forall a.
ResolveGraphRefTransactionMarker a =>
a -> DatabaseContextEvalMonad a
resolve GraphRefRelationalExpr
exprB
  resolve (Extend GraphRefExtendTupleExpr
extendExpr GraphRefRelationalExpr
relExpr) = GraphRefExtendTupleExpr
-> GraphRefRelationalExpr -> GraphRefRelationalExpr
forall a.
ExtendTupleExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Extend (GraphRefExtendTupleExpr
 -> GraphRefRelationalExpr -> GraphRefRelationalExpr)
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     GraphRefExtendTupleExpr
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (GraphRefRelationalExpr -> GraphRefRelationalExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GraphRefExtendTupleExpr
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     GraphRefExtendTupleExpr
forall a.
ResolveGraphRefTransactionMarker a =>
a -> DatabaseContextEvalMonad a
resolve GraphRefExtendTupleExpr
extendExpr RWST
  DatabaseContextEvalEnv
  ()
  DatabaseContextEvalState
  (ExceptT RelationalError Identity)
  (GraphRefRelationalExpr -> GraphRefRelationalExpr)
-> DatabaseContextEvalMonad GraphRefRelationalExpr
-> DatabaseContextEvalMonad GraphRefRelationalExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GraphRefRelationalExpr
-> DatabaseContextEvalMonad GraphRefRelationalExpr
forall a.
ResolveGraphRefTransactionMarker a =>
a -> DatabaseContextEvalMonad a
resolve GraphRefRelationalExpr
relExpr
  resolve (With WithNameAssocs
withExprs GraphRefRelationalExpr
relExpr) = WithNameAssocs -> GraphRefRelationalExpr -> GraphRefRelationalExpr
forall a.
[(WithNameExprBase a, RelationalExprBase a)]
-> RelationalExprBase a -> RelationalExprBase a
With (WithNameAssocs
 -> GraphRefRelationalExpr -> GraphRefRelationalExpr)
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     WithNameAssocs
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (GraphRefRelationalExpr -> GraphRefRelationalExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((WithNameExprBase GraphRefTransactionMarker,
  GraphRefRelationalExpr)
 -> RWST
      DatabaseContextEvalEnv
      ()
      DatabaseContextEvalState
      (ExceptT RelationalError Identity)
      (WithNameExprBase GraphRefTransactionMarker,
       GraphRefRelationalExpr))
-> WithNameAssocs
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     WithNameAssocs
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(WithNameExprBase GraphRefTransactionMarker
nam, GraphRefRelationalExpr
expr) -> (,) (WithNameExprBase GraphRefTransactionMarker
 -> GraphRefRelationalExpr
 -> (WithNameExprBase GraphRefTransactionMarker,
     GraphRefRelationalExpr))
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (WithNameExprBase GraphRefTransactionMarker)
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (GraphRefRelationalExpr
      -> (WithNameExprBase GraphRefTransactionMarker,
          GraphRefRelationalExpr))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WithNameExprBase GraphRefTransactionMarker
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (WithNameExprBase GraphRefTransactionMarker)
forall a.
ResolveGraphRefTransactionMarker a =>
a -> DatabaseContextEvalMonad a
resolve WithNameExprBase GraphRefTransactionMarker
nam RWST
  DatabaseContextEvalEnv
  ()
  DatabaseContextEvalState
  (ExceptT RelationalError Identity)
  (GraphRefRelationalExpr
   -> (WithNameExprBase GraphRefTransactionMarker,
       GraphRefRelationalExpr))
-> DatabaseContextEvalMonad GraphRefRelationalExpr
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (WithNameExprBase GraphRefTransactionMarker,
      GraphRefRelationalExpr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GraphRefRelationalExpr
-> DatabaseContextEvalMonad GraphRefRelationalExpr
forall a.
ResolveGraphRefTransactionMarker a =>
a -> DatabaseContextEvalMonad a
resolve GraphRefRelationalExpr
expr) WithNameAssocs
withExprs RWST
  DatabaseContextEvalEnv
  ()
  DatabaseContextEvalState
  (ExceptT RelationalError Identity)
  (GraphRefRelationalExpr -> GraphRefRelationalExpr)
-> DatabaseContextEvalMonad GraphRefRelationalExpr
-> DatabaseContextEvalMonad GraphRefRelationalExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GraphRefRelationalExpr
-> DatabaseContextEvalMonad GraphRefRelationalExpr
forall a.
ResolveGraphRefTransactionMarker a =>
a -> DatabaseContextEvalMonad a
resolve GraphRefRelationalExpr
relExpr

instance ResolveGraphRefTransactionMarker GraphRefTupleExprs where
  resolve :: GraphRefTupleExprs
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     GraphRefTupleExprs
resolve (TupleExprs GraphRefTransactionMarker
marker [TupleExprBase GraphRefTransactionMarker]
tupleExprs) =
    GraphRefTransactionMarker
-> [TupleExprBase GraphRefTransactionMarker] -> GraphRefTupleExprs
forall a. a -> [TupleExprBase a] -> TupleExprsBase a
TupleExprs GraphRefTransactionMarker
marker ([TupleExprBase GraphRefTransactionMarker] -> GraphRefTupleExprs)
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     [TupleExprBase GraphRefTransactionMarker]
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     GraphRefTupleExprs
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TupleExprBase GraphRefTransactionMarker
 -> RWST
      DatabaseContextEvalEnv
      ()
      DatabaseContextEvalState
      (ExceptT RelationalError Identity)
      (TupleExprBase GraphRefTransactionMarker))
-> [TupleExprBase GraphRefTransactionMarker]
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     [TupleExprBase GraphRefTransactionMarker]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM TupleExprBase GraphRefTransactionMarker
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (TupleExprBase GraphRefTransactionMarker)
forall a.
ResolveGraphRefTransactionMarker a =>
a -> DatabaseContextEvalMonad a
resolve [TupleExprBase GraphRefTransactionMarker]
tupleExprs

instance ResolveGraphRefTransactionMarker GraphRefTupleExpr where
  resolve :: TupleExprBase GraphRefTransactionMarker
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (TupleExprBase GraphRefTransactionMarker)
resolve (TupleExpr Map AttributeName GraphRefAtomExpr
tupMap) = do
    [(AttributeName, GraphRefAtomExpr)]
tupMap' <- ((AttributeName, GraphRefAtomExpr)
 -> RWST
      DatabaseContextEvalEnv
      ()
      DatabaseContextEvalState
      (ExceptT RelationalError Identity)
      (AttributeName, GraphRefAtomExpr))
-> [(AttributeName, GraphRefAtomExpr)]
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     [(AttributeName, GraphRefAtomExpr)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(AttributeName
attrName, GraphRefAtomExpr
expr) -> (,) AttributeName
attrName (GraphRefAtomExpr -> (AttributeName, GraphRefAtomExpr))
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     GraphRefAtomExpr
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (AttributeName, GraphRefAtomExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GraphRefAtomExpr
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     GraphRefAtomExpr
forall a.
ResolveGraphRefTransactionMarker a =>
a -> DatabaseContextEvalMonad a
resolve GraphRefAtomExpr
expr ) (Map AttributeName GraphRefAtomExpr
-> [(AttributeName, GraphRefAtomExpr)]
forall k a. Map k a -> [(k, a)]
M.toList Map AttributeName GraphRefAtomExpr
tupMap)
    TupleExprBase GraphRefTransactionMarker
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (TupleExprBase GraphRefTransactionMarker)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map AttributeName GraphRefAtomExpr
-> TupleExprBase GraphRefTransactionMarker
forall a. Map AttributeName (AtomExprBase a) -> TupleExprBase a
TupleExpr ([(AttributeName, GraphRefAtomExpr)]
-> Map AttributeName GraphRefAtomExpr
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(AttributeName, GraphRefAtomExpr)]
tupMap'))

instance ResolveGraphRefTransactionMarker GraphRefAttributeNames where
  resolve :: AttributeNamesBase GraphRefTransactionMarker
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (AttributeNamesBase GraphRefTransactionMarker)
resolve orig :: AttributeNamesBase GraphRefTransactionMarker
orig@AttributeNames{} = AttributeNamesBase GraphRefTransactionMarker
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (AttributeNamesBase GraphRefTransactionMarker)
forall (f :: * -> *) a. Applicative f => a -> f a
pure AttributeNamesBase GraphRefTransactionMarker
orig
  resolve orig :: AttributeNamesBase GraphRefTransactionMarker
orig@InvertedAttributeNames{} = AttributeNamesBase GraphRefTransactionMarker
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (AttributeNamesBase GraphRefTransactionMarker)
forall (f :: * -> *) a. Applicative f => a -> f a
pure AttributeNamesBase GraphRefTransactionMarker
orig
  resolve (UnionAttributeNames AttributeNamesBase GraphRefTransactionMarker
namesA AttributeNamesBase GraphRefTransactionMarker
namesB) = AttributeNamesBase GraphRefTransactionMarker
-> AttributeNamesBase GraphRefTransactionMarker
-> AttributeNamesBase GraphRefTransactionMarker
forall a.
AttributeNamesBase a
-> AttributeNamesBase a -> AttributeNamesBase a
UnionAttributeNames (AttributeNamesBase GraphRefTransactionMarker
 -> AttributeNamesBase GraphRefTransactionMarker
 -> AttributeNamesBase GraphRefTransactionMarker)
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (AttributeNamesBase GraphRefTransactionMarker)
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (AttributeNamesBase GraphRefTransactionMarker
      -> AttributeNamesBase GraphRefTransactionMarker)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AttributeNamesBase GraphRefTransactionMarker
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (AttributeNamesBase GraphRefTransactionMarker)
forall a.
ResolveGraphRefTransactionMarker a =>
a -> DatabaseContextEvalMonad a
resolve AttributeNamesBase GraphRefTransactionMarker
namesA RWST
  DatabaseContextEvalEnv
  ()
  DatabaseContextEvalState
  (ExceptT RelationalError Identity)
  (AttributeNamesBase GraphRefTransactionMarker
   -> AttributeNamesBase GraphRefTransactionMarker)
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (AttributeNamesBase GraphRefTransactionMarker)
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (AttributeNamesBase GraphRefTransactionMarker)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AttributeNamesBase GraphRefTransactionMarker
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (AttributeNamesBase GraphRefTransactionMarker)
forall a.
ResolveGraphRefTransactionMarker a =>
a -> DatabaseContextEvalMonad a
resolve AttributeNamesBase GraphRefTransactionMarker
namesB
  resolve (IntersectAttributeNames AttributeNamesBase GraphRefTransactionMarker
namesA AttributeNamesBase GraphRefTransactionMarker
namesB) = AttributeNamesBase GraphRefTransactionMarker
-> AttributeNamesBase GraphRefTransactionMarker
-> AttributeNamesBase GraphRefTransactionMarker
forall a.
AttributeNamesBase a
-> AttributeNamesBase a -> AttributeNamesBase a
IntersectAttributeNames (AttributeNamesBase GraphRefTransactionMarker
 -> AttributeNamesBase GraphRefTransactionMarker
 -> AttributeNamesBase GraphRefTransactionMarker)
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (AttributeNamesBase GraphRefTransactionMarker)
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (AttributeNamesBase GraphRefTransactionMarker
      -> AttributeNamesBase GraphRefTransactionMarker)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AttributeNamesBase GraphRefTransactionMarker
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (AttributeNamesBase GraphRefTransactionMarker)
forall a.
ResolveGraphRefTransactionMarker a =>
a -> DatabaseContextEvalMonad a
resolve AttributeNamesBase GraphRefTransactionMarker
namesA RWST
  DatabaseContextEvalEnv
  ()
  DatabaseContextEvalState
  (ExceptT RelationalError Identity)
  (AttributeNamesBase GraphRefTransactionMarker
   -> AttributeNamesBase GraphRefTransactionMarker)
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (AttributeNamesBase GraphRefTransactionMarker)
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (AttributeNamesBase GraphRefTransactionMarker)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AttributeNamesBase GraphRefTransactionMarker
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (AttributeNamesBase GraphRefTransactionMarker)
forall a.
ResolveGraphRefTransactionMarker a =>
a -> DatabaseContextEvalMonad a
resolve AttributeNamesBase GraphRefTransactionMarker
namesB
  resolve (RelationalExprAttributeNames GraphRefRelationalExpr
expr) = GraphRefRelationalExpr
-> AttributeNamesBase GraphRefTransactionMarker
forall a. RelationalExprBase a -> AttributeNamesBase a
RelationalExprAttributeNames (GraphRefRelationalExpr
 -> AttributeNamesBase GraphRefTransactionMarker)
-> DatabaseContextEvalMonad GraphRefRelationalExpr
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (AttributeNamesBase GraphRefTransactionMarker)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GraphRefRelationalExpr
-> DatabaseContextEvalMonad GraphRefRelationalExpr
forall a.
ResolveGraphRefTransactionMarker a =>
a -> DatabaseContextEvalMonad a
resolve GraphRefRelationalExpr
expr

instance ResolveGraphRefTransactionMarker GraphRefRestrictionPredicateExpr where
  resolve :: RestrictionPredicateExprBase GraphRefTransactionMarker
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (RestrictionPredicateExprBase GraphRefTransactionMarker)
resolve RestrictionPredicateExprBase GraphRefTransactionMarker
TruePredicate = RestrictionPredicateExprBase GraphRefTransactionMarker
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (RestrictionPredicateExprBase GraphRefTransactionMarker)
forall (f :: * -> *) a. Applicative f => a -> f a
pure RestrictionPredicateExprBase GraphRefTransactionMarker
forall a. RestrictionPredicateExprBase a
TruePredicate
  resolve (AndPredicate RestrictionPredicateExprBase GraphRefTransactionMarker
exprA RestrictionPredicateExprBase GraphRefTransactionMarker
exprB) = RestrictionPredicateExprBase GraphRefTransactionMarker
-> RestrictionPredicateExprBase GraphRefTransactionMarker
-> RestrictionPredicateExprBase GraphRefTransactionMarker
forall a.
RestrictionPredicateExprBase a
-> RestrictionPredicateExprBase a -> RestrictionPredicateExprBase a
AndPredicate (RestrictionPredicateExprBase GraphRefTransactionMarker
 -> RestrictionPredicateExprBase GraphRefTransactionMarker
 -> RestrictionPredicateExprBase GraphRefTransactionMarker)
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (RestrictionPredicateExprBase GraphRefTransactionMarker)
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (RestrictionPredicateExprBase GraphRefTransactionMarker
      -> RestrictionPredicateExprBase GraphRefTransactionMarker)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RestrictionPredicateExprBase GraphRefTransactionMarker
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (RestrictionPredicateExprBase GraphRefTransactionMarker)
forall a.
ResolveGraphRefTransactionMarker a =>
a -> DatabaseContextEvalMonad a
resolve RestrictionPredicateExprBase GraphRefTransactionMarker
exprA RWST
  DatabaseContextEvalEnv
  ()
  DatabaseContextEvalState
  (ExceptT RelationalError Identity)
  (RestrictionPredicateExprBase GraphRefTransactionMarker
   -> RestrictionPredicateExprBase GraphRefTransactionMarker)
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (RestrictionPredicateExprBase GraphRefTransactionMarker)
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (RestrictionPredicateExprBase GraphRefTransactionMarker)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RestrictionPredicateExprBase GraphRefTransactionMarker
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (RestrictionPredicateExprBase GraphRefTransactionMarker)
forall a.
ResolveGraphRefTransactionMarker a =>
a -> DatabaseContextEvalMonad a
resolve RestrictionPredicateExprBase GraphRefTransactionMarker
exprB
  resolve (OrPredicate RestrictionPredicateExprBase GraphRefTransactionMarker
exprA RestrictionPredicateExprBase GraphRefTransactionMarker
exprB) = RestrictionPredicateExprBase GraphRefTransactionMarker
-> RestrictionPredicateExprBase GraphRefTransactionMarker
-> RestrictionPredicateExprBase GraphRefTransactionMarker
forall a.
RestrictionPredicateExprBase a
-> RestrictionPredicateExprBase a -> RestrictionPredicateExprBase a
OrPredicate (RestrictionPredicateExprBase GraphRefTransactionMarker
 -> RestrictionPredicateExprBase GraphRefTransactionMarker
 -> RestrictionPredicateExprBase GraphRefTransactionMarker)
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (RestrictionPredicateExprBase GraphRefTransactionMarker)
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (RestrictionPredicateExprBase GraphRefTransactionMarker
      -> RestrictionPredicateExprBase GraphRefTransactionMarker)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RestrictionPredicateExprBase GraphRefTransactionMarker
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (RestrictionPredicateExprBase GraphRefTransactionMarker)
forall a.
ResolveGraphRefTransactionMarker a =>
a -> DatabaseContextEvalMonad a
resolve RestrictionPredicateExprBase GraphRefTransactionMarker
exprA RWST
  DatabaseContextEvalEnv
  ()
  DatabaseContextEvalState
  (ExceptT RelationalError Identity)
  (RestrictionPredicateExprBase GraphRefTransactionMarker
   -> RestrictionPredicateExprBase GraphRefTransactionMarker)
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (RestrictionPredicateExprBase GraphRefTransactionMarker)
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (RestrictionPredicateExprBase GraphRefTransactionMarker)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RestrictionPredicateExprBase GraphRefTransactionMarker
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (RestrictionPredicateExprBase GraphRefTransactionMarker)
forall a.
ResolveGraphRefTransactionMarker a =>
a -> DatabaseContextEvalMonad a
resolve RestrictionPredicateExprBase GraphRefTransactionMarker
exprB
  resolve (NotPredicate RestrictionPredicateExprBase GraphRefTransactionMarker
expr) = RestrictionPredicateExprBase GraphRefTransactionMarker
-> RestrictionPredicateExprBase GraphRefTransactionMarker
forall a.
RestrictionPredicateExprBase a -> RestrictionPredicateExprBase a
NotPredicate (RestrictionPredicateExprBase GraphRefTransactionMarker
 -> RestrictionPredicateExprBase GraphRefTransactionMarker)
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (RestrictionPredicateExprBase GraphRefTransactionMarker)
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (RestrictionPredicateExprBase GraphRefTransactionMarker)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RestrictionPredicateExprBase GraphRefTransactionMarker
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (RestrictionPredicateExprBase GraphRefTransactionMarker)
forall a.
ResolveGraphRefTransactionMarker a =>
a -> DatabaseContextEvalMonad a
resolve RestrictionPredicateExprBase GraphRefTransactionMarker
expr
  resolve (RelationalExprPredicate GraphRefRelationalExpr
expr) = GraphRefRelationalExpr
-> RestrictionPredicateExprBase GraphRefTransactionMarker
forall a. RelationalExprBase a -> RestrictionPredicateExprBase a
RelationalExprPredicate (GraphRefRelationalExpr
 -> RestrictionPredicateExprBase GraphRefTransactionMarker)
-> DatabaseContextEvalMonad GraphRefRelationalExpr
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (RestrictionPredicateExprBase GraphRefTransactionMarker)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GraphRefRelationalExpr
-> DatabaseContextEvalMonad GraphRefRelationalExpr
forall a.
ResolveGraphRefTransactionMarker a =>
a -> DatabaseContextEvalMonad a
resolve GraphRefRelationalExpr
expr
  resolve (AtomExprPredicate GraphRefAtomExpr
expr) = GraphRefAtomExpr
-> RestrictionPredicateExprBase GraphRefTransactionMarker
forall a. AtomExprBase a -> RestrictionPredicateExprBase a
AtomExprPredicate (GraphRefAtomExpr
 -> RestrictionPredicateExprBase GraphRefTransactionMarker)
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     GraphRefAtomExpr
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (RestrictionPredicateExprBase GraphRefTransactionMarker)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GraphRefAtomExpr
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     GraphRefAtomExpr
forall a.
ResolveGraphRefTransactionMarker a =>
a -> DatabaseContextEvalMonad a
resolve GraphRefAtomExpr
expr
  resolve (AttributeEqualityPredicate AttributeName
nam GraphRefAtomExpr
expr)= AttributeName
-> GraphRefAtomExpr
-> RestrictionPredicateExprBase GraphRefTransactionMarker
forall a.
AttributeName -> AtomExprBase a -> RestrictionPredicateExprBase a
AttributeEqualityPredicate AttributeName
nam (GraphRefAtomExpr
 -> RestrictionPredicateExprBase GraphRefTransactionMarker)
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     GraphRefAtomExpr
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (RestrictionPredicateExprBase GraphRefTransactionMarker)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GraphRefAtomExpr
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     GraphRefAtomExpr
forall a.
ResolveGraphRefTransactionMarker a =>
a -> DatabaseContextEvalMonad a
resolve GraphRefAtomExpr
expr

instance ResolveGraphRefTransactionMarker GraphRefExtendTupleExpr where
  resolve :: GraphRefExtendTupleExpr
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     GraphRefExtendTupleExpr
resolve (AttributeExtendTupleExpr AttributeName
nam GraphRefAtomExpr
atomExpr) = AttributeName -> GraphRefAtomExpr -> GraphRefExtendTupleExpr
forall a. AttributeName -> AtomExprBase a -> ExtendTupleExprBase a
AttributeExtendTupleExpr AttributeName
nam (GraphRefAtomExpr -> GraphRefExtendTupleExpr)
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     GraphRefAtomExpr
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     GraphRefExtendTupleExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GraphRefAtomExpr
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     GraphRefAtomExpr
forall a.
ResolveGraphRefTransactionMarker a =>
a -> DatabaseContextEvalMonad a
resolve GraphRefAtomExpr
atomExpr

instance ResolveGraphRefTransactionMarker GraphRefWithNameExpr where
  resolve :: WithNameExprBase GraphRefTransactionMarker
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (WithNameExprBase GraphRefTransactionMarker)
resolve orig :: WithNameExprBase GraphRefTransactionMarker
orig@WithNameExpr{} = WithNameExprBase GraphRefTransactionMarker
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (WithNameExprBase GraphRefTransactionMarker)
forall (f :: * -> *) a. Applicative f => a -> f a
pure WithNameExprBase GraphRefTransactionMarker
orig -- match uncommitted marker?

instance ResolveGraphRefTransactionMarker GraphRefAtomExpr where
  resolve :: GraphRefAtomExpr
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     GraphRefAtomExpr
resolve orig :: GraphRefAtomExpr
orig@AttributeAtomExpr{} = GraphRefAtomExpr
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     GraphRefAtomExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure GraphRefAtomExpr
orig
  resolve orig :: GraphRefAtomExpr
orig@NakedAtomExpr{} = GraphRefAtomExpr
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     GraphRefAtomExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure GraphRefAtomExpr
orig
  resolve (FunctionAtomExpr AttributeName
nam [GraphRefAtomExpr]
atomExprs GraphRefTransactionMarker
marker) =
    AttributeName
-> [GraphRefAtomExpr]
-> GraphRefTransactionMarker
-> GraphRefAtomExpr
forall a. AttributeName -> [AtomExprBase a] -> a -> AtomExprBase a
FunctionAtomExpr AttributeName
nam ([GraphRefAtomExpr]
 -> GraphRefTransactionMarker -> GraphRefAtomExpr)
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     [GraphRefAtomExpr]
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (GraphRefTransactionMarker -> GraphRefAtomExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (GraphRefAtomExpr
 -> RWST
      DatabaseContextEvalEnv
      ()
      DatabaseContextEvalState
      (ExceptT RelationalError Identity)
      GraphRefAtomExpr)
-> [GraphRefAtomExpr]
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     [GraphRefAtomExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM GraphRefAtomExpr
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     GraphRefAtomExpr
forall a.
ResolveGraphRefTransactionMarker a =>
a -> DatabaseContextEvalMonad a
resolve [GraphRefAtomExpr]
atomExprs RWST
  DatabaseContextEvalEnv
  ()
  DatabaseContextEvalState
  (ExceptT RelationalError Identity)
  (GraphRefTransactionMarker -> GraphRefAtomExpr)
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     GraphRefTransactionMarker
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     GraphRefAtomExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GraphRefTransactionMarker
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     GraphRefTransactionMarker
forall (f :: * -> *) a. Applicative f => a -> f a
pure GraphRefTransactionMarker
marker
  resolve (RelationAtomExpr GraphRefRelationalExpr
expr) = GraphRefRelationalExpr -> GraphRefAtomExpr
forall a. RelationalExprBase a -> AtomExprBase a
RelationAtomExpr (GraphRefRelationalExpr -> GraphRefAtomExpr)
-> DatabaseContextEvalMonad GraphRefRelationalExpr
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     GraphRefAtomExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GraphRefRelationalExpr
-> DatabaseContextEvalMonad GraphRefRelationalExpr
forall a.
ResolveGraphRefTransactionMarker a =>
a -> DatabaseContextEvalMonad a
resolve GraphRefRelationalExpr
expr
  resolve (ConstructedAtomExpr AttributeName
dConsName [GraphRefAtomExpr]
atomExprs GraphRefTransactionMarker
marker) =
    AttributeName
-> [GraphRefAtomExpr]
-> GraphRefTransactionMarker
-> GraphRefAtomExpr
forall a. AttributeName -> [AtomExprBase a] -> a -> AtomExprBase a
ConstructedAtomExpr AttributeName
dConsName ([GraphRefAtomExpr]
 -> GraphRefTransactionMarker -> GraphRefAtomExpr)
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     [GraphRefAtomExpr]
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     (GraphRefTransactionMarker -> GraphRefAtomExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (GraphRefAtomExpr
 -> RWST
      DatabaseContextEvalEnv
      ()
      DatabaseContextEvalState
      (ExceptT RelationalError Identity)
      GraphRefAtomExpr)
-> [GraphRefAtomExpr]
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     [GraphRefAtomExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM GraphRefAtomExpr
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     GraphRefAtomExpr
forall a.
ResolveGraphRefTransactionMarker a =>
a -> DatabaseContextEvalMonad a
resolve [GraphRefAtomExpr]
atomExprs RWST
  DatabaseContextEvalEnv
  ()
  DatabaseContextEvalState
  (ExceptT RelationalError Identity)
  (GraphRefTransactionMarker -> GraphRefAtomExpr)
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     GraphRefTransactionMarker
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     GraphRefAtomExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GraphRefTransactionMarker
-> RWST
     DatabaseContextEvalEnv
     ()
     DatabaseContextEvalState
     (ExceptT RelationalError Identity)
     GraphRefTransactionMarker
forall (f :: * -> *) a. Applicative f => a -> f a
pure GraphRefTransactionMarker
marker

--convert series of simple Union queries into MakeStaticRelation
-- this is especially useful for long, nested applications of Union with simple tuples
-- Union (MakeRelation x y) (MakeRelation x y') -> MakeRelation x (y + y')

--MakeRelationFromExprs Nothing (TupleExprs UncommittedContextMarker [TupleExpr (fromList [("name", NakedAtomExpr (TextAtom "steve"))])])

applyUnionCollapse :: GraphRefRelationalExpr -> GraphRefRelationalExpr
applyUnionCollapse :: GraphRefRelationalExpr -> GraphRefRelationalExpr
applyUnionCollapse = (Base GraphRefRelationalExpr GraphRefRelationalExpr
 -> GraphRefRelationalExpr)
-> GraphRefRelationalExpr -> GraphRefRelationalExpr
forall t a. Recursive t => (Base t a -> a) -> t -> a
Fold.cata Base GraphRefRelationalExpr GraphRefRelationalExpr
-> GraphRefRelationalExpr
RelationalExprBaseF
  GraphRefTransactionMarker GraphRefRelationalExpr
-> GraphRefRelationalExpr
opt
  where
    opt :: RelationalExprBaseF GraphRefTransactionMarker GraphRefRelationalExpr -> GraphRefRelationalExpr
    opt :: RelationalExprBaseF
  GraphRefTransactionMarker GraphRefRelationalExpr
-> GraphRefRelationalExpr
opt (UnionF GraphRefRelationalExpr
exprA GraphRefRelationalExpr
exprB) | GraphRefRelationalExpr
exprA GraphRefRelationalExpr -> GraphRefRelationalExpr -> DirtyFlag
forall a. Eq a => a -> a -> DirtyFlag
== GraphRefRelationalExpr
exprB = GraphRefRelationalExpr
exprA
    opt (UnionF
         exprA :: GraphRefRelationalExpr
exprA@(MakeRelationFromExprs Maybe [AttributeExprBase GraphRefTransactionMarker]
mAttrs1 GraphRefTupleExprs
tupExprs1)
         exprB :: GraphRefRelationalExpr
exprB@(MakeRelationFromExprs Maybe [AttributeExprBase GraphRefTransactionMarker]
mAttrs2 GraphRefTupleExprs
tupExprs2)) | GraphRefTupleExprs
tupExprs1 GraphRefTupleExprs -> GraphRefTupleExprs -> DirtyFlag
forall a. Eq a => a -> a -> DirtyFlag
== GraphRefTupleExprs
tupExprs2 = Maybe [AttributeExprBase GraphRefTransactionMarker]
-> GraphRefTupleExprs -> GraphRefRelationalExpr
forall a.
Maybe [AttributeExprBase a]
-> TupleExprsBase a -> RelationalExprBase a
MakeRelationFromExprs (Maybe [AttributeExprBase GraphRefTransactionMarker]
mAttrs1 Maybe [AttributeExprBase GraphRefTransactionMarker]
-> Maybe [AttributeExprBase GraphRefTransactionMarker]
-> Maybe [AttributeExprBase GraphRefTransactionMarker]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe [AttributeExprBase GraphRefTransactionMarker]
mAttrs2) GraphRefTupleExprs
tupExprs1
                                                    | GraphRefTupleExprs -> DirtyFlag
forall a. TupleExprsBase a -> DirtyFlag
tupExprsNull GraphRefTupleExprs
tupExprs1 = GraphRefRelationalExpr
exprB
                                                    | GraphRefTupleExprs -> DirtyFlag
forall a. TupleExprsBase a -> DirtyFlag
tupExprsNull GraphRefTupleExprs
tupExprs2 = GraphRefRelationalExpr
exprA
    opt RelationalExprBaseF
  GraphRefTransactionMarker GraphRefRelationalExpr
x = Base GraphRefRelationalExpr GraphRefRelationalExpr
-> GraphRefRelationalExpr
forall t. Corecursive t => Base t t -> t
Fold.embed Base GraphRefRelationalExpr GraphRefRelationalExpr
RelationalExprBaseF
  GraphRefTransactionMarker GraphRefRelationalExpr
x
    tupExprsNull :: TupleExprsBase a -> DirtyFlag
tupExprsNull (TupleExprs a
_ []) = DirtyFlag
True
    tupExprsNull TupleExprsBase a
_ = DirtyFlag
False


--UPDATE optimization- find matching where clause in "lower" levels of renaming
--update x where y=1 set (x:=5,z:=10); update x where y=1 set(x:=6,z:=11)
-- =>
-- update x where y=1 set (x:=6,z:=11)
-- future opt: match individual attributes update x where y=1 set (x:=5); update x where y=1 set (z:=11) => update x where y=1 set (x:=5,z:=11)

--strategy: try to collapse the top-level update (union (restrict pred MakeRelationFromExpr) expr) if it contains the same predicate and resultant relation

--DELETE optimization
-- if a restriction matches a previous restriction, combine them
-- O(1) since it only scans at the top level, critical in benchmarks generating redundant deletions
applyRestrictionCollapse :: GraphRefRelationalExpr -> GraphRefRelationalExpr
applyRestrictionCollapse :: GraphRefRelationalExpr -> GraphRefRelationalExpr
applyRestrictionCollapse orig :: GraphRefRelationalExpr
orig@(Restrict npred :: RestrictionPredicateExprBase GraphRefTransactionMarker
npred@(NotPredicate RestrictionPredicateExprBase GraphRefTransactionMarker
_) GraphRefRelationalExpr
expr) =
  case GraphRefRelationalExpr
expr of
    orig' :: GraphRefRelationalExpr
orig'@(Restrict npred' :: RestrictionPredicateExprBase GraphRefTransactionMarker
npred'@(NotPredicate RestrictionPredicateExprBase GraphRefTransactionMarker
_) GraphRefRelationalExpr
_) | RestrictionPredicateExprBase GraphRefTransactionMarker
npred RestrictionPredicateExprBase GraphRefTransactionMarker
-> RestrictionPredicateExprBase GraphRefTransactionMarker
-> DirtyFlag
forall a. Eq a => a -> a -> DirtyFlag
== RestrictionPredicateExprBase GraphRefTransactionMarker
npred' -> GraphRefRelationalExpr
orig'
    GraphRefRelationalExpr
_ -> GraphRefRelationalExpr
orig
applyRestrictionCollapse GraphRefRelationalExpr
expr = GraphRefRelationalExpr
expr